[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.

[http//195.241.128i.75/Wiki/procswin1.jpg]

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_vannilla 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.