| ︙ | | |
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
+
|
# -cmd for -command
# command part is put through "subst"
# -acc for -accelerator
# Will bind <Key-acc> to command unless -accelerator
# -def for default value of -var
# checkbuttons default to default 0
# radiobuttons default to first value seen
# if/else commands can be included
package require psmenu
psmenu::psmenu . {
# Comments are ok
# If an argument looks like a "body" this is a cascade
"&File" {
"&Copy Solver URL" -cmd copySolverUrl
# Separator is --*
|
| ︙ | | |
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
+
+
+
|
# Individual example
"6" -value 6 -var ::ruleset(gridsize) -cmd newGame
}
}
# checkbutton has a -var and possibly -cmd, -onvalue, -offvalue
"Conflict Check" -var ::uiData(conflict) -cmd autoConflict
}
}
# More calls with more cascades work
psmenu::psmenu . {
"&Debug" {
"Reread &Source" -acc F1 -cmd _rs
}
}
}
# Main call for psmenu. Optional arguments are for internal use.
|
| ︙ | | |
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
-
-
+
+
+
+
|
}
# It might exists for a second user call
if { ! [winfo exists $m]} {
# Create
menu $m -tearoff 0
}
if {$Toplevel eq ""} {
# Store inital level to handle scope when recursing cascades
if {$Level eq ""} {
# Store initial level to handle scope when recursing cascades
set Level [uplevel 1 info level]
}
if {$Toplevel eq ""} {
set Toplevel $top
$top configure -menu $m
}
# Comments in definition block
set def [regsub -all -line {^\s*#.*$} $def ""]
|
| ︙ | | |
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
|
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
|
+
+
+
+
+
+
-
+
|
}
}
# TK helper to handle & in label
::tk::AmpMenuArgs $m add $type {*}$newOptions
if {$doBind ne ""} {
if {[regexp {^(.*)-(.*)$} $doBind -> pre post]} {
set doBind $pre-Key-$post
} else {
set doBind Key-$doBind
}
#puts "Binding '$doBind' '$command'"
bind $Toplevel <Key-$doBind> $command
bind $Toplevel <$doBind> $command
}
}
return $m
}
# Extract one entry from definiton
|
| ︙ | | |