ProcMeUp

George Peter Staplin: ProcMeUp is a structured editor. It automates the structuring of Tcl program sources. Files are saved automatically, and adding files is easy. ProcMeUp is written using itself, and is also used in the Fed Builder project.
This is release 10 with the plastik tile theme:
License: BSD
Requirements: Tcl and Tk >= 8.4
Author: George Peter Staplin
Optional: tile05.kit or a later version
Useful with: memory file system
Version 23, 5/2006 [L1 ]
This is an older version:
 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 <<ListboxSelect>> {selected.file %W}
 
  bind .pw.ftop.pw.fattr.targ <ButtonPress-3> \
   {display.text.selection.menu %W %X %Y}
  bind .pw.ftop.pw.fattr.plan <ButtonPress-3> \
   {display.text.selection.menu %W %X %Y}
  bind .pw.ftext.t <ButtonPress-3> \
   {display.text.selection.menu %W %X %Y}
 
  bind .pw.ftop.pw.flist.fadd.eadd <ButtonPress-3> \
   {display.entry.selection.menu %W %X %Y}
 
  bind $::file_listbox <ButtonPress-3> 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]
George Peter Staplin: Thanks :)
rdt likes this too. Now if we can just get color syntax highlighting (like in vim) for tcl/tk then we're all set.
George Peter Staplin: Thank you. I may add my next version of Ctext to it for highlighting. The next ctext is far off at the moment though (as of Mar 21, 2005). I'm exploring different ways of solving the problems.