[slebetman]: I've been using the console editor form [Linux Console Text Editor In Pure TCL] a lot and have modified it to suit my needs. The first thing I did was to add syntax hilighting mainly because I wanted to easily distinguish lines that I have commented out at a glance. Later I added other features and changed a lot of the underlaying engine. Rather than backport my changes to the original code I decided to post my code here and leave the original code alone.

'''Features:'''

   * Basic syntax hilighting. The hilighting is line based and can easily cope with Tcl style # comments but because it is line based it can't cope with multiline C style /* comments */
   * This is faster at pasting large blocks of text since it does it line by line rather than character by character. It will also try to redraw only the current line if possible rather than the whole screen.
   * Implements '''search''', '''goto''' and '''save''' (without closing the file).
   * Handles '''Home''' and '''End''' keys.
   * Changed the tab to 4 characters (can be easily modified if you prefer 8 or other values).
   * Auto resizes the editor to fit the terminal window.
   * Implements a simple auto-indenting. When inserting a newline by pressing the '''Enter''' or '''Return''' key the leading whitespace of the previous line is copied and automatically inserted.
   * Converts spaces to tabs when pasting text.
   * Implements key rate limiting for control characters and escape sequences. This is to improve responsiveness especially on slow machines/connections so that you don't accidentally "over-delete" when you press the delete key for too long.
   * Implements '''undo''' and '''redo'''.

'''Usage:'''
''The "^" character below denotes pressing the Ctrl key''
   * '''Arrow keys''' : Moves the cursor around. Typing anything inserts text at the cursor.
   * '''Backspace''' : Deletes the character before the cursor.
   * '''Delete''' : Deletes the character behind the cursor.
   * '''Home''' : Moves the cursor to the first non-whitespace character on the current line. Pressing it a second time moves the cursor to the beginning of the line.
   * '''End''' : Moves the cursor to the end of the line.
   * '''Page Up''' and '''Page Down''' : Moves the cursor forwards and backwards one full page at a time.
''Basically the usual navigation keys behaves as expected''
   * '''^a''' : Moves the cursor to the beginning of the line.
   * '''^c''' : Exits the program.
   * '''^d''' : '''D'''eletes the current line.
   * '''^e''' : Moves the cursor to the '''E'''nd of the line.
   * '''^f''' : '''F'''ind/Search. The search pattern is regexp based so characters like ".", "(" and "[" needs to be escaped. Because it is based on Tcl's regexp engine case insensitive search can be done by starting the search with ''(?i)''.
   * '''F3''' : Repeat the previous search.
   * '''^g''' : '''G'''oto line number.
   * '''^q''' : '''Q'''uits/Exits the program. Ask to save the file if buffer is modified.
   * '''^s''' : '''S'''ave the file.
   * '''^z''' : Undo the previous edit.
   * '''^y''' : Redo the last undo.

'''Code:'''

The code is quite messy. A lot of the procs here are not functions but merely act like macros which are upleveled and evaluated in the caller's context. I simply moved them to procs to make it easier for me to see the program logic. The syntax hilighting rules are also hardcoded into the code but is easy enough to modify.

The control character and escape sequence handling have been re-written to be more general and to report unhandled cases. This is to make it easier to add new features to the code. For example, if you want to implement a feature and bind it to ^k just run the editor and press ^k. It will tell you "Unhandled control character:0xb" so that you know you should add the code as a \u000b case in handleControls. The same goes for escape sequences. For example, pressing F12 will generate the message "Unhandled sequence:[24~"

[slebetman] 21 June 2006: An updated version with improved tab handling. Added some more key bindings to support xterm, rxvt and Hyperterminal ''(yes, I really did test it on Hyperterminal)''. I also back-ported [SRIV]'s unique long-line editing method to this code which simplified my rendering engine.

[slebetman] 22 June 2006: Another update. Improved rendering & scrolling speed by removing a few uplevels (upleveled code is really slow). Added "End" key binding for KDE Konsole. Improved search to not change the current view if not necessary.

[slebetman] 23 June 2006: Lots of updates. Moved blocks of code around to make it more readable (for me at least). Implemented '''undo''' and '''redo'''. Solved terminal hanging problem (by implementing my own output buffering for handleRedraw).

  #! /usr/bin/env tclsh
  # tcledit: a linux console based editor in pure tcl
  # 2001-05-30 Original code by Steve Redler IV
  # 2006-06-23 Modified by Adly Abdulah
  
  ################################
  # Preferences:
  ################################
  # How many spaces each tab character takes:
  set tabstop 4
  # Substitute spaces to tabs on newline and pasting:
  set usetabs true
  # Search is case sensitive:
  set searchcase false
  
  ################################
  # Syntax hilighting:
  ################################
  array set bg {
      black 40 red 41 green 42 yellow 43
      blue 44 magenta 45 cyan 46 white 47
  }
  array set fg {
      black 30 red 31 green 32 yellow 33
      blue 34 magenta 35 cyan 36 white 37
  }
  array set style {
      none 0 bright 1 dim 2
      underline 4 blink 5 reverse 7
  }
  set syntaxRules {
      # The syntax rules is in the form:
      #   {regexp} {formatting}
      # Each rule must be on a single line. Comments in here are ignored.    
      # Syntax hilighting is line based so we can't have multi-line rules
      # like C-style comments.
      #
      # If more than one rule applies to piece of text then the most 
      # encompassing rule wins. For example for the text:
      #   "$example" 
      # both the script variable (due to $) and the string rules (".*?") 
      # apply. However since the string rule encompasses the script 
      # variable rule then the string rule wins and the text is colored
      # according to the string rule.
      #
      # But within each rule toe opposite is true. If the regexp matches
      # a piece of text multiple times then the most specific match wins.
      # For example for the Tcl variable regexp:
      #   {(?:set|append|incr) ([a-zA-Z_][a-zA-Z0-9_]*)}
      # the text:
      #   set x
      # matches twice. Once for "set x" and another time for "x". Since
      # "x" is more specific then only it will be colored by the rule.
      # This overcomes Tcl's lack of look-behind in its regexp engine.
      #
      # Formatting is defined by ANSI escape sequence. For example bright
      # green is {1;32}. The arrays fg, bg and style above makes it more
      # convenient to define the formatting. Using the previous example
      # bright green may be written as {$style(bright);$fg(green)}.
      
      # Strings & numbers:
      {".*?"} {$fg(magenta)}
      {[0-9]+} {$fg(magenta)}
      
      # File magics:
      {^#!.*$} {$style(bright);$fg(green);$bg(blue)}
      {^package\s+.*$} {$style(bright);$fg(green);$bg(blue)}
      
      # Script comments/C preprocessing
      {(?:^|;)\s*#.*$} {$fg(green)}
      
      # Script style variables:
      {(?i)\$[a-z_][a-z0-9_]*} {$style(bright);$fg(cyan)}
      {(?i)[\@\%][a-z_][a-z0-9_]*} {$style(bright);$fg(yellow)}
      
      # Tcl variable names after a command:
      {(?:set|append|incr) ([a-zA-Z_][a-zA-Z0-9_]*)} {$fg(cyan)}
      {(?:global) ([a-zA-Z_][a-zA-Z0-9_ ]*)} {$fg(cyan)}
      
      # Email address:
      {(?i)(?:[a-z0-9-]+\.)*[a-z0-9-]+\@(?:[a-z0-9-]+\.)*[a-z0-9-]+} {$style(bright)}
      
      # Backtick exec:
      {`.*?`} {$bg(yellow);$fg(black)}
  }
  foreach rule [split $syntaxRules "\n"] {
      set rule [string trim $rule]
      if {$rule != "" && [string index $rule 0] != "#"} {
          foreach {pattern attr} $rule break
          lappend hilight $pattern [subst $attr]
      }
  }
  
  ################################
  # Globals
  ################################
  set filename [lindex $argv 0]
  set searchpattern ""
  set statusmessage ""
  set modified 0
  set viewRow 1
  set viewCol 1
  set bufRow 0
  set bufCol 0
  set undoBuffer ""
  set redoBuffer ""
  
  ################################
  # Utilities
  ################################
  proc readbuf {txt} {
      upvar 1 $txt STRING
      upvar 1 fid fid
      
      set ret [string index $STRING 0]
      set STRING [string range $STRING 1 end]
      if {$STRING == ""} {
          append STRING [read $fid]
      }
      return $ret
  }
  
  proc endLine {} {
      global BUFFER bufRow bufCol
      set x [string length [lindex $BUFFER $bufRow]]
      if {$bufCol > $x} {
          set bufCol $x
      }
  }
  
  proc getSpaces {line} {
      global tabstop usetabs
      set ret [lindex [regexp -inline {^[[:space:]]+} $line] 0]
      if {$usetabs} {
          string map [list [string repeat " " $tabstop] "\t"] $ret
      } else {
          set ret
      }
  }
  
  proc getInput {buffer {txt ""}} {
      global viewRow viewCol
      
      upvar 1 $buffer keybuffer
      upvar 1 fid fid
  
      status ""
      goto end 1
      puts -nonewline "\033\[7m$txt "
      flush stdout
      set ret ""
      while {[set ch [readbuf keybuffer]] != "\n" && $ch != "\r"} {
          if {$ch == ""} {
              after 40
              continue
          }
          if {$ch == "\u0003"} {
              doExit
          } elseif {$ch == "\u001b"} {
              # escape:
              if {$keybuffer == ""} {
                  return
              }
  
              # need to ignore escapes sequences:
              while {[set ch [readbuf keybuffer]] != "~"
                  && $keybuffer != ""} {}
              continue
          } elseif {$ch == "\u007f" || $ch == "\u0008"} {
              # handle backspace:
              set ret [string range $ret 0 end-1]
          } elseif {[string is print $ch]} {
              append ret $ch
          }
          set stat "$txt $ret"
          set len [expr [string length $stat]+1]
          status $stat
          goto end $len
          flush stdout
      }
      return $ret
  }
  
  proc getCol {row bCol} {
      global BUFFER tabstop
  
      set col 0
      set i 0
      foreach c [split [lindex $BUFFER $row] ""] {
          if {$i >= $bCol} break
          if {$c == "\t"} {
              # align to tabs:
              incr col [expr {$tabstop-$col%$tabstop}]
          } else {
              incr col
          }
          incr i
      }
      incr col
  }
  
  proc status {args} {
      global IDX statusmessage
      
      if {[llength $args] != 0} {
          set statusmessage [join $args " "]
      }
  
      set len $IDX(ROWCOL)
      set str [format "%-${len}.${len}s" $statusmessage]
      puts -nonewline "\033\[7m\u001b\[$IDX(ROWMAX);00H$str\033\[0m"
      goto cursor
      #flush stdout
  }
  
  proc idx {row col} {
      global IDX BUFFER
      set c $IDX(ROWCOL)
      set r $IDX(ROWMAX)
      set str [format " L:%-9s C:%-4d\033\[0m" "$row/[llength $BUFFER]" $col]
      set str [string range $str 0 $IDX(ROWCOLLEN)]
      puts -nonewline "\033\[7m\u001b\[${r};${c}H${str}\033\[0m"
  }
  
  proc goto {row {col 1}} {
      puts -nonewline [doGoto $row $col]
  }
  proc doGoto {row {col 1}} {
      global IDX viewRow viewCol
  
      switch -- $row {
          "home" {set row 1}
          "cursor" {
              set row $viewRow
              set col $viewCol
          }
      }
  
      if {$row == "end"} {
          set row $IDX(ROWMAX)
      }
      return "\u001b\[${row};${col}H"
  }
  
  proc clear {} {
      puts -nonewline "\u001b\[2J"
      flush stdout
  }
  
  proc clearline {} {
      return "\u001b\[2K"
  }
  
  ################################
  # Command handlers
  ################################
  proc handleDelete {dir} {
      global BUFFER bufRow bufCol viewRow
      global undoBuffer redoBuffer
      upvar 1 line line
  
      set line [lindex $BUFFER $bufRow]
  
      if {$dir == "-"} {
          if {$bufCol == 0 && $bufRow > 0} {
              set upRow [expr {$bufRow-1}]
              set line [lindex $BUFFER $upRow]
              set bufCol [string length $line]
              append line [lindex $BUFFER $bufRow]
              set BUFFER [lreplace $BUFFER $upRow $bufRow $line]
              incr viewRow -1
              set bufRow $upRow
              
              register undoDelete $bufRow $bufCol "\n"
              
              handleRedraw partial
              return
          }
          incr bufCol -1
      } else {
          if {$bufCol == [string length $line] && $bufRow < [llength $BUFFER]} {
              set downRow [expr {$bufRow+1}]
              append line [lindex $BUFFER $downRow]
              set BUFFER [lreplace $BUFFER $bufRow $downRow $line]
              
              register undoDelete $bufRow $bufCol "\n"
              
              handleRedraw partial
              return
          }
      }
      
      register undoDelete $bufRow $bufCol [string index $line $bufCol]
      
      set line [string replace $line $bufCol $bufCol]
      set BUFFER [lreplace $BUFFER $bufRow $bufRow $line]
      handleRedraw edit
      return
  }
  
  proc syntaxHilight {line start {charmap ""}} {
      global hilight IDX
      
      set tabmap "\t"
      if {$charmap != ""} {
          set tabmap $charmap
      }
  
      set matches ""
      set end [expr {$start+$IDX(COLMAX)-1}]
      foreach {pattern color} $hilight {
          set ps 0
          set pn 0
          foreach m [regexp -inline -all -indices -- $pattern $line] {
              foreach {s n} $m break
              lappend m $color
              if {$s <= $pn && $s >= $ps && $n <= $pn} {
                  set matches [lreplace $matches end end $m]
              } else {
                  lappend matches $m
              }
              set ps $s
              set pn $n
          }
      }
  
      set oldline [string range $line $start $end]
      set line {}
      set prev 0
      foreach m [lsort -integer -index 0 $matches] {
          foreach {s n color} $m break
          if {$s < $start} {
              set s 0
          } else {
              set s [expr {$s-$start}]
          }
          set n [expr {$n-$start}]
          if {$n > $end} {set n $end}
              
          if {$s < $prev} continue
          append line [string range $oldline $prev [expr {$s-1}]]
          set prev [expr {$n+1}]
          append line "\033\[${color}m"
          append line [string range $oldline $s $n]
          if {$n != $end} {
              append line "\033\[0m"
          }
      }
      append line [string range $oldline $prev end]
      append line "\033\[0m"
      
      return $line
  }
  
  proc handleSearch {} {
      global searchpattern searchcase
      global BUFFER IDX viewRow bufRow bufCol
      
      if {$searchpattern != ""} {
          status "Search: $searchpattern"
          
          if {!$searchcase} {
              # Add (?i) to make search case insensitive:
              
              set n [regexp -inline -indices \
                  {^\(\?[bceimnpqstwx]+?\)} $searchpattern]
              if {$n == ""} {
                  set pattern "(?i)$searchpattern"
              } else {
                  set n [lindex [lindex $n 0] 1]
                  set opt [string range $searchpattern 2 [expr {$n-1}]]
                  if {[regexp {i|c} $opt] == 0} {
                      append opt i
                  }
                  set pattern "(?$opt)"
                  append pattern [string range $searchpattern [expr {$n+1}] end]
              }
          } else {
              set pattern $searchpattern
          }
          
          if {[catch {lsearch -regexp [lrange $BUFFER \
              [expr {$bufRow+1}] end] $pattern} found]} {
              # Regexp error:
              status "regexp error: [lindex [split $found :] 1]"
          } else {
              set startRow $bufRow
              if {$found == -1} {
                  set found [lsearch -regexp $BUFFER $pattern]
                  if {$found != -1} {
                      set bufRow $found
                  }
              } else {
                  incr bufRow $found
                  incr bufRow
              }
              if {$found != -1} {
                  set rowDiff [expr {$bufRow-$startRow}]
                  incr viewRow $rowDiff
                  if {$viewRow < 0 || $viewRow > $IDX(ROWMAX)} {
                      set viewRow 5
                  }
              
                  set C [regexp -indices -inline -- $pattern \
                      [lindex $BUFFER $bufRow]]
                  set bufCol [lindex [lindex $C 0] 0]
                  if {$bufRow < $viewRow} {
                      set viewRow 0
                  }
              } else {
                  status "Search: $searchpattern (not found!)"
              }
          }
      }
      handleRedraw
  }
  
  proc handleNewline {} {
      global BUFFER viewRow bufRow bufCol
      global undoBuffer redoBuffer
      upvar 1 keybuffer keybuffer
      
      # The getSpaces is for auto-indenting:
      set line [lindex $BUFFER $bufRow]
      set newline [getSpaces $line]
  
      set currline [string range $line 0 [expr {$bufCol - 1}]]
      set line [string range $line $bufCol end]
      set BUFFER [lreplace $BUFFER $bufRow $bufRow $currline]
  
      set row $bufRow
      incr bufRow
      set col $bufCol
  
      if {$keybuffer == "" && [regexp {^\s} $line] == 0} {
          set len [string length $newline]
          append newline $line
          set bufCol $len
      } else {
          set newline $line
          set bufCol 0
      }
      set BUFFER [linsert $BUFFER $bufRow $newline]
      
      register undoInsert $row $col $bufRow $bufCol
      
      handleRedraw partial
      incr viewRow
  }
  
  proc handleInsert {} {
      global BUFFER bufRow bufCol viewRow
      global undoBuffer redoBuffer
      upvar 1 printbuffer printbuffer
      
      set line [lindex $BUFFER $bufRow]
      set oldline $line
      set line [string range $oldline 0 [expr $bufCol - 1]]
      append line [getSpaces $printbuffer]
      append line [string trimleft $printbuffer]
      append line [string range $oldline $bufCol end]
      set BUFFER [lreplace $BUFFER $bufRow $bufRow $line]
      set len [string length $printbuffer]
      set col $bufCol
      incr bufCol $len
      
      register undoInsert $bufRow $col $bufRow $bufCol
  }
  
  proc undoDelete {sRow sCol txt} {
      global BUFFER IDX bufRow bufCol viewRow
      
      set bufRow $sRow
      set bufCol $sCol
      set line [lindex $BUFFER $bufRow]
      set oldline $line
      
      set txt [split $txt "\n"]
      
      set line [string range $oldline 0 [expr $bufCol - 1]]
      set endline [string range $oldline $bufCol end]
      set line "$line[lindex $txt 0]"
      if {[llength $txt] > 1} {
          set BUFFER [lreplace $BUFFER $bufRow $bufRow $line]
          foreach x [lrange $txt 1 end-1] {
              incr bufRow
              set BUFFER [linsert $BUFFER $bufRow $x]
          }
          incr bufRow
          set last [lindex $txt end]
          set endline "$last$endline"
          set BUFFER [linsert $BUFFER $bufRow $endline]
          set len [string length $last]
          set bufCol $len
      } else {
          append line [string range $oldline $bufCol end]
          set BUFFER [lreplace $BUFFER $bufRow $bufRow $line]
          set len [string length [lindex $txt 0]]
          incr bufCol $len
      }
      
      if {$bufRow < $IDX(COLMAX)} {
          set viewRow [expr {$bufRow+1}]
      }
      set IDX(ROWLAST) -1 ;# force redraw
      handleRedraw
      
      return [list undoInsert $sRow $sCol $bufRow $bufCol]
  }
  
  proc undoInsert {sRow sCol nRow nCol} {
      global BUFFER IDX bufRow bufCol viewRow
      
      set bufRow $sRow
      set bufCol $sCol
      set oldline [lindex $BUFFER $sRow]
      set line [string range $oldline 0 [expr {$sCol-1}]]
      set endline [lindex $BUFFER $nRow]
      
      if {$sRow == $nRow} {
          set deleted [string range $oldline $sCol [expr {$nCol-1}]]
      } else {
          set deleted [string range $oldline $sCol end]
          for {set x [expr {$sRow+1}]} {$x < $nRow} {incr x} {
              append deleted "\n"
              append deleted [lindex $BUFFER $x]
          }
          append deleted "\n"
          append deleted [string range $endline 0 [expr {$nCol-1}]]
      }
      
      append line [string range $endline $nCol end]
      set BUFFER [lreplace $BUFFER $sRow $nRow $line]
      
      if {$bufRow < $IDX(COLMAX)} {
          set viewRow [expr {$bufRow+1}]
      }
      set IDX(ROWLAST) -1 ;# force redraw
      handleRedraw
      return [list undoDelete $sRow $sCol $deleted]
  }
  
  proc handleUndo {} {
      global undoBuffer redoBuffer
      if {[llength $undoBuffer] > 0} {
          set op [lindex $undoBuffer end]
          set undoBuffer [lreplace $undoBuffer end end]
          lappend redoBuffer [eval $op]
          status ""
      } else {
          status "undo buffer empty."
          flush stdout
      }
  }
  
  proc handleRedo {} {
      global undoBuffer redoBuffer
      if {[llength $redoBuffer] > 0} {
          set op [lindex $redoBuffer end]
          set redoBuffer [lreplace $redoBuffer end end]
          lappend undoBuffer [eval $op]
          status ""
      } else {
          status "redo buffer empty."
          flush stdout
      }
  }
  
  proc register {type args} {
      global undoBuffer redoBuffer
      set last [lindex $undoBuffer end]
      set lastarg [lrange $last 1 end]
      set last [lindex $last 0]
      
      set redoBuffer ""
      
      switch -exact -- $type {
          "undoInsert" {
              foreach {sRow sCol nRow nCol} $args break
              if {$last == $type} {
                  foreach {lsRow lsCol lnRow lnCol} $lastarg break
                  if {$sRow == $lnRow && $sCol == $lnCol} {
                      set sRow $lsRow
                      set sCol $lsCol
                      set undoBuffer [lreplace $undoBuffer end end]
                  }
              }
              lappend undoBuffer [list $type $sRow $sCol $nRow $nCol]
          }
          "undoDelete" {
              foreach {sRow sCol txt} $args break
              if {$last == $type} {
                  foreach {lsRow lsCol ltxt} $lastarg break
                  if {$sRow == $lsRow} {
                      if {$sCol == $lsCol} {
                          set txt "$ltxt$txt"
                          set undoBuffer [lreplace $undoBuffer end end]
                      } elseif {$sCol+1 == $lsCol} {
                          append txt $ltxt
                          set undoBuffer [lreplace $undoBuffer end end]
                      }
                  } elseif {$sRow+1 == $lsRow && $txt == "\n"} {
                      append txt $ltxt
                      set undoBuffer [lreplace $undoBuffer end end]
                  }
              }
              lappend undoBuffer [list $type $sRow $sCol $txt]
          }
      }
  }
  
  ################################
  # Key bindings
  ################################
  proc handleEscapes {} {
  uplevel 1 {
      set seq ""
      set found 0
      while {[set ch [readbuf keybuffer]] != ""} {
          append seq $ch
  
          switch -exact -- $seq {
              "\[A" { ;# Cursor Up (cuu1,up)
                  if {$bufRow > 0} {
                      if {[getCol $bufRow $bufCol] > $IDX(COLMAX)} {
                          set tmp $bufCol
                          set bufCol 0
                          handleRedraw line
                          set bufCol $tmp
                      }
                      incr bufRow -1
                      incr viewRow -1
                  }
                  endLine
                  handleRedraw
                  set found 1; break
              }
              "\[B" { ;# Cursor Down
                  if {$bufRow < [expr {[llength $BUFFER] - 1}]} {
                      if {[getCol $bufRow $bufCol] > $IDX(COLMAX)} {
                          set tmp $bufCol
                          set bufCol 0
                          handleRedraw line
                          set bufCol $tmp
                      }
                  
                      incr bufRow 1
                      incr viewRow 1
                  }
                  endLine
                  handleRedraw
                  set found 1; break
              }
              "\[C" { ;# Cursor Right (cuf1,nd)
                  if {$bufCol < [string length [lindex $BUFFER $bufRow]]} {
                      incr bufCol 1
                  }
                  handleRedraw line
                  set found 1; break
              }
              "\[D" { ;# Cursor Left
                  if {$bufCol > 0} {
                      incr bufCol -1
                  }
                  handleRedraw line
                  set found 1; break
              }
              "\[H" -
              "\[7~" -
              "\[1~" { ;# home
                  set line [lindex $BUFFER $bufRow]
                  set homeCol [regexp \
                      -indices -inline -- \
                      {^[[:space:]]*} $line]
                  set homeCol [lindex [lindex $homeCol 0] 1]
                  incr homeCol
                  if {$bufCol != $homeCol} {
                      set bufCol $homeCol
                  } else {
                      set bufCol 0
                  }
                  handleRedraw line
                  set found 1; break
              }
              "\[3~" { ;# delete
                  handleDelete +
                  set found 1; break
              }
              "\[F" -
              "\[K" -
              "\[8~" -
              "\[4~" { ;# end
                  set bufCol [string length [lindex $BUFFER $bufRow]]
                  handleRedraw line
                  set found 1; break
              }
              "\[5~" { ;# 5 Prev screen
                  set size [expr {$IDX(ROWMAX) - 1}]
                  if {$bufRow < $size} {
                      set bufRow  0
                      set viewRow 1
                  } else {
                      incr bufRow  -$size
                      incr viewRow -$size
                  }
                  endLine
                  handleRedraw
                  set found 1; break
              }
              "\[6~" { ;# 6 Next screen
                  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}]
                  }
                  endLine
                  handleRedraw
                  set found 1; break
              }
              "OR" -
              "\[13~" { ;# F3
                  handleSearch
                  set found 1; break
              }
          }
      }
      if {$found == 0} {
          status "Unhandled sequence:$seq ([string length $seq])"
          flush stdout
      }
  }
  }
  
  proc handleControls {} {
  uplevel 1 {
      # Control chars start at a == \u0001 and count up.
      switch -exact -- $char {
          \u001a { ;# ^z - undo
              handleUndo
          }
          \u0019 { ;# ^y - redo
              handleRedo
          }
          \u001c { ;# ^| - dump undoBuffer (for dubugging)
              global undoBuffer redoBuffer
              puts -nonewline "\033\[2J"
              goto home
              puts "Debug Info (press ESC to exit this screen)"
              puts "\033\[7mUndo buffer ([llength $undoBuffer] actions):\033\[0m"
              foreach x $undoBuffer {
                  puts $x
              }
              puts "\033\[7mRedo buffer ([llength $redoBuffer] actions):\033\[0m"
              foreach x $redoBuffer {
                  puts $x
              }
              status
              idx $viewRow $viewCol
              flush stdout
              
              # Wait for ESC key:
              fconfigure stdin -blocking 1
              while 1 {if {[read stdin 1] == "\033"} break}
              fconfigure stdin -blocking 0
              read stdin
              set IDX(ROWLAST) -1 ;# force redraw
              handleRedraw
          }
          \u0011 { ;# ^q - quit
              return done
          }
          \u0001 { ;# ^a - beginning of line
              set bufCol 0
              handleRedraw line
          }
          \u0003 { ;# ^c
              doExit 1
          }
          \u0004 { ;# ^d - delete line
              if {$bufRow < [llength $BUFFER]} {
                  set oldline [lindex $BUFFER $bufRow]
                  set BUFFER [lreplace $BUFFER $bufRow $bufRow]
                  
                  register undoDelete $bufRow 0 "$oldline\n"
                  
                  handleRedraw partial
              }
          }
          \u0005 { ;# ^e - end of line
              set bufCol [string length $line]
              handleRedraw line
          }
          \u0006 { ;# ^f - find/search
              global searchpattern
              set searchpattern [getInput keybuffer "Search:"]
              handleSearch
          }
          \u0007 { ;# ^g - goto line
              if {[set n [getInput keybuffer "Goto Line:"]] != "" &&
                  [string is integer $n]
              } {
                  
                  set bufRow [expr {$n-1}]
                  if {$bufRow < $viewRow} {
                      set viewRow 0
                  } else {
                      set len [llength $BUFFER]
                      if {$bufRow > $len} {
                          set bufRow [expr {$len-1}]
                      }
                  }
              } else {
                  status ""
              }
              handleRedraw
          }
          \u0013 { ;# ^s - save file
              saveFile
          }
          \u0008 -
          \u007f { ;# ^h && backspace ?
              handleDelete -
          }
          \u001b { ;# ESC - handle escape sequences
              handleEscapes
          }
          default {
              binary scan $char c ch
              status "Unhandled control character:[format 0x%x $ch]"
              flush stdout
          }
      }
      # Rate limiter:
      set keybuffer ""
  }
  }
  
  ################################
  # Rendering engine
  ################################
  proc linerange {row} {
      global BUFFER tabstop bufCol
      
      set col 0
      set line ""
      set L [split [lindex $BUFFER $row] "\t"]
      set last [lindex $L end]
      set L [lrange $L 0 end-1]
      foreach c $L {
          incr col [string length $c]
          set n [expr {$tabstop-$col%$tabstop}]
          incr col $n
      
          # align to tabs:
          append line $c
          append line [string repeat " " $n]
      }
      append line $last
  }
  
  proc handleRedraw {{mode "full"}} {
      # Valid modes are: full(default), line, edit, partial
      
      global IDX BUFFER tabstop viewRow viewCol bufRow bufCol
      
      # Buffer-up everything so we can manage outputs better:
      set drawBuffer ""
      
      # Constrain current view idx
      set inview 1
      if {$viewRow <= 1} {set viewRow 1}
      if {$viewRow >= ($IDX(ROWMAX) - 1)} {
          set viewRow [expr {$IDX(ROWMAX) - 1}]
          set inview 0
      }
      
      set startRow [expr {$bufRow + 1 - $viewRow}]
      if {$mode == "partial" && $inview} {
          set start $bufRow
          append drawBuffer [doGoto $viewRow 1]
      } else {
          set start $startRow
          append drawBuffer [doGoto home]
      }
      set row $bufRow
  
      if {$mode == "full" || $mode == "partial"} {
          if {$IDX(ROWLAST) != $startRow || $mode == "partial"} {
              # Add display size to get end points
              set endRow [expr {$startRow + $IDX(ROWMAX) - 1}]
              set i 0
              for {set row $start} {$row < $endRow} {incr row} {
                  incr i
                  if {$row == $bufRow} {
                      append drawBuffer "\n"
                  } else {
                      set line [linerange $row]
                      append drawBuffer [clearline]
                      append drawBuffer [syntaxHilight $line 0]
                      append drawBuffer "\n"
                  }
              }
          }
      }
  
      set line [linerange $bufRow]
      set viewCol [set col [getCol $bufRow $bufCol]]
      if {$viewCol >= $IDX(COLMAX)} {set viewCol $IDX(COLMAX)}
          
      if {$IDX(ROWLAST) != $startRow || 
          $mode == "line" || 
          $mode == "edit" ||
          $mode == "partial"
      } {
          set startCol [expr {$col-$viewCol}]
          if {$mode != "line" || $IDX(COLLAST) != $startCol} {
              append drawBuffer [doGoto $viewRow 1]
              append drawBuffer [clearline]
              append drawBuffer [syntaxHilight $line $startCol " "]
              set IDX(COLLAST) $startCol
          }
      }
      
      if {$IDX(ROWLAST) != $startRow} {
          set IDX(ROWLAST) $startRow
      }
  
      idx [expr {$bufRow + 1}] [expr {$bufCol+1}]
  
      append drawBuffer [doGoto $viewRow $viewCol]
      
      # Output 2k bytes at a time and flush.
      # This is necessary to avoid tty hanging due to buffer overrun:
      for {set i 0} {$i < [string length $drawBuffer]} {incr i 2048} {
          puts -nonewline [string range $drawBuffer $i [expr {$i+2047}]]
          flush stdout
          after 1
      }
  }
  
  ################################
  # main()
  ################################
  proc edittext {fid} {
      global BUFFER IDX viewRow viewCol bufRow bufCol
  
      set IDX(ROWLAST) -1 ; # last row most recently displayed in view
      set IDX(COLLAST) -1
      set char ""         ; # last char received
      set line [lindex $BUFFER $bufRow] ; # line data of current line
  
      handleRedraw
      goto home; flush stdout
      set keybuffer ""
      set printbuffer ""
      set timestamp [clock seconds]
      set prevRow $bufRow
  
      while {$char != "\u0011"} {
          append keybuffer [read $fid]
          if {[eof $fid]} {return done}
          if {$keybuffer == ""} {
              set now [clock seconds]
              if {$now != $timestamp} {
                  set timestamp $now
                  set changed 0
                  getRowColMax
                  if {$changed} {
                      handleRedraw
                  }
              }
              if {$printbuffer != ""} {
                  handleInsert
                  if {$prevRow != $bufRow} {
                      set prevRow $bufRow
                      handleRedraw
                  }
                  handleRedraw edit
                  set printbuffer ""
              }
              after 40
              continue
          }
          set char [readbuf keybuffer]
          
          if {[string is print $char] || $char == "\t"} {
              append printbuffer $char
          } elseif {$char == "\n" || $char == "\r"} {
              handleInsert
              handleNewline
              if {$keybuffer == ""} {
                  handleRedraw
              }
              set printbuffer ""
          } else {
              handleControls
              set prevRow $bufRow
          }
      }
  }
  
  proc getRowColMax {} {
  uplevel 1 {
      if {![catch {exec stty -a} err]
          && [regexp {rows (\d+); columns (\d+)} $err -> rows cols]} {
          if {$rows != 0 && $cols != 0} {
              if {$rows != $IDX(ROWMAX)} {
                  set IDX(ROWMAX) $rows
                  set changed 1
              }
              if {$cols != $IDX(COLMAX)} {
                  set IDX(COLMAX) $cols
                  set changed 1
              }
          }
      }
      if {$changed} {
          set IDX(ROWCOL) [expr {$IDX(COLMAX) - $IDX(ROWCOLLEN)}]
          status
          idx $bufRow $bufCol
          set IDX(ROWLAST) -1 ;# force redraw
      }
  }
  }
  
  proc saveFile {} {
      global filename BUFFER modified
      
      if {!$modified} return
      
      status "Save '$filename'? Y/n"
      flush stdout
      fconfigure stdin -blocking 1
      while 1 {
          set line [read stdin 1]
          if {$line == "y" || $line == "Y" || $line == "\n"} {
              set outfile [open $filename w ]
              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 '$filename' ([llength $BUFFER] lines)"
              set modified 0
              break
          } elseif {$line == "n" || $line == "N" || $line == "\033"} {
              status " Aborted"
              break
          } elseif {$line == "\u0003"} {
              doExit
          }
      }
      flush stdout
      fconfigure stdin -blocking 0
  }
  
  proc bufferModified {args} {
      global modified
      set modified 1
  }
  
  proc console_edit {fileName} {
      global BUFFER IDX tabstop bufRow bufCol
  
      set IDX(ROWMAX) 24
      set IDX(COLMAX) 80
      set IDX(ROWCOLLEN) 18
      set changed 1
  
      set infile [open $fileName RDWR]
      set BUFFER [split [read $infile] "\n"]
      close $infile
      
      trace variable BUFFER w bufferModified
      
      getRowColMax
  
      clear ; goto home
      status "$fileName loaded"
      idx [llength $BUFFER] 1
  
      fconfigure stdin -buffering none -blocking 0 -encoding iso8859-1
      fconfigure stdout -buffering full -translation crlf -encoding iso8859-1
  
      flush stdout
      exec stty raw -echo
      set err [catch {edittext stdin}]
      
      if {$err == 0} {
          saveFile
      }
      
      doExit $err
  }
  
  proc doExit {{err 0}} {
      # Reset terminal:
      puts -nonewline "\033c\033\[2J"
      if {$err} {
          global errorInfo
          puts $errorInfo
      }
      flush stdout
      exec stty -raw echo
      after 100
      exit 0
  }
  
  if {$filename == ""} {
      puts "\nPlease specify a filename"
      gets stdin filename
      if {$filename == ""} {exit}
  }
  
  console_edit $filename


[SRIV] I really like the addition of color. The one issue I found was that the editor consumes 100% cpu while waiting for a keystoke. Easily noticable for me since I'm on a notebook.

[slebetman] Yeah, this implementation uses busy polling the non-blocking stdin. In lieu of Tk's event loop this was the quickest hack I could think of to get the auto-resizing and fast-pasting to work. Of course we can reduce CPU consumption by using after and vwait. In fact, something like after 100 is responsive and fast enough for a human to not notice yet will reduce CPU consumption by more than 85% (depending on your CPU MHz of course).

[slebetman] I've added a couple of '''after 50''' in the input loops which should limit the polling rate down to 20Hz max. This is still an ugly hack but on my machine it brought down CPU usage from 75%-99.9% to 0.2%-5%.

[SRIV] Great job! I think I'll start using your version now. I like it a lot!
----
[Category Editor utility], [Category Application]