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