Version 2 of e: a tiny editor plugin for eTcl

Updated 2006-01-16 11:27:16 by suchenwi

Richard Suchenwirth 2006-01-16 - With the eTcl distribution for PocketPC I have taken up doing weekend fun projects again. Here's the fruit of last Sunday, simple, but already very useful:

  • a really compact editor that can be called from the eTcl console with a file or proc name,
  • called without argument, e just brings up the edit window, so one can switch
  • displays the content in a window that leaves room for the virtual keyboard
  • can save the content to file again, or evaluate it (e.g. for modified procs)
  • Most of edit functionality is from text anyway, just need menu items to invoke them

The main function builds the UI too, if not already there:

 proc e {{name ""}} {
    if ![winfo exists .t] {
       toplevel .t
       text .t.t -wrap word -yscr ".t.y set" -width 37 -bd 2 -undo 1
       scrollbar .t.y -com ".t.t yview"
       pack .t.t .t.y -side left -fill y
       set m [menu .t.m]
       .t config -menu $m
       m+ $m File Open.. e'open
       m+ $m File Save {e'save $::g(filename)}
       m+ $m File "Save as.." e'save
       m+ $m File ---
       m+ $m File Eval {eval [.t.t get 1.0 end]}
       m+ $m File Clear {.t.t delete 1.0 end}
       m+ $m File ok {console eval {raise .; focus -force .console}}
       foreach i {Cut Copy Paste} {
          m+ $m Edit $i [list event gen .t.t <<$i>>]
       }
       m+ $m Edit ---
       m+ $m Edit Undo {.t.t edit undo}
       m+ $m Edit Redo {.t.t edit redo}
       wm geo .t 240x189+0+25
       set ::g(dir) [pwd]
    }
    if {$name ne ""} {
       .t.t delete 1.0 end
       .t.t insert end [e'get $name]
        wm title .t [file tail $name]
    }
    raise .t
    focus -force .t.t
 }

#-- Dispatcher for content types - file or proc

 proc e'get name {
   if [file exists $name] {
      set f [open $name]
      set ::g(filename) $name
      K [read $f] [close $f]
   } else {corp $name}
 }
 proc K {a b} {set a}

#-- reconstruct a proc's full text, with args and defaults

 proc corp name {
   set argl {}
   foreach a [info args $name] {
      if [info default $name $a def] {
         lappend a $def
      }
      lappend argl $a
   }
   list proc $name $argl [info body $name]
 }

#-- File I/O

 proc e'open {} {
    e [tk_getOpenFile -initialdir $::g(dir)]
 }
 proc e'save {{file ""}} {
   if {$file eq ""} {
      set file [tk_getSaveFile -initialdir $::g(dir)]
   }
   if {$file ne ""} {
      set ::g(dir) [file dir [file join [pwd] $file]]
      set f [open $file w]
      puts $f [.t.t get 1.0 "end - 1c"]
      close $f
   }
 }

#--- Wrapper for simple menu definition

 proc m+ {m head label {cmd ""}} {
   if ![winfo ex $m.m$head] {
      $m add casc -label $head -menu [menu $m.m$head -tearoff 0]
   }
   if {$label ne "---"} {
      $m.m$head add command -label $label -command $cmd
   } else {$m.m$head add separator}
 }

Category Example | Arts and crafts of Tcl-Tk programming