Theo Verelst'
That name again.. Sort of a joke from a former employer circuit (Delft University) where their most prestigeous microelectronics (which indirectly paid my wages at the time) had my name on their main internet page suggesting someone may want to suggest typing errors, what a horrible secrets must lay hidden.
Anyhow, I thought I'd take out and upgrade a little a handy (I use it myself) tcl/tk script to maintain procedures in a running application, such as one can develop in wish.
The procedure lists all procedures, with the exception of a list of default procedures, the system- and package-supplied ones, and allows to click on a name and get an edit window on that procedure, with an update button to redefine the proc.
Also, all edited procedures, edited in this edit window that is, can be saved to a file easily, as a list of decently formed tcl procedures which can be sources at the next session to let you have the latest edited procedure definitions easily.
This is the main procedure:
proc procs_window { } {
global defaultprocs
if {[info exists defaultprocs] != 1} {
set defaultprocs {}
}
get_procvanilla
toplevel .f
frame .f.fl ; pack .f.fl -expand n -fill x
listbox .f.fl.l -height 5 -yscroll ".f.fl.s set";
pack .f.fl.l -expand y -fill x -side left
scrollbar .f.fl.s -command ".f.fl.l yview"
pack .f.fl.s -side right -expand n -fill y
frame .f.ft ; pack .f.ft -expand y -fill both
pack .f.ft -expand y -fill both
text .f.ft.t -width 20 -height 4 -wrap none -yscroll ".f.ft.s set";;
pack .f.ft.t -expand y -fill both -side left
scrollbar .f.ft.s -command ".f.ft.t yview"
pack .f.ft.s -side right -expand n -fill y
frame .f.f; pack .f.f -expand n -fill x
button .f.f.b -text {Update Proc} -command {
global procs;
set p [.f.ft.t get 0.0 end];
eval $p;
set procs([lindex $p 1]) $p
}
pack .f.f.b -side right
bind .f.fl.l <Double-Button-1> {
global cf; set cf [selection get];
.f.ft.t del 0.0 end;
.f.ft.t insert end "proc $cf \{"
foreach a [info args $cf] {
if { [info default $cf $a b] == 1} {
.f.ft.t insert end " {$a {$b}}" } {
.f.ft.t insert end " {$a}"
}
}
.f.ft.t insert end " \} \{[info body $cf]\} "
}
button .f.f.b2 -text "Refresh List" -command {
set o {};
foreach i [info procs] {
if {[string match {tk*} $i] == 0 &&
[string match {tcl*} $i] == 0 &&
[lsearch $defaultprocs $i] == -1 } {
lappend o $i
}
};
.f.fl.l del 0 end;
foreach i [lsort $o] {.f.fl.l insert end $i}
};
pack .f.f.b2 -side right
entry .f.f.f -width 15 -textvar procsfile
pack .f.f.f -side left
button .f.f.bs -text {Save Procs} -command {
global procsfile procs
set o {}
foreach i [lsort [array names procs]] {
eval append o { $procs($i) } \n
}
set f [open $procsfile w];
puts $f $o;
close $f
}
pack .f.f.bs -side left
bind .f.fl.l <F1> [bind .f.fl.l [bind .f.fl.l ]]
.f.f.b2 invoke
}