home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / x / volume17 / tcl-editor / part02 / tclLib / makeMenus.tcl < prev    next >
Encoding:
Text File  |  1992-03-18  |  3.4 KB  |  110 lines
  1. #
  2. #
  3. # Make the menus and menu bars
  4. #
  5. #
  6. proc MakeMenubar {name menuString} {
  7.     global raised bd
  8.     frame $name -relief $raised -bd $bd
  9.     foreach item $menuString {
  10.         set kind [lindex $item 0]
  11.         set buttonName "[lindex $item 1]"
  12.         case $kind in \
  13.         "button"    {MakeButton $name.$buttonName \
  14.                 "[lindex $item 2]" "[lindex $item 3]" } \
  15.         "menu"      {MakeMenu $name.$buttonName \
  16.                 "[lindex $item 2]" "[lindex $item 3]" }
  17.         pack append $name $name.$buttonName {left fill}
  18.     }
  19. }
  20.  
  21. proc MakeButton {name text cmd} {
  22.     global raised bd
  23.     button $name -text "$text" -relief $raised -bd $bd
  24.     bind $name <Any-Enter> {global insideButton;set insideButton 1}
  25.     bind $name <Any-Leave> {global insideButton;set insideButton 0}
  26.     bind $name <Any-ButtonRelease-1> "+execButton $name \{[lindex $cmd 0]\}"
  27.     bind $name <Any-ButtonRelease-2> "execButton $name \{[lindex $cmd 1]\}"
  28.     bind $name <Any-ButtonRelease-3> "execButton $name \{[lindex $cmd 2]\}"
  29. }
  30.  
  31. proc MakeMenuItems {name menuString} {
  32.     set n 0
  33.     foreach item $menuString {
  34.         set kind [lindex $item 0]
  35.         case $kind in {
  36.         "cascade"   {
  37.             $name add cascade -label [lindex $item 1] \
  38.                 -menu $name.$n
  39.             menu $name.$n 
  40.             bind.menu $name.$n
  41.             if {[llength [lindex $item 2]]==1} then {
  42.                 set m [lindex $item 2]
  43.                 global $m
  44.                 MakeMenuItems $name.$n [set $m]
  45.             } else {
  46.                 MakeMenuItems $name.$n [lindex $item 2]
  47.             }
  48.         }
  49.         "separator" { $name add separator }
  50.         "command"   {MakeCommand $name \
  51.             [lindex $item 1] [lindex $item 2] }
  52.         "check"     {MakeCheck $name $n \
  53.             [lindex $item 1]  [lindex $item 2] [lindex $item 3] }
  54.         "radio"     {MakeRadio $name $n \
  55.             [lindex $item 1]  [lindex $item 2] \
  56.             [lindex $item 3]  [lindex $item 4] }
  57.         }
  58.         if "[string compare $kind "separator"] != 0" \
  59.             {set n [expr $n+1]}
  60.     }
  61. }
  62.  
  63. proc MakeCommand {name text cmd} {
  64.     $name add command -label "$text" -command "$cmd"
  65. }
  66.  
  67. proc MakeCheck {name index text variable cmd} {
  68.     global $variable
  69.     $name add checkbutton -label "$text" -variable $variable \
  70.                             -command "$cmd"
  71.     set xx [Option get $variable]
  72.     if {$xx!=[set $variable]} {catch {$name invoke $index}}
  73. }
  74.  
  75. proc MakeRadio {name index text variable value cmd} {
  76.     global $variable
  77.     $name add radio -label "$text" -variable $variable -value $value \
  78.         -command $cmd
  79.     if ![string compare "[Option get $variable]" "$value"] {
  80.         catch {$name invoke $index}
  81.     }
  82. }
  83.  
  84. proc MakeMenu {name text menuString} {
  85.     global raised bd
  86.     global menuBarButton
  87.     menubutton $name -text $text -relief $raised -bd $bd -menu $name.m
  88.     menu $name.m
  89.     bind $name <Any-Enter> "set postedMenu {};$name activate"
  90.     bind $name <Any-B1-Enter> "set menuBarButton 1;$name activate; $name post"
  91.     bind $name <Any-B3-Enter> "set menuBarButton 3;$name activate; $name post"
  92.     bind $name <Any-B1-Leave> "$name deactivate"
  93.     bind $name <Any-B3-Leave> "$name deactivate"
  94.     bind $name <Shift-B1-Leave> "$name deactivate"
  95.     bind $name <Shift-B3-Leave> "$name deactivate"
  96.     bind $name <Any-Leave> "$name deactivate"
  97.     bind $name <Any-1> "set menuBarButton 1;$name post"
  98.     bind $name <Any-3> "set menuBarButton 3;$name post"
  99.     bind $name <Shift-1> "set menuBarButton 1;$name.m post %X %Y"
  100.     bind $name <Shift-3> "set menuBarButton 3;$name.m post %X %Y"
  101.     bind $name <Any-ButtonRelease-1> "$name unpost"
  102.     bind $name <Any-ButtonRelease-3> "$name unpost"
  103.     bind $name <Shift-B1-Motion> "set menuBarButton 1;$name.m post %X %Y"
  104.     bind $name <Shift-B3-Motion> "set menuBarButton 1;$name.m post %X %Y"
  105.     global $menuString
  106.     MakeMenuItems $name.m [set $menuString]
  107.     bind.menu $name.m
  108. }
  109.  
  110.