# jmenu.tcl - procedures to manage menus
#
######################################################################
# Copyright 1992-1998 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.     #
######################################################################

# the import 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 aq
  namespace eval ::aq { }			;# so namespace is defined
}

######################################################################
# j:menu:menubutton mb menu key -
#   create a menubutton with an appropriate label and underline
#   position from the nls database.
#   creates both the menubutton and the menu.
######################################################################

proc j:menu:menubutton { mb menu key } {
  menubutton $mb -menu $menu \
    -text [uplevel 1 [list = $key]] \
    -underline [::jldb::underline $key]
  menu $menu
  
  return $mb
}

######################################################################
# j:menu:commands menu w cmds - 
#   create a menu entry to perform a command procedure
######################################################################

proc j:menu:commands { menu w cmds } {
  foreach cmd $cmds {
    if {"x$cmd" == "x-"} {
      $menu add separator
    } else {
      $menu add command \
        -label [uplevel 1 [list = $cmd]] \
        -underline [::jldb::underline $cmd] \
        -accelerator [::jldb::accelerator $cmd] \
        -command [list $cmd $w]
    }
  }
}

# alias for j:menu:commands, more natural when adding one command:

proc j:menu:command \
  [info args j:menu:commands] \
  [info body j:menu:commands]

######################################################################
# j:menu:checkbuttons menu ?-command cmd? { {key variable}... } -
#   create checkbutton menu entries.
######################################################################

proc j:menu:checkbuttons { args } {
  ::aq::parse_args {
    {command {}}
  }
  if { [llength $args] != 2 } {
    error [= misc:badargs]
  }
  
  set menu [lindex $args 0]
  set list [lindex $args 1]
  
  foreach pair $list {
    if {"x$pair" == "x-"} {
      $menu add separator
      continue
    }
    
    set key [lindex $pair 0]
    set var_name [lindex $pair 1]
    
    if {"x$command" == "x"} {
      $menu add checkbutton \
        -label [uplevel 1 [list = $key]] \
        -underline [::jldb::underline $key] \
        -accelerator [::jldb::accelerator $key] \
        -variable $var_name
    } else {
      $menu add checkbutton \
        -command $command \
        -label [uplevel 1 [list = $key]] \
        -underline [::jldb::underline $key] \
        -accelerator [::jldb::accelerator $key] \
        -variable $var_name
    }
  }
}

# alias for j:menu:checkbuttons, more natural when adding one entry:

proc j:menu:checkbutton \
  [info args j:menu:checkbuttons] \
  [info body j:menu:checkbuttons]

######################################################################
# j:menu:radiobuttons menu ?options? list -
#   create checkbutton menu entries
# options are -command tclCommand and -variable globalVar
# list is a list of {key value ?variable?} sublists
######################################################################

proc j:menu:radiobuttons { args } {
  ::aq::parse_args {
    {command {}}
    {variable VAR}
  }
  if { [llength $args] != 2 } {
    error [= misc:badargs]
  }
  
  set menu [lindex $args 0]
  set list [lindex $args 1]
  
  foreach sublist $list {
    if {"x$sublist" == "x-"} {
      $menu add separator
      continue
    }
    
    set key [lindex $sublist 0]
    set var_value [lindex $sublist 1]
    set var_name [lindex $sublist 2]
    
    if {"x$var_name" == "x"} {
      set var_name $variable
    }
    
    if {"x$command" == "x"} {
      $menu add radiobutton \
        -label [uplevel 1 [list = $key]] \
        -underline [::jldb::underline $key] \
        -accelerator [::jldb::accelerator $key] \
        -variable $var_name \
        -value $var_value
    } else {
      $menu add radiobutton \
        -command $command \
        -label [uplevel 1 [list = $key]] \
        -underline [::jldb::underline $key] \
        -accelerator [::jldb::accelerator $key] \
        -variable $var_name \
        -value $var_value
    }
  }
}

# alias for j:menu:radiobuttons, more natural when adding one entry:

proc j:menu:radiobutton \
  [info args j:menu:radiobuttons] \
  [info body j:menu:radiobuttons]

######################################################################
# j:menu:docs menu {{key docfile}...} - 
#   create menu entries to look up documentation
######################################################################

proc j:menu:docs { menu docpairs } {
# kludge to fix Tcl 8.0a1 bug:
  set docpairs [format %s $docpairs]
  foreach pair $docpairs {
    if {"x$pair" == "x-"} {
      $menu add separator
    } else {
      set key [lindex $pair 0]
      set doc [lindex $pair 1]
      $menu add command \
        -label [uplevel 1 [list = $key]] \
        -underline [::jldb::underline $key] \
        -accelerator [::jldb::accelerator $key] \
        -command [list exec jdoc $doc &]
    }
  }
}

