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:
Update 2006-02-05: adding 9 lines of code brought coloring for proc and comment lines. Marked as #(1)
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 .t.t tag config red -foreground red ;#(1) .t.t tag config blue -foreground blue ;#(1) 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] - now replaced by: #(1) foreach line [split [e'get $name] \n] { if [regexp {^\s*proc } $line] { set tag blue } elseif {[regexp {^\s*#} $line]} { set tag red } else {set tag ""} .t.t insert end $line\n $tag } 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 (see corp for more)
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} }
Some more goodies: the following menu items make navigating in larger files very convenient:
m+ $m Goto Top {.t.t see 1.0} m+ $m Goto Cursor {.t.t see insert} m+ $m Goto Bottom {.t.t see end}
And for a feature that most M$ editors, and even emacs don't fully provide: displaying the cursor line and column position. For this I make creative use of the menu, by adding a dummy with the label @. Whenever the mouse is clicked in the text, the label is updated to show the current position:
$m add casc -label @ -menu [menu $m.dummy] bind .t.t <ButtonRelease-1> {.t.m entryconf @* -label @[.t.t index current]; xx}
The xx is a necessary workaround in eTcl at least pl4 (fixed in pl6), to prevent that the menu is repeatedly displayed:
proc xx {} { .t config -menu "" .t config -menu .t.m }
Little code that does much - that's why I love Tcl !-)
EF I have repackaged this into a proper package that does (hopefully) the same. The package incorporates all the additions listed above. It is available in e: a packaged tiny editor for eTcl.
See also Sepp.
JM Richard, is the following problem also showing up in this distribution?
Native file selectors allow only to choose files from /My Documents and (only one level?) below
Category Example | Arts and crafts of Tcl-Tk programming | Category Editor utility