[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]