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
 }