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
|
# copyright (C) 1997-2001 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
set rcsId {$Id: modgui.tcl,v 2.15 2001/01/23 21:55:14 jfontain Exp $}
class moduleOperations {
proc moduleOperations {this action} { ;# action can be display, load or unload
set buttons ho
if {![string equal $action display]} {
append buttons c
}
set dialog [new dialogBox .grabber\
-buttons $buttons -default o -die 0 -command "moduleOperations::done $this" -helpcommand "moduleOperations::help $this"\
-x [winfo pointerx .] -y [winfo pointery .] -deletecommand "delete $this; grab release .grabber"\
]
grab .grabber ;# grab siblings such as help window so that it is usable
composite::configure $dialog help -state disabled ;# disable module help button until module is selected
set frame [frame $widget::($dialog,path).frame]
grid columnconfigure $frame 1 -weight 1
set ($this,label) [label $frame.label -font $font::(mediumNormal)]
grid $($this,label) -row 0 -column 0 -sticky nw
set entry [new comboEntry $frame -font $font::(mediumBold)]
composite::configure $entry button scroll -height 5
grid $widget::($entry,path) -row 0 -column 1 -sticky new
set scroller [new scroller $frame -height 100 -width 200]
set ($this,container) [frame $widget::($scroller,path).container]
scroller::display $scroller $($this,container)
grid rowconfigure $frame 1 -weight 1
grid $widget::($scroller,path) -row 1 -column 0 -columnspan 2 -sticky nsew
dialogBox::display $dialog $frame
set ($this,dialog) $dialog
set ($this,frame) $frame
set ($this,entry) $entry
set ($this,scroller) $scroller
set ($this,action) $action
switch $action {
display {
composite::configure $dialog -title {moodss: Loaded modules}
loaded $this 0
}
load {
composite::configure $dialog -title {moodss: Load module}
discover $this
}
unload {
composite::configure $dialog -title {moodss: Unload module}
loaded $this 1
}
}
composite::configure $entry -editable 0 ;# user is not allowed to input an invalid name
set ($this,module) {} ;# selected module
}
proc ~moduleOperations {this} {
delete $($this,scroller) $($this,entry) ;# delete objects other than dialog box
}
proc discover {this} {
if {![info exists (discoveredModules)]} { ;# cache modules and their switches
$($this,label) configure -text {Searching for modules... Found:}
$($this,frame) configure -cursor watch ;# show user that we are busy
update idletasks
set path $composite::($($this,entry),entry,path)
modules::available "
lappend moduleOperations::(discoveredModules) %M
set moduleOperations::(%M,discoveredSwitches) %S ;# save module switches
$path delete 0 end
$path insert 0 %M ;# show modules one by one for user feedback
update idletasks
"
$($this,frame) configure -cursor {}
$path delete 0 end
}
if {[info exists (discoveredModules)]} {
$($this,label) configure -text {Select available module:}
update idletasks
set modules [lsort $(discoveredModules)] ;# sort modules for easy navigation
foreach module $modules {
foreach {option argument} [set ($module,switches) $($module,discoveredSwitches)] {
if {$argument} {
set ($this,$module,$option) {}
} else {
set ($this,$module,$option) 0
}
}
}
composite::configure $($this,entry) -list $modules -command "moduleOperations::selection $this"
} else {
$($this,label) configure -text {Found no modules:}
}
}
proc loaded {this unload} {
foreach {namespace options} [modules::loaded] {
lappend namespaces $namespace
set switches {}
foreach {switch argument value} $options {
lappend switches $switch $argument
set ($this,$namespace,$switch) $value
}
set ($namespace,switches) $switches
}
if {[info exists namespaces]} {
if {$unload} {
$($this,label) configure -text {Select module to unload:}
} else {
$($this,label) configure -text {Select loaded module:}
}
composite::configure $($this,entry) -list $namespaces -command "moduleOperations::selection $this"
} else {
$($this,label) configure -text {No loaded modules:}
composite::configure $($this,entry) -state disabled
}
}
proc selection {this module} {
if {[string equal $module $($this,module)]} return
composite::configure $($this,dialog) help -state normal ;# enable module help button now that module name is known
set frame $($this,container)
eval destroy [grid slaves $frame] ;# first remove existing switches display
grid columnconfigure $frame 1 -weight 1
if {[string equal $($this,action) display]} { ;# set parameter widgets state
set state disabled
} else {
set state normal
}
set row 0
foreach {option argument} $($module,switches) {
grid [label $frame.$row,0 -font $font::(mediumBold) -text $option] -padx 5 -sticky w -row $row -column 0
if {$argument} {
set path [entry $frame.$row,1\
-font $font::(mediumNormal) -width 40 -textvariable moduleOperations::($this,$module,$option) -state $state\
]
} else {
set path [checkbutton $frame.$row,1 -variable moduleOperations::($this,$module,$option) -state $state]
}
grid $path -sticky w -row $row -column 1
incr row
}
if {$row==0} { ;# no options for this module
grid [label $frame.$row,0 -font $font::(mediumItalic) -text {no options}] -padx 5 -sticky w -row $row -column 0
}
set ($this,module) $module
}
proc done {this} {
set delete 1
set module $($this,module)
if {[string length $module]>0} {
switch $($this,action) {
load {
set string $module
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"
}
}
}
if {[catch {dynamicallyLoadModules $string} message]} {
tk_messageBox -title {moodss: Error loading module} -type ok -icon error -message $message
set delete 0
}
}
unload {
dynamicallyUnloadModule $module
}
}
}
if {$delete} {
delete $($this,dialog) ;# which in turn deletes this object
}
}
proc help {this} { ;# module must be already selected
foreach {name index} [modules::decoded $($this,module)] {} ;# only name is required, not eventual index
moduleHelpWindow $name [modules::helpHTMLData $name]
}
}
|
