[GPS]: This project has been removed from the public server. ---- License: [OLL] Author: [GPS]/[George Peter Staplin] ---- proc add.procedure {name} { save.script save.plan if {![file exists $name.proc]} { puts [set fd [open $name.proc w]] "proc $name {} {}" close $fd load.directory } load.file $name.proc load.plan $name.proc.plan} proc copy.entry.selection {w} { if {![$w selection present]} return clipboard clear -displayof $w clipboard append -displayof $w \ [string range [$w get] [$w index sel.first] [$w index sel.last]] } proc create.gui {} { panedwindow .pw -orient vertical frame .pw.ftop frame .pw.ftext panedwindow .pw.ftop.pw -orient horizontal frame .pw.ftop.pw.flist listbox .pw.ftop.pw.flist.l \ -yscrollcommand {.pw.ftop.pw.flist.yview set} set ::file_listbox .pw.ftop.pw.flist.l scrollbar .pw.ftop.pw.flist.yview \ -command {.pw.ftop.pw.flist.l yview} set ::procedure_to_add "" frame .pw.ftop.pw.flist.fadd entry .pw.ftop.pw.flist.fadd.eadd -textvariable ::procedure_to_add button .pw.ftop.pw.flist.fadd.badd \ -text Add \ -padx 1 \ -pady 1 \ -command { add.procedure $::procedure_to_add set ::procedure_to_add "" } frame .pw.ftop.pw.fattr label .pw.ftop.pw.fattr.lname \ -textvariable ::procedure \ -font {Helvetica 18} label .pw.ftop.pw.fattr.larg -text Arguments: text .pw.ftop.pw.fattr.targ -height 1 label .pw.ftop.pw.fattr.lplan -text Plan: set ::plan [text .pw.ftop.pw.fattr.plan] text .pw.ftext.t \ -yscrollcommand {.pw.ftext.yview set} scrollbar .pw.ftext.yview \ -command {.pw.ftext.t yview} } proc cut.entry.selection {w} { copy.entry.selection $w $w delete sel.first sel.last } proc display.entry.selection.menu {w x y} { set m $w._menu if {[winfo exists $m]} { tk_popup $m $x $y return } menu $m -tearoff 0 $m add command -label "Select All" -command [list $w selection range 0 end] $m add separator $m add command -label Cut -command [list cut.entry.selection $w] $m add command -label Copy -command [list copy.entry.selection $w] $m add command -label Paste -command [list paste.into.entry $w] tk_popup $m $x $y } proc display.text.selection.menu {w x y} { if {[winfo exists $w.m]} { tk_popup $w.m $x $y return } menu $w.m -tearoff 0 $w.m add command \ -label "Select All" \ -command [list $w tag add sel 1.0 end] $w.m add separator $w.m add command \ -label Cut \ -command [list tk_textCut $w] $w.m add command \ -label Copy \ -command [list tk_textCopy $w] $w.m add command \ -label Paste \ -command [list tk_textPaste $w] tk_popup $w.m $x $y } proc every {t body} { uplevel #0 $body after $t [list every $t $body] } proc get.token {s i_ptr} { upvar $i_ptr i set s_len [string length $s] set brace_count 0 set tok "" set escaped 0 for {} {$i < $s_len} {incr i} { set c [string index $s $i] if {"\\" == $c} { set escaped 1 append tok $c continue } elseif {!$escaped && "\{" == $c} { if {$brace_count > 0} { append tok $c } incr brace_count } elseif {!$escaped && "\}" == $c} { incr brace_count -1 if {$brace_count > 0} { append tok $c } elseif {!$brace_count} { incr i return $tok } } elseif {[string is space $c]} { if {!$brace_count && [string length $tok]} { incr i return $tok } append tok $c } else { append tok $c } set escaped 0 } if {0 != $brace_count} { return -code error "brace_count is: $brace_count ... expected 0" } elseif {[string length $tok]} { return $tok } } proc load.directory {} { $::file_listbox delete 0 end foreach f [lsort -dictionary [glob *.proc]] { $::file_listbox insert end $f }} proc load.file {f} { parse.script ar [read [set fd [open $f r]]] close $fd set ::procedure $ar(name) .pw.ftop.pw.fattr.targ delete 1.0 end .pw.ftop.pw.fattr.targ insert end $ar(args) .pw.ftext.t delete 1.0 end .pw.ftext.t insert end $ar(body) } proc load.plan {f} { $::plan delete 1.0 end $::plan insert end [read [set fd [open $f "CREAT RDONLY"]]] close $fd} proc main {argc argv} { if {$argc > 0} { cd [lindex $argv 0] } set.widget.defaults create.gui manage.gui load.directory every 1000 save.script every 1000 save.plan wm title . "ProcMeUp: [pwd]"} proc manage.gui {} { grid .pw \ -row 0 \ -column 0 \ -sticky news grid rowconfigure . 0 -weight 100 grid columnconfigure . 0 -weight 100 grid .pw.ftop.pw \ -row 0 \ -column 0 \ -sticky news grid rowconfigure .pw.ftop 0 -weight 100 grid columnconfigure .pw.ftop 0 -weight 100 grid .pw.ftop.pw.flist.yview \ -row 0 \ -column 0 \ -sticky ns grid .pw.ftop.pw.flist.l \ -row 0 \ -column 1 \ -sticky news grid .pw.ftop.pw.flist.fadd \ -row 1 \ -column 0 \ -columnspan 2 \ -sticky we grid .pw.ftop.pw.flist.fadd.eadd \ -row 0 \ -column 0 -sticky we grid .pw.ftop.pw.flist.fadd.badd \ -row 0 \ -column 1 -sticky e grid columnconfigure .pw.ftop.pw.flist.fadd 0 -weight 100 grid rowconfigure .pw.ftop.pw.flist 0 -weight 100 grid columnconfigure .pw.ftop.pw.flist 1 -weight 100 grid .pw.ftop.pw.fattr.lname \ -row 0 \ -column 0 \ -sticky w grid .pw.ftop.pw.fattr.larg \ -row 1 \ -column 0 \ -sticky w grid .pw.ftop.pw.fattr.targ \ -row 2 \ -column 0 \ -sticky we grid .pw.ftop.pw.fattr.lplan \ -row 3 \ -column 0 \ -sticky w grid .pw.ftop.pw.fattr.plan \ -row 4 \ -column 0 \ -sticky news grid columnconfigure .pw.ftop.pw.fattr 0 -weight 100 grid rowconfigure .pw.ftop.pw.fattr 4 -weight 100 .pw.ftop.pw add .pw.ftop.pw.flist -width 220 .pw.ftop.pw add .pw.ftop.pw.fattr -width 100 grid .pw.ftext.yview \ -row 0 \ -column 0 \ -sticky ns grid .pw.ftext.t \ -row 0 \ -column 1 \ -sticky news grid rowconfigure .pw.ftext 0 -weight 100 grid columnconfigure .pw.ftext 1 -weight 100 .pw add .pw.ftop -height 200 .pw add .pw.ftext -height 300 bind .pw.ftop.pw.flist.l <> {selected.file %W} bind .pw.ftop.pw.fattr.targ \ {display.text.selection.menu %W %X %Y} bind .pw.ftop.pw.fattr.plan \ {display.text.selection.menu %W %X %Y} bind .pw.ftext.t \ {display.text.selection.menu %W %X %Y} bind .pw.ftop.pw.flist.fadd.eadd \ {display.entry.selection.menu %W %X %Y} bind $::file_listbox load.directory} proc parse.script {ar_ptr s} { upvar $ar_ptr ar set i 0 get.token $s i ;# throw away "proc" set ar(name) [get.token $s i] set ar(args) [get.token $s i] set ar(body) [get.token $s i] if {[regexp -indices {[ \t]*\n} $ar(body) m] > 0} { set ar(body) [string range $ar(body) [expr {[lindex $m 1] + 1}] end] } } proc paste.into.entry {w} { if {[catch {selection get -displayof $w -selection CLIPBOARD} data]} { return } $w insert insert $data} proc save.plan {} { if {![$::plan edit modified] || "" == $::procedure} return write \ [set fd [open $::procedure.proc.plan w]] \ [$::plan get 1.0 end-1c] close $fd $::plan edit modified 0 } proc save.script {} { if {"" == $::procedure} return if {![.pw.ftext.t edit modified] && \ ![.pw.ftop.pw.fattr.targ edit modified]} return set args [.pw.ftop.pw.fattr.targ get 1.0 end-1c] set body [.pw.ftext.t get 1.0 end-1c] write \ [set fd [open $::procedure.proc w]] \ "proc $::procedure \{[set args]\} \{\n[set body]\}" close $fd .pw.ftext.t edit modified 0 .pw.ftop.pw.fattr.targ edit modified 0 } proc selected.file {w} { save.plan save.script load.file [set f [$w get [$w curselection]]] load.plan $f.plan } proc set.widget.defaults {} { set frame_bg #ccccba set text_bg white set text_fg black set label_fg black set label_bg $frame_bg option add *font -*-lucidatypewriter-medium-*-*-*-14-*-*-*-*-*-*-* option add *highlightThickness 0 option add *borderWidth 1 option add *background $frame_bg option add *foreground black option add *Entry.background $text_bg option add *Entry.foreground $text_fg option add *Label.borderWidth 0 option add *Label.highlightThickness 0 option add *Label.padX 1 option add *Label.padY 1 option add *Listbox.background $text_bg option add *Listbox.foreground $text_fg option add *Text.background $text_bg option add *Text.foreground $text_fg } proc write {fd data} { puts -nonewline $fd $data } main $::argc $::argv ---- Clever! [[responds one casual reader, with no time to comment more deeply]] ---- [Category Application]