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
}The proc_vanilla procedures are needed to make the procedure list limited, once you call the set_procvanilla procedure in an only initialized wish or equivalent shell, it will write a file in the current directory which contains a list of all procedures then present.When get_procvanilla is called, it reads that file and thus makes the above proc filter all system procs out the list.
proc get_procvanilla { } {
global defaultprocs ;
set f [open defaultprocs.tcl r];
if {$f == {}} {return -1}
set defaultprocs [ read $f ] ;
close $f
return 0
}
proc set_procvanilla { } {
global defaultprocs
puts "This routine should be called when only the startup\m"
puts "procedures are present to make the file 'defaultprocs.tcl'"
set defaultprocs {}
foreach i [info procs] {
if {[string match {tk*} $i] == 1 ||
[string match {tcl*} $i] == 1} {
append defaultprocs "$i "
}
}
set f [open defaultprocs.tcl w]
puts $f $defaultprocs
close $f}These procedures, except that the main one is updated with sliders, are present in the bwise package for graph based programming. See earlier versions and explanations: [1] and [2] .PT 8-Jul-2003: This is related to tkinspect.
