Version 11 of ProcMeUp

Updated 2004-08-28 22:56:46 by rdt

Release 7 now available

GPS: 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.

http://www.xmission.com/~georgeps/implementation/software/ProcMeUp/ProcMeUp-6.png

Browsable directory: http://www.xmission.com/~georgeps/implementation/software/ProcMeUp/


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]

GPS: 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.


See also: memory file system


Category Application | Category Dev. Tools