Updated 2014-09-18 14:47:54 by aspect

There is a more elaborated version of this code at Console Text Editor in Pure Tcl 2. The below may be of interest if you're looking for a solution in <1000 LoC.

2004-06-16 SRIV This is a minimal console text editor for Linux written in pure Tcl.

Usage: con-editor.tcl filename

To save the file, press Ctrl-Q, it will prompt you to Save Y/n.

Ctrl-Y will delete the current line.

If you use this from a minicom serial console in Linux, switch minicom's terminal type from VT102 to ANSI.

I'm using this on a Gumstix[1] with tclsh, since there's no more space left for any larger editor binary. This takes up a whole 8538 bytes.

dzach: I've been looking for a port of tcl to the Gumstix platform for some time now, as a prerequisit to buy one. Googlin' hasn't produced much info, neither has gumstix wiki. Could you please elaborate more on running tcl on a Gumstix? Or, even better, write a new wiki page for it?

LV Perhaps the backspace key would work if you added a \u0008 (^h) to the current \u0007f (^?) case? (JH: Yes, added in.)

Edited by JH 2005-05-04 to support any size terminal, clean up the code for improved readability, add real tab handling (tricky) and some other tidbits. Anyone wanting to interpret more escape codes should find it easier to work with.

Mar 19,2006 SRIV I made a new version that adds tab handling using a different technique, as well a novel long line editing feature that doesn't redraw the whole screen to save on bandwidth over slow links. Grab it here [2] .

Mar 24,2006 LES I write "Isso é um teste de acentuação". Press Enter and it becomes "Isso ��© um teste de acentua��§��£o". Eh.

schlenk Looks like it is read correctly and then transformed to utf-8, which the term does not display correctly. Changing the fconfigures for stdout/stdin to use some -encoding value may help.

SRIV I added -encoding iso8859-1 to the two fconfigures and it seems to work. I'm not familiar enough with encodings to know what the right answer is though.

Screenshot:


 #!/bin/sh
 # The next line is executed by /bin/sh, but not tcl \
     exec tclsh "$0" ${1+"[email protected]"}

 # con-editor.tcl a linux console based editor in pure tcl
 # 2004-06-16 Steve Redler IV
 # 2005-05-04 mods by Hobbs to work in any terminal size, clean up code
 #            and add more key functionality, tab handling
 # 2006-03-17 bugfix for cursor-left & for terms that report 0 cols & rows
 #            place cursor at home after file is loaded
 #            bugfix: allow inserting text to blank lines
 # 2006-06-16 slebetman, added search and goto line functionality
 #            bugfix: removed extra newline each time a file is saved
 #            added handling for Home and End keys.

 set filename [lindex $argv 0]
 set searchpattern ""

 proc handleSearch {} {
 uplevel 1 {
     global searchpattern
     status "Search: $searchpattern"

     if {$searchpattern != ""} {
         set found [lsearch -regexp \
             [lrange $BUFFER \
             [expr {$bufRow+1}] end] $searchpattern]
         if {$found == -1} {
             set found [lsearch -regexp $BUFFER $searchpattern]
             if {$found != -1} {
                 set bufRow $found
             }
         } else {
             incr bufRow $found
             incr bufRow
         }
         if {$found != -1} {
             set C [regexp -indices -inline $searchpattern \
                 [lindex $BUFFER $bufRow]]
             set bufCol [lindex [lindex $C 0] 0]
         } else {
             status "Search: $searchpattern (not found!)"
         }
     }

     if {$bufRow < $viewRow} {
         set viewRow 0
     }
 }
 }

 proc getInput {f {txt ""}} {
     upvar 1 $f fid

     status ""
     goto end 1
     puts -nonewline "$txt "
     flush stdout
     set ret ""
     while {[set ch [read $fid 1]] != "\n" && $ch != "\r"} {
         if {$ch == ""} continue
         if {$ch == "\u007f"} {
             # handle backspace:
             set ret [string range $ret 0 end-1]
         } else {
             append ret $ch
         }
         set stat "$txt $ret"
         status $stat
         goto end [expr [string length $stat]+1]
         flush stdout
     }
     return $ret
 }

 proc edittext {fid} {
     global BUFFER IDX

     set viewRow 1    ; # row idx into view area, 1-based
     set viewCol 1    ; # col idx into view area, 1-based
     set bufRow 0    ; # row idx into full buffer, 0-based
     set bufCol 0    ; # col idx into full buffer, 0-based
     set IDX(ROWLAST) -1    ; # last row most recently displayed in view
     set IDX(COLLAST) -1    ; # last col most recently displayed in view
     set char ""        ; # last char received
     set line [lindex $BUFFER $bufRow] ; # line data of current line

     display $bufRow $bufCol
     home; flush stdout

     while {$char != "\u0011"} {
     set char [read $fid 1]
     if {[eof $fid]} {return done}

     # Control chars start at a == \u0001 and count up.
     switch -exact -- $char {
         \u0011 { # ^q - quit
             return done
         }
         \u0001 { # ^a - beginning of line
             set bufCol 0
         }
         \u0004 { # ^d - delete
             if {$bufCol > [string length $line]} {
                 set bufCol [string length $line]
             }
             set line [string replace $line $bufCol $bufCol]
             set BUFFER [lreplace $BUFFER $bufRow $bufRow $line]
             set IDX(COLLAST) -1 ; # force redraw
         }
         \u0005 { # ^e - end of line
             set bufCol [string length $line]
         }
         \u0006 { ;# ^f - find/search
             global searchpattern
             set searchpattern [getInput fid "Search:"]
             handleSearch
         }
         \u0007 { ;# ^g - goto line
             if [string is integer [set n [getInput fid "Goto Line:"]]] {
                 set bufRow [expr {$n-1}]
                 if {$bufRow < $viewRow} {
                     set viewRow 0
                 } else {
                     set len [llength $BUFFER]
                     if {$bufRow > $len} {
                         set bufRow [expr {$len-1}]
                     }
                 }
             }
         }
         \u000a { # ^j - insert last yank
             set currline [string range $line 0 [expr {$bufCol - 1}]]
             set BUFFER [lreplace $BUFFER $bufRow $bufRow $currline]

             incr bufRow
             incr viewRow
             set BUFFER [linsert $BUFFER $bufRow \
                     [string range $line $bufCol end]]
             set IDX(COLLAST) -1 ; # force redraw
             set line [lindex $BUFFER $bufRow]
             set bufCol 0
         }
         \u0019 { # ^y - yank line
             if {$bufRow < [llength $BUFFER]} {
                 set BUFFER [lreplace $BUFFER $bufRow $bufRow]
                 set IDX(COLLAST) -1 ; # force redraw
             }
         }
         \u0008 -
         \u007f { # ^h && backspace ?
             if {$bufCol != 0} {
                 if {$bufCol > [string length $line]} {
                 set bufCol [string length $line]
                 }
                 incr bufCol -1
                 set line [string replace $line $bufCol $bufCol]
                 set BUFFER [lreplace $BUFFER $bufRow $bufRow $line]
                 set IDX(COLLAST) -1 ; # force redraw
             }
         }
         \u001b { # ESC - handle escape sequences
             set next [read $fid 1]
             if {$next == "\["} { ; # \[
                 set next [read $fid 1]
                 switch -exact -- $next {
                     A { # Cursor Up (cuu1,up)
                         if {$bufRow > 0} {
                         incr bufRow -1
                         incr viewRow -1
                         }
                     }
                     B { # Cursor Down
                         if {$bufRow < [expr {[llength $BUFFER] - 1}]} {
                         incr bufRow 1
                         incr viewRow 1
                         }
                     }
                     C { # Cursor Right (cuf1,nd)
                         if {$bufCol < [string length $line]} {
                         incr bufCol 1
                         }
                     }
                     D { # Cursor Left
                         if {$bufCol > [string length $line]} {
                         set bufCol [string length $line]
                                     }
                         if {$bufCol > 0} { incr bufCol -1 }
                     }
                     H { # Cursor Home
                         set bufCol 0
                         set bufRow 0
                         set viewRow 1
                     }
                     1 { # check for F3/Home
                         set next [read $fid 1]
                         if {$next == "~"} {
                             # Home:
                             set bufCol [regexp -indices -inline -- \
                                 {^[[:space:]]*} $line]
                             set bufCol [lindex [lindex $bufCol 0] 1]
                             incr bufCol 1
                         } elseif {$next == "3" && [read $fid 1] == "~"} {
                             # F3:
                             handleSearch
                         }
                     }
                     3 { # delete
                         set next [read $fid 1]
                         if {$bufCol > [string length $line]} {
                         set bufCol [string length $line]
                         }
                         set line [string replace $line $bufCol $bufCol]
                         set BUFFER [lreplace $BUFFER $bufRow $bufRow $line]
                         set IDX(COLLAST) -1 ; # force redraw
                     }
                     4 { # end
                         if {[read $fid 1] == "~"} {
                             set bufCol [string length $line]
                         }
                     }
                     5 { # 5 Prev screen
                         if {[read $fid 1] == "~"} {
                         set size [expr {$IDX(ROWMAX) - 1}]
                         if {$bufRow < $size} {
                             set bufRow  0
                             set viewRow 1
                         } else {
                             incr bufRow  -$size
                             incr viewRow -$size
                         }
                         }
                     }
                     6 { # 6 Next screen
                         if {[read $fid 1] == "~"} {
                         set size [expr {$IDX(ROWMAX) - 1}]
                         incr bufRow  $size
                         incr viewRow $size
                         if {$bufRow >= [llength $BUFFER]} {
                             set viewRow [llength $BUFFER]
                             set bufRow  [expr {$viewRow - 1}]
                         }
                         }
                     }
                 }
             }
             # most of the above cause a BUFFER row change
             set line [lindex $BUFFER $bufRow]
         }
         default {
             set line [string range $line 0 [expr $bufCol - 1]]
             append line $char
             append line [string range $line $bufCol end]

             set BUFFER [lreplace $BUFFER $bufRow $bufRow $line]
             incr bufCol [string length $char]
             if {$bufCol > [string length $line]} {
                 set bufCol [string length $line]
             }
             set IDX(COLLAST) -1 ; # force redraw
         }

     }

     # Constrain current view idx
     if {$viewRow <= 1} {set viewRow 1}
     if {$viewRow >= ($IDX(ROWMAX) - 1)} {
         set viewRow [expr {$IDX(ROWMAX) - 1}]
     }
     set viewCol [expr {$bufCol + 1}]
     if {$viewCol >= $IDX(COLMAX)} {set viewCol $IDX(COLMAX)}

     # start and end view area to display
     set startRow [expr {$bufRow + 1 - $viewRow}]
     set startCol [expr {$bufCol + 1 - $viewCol}]

     display $startRow $startCol

     # translate viewCol to proper index (account for tabs)
     if {[string match "*\t*" $line]} {
         # let's just brute force over the line
         set i 0
         foreach c [split [string range $line \
                 $startCol [expr {$bufCol - 1}]] ""] {
         if {[string equal "\t" $c]} {
             set i [expr {$i + (8 - $i%8)}] ; # align to 8c boundary
         } else {
             incr i
         }
         }
         set viewCol [expr {$startCol + 1 + $i}]
     }

     idx [expr {$bufRow + 1}] $viewCol

     goto $viewRow $viewCol
     cursor on
     flush stdout
     }
 }

 proc linerange {line start end} {
     # Get # *visual* chars - account for tabs (== 8c) in line range
     set line [string range $line $start $end]
     if {[string match "*\t*" $line]} {
     # let's just brute force over the line
     set i    0
     set end [expr {$end-$start}]
     set res {}
     foreach c [split $line ""] {
         if {[string equal "\t" $c]} {
         set i [expr {$i + (8 - $i%8)}] ; # align to 8c boundary
         } else {
         incr i
         }
         append res $c
         if {$i > $end} { break }
     }
     return $res
     }
     return $line
 }

 proc display {startRow startCol} {
     global IDX BUFFER

     cursor off ; home

     if {($IDX(ROWLAST) != $startRow) || ($IDX(COLLAST) != $startCol)} {
     # Add display size to get end points
     set endRow [expr {$startRow + $IDX(ROWMAX) - 1}]
     set endCol [expr {$startCol + $IDX(COLMAX) - 1}]

     for {set i $startRow} {$i < $endRow} {incr i} {
         puts -nonewline "\u001b\[K" ; # erase current line
         puts [linerange [lindex $BUFFER $i] $startCol $endCol]
     }

     set IDX(ROWLAST) $startRow
     set IDX(COLLAST) $startCol
     }
 }

 proc status {msg} {
     global IDX
     set len [expr {$IDX(ROWCOL) - 1}]
     set str [format "%-${len}.${len}s" $msg]
     goto $IDX(ROWMAX) 1
     puts -nonewline "$str"
 }

 proc idx {row col} {
     global IDX
     set str [format " L:%-4d C:%-4d" $row $col]
     # the string must not exceed $IDX(ROWCOLLEN) length
     goto $IDX(ROWMAX) $IDX(ROWCOL)
     puts -nonewline [string range $str 0 $IDX(ROWCOLLEN)]
 }

 proc home {}  { goto 1 1 }
 proc goto {row col} {
     global IDX
     if {$row == "end"} {
         set row $IDX(ROWMAX)
     }
     puts -nonewline "\u001b\[${row};${col}H"
 }
 proc clear {} { puts -nonewline "\u001b\[2J" }
 proc cursor {bool} {
     puts -nonewline "\u001b\[?[expr \
         {$::IDX(ROWMAX)+1}][expr {$bool ? "h" : "j"}]"
 }

 #start of console editor program

 proc console_edit {fileName} {
     global BUFFER IDX
     #Script-Edit by Steve Redler IV  5-30-2001

     set IDX(ROWMAX) 24
     set IDX(COLMAX) 80
     if {![catch {exec stty -a} err]
     && [regexp {rows (\d+); columns (\d+)} $err -> rows cols]} {
         if {$rows != "0" && $cols != 0} {
     set IDX(ROWMAX) $rows
     set IDX(COLMAX) $cols
         }
     }
     set IDX(ROWCOLLEN) 15
     set IDX(ROWCOL) [expr {$IDX(COLMAX) - $IDX(ROWCOLLEN)}]

     set infile [open $fileName RDWR]
     set BUFFER [split [read $infile] "\n"]
     close $infile

     clear ; home
     status "\u0007$fileName loaded"
     idx [llength $BUFFER] 1

     fconfigure stdin -buffering none -blocking 1 -encoding iso8859-1
     fconfigure stdout -translation crlf -encoding iso8859-1

     flush stdout
     exec stty raw -echo
     edittext stdin
     status "Save '$fileName'? Y/n"
     flush stdout
     #fconfigure stdin -buffering full -blocking 1
     set line [read stdin 1]
     exec stty -raw echo
     if {$line != "n"} {
         set outfile [open $fileName w ]
         puts "len of buffer [llength $BUFFER]"
         for {set i 0} {$i<[expr [llength $BUFFER]-1]} {incr i} {
             puts $outfile [lindex $BUFFER $i]
         }
         puts -nonewline $outfile [lindex $BUFFER end]
         close $outfile
         status " Saved"
     } else {
         status " Aborted"
     }
     after 100

     # Reset terminal:
     puts -nonewline "\033c"

     exit 0
 }

 if {$filename == ""} {
     puts "\nPlease specify a filename"
     gets stdin filename
     if {$filename == ""} {exit}

 }

 #SRIV place hostname & filename into the xterms titlebar
 puts -nonewline  "\033\]0;[info hostname] - [file tail $filename]\007"

 console_edit $filename

RLH Is this limited to Linux only? Can another *nix use it as well?

SRIV It should work on any *nix, but I've only tested it on Linux. Test reports welcome.

escargo 29 Mar 2006 - I might give it a try under Cygwin and Cygwin/X [3]. It seems like the key to its function is that the terminal needs to interpret ANSI escape sequences correctly. It might be possible to check the value of env(TERM) to see if it's an acceptable value.

escargo 30 Mar 2006 - The Microsoft Windows with Cygwin console window is of terminal type "cygwin". When I start Cygwin/X, and use the xterm there (of terminal type "xterm"), I get an error message about the "exec stty raw -echo". It's funny, because the commands for stty work in the xterm window.

RLH I might try it on an HP/UX server. I wonder if we could shoot for a PICO/NANO clone?

DKF: With experience, "stty" on some platforms needs to have stdin as a terminal. That's probably the cause of that error message.

slebetman: I've fixed a bug with saving files which caused files to grow by one line each save. I also added code to handle the Home and End keys (mostly copied form the ^a and ^e code). I added search (^f) and goto line (^g) features as well. The previous search can be repeated by pressing the F3 key. The search is regexp based so you can do case insensitive searching by starting your search with (?i).

I hope it's OK since it's only around 80 lines of code. How much of the code can I change anyway? My personal copy of this is radically different and has stuff like syntax hilighting, live/automatic window resize support etc but it breaks the basic processing model of the current code by using nonblocking I/O (still polling though, so my copy uses much higher CPU time). I'm working on re-writing the rendering engine to redraw only changed lines if possible so save bandwidth & speed up I/O.

SRIV Its ok to add to the code, but since you've gone off on a more feature filled tangent, perhaps we could make yours available for download. This is what I've done with my "enhanced" version above. If you would like to send it to me, I'll be glad to host it on my server.

slebetman: In which case I think I'll start a new wiki page and put my code there. I was uncomfortable updating this code because the direction I'm heading with my code will no longer make it a minimal editor. And there is a certain charm with code this small that is lost once it gets too big ;-)

SRIV Great idea! I look forward to trying it. I use mine every day on all the servers/routers I admin (~30) via ssh.

slebetman: Here's my version of the editor: Console Text Editor in Pure Tcl 2. It's almost twice the size of the original editor at around 15k and is still a little bit buggy but good enough for me to use it for heavy coding.

AM (19 june 2006) Could this serve to build a Tcl-only implementation of "readline"? That is, a facility to edit the command line in a more user-friendly way than usual, with history facilities and all? (Probably more work than it seems at first sight :)).

SRIV I think its doable. I would be neat to put in .tclrc. Since the console.tcl code (mostly used in Windows) is pure tcl, then the mechanism is there. Just a blend of code from the editor and console.tcl.

slebetman Yes, I've always wanted readline on tclsh. Not everybody can run TkCon since not every installation have xlib. I already have code to handle history that I implemented in Tk (I couldn't figure out a way to use the built-in history command since the Tcl code handling history will itself interfere with it). It should be quite easy to strip out the Tk bits to suit tclsh:

Inserting a command to the history list:
  set hlevel -1
  set old [lsearch -exact $hist $command]
  if {$old != -1} {
    set hist [lreplace $hist $old $old]
  }
  lappend hist $command

Handling history (I bind this to <KeyPress-Up> and <KeyPress-Down>. Of course we need to change this to work without Tk):
  proc handleHistory {x} {
    global hist hlevel
    clearEnd
    set hlen [llength $hist]
    incr hlevel $x
    if {$hlevel > -1} {
      print [lindex $hist end-$hlevel]
    }
    if {$hlevel < -1} {
      set hlevel -1
    } elseif {$hlevel > $hlen} {
      set hlevel $hlen
    }
    .t.internal mark set insert end
  }
  bind .t <KeyPress-Up> {handleHistory 1}
  bind .t <KeyPress-Down> {handleHistory -1}

AM (6 july 2006) Actually, it might be very simple:

  • Use the editing facilities provided by the above script to edit in a window of one row at the bottom of the screen
  • Add support for the Enter key: that runs the command and displays the output using the ordinary terminal mode, then goes back to editing
  • For multiline commands, we need to fiddle a bit more :)

I want to give that a try ...

slebetman: Encouraged by the experiment of Tcl/Tk OS, I decided to try and see if it is possible to actually implement a pure-tcl readline alternative. Guess what, i believe it is! Here's my attempt: Pure-tcl readline.