1set _MenuData(next) 0 2 3proc menubar_create {menulist {top .}} { 4 global _MenuData tcl_platform bgColor 5 6 if {$top == "." || $top == ""} { 7 set mw .menubar 8 set ms .menusep 9 } else { 10 set mw $top.menubar 11 set ms $top.menusep 12 } 13 14 set _MenuData(menu) $mw 15 set _MenuData(list) "" 16 17 if {$tcl_platform(platform) == "windows"} { 18 menu $mw -tearoff 0 -relief flat -type menubar 19 foreach j $menulist { 20 set i [string tolower $j] 21 lappend _MenuData(list) $i 22 set m m$_MenuData(next) 23 incr _MenuData(next) 24 $mw add cascade -label $j -menu $mw.$m -underline 0 25 menu $mw.$m -tearoff 0 26 set _MenuData($i,menu) $mw.$m 27 } 28 . configure -menu $mw 29 } else { 30 frame $mw -relief flat -bg $bgColor(button) 31 pack $mw -side top -fill x 32 foreach j $menulist { 33 set i [string tolower $j] 34 lappend _MenuData(list) $i 35 set m m$_MenuData(next) 36 incr _MenuData(next) 37 menubutton $mw.$m -text $j -menu $mw.$m.menu -pady 0 \ 38 -highlightthickness 0 -underline 0 39 pack $mw.$m -side left -padx 5 40 menu $mw.$m.menu -tearoff 0 41 set _MenuData($i,menu) $mw.$m.menu 42 } 43 } 44 45 frame $ms -bd 1 -height 2 -relief sunken 46 pack $ms -side top -fill x 47} 48 49proc menubar_add {menu {before ""}} { 50 global tcl_platform _MenuData bgColor 51 52 set i [string tolower $menu] 53 if {[info exists _MenuData($i,menu)]} { 54 return $_MenuData($i,menu) 55 } 56 set where "" 57 if {$before != ""} { 58 set before [string tolower $before] 59 set n [lsearch $_MenuData(list) $before] 60 if {$n >= 0} {set where $n} 61 } 62 set mw $_MenuData(menu) 63 set m m$_MenuData(next) 64 incr _MenuData(next) 65 66 if {$tcl_platform(platform) == "windows"} { 67 if {$where == ""} { 68 $mw add cascade -label $menu -menu $mw.$m -underline 0 69 } else { 70 $mw insert $where cascade -label $menu -menu $mw.$m -underline 0 71 } 72 set _MenuData($i,menu) $mw.$m 73 } else { 74 menubutton $mw.$m -text $menu -menu $mw.$m.menu -pady 0 \ 75 -highlightthickness 0 -underline 0 76 if {$where == ""} { 77 pack $mw.$m -side left -padx 5 78 } else { 79 pack $mw.$m -side left -padx 5 \ 80 -before [winfo parent $_MenuData($before,menu)] 81 } 82 set _MenuData($i,menu) $mw.$m.menu 83 } 84 85 menu $_MenuData($i,menu) -tearoff 0 86 if {$where == ""} { 87 lappend _MenuData(list) $i 88 } else { 89 set _MenuData(list) [linsert $_MenuData(list) $where $i] 90 } 91 return $_MenuData($i,menu) 92} 93 94proc menubar_delete {menu} { 95 global _MenuData tcl_platform 96 97 set i [string tolower $menu] 98 set n [lsearch $_MenuData(list) $i] 99 if {$n < 0} return 100 if {$tcl_platform(platform) == "windows"} { 101 $_MenuData(menu) delete $n $n 102 } else { 103 set m [winfo parent $_Menudata($i,menu)] 104 pack forget $m 105 destroy $m 106 } 107 set _MenuData(list) [lreplace $_MenuData(list) $n $n] 108} 109 110proc menubar_get {menu} { 111 global _MenuData 112 set i [string tolower $menu] 113 if {[lsearch $_MenuData(list) $i] >= 0} { 114 return $_MenuData($i,menu) 115 } 116 return "" 117} 118 119proc menubar_state {menu state {entry ""}} { 120 global _MenuData tcl_platform 121 122 set i [string tolower $menu] 123 set n [lsearch $_MenuData(list) $i] 124 if {$n < 0} return 125 if {$entry != ""} { 126 $_MenuData($i,menu) entryconfigure $entry -state $state 127 } elseif {$tcl_platform(platform) == "windows"} { 128 $_MenuData(menu) entryconfigure $n -state $state 129 } else { 130 [winfo parent $_MenuData($i,menu)] configure -state $state 131 } 132} 133 134