Version 2 of interactive command composer

Updated 2003-11-18 18:13:20

by Theo Verelst

http://195.241.128.75/Bwise/procwindow1.jpg

The below assumes you loaded bwise first, command:

   destroy .f

to get rid of the old function window, unless you replace the procedure in the 0.34 source, and re-invoke the procedure to set up the procedure list window by

   procs_window

 proc procs_window { } {
           global defaultprocs
                     # The procedures which are listed in this list are not shown
           if {[info exists defaultprocs] != 1} {
              set defaultprocs {bgerror history loadvfs unknown}
           }
 #           get_procvanilla
           toplevel .f
         wm title .f "Procedure Window"

         frame .f.fu ; pack .f.fu -expand n -fill x;      # top frame with two scrollable lists

         listbox .f.fu.l -height 5 -yscroll ".f.fu.s set";   # left list
         pack .f.fu.l -expand y -fill x -side left
         scrollbar .f.fu.s -command ".f.fu.l yview"
         pack .f.fu.s -side left -expand n -fill y
         listbox .f.fu.lr -height 5 -yscroll ".f.fu.sr set";   # right list
         pack .f.fu.lr -expand y -fill x -side left
         scrollbar .f.fu.sr -command ".f.fu.lr yview"
         pack .f.fu.sr -side left -expand n -fill y

         frame .f.fe ; pack .f.fe -expand n -fill x ;             # Entries
         proc_entry fargs {set fcom [pro_args [lindex $fcom 0] $fargs]} "Form Command"
         proc_entry fcom {} Execute

         frame .f.ft ; pack .f.ft -expand y -fill both ;         # Text area
         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.fu.l <Double-Button-1> {
            global cf; set cf [selection get];
            .f.ft.t del 0.0 end;
            .f.ft.t insert end "proc $cf \{"
            .f.fu.lr del 0 end; 
            foreach i [info args $cf] {
               .f.fu.lr insert end $i
            }

            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]\} "
         global fargs fcom
         set fcom $cf
         set fargs "pro_args "
        }
           button .f.f.b2 -text "Refresh List" -command {
              set o {};
                                            # Don't list certain procs
              foreach i [info procs] {
                 if {[string match {tk*} $i] == 0 && 
                 [string match {tcl*} $i] == 0 &&
                 [string match {pkg_*} $i] == 0 &&
                 [string match {auto_*} $i] == 0 &&
                 [lsearch $defaultprocs $i] == -1 } {
                    lappend o $i
                 }
              };
              .f.fu.l del 0 end;
              foreach i [lsort $o] {.f.fu.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.fu.lr <Double-Button-1> {
      append fargs " \{" [selection get] " \{"
      .f.fe.ffargs.e icursor end
      append fargs "\}\} "
   }

   bind .f.fu.l  <F1> [bind .f.fu.l [bind .f.fu.l ]]
   .f.f.b2 invoke
   .f.ft.t insert end "Use refresh list when you made a new procedure.\n"
   .f.ft.t insert end "Double click a procedure name to make it appear \n"
   .f.ft.t insert end "in the bottom window.\n\n"
   .f.ft.t insert end "After editing it, press Update to resource the proc.\n\n"
   .f.ft.t insert end "There is no extra storage except regular tcl procs,\n"
   .f.ft.t insert end "loading another proc destroys you edits: \nUPDATE FIRST.\n\n"
   .f.ft.t insert end "Save button saves EDITED procs, \nsee filebox entry on the left.\n"
   .f.ft.t insert end "Most Bwise regular windows can be resized."
 } 

 proc proc_entry {var {command {}} {buttontext Do}} {
         set w .f.fe.f$var
         frame $w ; pack $w -expand yes -fill x
         entry $w.e -textvar $var ; pack $w.e -side left -expand y -fill x
         if {$command == {}} {set command "eval \$$var"}
         button $w.b -command $command -text $buttontext
         pack $w.b -side right -expand n -fill none
 }