1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
# menu.tcl -- Make TkDVI menu bars.
# Copyright 1999 Anselm Lingnau.
# See file COPYING for conditions on use and distribution.
# $Id: menu.tcl,v 1.3 2000/07/05 08:47:36 lingnau Exp $
#
# This code borrows heavily from Brent Welch's book. Thanks Brent!
package provide tkdvi::menu 1.0
namespace eval tkdvi::menu {
proc menubar {name {top {}}} {
variable Menu
set m [menu $name]
foreach b [option get $m menulist {}] {
if [catch {menu $m.$b}] {
menu $m.$b -font fixed
}
set label [option get $m.$b text {}]
set ul [string first & $label]
regsub {&} $label {} label
set cmd [list $m add cascade -label $label -menu $m.$b]
if [catch $cmd t] {
eval $cmd {-font fixed}
}
if {$ul >= 0} {
$m entryconfigure end -underline $ul
}
define $m.$b $top
}
}
proc define {menu {top {}}} {
variable Menu
foreach e [option get $menu entrylist {}] {
if {$e == "-"} {
$menu add separator
continue
}
set onv 1
set offv 0
set l [option get $menu l_$e {}]
set ul [string first & $l]
regsub {&} $l {} l
set c [option get $menu c_$e {}]
set v [option get $menu v_$e {}]
set onv [option get $menu onv_$e {}]
set offv [option get $menu offv_$e {}]
set accel [option get $menu a_$e {}]
regsub -all {%T} $c $top c
regsub -all {%M} $c $menu c
regsub -all {%T} $v $top v
regsub -all {%M} $v $menu v
switch -- [option get $menu t_$e {}] {
check {
$menu add checkbutton -label $l -variable $v
if {$c != {}} {
$menu entryconfigure end -command $c
}
if {$onv != {}} {
$menu entryconfigure end -onvalue $onv
}
if {$offv != {}} {
$menu entryconfigure end -offvalue $offv
}
}
radio {
$menu add radiobutton -label $l -variable $v -value $e
}
cascade {
set sub [option get $menu m_$e {}]
set post [option get $menu p_$e {}]
if {$post != {}} {
regsub -all {%T} $post $top post
regsub -all {%S} $post $menu.$sub post
set submenu [menu $menu.$sub -postcommand $post]
$menu add cascade -label $l -menu $submenu
} elseif {[string length $sub] != 0} {
set submenu [menu $menu.$sub]
regsub -all {%S} $c $submenu c
$menu add cascade -label $l -command $c -menu $submenu
define $submenu $top
}
}
default {
$menu add command -label $l -command $c
}
}
if {$ul >= 0} {
$menu entryconfigure end -underline $ul
}
if {[string length $accel] > 0} {
$menu entryconfigure end -accelerator $accel
}
set Menu($l) [list $menu [$menu index end]]
}
}
proc finditem {title} {
variable Menu
set result {}
foreach i [array names Menu $title] {
set result [concat $result $Menu($i)]
}
return $result
}
}
|
