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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
|
# copyright (C) 1997-2005 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu
# $Id: modgui.tcl,v 2.57 2005/01/02 00:45:07 jfontain Exp $
class moduleOperations {
variable internal ;# internally used options to hide in interface
set internal(--daemon) {}
proc moduleOperations {this action} { ;# action can be display, load or manage
if {[info exists (displayed)]} {
delete $($(displayed),dialog) ;# only a single module operations dialog box can be active at a time
}
set (displayed) $this
switch $action {
display {set others {}}
load {set others load}
manage {set others {unload reload new}}
default {error "bad action $action"}
}
set dialog [new dialogBox .\
-buttons hx -default x -helpcommand "moduleOperations::help $this" -x [winfo pointerx .] -y [winfo pointery .]\
-grab release -deletecommand "delete $this" -closecommand "moduleOperations::close $this" -otherbuttons $others\
]
wm geometry $widget::($dialog,path) 400x200
set frame [frame $widget::($dialog,path).frame]
set ($this,label) [label $frame.label -font $font::(mediumNormal) -anchor nw]
grid $($this,label) -row 0 -column 0 -sticky nw -columnspan 2
set list [new scrollList $frame -font $font::(mediumBold) -width 0]
grid $widget::($list,path) -row 1 -column 0 -sticky nws
set entries [frame $frame.entries]
# use a table in order to be able to combine expanding entries and a scrollbar:
set container [table $entries.container\
-colstretchmode last -rows 0 -cols 2 -highlightthickness 0 -takefocus 0 -borderwidth 0 -cursor {} -bordercursor {}\
-padx 1 -pady 1 -state disabled -exportselection 0\
]
$container tag configure sel -background {} ;# so that selection on sole row is invisible initially
set scroll [scrollbar $entries.scroll -orient vertical -highlightthickness 0]
$container configure -yscrollcommand "moduleOperations::updateScrollBar $scroll"
$scroll configure -command "$container yview"
grid rowconfigure $entries 0 -weight 1
grid columnconfigure $entries 0 -weight 1
grid $container -row 0 -column 0 -sticky nsew
set ($this,container) $container
grid rowconfigure $frame 1 -weight 1
grid columnconfigure $frame 1 -weight 1
grid $entries -row 1 -column 1 -columnspan 2 -sticky nsew
dialogBox::display $dialog $frame
set ($this,dialog) $dialog
set ($this,frame) $frame
set ($this,list) $list
set ($this,action) $action
set ($this,tips) {}
lappend ($this,tips) [new widgetTip\
-path $composite::($dialog,help,path) -text [mc {display help on this dialog box or on selected module}]\
]
switch $action {
display {
composite::configure $dialog -title [mc {moodss: Loaded modules}]
loaded $this
}
load {
composite::configure $dialog -title [mc {moodss: Load modules}]
composite::configure $dialog load -text [mc Load] -command "moduleOperations::load $this" -state disabled
lappend ($this,tips)\
[new widgetTip -path $composite::($dialog,load,path) -text [mc {load selected module with specified options}]]
discover $this
}
manage {
composite::configure $dialog -title [mc {moodss: Manage modules}]
composite::configure $dialog unload -text [mc Unload] -command "moduleOperations::unload $this"
composite::configure $dialog reload -text [mc Reload] -command "moduleOperations::reload $this"
composite::configure $dialog new -text [mc New]\
-command "moduleOperations::load $this; moduleOperations::loaded $this"
lappend ($this,tips)\
[new widgetTip -path $composite::($dialog,unload,path) -text [mc {unload selected module}]]\
[new widgetTip -path $composite::($dialog,reload,path)\
-text [mc {unload the selected module then load a new instance using the updated parameters}]\
]\
[new widgetTip -path $composite::($dialog,new,path)\
-text [mc {load a new instance of the selected module using the updated parameters}]\
]
loaded $this
}
}
set ($this,index) {} ;# selected listbox index
}
proc ~moduleOperations {this} {
eval delete $($this,tips)
delete $($this,list) ;# delete objects other than dialog box
unset (displayed)
}
proc discover {this} {
variable internal
if {![info exists (discoveredModules)]} { ;# cache modules and their switches during the lifetime of the application
$($this,label) configure -text [mc {searching for modules...}]
busy 1 $($this,frame) ;# show user that we are busy
update ;# we could use idle tasks update here but it does not work well on windows
set format [mc {scanning module %s...}]
modules::available "
lappend moduleOperations::(discoveredModules) %M
set moduleOperations::(%M,discoveredSwitches) %S ;# save module switches for caching
scrollList::insert $($this,list) 0 %M ;# display just discovered module first
update idletasks ;# keep refreshing while preventing interruptions
" "
$($this,label) configure -text \[format {$format} %M\] ;# show scanned module for better user feedback
update idletasks ;# keep refreshing while preventing interruptions
"
busy 0 $($this,frame)
}
if {[info exists (discoveredModules)]} {
$($this,label) configure -text [mc {Select module (view its documentation with Help button):}]
update idletasks
set modules [lsort -dictionary $(discoveredModules)] ;# sort modules for easy navigation
set index 0
foreach module $modules {
set switches {}
foreach {option argument} $($module,discoveredSwitches) {
if {[info exists internal($option)]} continue ;# ignore internally used options
lappend switches $option $argument
}
foreach {option argument} $switches {
if {[info exists (last,$module,$option)]} {
set ($this,$module,$option) $(last,$module,$option) ;# use module options used by last loaded instance
} elseif {$argument} { ;# the option takes an argument
set ($this,$module,$option) {} ;# the argument is always empty by default
} else {
set ($this,$module,$option) 0 ;# a boolean option is always false by default
}
}
set ($module,switches) $switches
set ($this,indexNamespace,$index) $module
incr index
}
composite::configure $($this,list) -list $modules
bind $composite::($($this,list),listbox,path) <<ListboxSelect>> "moduleOperations::selection $this"
} else {
$($this,label) configure -text [mc {Found no modules:}]
}
}
proc selection {this} {
set index [lindex [scrollList::curselection $($this,list)] 0]
if {([string length $index] == 0) || [string equal $index $($this,index)]} return
if {[string equal $($this,action) manage] && ([string length $($this,index)] > 0) && [changed $this $($this,index)]} {
# in manage mode, there was a previous selection and some last selected module option values have changed
# deselect next selection:
scrollList::selection $($this,list) clear $index; scrollList::selection $($this,list) set $($this,index)
if {![interactiveQuery\
$this [mc {moodss: Module parameters}] [mc {Ignore changes and continue the selection of another module?}]\
]} return ;# user canceled selection
set module $($this,indexNamespace,$($this,index)) ;# last selected module
foreach {option argument} $($module,switches) value $($this,values) {
set ($this,$module,$option) $value ;# restore original values for previous selection
}
# reselect next selection:
scrollList::selection $($this,list) clear $($this,index); scrollList::selection $($this,list) set $index
}
set module $($this,indexNamespace,$index) ;# module (discovered) or namespace (loaded)
switch $($this,action) {
display {
set state disabled
}
load {
set state normal
composite::configure $($this,dialog) load -state normal
}
manage {
set state normal
composite::configure $($this,dialog) unload -state normal
composite::configure $($this,dialog) reload -state normal
composite::configure $($this,dialog) new -state normal
}
}
cleanOptions $this
set table $($this,container)
$table configure -rows [expr {[llength $($module,switches)] / 2}]
set row 0
set width 0
set ($this,values) {} ;# remember original values to check for changes when selecting another module
foreach {option argument} $($module,switches) {
set label [label $table.$row,0 -font $font::(mediumBold) -text $option]
$table window configure $row,0 -window $label
if {[winfo reqwidth $label] > $width} { ;# keep track of labels column width
set width [winfo reqwidth $label]
}
if {$argument} {
set path [entry $table.$row,1\
-font $font::(mediumNormal) -width 0 -textvariable moduleOperations::($this,$module,$option) -state $state\
]
if {[regexp $global::passwordOptionExpression $option]} {
$path configure -show * ;# do not display passwords
}
$table window configure $row,1 -window $path -sticky ew
} else {
set path [checkbutton $table.$row,1 -variable moduleOperations::($this,$module,$option) -state $state]
$table window configure $row,1 -window $path -sticky w
}
lappend ($this,values) $($this,$module,$option)
incr row
}
if {$row == 0} { ;# no options for this module
set label [label $table.$row,0 -font $font::(mediumItalic) -text [mc {no options}]]
$table window configure $row,0 -window $label
$table window configure $row,1 -window [label $table.$row,1] -sticky ew
set width [winfo reqwidth $label]
}
$table width 0 -$width
set ($this,index) $index
}
proc load {this} {
set module $($this,indexNamespace,$($this,index))
# only name must be used, not eventual index to avoid clashes with loaded instances of the same module:
foreach {name index} [modules::decoded $module] {}
array unset {} last,$name,* ;# reset last loaded options for that module
set string $name
foreach {option argument} $($module,switches) {
if {$argument} {
if {[string length $($this,$module,$option)] > 0} {
append string " $option [list $($this,$module,$option)]" ;# properly quote option value
}
} else {
if {$($this,$module,$option)} {
append string " $option"
}
}
set (last,$name,$option) $($this,$module,$option) ;# remember option value for module name
}
if {[catch {dynamicallyLoadModules $string} message]} {
tk_messageBox -title [mc {moodss: Error loading module}]\
-type ok -icon error -message $message -parent $widget::($($this,dialog),path)
}
}
proc loaded {this} {
variable internal
$($this,label) configure -text [mc {Select loaded module (view its documentation with Help button):}]
cleanOptions $this
set index 0
foreach {namespace identifier options} [modulesData] {
lappend list $identifier
set switches {}
foreach {switch argument value} $options {
if {[info exists internal($switch)]} continue ;# ignore internally used options
lappend switches $switch $argument
set ($this,$namespace,$switch) $value
}
set ($namespace,switches) $switches
set ($this,indexNamespace,$index) $namespace
incr index
}
if {![info exists list]} {error {no loaded modules}} ;# user interface should never allow this to occur
composite::configure $($this,list) -list {} ;# first clean displayed list
set ($this,index) {} ;# reset selected index since selection is gone
composite::configure $($this,list) -list $list ;# then update
bind $composite::($($this,list),listbox,path) <<ListboxSelect>> "moduleOperations::selection $this"
if {[string equal $($this,action) manage]} {
composite::configure $($this,dialog) unload -state disabled ;# since selection is gone
composite::configure $($this,dialog) reload -state disabled
composite::configure $($this,dialog) new -state disabled
}
}
proc unload {this} {
dynamicallyUnloadModule $($this,indexNamespace,$($this,index))
if {[llength [modulesData]] == 0} {
# nothing to display: just vanish once module is completely unloaded (### unreproducible bug ###):
after idle delete $($this,dialog)
} else {
loaded $this ;# refresh display
composite::configure $($this,dialog) unload -state disabled
}
}
proc reload {this} {
dynamicallyUnloadModule $($this,indexNamespace,$($this,index))
load $this ;# replace the module with a new instance but which keeps the just deleted instance number, if any
if {[llength [modulesData]] == 0} {
# if the module failed to reload (due to bad options, for example), there may be no loaded modules left at this point
after idle delete $($this,dialog)
} else {
loaded $this
}
}
proc help {this} { ;# module must be already selected
if {[string length $($this,index)] > 0} { ;# a module is selected
set module $($this,indexNamespace,$($this,index)) ;# module or namespace
foreach {name index} [modules::decoded $module] {} ;# only name is required, not eventual index
moduleHelpWindow $name [modules::helpHTMLData $name]
} else { ;# display general help
switch $($this,action) {
display {generalHelpWindow #menus.file.modules.loaded}
load {generalHelpWindow #menus.file.modules.load}
manage {generalHelpWindow #menus.file.modules.manage}
}
}
}
proc updateScrollBar {widget beginning end} {
$widget set $beginning $end
if {($end - $beginning) < 1} { ;# display only when necessary
grid $widget -row 0 -column 1 -sticky ns
} else {
grid forget $widget
}
}
proc cleanOptions {this} {
set table $($this,container)
foreach cell [$table window names] { ;# eventually remove existing switches display
destroy $table.$cell
}
}
proc changed {this index} {
set module $($this,indexNamespace,$index)
foreach {option argument} $($module,switches) value $($this,values) {
if {![string equal $($this,$module,$option) $value]} {
return 1 ;# stop at first difference
}
}
return 0
}
proc interactiveQuery {this title message} {
return [string equal\
[tk_messageBox -title $title -type yesno -icon question -parent $widget::($($this,dialog),path) -message $message] yes\
]
}
proc close {this} {
if {![string equal $($this,action) manage]} {return 1} ;# always close when not in manage mode
if {([string length $($this,index)] == 0) || ![changed $this $($this,index)]} { ;# no module selected or no changes
return 1 ;# safe to close
} elseif {[interactiveQuery $this [mc {moodss: Module parameters}] [mc {Ignore changes and close the dialog box?}]]} {
return 1 ;# user chose to ignore the changes
} else {
return 0
}
}
proc modulesData {} {
set list {}
foreach {namespace identifier options} [modules::loaded] {
if {[string equal [lindex [modules::decoded $namespace] 0] formulas]} continue ;# skip internal modules
regsub {<0>$} $identifier {} identifier ;# remove trailing namespace index for first instance of a module
lappend list $namespace $identifier $options
}
return $list
}
}
|
