# jcommand.tcl - procedures to manage user-invokable commands
#
######################################################################
# Copyright 1992-199 by Jay Sekora.  This file may be freely        #
# distributed, modified or unmodified, for any purpose, provided     #
# that this copyright notice is retained verbatim in all copies and  #
# no attempt is made to obscure the authorship of this file.  If you #
# distribute any modified versions, I ask, but do not require, that  #
# you clearly mark any changes you make as such and that you provide #
# your users with instructions for getting the original sources.     #
######################################################################

# THIS IS A BIG PROBLEM until this whole file gets wrapped in its own
# namespace:

catch {
  package require jldb
  # following likely to fail, because done by other libraries too
  namespace import ::jldb::shortcuts::*
}

catch {
  package require jstools
  namespace eval ::jstools { }			;# so namespace is defined
}

######################################################################
# j:command:register cmd ?name? - 
#   register the existence of a command procedure
######################################################################

proc j:command:register { cmd {defaultname {}} } {
  ::jstools::debug
  global J_CMDS
  set J_CMDS($cmd) 1
  
  if {[string length $defaultname]} {
    ::jldb::set_defaults [list [list $cmd $defaultname]]
  }
}

######################################################################
# j:command:list - list all currently-registered command procedures
######################################################################

proc j:command:list {} {
  ::jstools::debug
  global J_CMDS
  return [array names J_CMDS]
}

######################################################################
# j:command:button b cmd w - create a button to perform a command procedure
######################################################################

proc j:command:button { b w cmd } {
  ::jstools::debug
  set text [::jldb::short_text $cmd]
  set width [expr [string length $text] + 1]
  if {$width < 8} {set width 8}
  
  button $b \
    -width $width \
    -text $text \
    -command [list $cmd $w]
  
  return $b
}

######################################################################
# j:command:buttonbar ?options? frame w commands -
#   make a buttonbar packed in frame to execute commands on w
######################################################################

proc j:command:buttonbar {args} {
  ::jstools::debug "j:command:buttonbar $args"
  ::jstools::parse_args {
    {default "(NONE)"}
    {padx 5}
    {pady 5}
    {orient horizontal}
  }

  if {[llength $args] != 3} {
    error [= misc:badargs {Improper arguments}]
  }
  
  set newframe [lindex $args 0]
  set w [lindex $args 1]
  set commands [lindex $args 2]
  
  if {$orient == "horizontal"} {
    set side right				;# for packing
  } else {
    set side bottom				;# for packing
  }

  frame $newframe
  if {$padx} {
    pack [::jstools::filler $newframe -width $padx] -in $newframe -side left
    pack [::jstools::filler $newframe -width $padx] -in $newframe -side right
  }
  if {$pady} {
    pack [::jstools::filler $newframe -height $pady] -in $newframe -side top
    pack [::jstools::filler $newframe -height $pady] -in $newframe -side bottom
  }
  
  foreach cmd $commands {
    set button $newframe.$cmd
    j:command:button $button $w $cmd
    set border $newframe.border_$cmd
    frame $border -relief flat -borderwidth 1
    raise $button
    pack $button -in $border -padx 2 -pady 2
    pack $border -in $newframe -side $side -padx 2
    if {[string match $default $cmd]} {
      $border configure -relief sunken
    }
  }
  return $newframe
}

######################################################################
# j:command:bind widgets w cmds - set up bindings for command accelerators
######################################################################

proc j:command:bind { widgets w cmds } {
  ::jstools::debug
  foreach cmd $cmds {
    set binding [::jldb::binding $cmd]
    if {"x$binding" != "x"} {
      foreach widget $widgets {
        if {[catch {bind $widget $binding [list $cmd $w]} error]} {
          ::jstools::debug "binding of $binding failed: $error"
        }
      }
    }
  }
}


