[slebetman]: I've been using the console editor from [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 highlighting 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 underlying engine. Rather than backport my changes to the original code I decided to post my code here and leave the original code alone.

[slebetman] 10 March 2014: This code is now hosted on github: https://github.com/slebetman/tcled.

To clone the repository simply do:

======none
  git clone https://github.com/slebetman/tcled.git
======

The code on this page remains for historical reference. Please clone or fork the one on github for future updates.


'''Features:'''

   * Basic syntax highlighting. The highlighting 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'''.
   * Implements suspending and resuming the editing session.
   * Implements tab completion based on words already in the current document.
   * Supports CTags's tags file (if one is found) so you can look up function and variable definitions.

'''Usage:'''
   * '''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 backwards and forwards one full page at a time.
''Basically the usual navigation keys behaves as expected.''
''The "^" character below denotes pressing the Ctrl key.''
   * '''^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.
   * '''F3''' : Repeat the previous search.
   * '''^g''' : '''G'''oto line number. If you type "here" as the line number you will goto the current line. Since goto keeps a history of all previous gotos the "here" index is useful for bookmarking the current line.
   * '''^o''' : Page Up. Moves the cursor backwards one full page.
   * '''^p''' : Page Down. Moves the cursor forwards one full page.
   * '''^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.
   * '''^w''' : Suspend the session, optionally save the file and exit. The suspended session is saved to a file with a ''.tsuspend'' extension. Opening this file will resume where you left off.
   * '''Tab''' : When typing autocompletes the current word.
   * '''^Down Arrow''' : Go to definition of word under cursor (if found in tags file).
   * '''^Up Arrow''' : Return from definition.

'''Command Line Arguments:'''
   * '''-s''' ''filename'' : Append the syntax rules defined in a file to the current list of syntax rules.
   * '''-S''' ''filename'' : Replace the current syntax rules with ones defined in the file.
   * '''-f''' ''extension'' : Force the syntax highlighter to use the rules for the given extension.
   * '''-G''' '''line_number''' : Open file and go to line.
   * '''-F''' '''regexp''' : Open file and executes a find/search.
   * '''-define''' ''variable'' ''value'' : Allows you to modify global variables.
----

'''Code:'''

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). Implemented case-insensitive searching (can still be overridden by the (?c) switch). This can be turned off by setting the '''searchcase''' variable to true. Gathered all preference related golbals to the top of the file.

[slebetman] 25 June 2006: Modified handling of non-existent files so that you can create a new file by simply starting the editor with a non-existant filename. But the editor won't create the file (like in [SRIV]'s modified version) until it is time to save so if you don't save then you don't need to delete the file. Also added code to handle opening read-only file. Not only can it now open read-only files but it also turns off editing for read-only files. Also added extra key bindings for PageUp and PageDown since Hyperterminal swallows PageUp and PageDown for its own use.

[slebetman] 26 June 2006: Added filepattern to syntax highlighting rules. This allows different types of files to have different highlighting rules. Like CSS, the rules are cascadable. File patterns are matched against either the tail of the shell magic (#! ...) or the file extension.

[slebetman] 30 August 2007: Big update & bug fixes. I've been using this version for almost a year now so I thought I'd update this page. New features include being able to suspend a session (^w), goto history (just use up and down arrow to view previous goto), bookmarking using goto and a bunch of command line arguments.

[slebetman] 22 July 2009: Added basic autocomplete/tab completion (because I find that I can't live without it). It basically scans the whole document for words that begins with the current word. Just tab to cycle through the list of words or type Alt-number to select matching words from the list at the bottom of the screen. Note that I have a personal code style that disallows use of tabs anywhere other than the beginning of lines so this works for me. If tab-to-complete annoys you then comment out the substAutoComplete call in handleInsert and add you own preferred key binding.

[slebetman] 11 October 2012: CTags support & bug fixes. Haven't updated this code for a long time so lots of small changes. First, I finally figured out how to handle terminals that send escape sequences in multiple packets (fileevents). I'm using Cygwin at my new work place and the bundled mintty terminal really likes to do that. As a side effect the bug fix also fixes crashes on linux terminals where this same problem sometimes causes the program to enter weird states due to improperly parsed escape sequences. The really big change is adding CTags support for navigating large code bases. Just move the cursor to a function or variable name and press ctrl-down_arrow to go to the file where it is defined. Pressing ctrl-up_arrow takes you back to where you came from. It's basically the same as exiting the current editor (ctrl-down_arrow basically spawns a new editor) but won't quit if you're in the last editor in the stack. 

[slebetman] 17 October 2012: Backported to tcl8.4. This does introduce a bug though. The CTags code cannot handle filenames with "{" or "}" in them. Can be fixed but is a not an issue for me at the moment.

======
  #! /usr/bin/env tclsh

  set ABOUT {
  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
  }

  # RE for strings and numbers:
  set STRINGS {{("(?:[^\"]*?[^\\])??")|('(?:[^']*?[^\\])??')}}
  set NUMBERS {{\y(0x[0-9a-fA-F]+|[0-9][0-9\.]*)\y}}

  set COMMENT_FORMAT {$fg(green)}

  set syntaxRules {
    # The syntax rules is in the form:
    # {filepattern} {{regexp} {formatting}...}
    # Comments in here are ignored.

    {^(po|pot)$} {
      {#:.+$} {$style(underline)}
      {#,\s*fuzzy.*$} {$fg(yellow);$bg(red);$style(bright)}
      {msgid|msgstr} {$bg(cyan);$fg(black)}
      $STRINGS {}
      $NUMBERS {}
    }

    # C and js comments
    {^(c|cc|cpp|h|hh|js)$} {
      # Comments:
      {(?:^|[^\\])//.*$} $COMMENT_FORMAT
      
      # Fake /* .. */ style comments:
      {/\*.*?\*/} $COMMENT_FORMAT
      # /* ...
      {/\*.*(?!\*/).*$} $COMMENT_FORMAT
      # * ...
      {^\s*\*.*$} {$fg(green)}
      # ... */
      {^[^(?!/\*)]*\*/} $COMMENT_FORMAT
    }

    # C
    {^(c|cc|cpp|h|hh)$} {
      # Preprocess:
      {(?:^|;)\s*#.*$} {$fg(yellow)}
      
      # Traditional constants:
      {\y([A-Z_][A-Z0-9_]+)\y} {$style(bright)}
      
      # Types:
      {\y(volatile|void|const|struct|signed|unsigned|register|union)\y}
        {$style(bright);$fg(cyan)}
      {\y(bool|char|short|int|long|double|float|enum|bit|static)\y}
        {$style(bright);$fg(cyan)}
      
      # Keywords:
      {\y(auto|break|case|case:|continue|default|do|else|extern)\y}
        {$fg(cyan)}
      {\y(for|goto|if|return|switch|typedef|while)\y}
        {$fg(cyan)}
        
      # PIC specific, I/O:
      {\y(?:PORT|TRIS)[A-Z]\y} {$style(bright);$fg(red)}
      {\yTRIS[A-Z][0-8]\y} {$style(bright);$fg(red)}
      {\yR[A-Z][0-8]\y} {$style(bright);$fg(red)}
    }
    
    # js
    {js$|\ynode\y} {
      # Keywords:
      {\y(break|case|catch|continue|default|delete|do|else|finally|for)\y}
        {$style(bright);$fg(cyan)}
      {\y(function|if|in|instanceof|new|return|switch|this|throw|try)\y}
        {$style(bright);$fg(cyan)}
      {\y(typeof|var|void|while|with)\y}
        {$style(bright);$fg(cyan)}
      
      # Reserved words:
      {\y(abstract|boolean|byte|char|class|const|debugger|double|enum)\y}
        {$fg(red)}
      {\y(export|extends|final|float|goto|implements|import|int|long)\y}
        {$fg(red)}
      {\y(interface|native|package|private|protected|public|short|static)\y}
        {$fg(red)}
      {\y(super|synchronized|throws|transient|volatile)\y}
        {$fg(red)}
        
      # Syntax elements:
      {[{}\[\]():;,]} {$style(dim)}
    }
    
    # Makefile:
    {(?i)^makefile$} {
      # Targets:
      {^\s*[^=:]+:} {$style(bright);$fg(white);$bg(blue)}
      
      # Variables:
      {\$\(\S+\)} {$style(bright);$fg(cyan)}
      {^\s*(\S+)\s*=} {$fg(cyan)}
    }

    # Special empty filepattern matches all files:
    {} {
      # Strings & numbers:
      $STRINGS {$style(bright);$fg(magenta)}
      $NUMBERS {$style(bright);$fg(magenta)}

      # File magics:
      {^#!.*$} {$style(bright);$fg(green);$bg(blue)}
      {^package\s+.*$} {$style(bright);$fg(green);$bg(blue)}

      # Script comments/C preprocessing
      {(?:^|;)\s*#.*$} $COMMENT_FORMAT

      # Email address:
      {(?i)(?:[a-z0-9-]+\.\:)*[a-z0-9-]+\@(?:[a-z0-9-]+\.)*[a-z0-9-]+}
        {$style(bright)}
    }

    # Spec file:
    {spec|dist} {
      {^\w+:} {$fg(yellow)}
      {^%(?:desc|pre|build|install|clean|files|post|changelog)\w*}
      {$bg(cyan);$fg(black)}
    }
    
    {\y(tcl|tm|tclsh|wish)\y} {
      # dictobject syntax
      {(?i)(?:\%[a-z_\:][\w:]*)(\.[\w\:\.]*)} {$fg(yellow)}
      
      # Tcl variable names after a command:
      {(?:set|append|incr|variable)\s+([a-zA-Z_\.]\w*)} {$fg(cyan)}
      {(?:global) ([a-zA-Z_\.][\w ]*)} {$fg(cyan)}

      # Functions, procs and subroutines:
      {(?:proc|sub|function|rename)\s+([a-zA-Z_\.\|]\w*)} {$style(bright)}
      {([a-zA-Z_\.]\w*)(?:\s*\()} {$style(bright)}
    }

    # Scripts
    {\y(sh|perl|cgi|pm|pl|py|spec|tcl|tm|tclsh|wish)\y} {
      # Script style variables:
      {(?i)\$[a-z_\.\:][\w\:]*} {$style(bright);$fg(cyan)}
      {(?i)[\@\%][a-z_\.\:][\w\:]*} {$style(bright);$fg(yellow)}
    }
    {\y(sh|perl|cgi|pm|pl|py|spec|bash)\y} {
      # Backtick exec:
      {`.*?`} {$bg(yellow);$fg(black)}
    }
    
    # Perl:
    {perl|ps|pm|awk} {
      {'.*?'} {$fg(magenta)}
      {(?:s|tr)(/(?:.*?[^\\])??)/(?:.*?[^\\])??/} {$bg(green);$fg(black)}
      {(?:s|tr)/(?:.*?[^\\])??(/(?:.*?[^\\])??/)} {$bg(white);$fg(black)}
    }
    # Regexp literal:
    {\y(perl|ps|pm|awk|js|node)\y} {
      {/(?:.*?[^\\])??/} {$bg(yellow);$fg(black)}
    }

    # Patch file:
    {patch|diff} {
      {^(?:\-\-\-|\+\+\+) .*$} {$bg(blue);$fg(white)}
      {^\@\@.*$} {$bg(yellow);$fg(black)}
      {^(?:\+|>).*$} {$bg(green);$fg(black)}
      {^(?:\-|<).*$} {$bg(red);$fg(black)}
      {^(diff.*)} {$bg(blue);$fg(white);$style(bright)}
    }

    # HTML:
    {htm|xml|svg} {
      {<!DOCTYPE.*?>} {$bg(blue);$fg(yellow)}
      {<!-.*?->} $COMMENT_FORMAT
      {<.*?>} {$style(bright);$fg(cyan)}
    }
    
    {^asn$} {
      {^\s*--.*$} $COMMENT_FORMAT
      {^\s*(\w+)\s.*::=} {$fg(yellow)}
    }
  }

  ################################
  # Globals
  ################################
  set filename ""
  set fileext ""
  set searchpattern ""
  set searchhistory ""
  set gotohistory ""
  set statusmessage ""
  set modified 0
  set viewRow 1
  set viewCol 1
  set bufRow 0
  set bufCol 0
  set undoBuffer ""
  set redoBuffer ""
  set writable 1
  set autoCompleteMatches ""
  set tabCompleteWord ""
  set comeFrom ""

  ###############################
  # Backport lassign if < 8.5
  ###############################
  if {[info commands lassign] == ""} {
    proc lassign {theList args} {
      foreach var $args val $theList {
        upvar 1 $var Var
        set Var $val
      }
    }
  }

  ################################
  # Utilities
  ################################
  proc shift {ls} {
    upvar 1 $ls LIST
    set ret [lindex $LIST 0]
    set LIST [lrange $LIST 1 end]
    return $ret
  }

  proc readbuf {txt} {
    upvar 1 $txt STRING

    set ret [string index $STRING 0]
    set STRING [string range $STRING 1 end]
    if {$STRING == ""} {
      append STRING [read stdin]
    }
    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 inputStat {txt ret} {
    global IDX
    set stat [string range "$txt $ret" 0 [expr {$IDX(ROWCOL)-1}]]
    set len [expr [string length $stat]+1]
    status $stat
    goto end $len
    flush stdout
  }

  proc historyAppend {thelist item} {
    upvar 1 $thelist hist

    if {[set hidx [lsearch -exact $hist $item]] != -1} {
      set hist [lreplace $hist $hidx $hidx]
    }
    lappend hist $item
  }

  proc getInput {buffer {txt ""} {historybuffer ""}} {
    global viewRow viewCol

    upvar 1 $buffer keybuffer
    if {$historybuffer != ""} {
      upvar 1 $historybuffer hist
      set hidx -1
    }

    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"} {
        # attempt to get all escape characters
        # on slow connections/terminals:
        after 10
        append keybuffer [read stdin]
      
        # escape:
        if {$keybuffer == ""} {
          status ""
          return
        }
        
        # handle history if given
        if {$historybuffer != ""} {
          if {$keybuffer == "\[A"} {
            if {$hidx < ([llength $hist]-1)} {
              incr hidx
            }
          } elseif {$keybuffer == "\[B"} {
            if {$hidx >= 0} {
              incr hidx -1
            }
          }
          if {$hidx >= 0} {
            set ret [lindex $hist end-$hidx]
          } else {
            set ret ""
          }
          inputStat $txt $ret
        }

        # 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
      }
      inputStat $txt $ret
    }
    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 {{txt "\0"}} {
    global IDX statusmessage

    if {$txt != "\0"} {
      set statusmessage $txt
    }

    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 [expr {$IDX(ROWCOLLEN)-1}]]
    
    # 80th column marker:
    if {$c > 80} {
      puts -nonewline "\033\[7m\u001b\[${r};80H|"
    }
    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"
  }

  proc stripComments {data} {
    set ret ""
    foreach x [split $data "\n"] {
      set x [string trim $x]
      if {[string index $x 0] != "#"} {
        append ret "$x\n"
      }
    }
    return $ret
  }

  proc currentFragment {{mode range}} {
    global BUFFER bufRow bufCol

    set line [lindex $BUFFER $bufRow]
    set idx [expr {$bufCol-1}]
    set s [string wordstart $line $idx]
    switch -- $mode {
      "range"  {return [list $s [expr {$bufCol-1}]]}
      "start"  {return $s}
      "end"    {return [expr {$bufCol-1}]}
      "string" {return [string range $line $s [expr {$bufCol-1}]]}
    }
  }

  proc currentWord {{mode range}} {
    global BUFFER bufRow bufCol

    set line [lindex $BUFFER $bufRow]
    set idx [expr {$bufCol-1}]
    set s [string wordstart $line $idx]
    set n [string wordend $line $idx]
    switch -- $mode {
      "range"  {return [list $s [expr {$n-1}]]}
      "start"  {return $s}
      "end"    {return [expr {$n-1}]}
      "string" {return [string range $line $s [expr {$n-1}]]}
    }
  }

  ################################
  # Autocomplete
  ################################
  proc scanAutoComplete {word} {
    global BUFFER autoCompleteMatches IDX
    
    set autoCompleteMatches ""
    if {$word != ""} {
      foreach line $BUFFER {
        foreach x [
          regexp -inline -all "\\y$word\\w+" $line
        ] {
          lappend autoCompleteMatches $x
        }
      }
      set autoCompleteMatches [lsort -unique $autoCompleteMatches]
    }
    
    autoCompleteStatus
  }

  proc autoCompleteStatus {} {
    global autoCompleteMatches IDX
    
    if {[llength $autoCompleteMatches]} {
      set stat ""
      foreach n {1 2 3 4 5 6} m $autoCompleteMatches {
        if {[expr {
          ([string length $stat]+[string length $m]+3) >
          $IDX(ROWCOL)
        }]} break
        
        if {$n != "" && $m != ""} {
          append stat "${n}:$m "
        }
      }
      status $stat
    } else {
      status ""
    }
  }

  proc substAutoComplete {{select 0}} {
    global BUFFER bufRow bufCol autoCompleteMatches
    
    if {[llength $autoCompleteMatches]} {
      set line [lindex $BUFFER $bufRow]
      
      set s [currentWord start]
      set n [currentWord end]
      
      set replacement [lindex $autoCompleteMatches $select]
      set line [string replace $line $s $n $replacement]
      
      registerUndo D $bufRow [expr {$n+1}] [string range $line $s $n]
      
      set BUFFER [lreplace $BUFFER $bufRow $bufRow $line]
      
      set bufCol [expr {$s+[string length $replacement]}]
      
      registerUndo I $bufRow $s $bufRow $bufCol
      
      set autoCompleteMatches [lreplace $autoCompleteMatches $select $select]
      lappend autoCompleteMatches $replacement
    }
  }

  ################################
  # Command handlers
  ################################
  proc handleDelete {dir} {
    global BUFFER bufRow bufCol viewRow
    global undoBuffer redoBuffer writable
    if {!$writable} return
    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

        registerUndo D $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]

        registerUndo D $bufRow $bufCol "\n"

        handleRedraw partial
        return
      }
    }

    registerUndo D $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 writable
    if {!$writable} return
    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]

    registerUndo I $row $col $bufRow $bufCol

    handleRedraw partial
    incr viewRow
  }

  proc handleInsert {} {
    global BUFFER bufRow bufCol viewRow tabCompleteWord
    global undoBuffer redoBuffer writable
    if {!$writable} return
    upvar 1 printbuffer printbuffer

    set line [lindex $BUFFER $bufRow]
    if {$printbuffer == "\t"} {
      # Tab completion:
      if {$tabCompleteWord == ""} {
        set tabCompleteWord [currentFragment string]
        if {[regexp {\w+} $tabCompleteWord tabCompleteWord]} {
          scanAutoComplete $tabCompleteWord
        } else {
          set tabCompleteWord ""
        }
      }
      if {$tabCompleteWord != ""} {
        substAutoComplete
        autoCompleteStatus
        return
      }
    } else {
      set tabCompleteWord ""
    }
    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

    set fragment [currentFragment string]
    if {[regexp {\w+} $fragment fragment]} {
      scanAutoComplete $fragment
    }
    
    registerUndo I $bufRow $col $bufRow $bufCol
  }

  proc undo {cmd sRow sCol args} {
    global BUFFER IDX bufRow bufCol viewRow

    set bufRow $sRow
    set bufCol $sCol
    set oldline [lindex $BUFFER $sRow]
    set line [string range $oldline 0 [expr $bufCol - 1]]
    set ret ""

    switch -exact -- $cmd {
      "D" {
        set txt [lindex $args 0]
        set txt [split $txt "\n"]
        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
        }
        set ret [list I $sRow $sCol $bufRow $bufCol]
      }
      "I" {
        foreach {nRow nCol} $args break
        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]
        set ret [list D $sRow $sCol $deleted]
      }
    }

    if {$bufRow < $IDX(COLMAX)} {
      set viewRow [expr {$bufRow+1}]
    }
    set IDX(ROWLAST) -1 ;# force redraw
    handleRedraw
    return $ret
  }

  proc handleUndo {from to} {
    global undoBuffer redoBuffer
    if {[llength [set $from]] > 0} {
      set op [lindex [set $from] end]
      set $from [lreplace [set $from] end end]
      lappend $to [eval "undo $op"]
      status ""
    } else {
      status "$from empty."
      flush stdout
    }
  }

  proc registerUndo {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 {
      "I" {
        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]
      }
      "D" {
        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]
      }
    }
  }

  proc handlePageUp {} {
    global IDX bufRow bufCol viewRow

    set size [expr {$IDX(ROWMAX) - 1}]
    if {$bufRow < $size} {
      set bufRow  0
      set viewRow 1
    } else {
      incr bufRow  -$size
      incr viewRow -$size
    }
    endLine
    handleRedraw
  }

  proc handlePageDown {} {
    global IDX BUFFER bufRow bufCol viewRow

    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
  }

  proc handleGotoLine {n} {
    global bufRow viewRow BUFFER

    set bufRow [expr {$n-1}]
    if {$bufRow < $viewRow} {
      set viewRow 0
    } else {
      set len [llength $BUFFER]
      if {$bufRow > $len} {
        set bufRow [expr {$len-1}]
      }
    }
    handleRedraw
  }

  proc goToDef {} {
    global tags tags_root filename IDX comeFrom
    
    set tag [currentWord string]
    
    if {[info exists tags($tag)]} {
      if {[llength $tags($tag)] > 2} {
        status "Warning! More than 1 found."
        flush stdout
      } else {
        status "Going to definition.."
        flush stdout
      }
      
      lassign $tags($tag) defFile searchSpec
      
      set thisDir [pwd]
      set redir ">&@ stdout <@ stdin"
      set myself "$redir {[info nameofexecutable]} {[info script]}"
      set command ""

      if {[regexp {^(\d+);"$} $searchSpec - lineNumber]} {
        set command [list -G $lineNumber]
      }
      if {[regexp {^/\^(.+)\$/;"$} $searchSpec - literal]} {
        set command [list -F "(?cq)$literal"]
      }
      
      if {$command != ""} {
        lappend command -define comeFrom "$filename > "
      
        cd $tags_root
        if {[catch "exec $myself {$defFile} $command" err]} {
          puts $err
        }
        cd $thisDir

        # Set raw mode again bacause the exiting program
        # may have reset it to canonical mode:
        exec stty raw -echo  
      
        # Set window title:
        puts -nonewline "\033\]0;$comeFrom$filename\007"

        read stdin
        set IDX(ROWLAST) -1 ;# force redraw
        status ""
        handleRedraw
      }
    }
  }

  proc suspend {} {
    global filename searchpattern modified
    global searchhistory gotohistory
    global viewRow viewCol bufRow bufCol
    global undoBuffer redoBuffer BUFFER

    # Don't save anything if BUFFER is not modified:
    if {$modified} {
      saveFile
      set suspendFile $filename.tsuspend

      set f [open $suspendFile w+]
      fconfigure $f
      puts $f "ted suspend"
      foreach x {
        filename
        searchpattern
        viewRow viewCol bufRow bufCol
      } {
        puts $f [list $x [set $x]]
      }
      foreach x {undoBuffer redoBuffer searchhistory gotohistory} {
        puts $f "$x {[join [string map {\n \000} [set $x]] \n]}"
      }
      puts $f "BUFFER {[join $BUFFER \n]}"
      close $f
    }
    doExit
  }

  proc resume {data} {
    global filename searchpattern modified
    global searchhistory gotohistory
    global viewRow viewCol bufRow bufCol
    global undoBuffer redoBuffer BUFFER
    set modified 1
    set ted ""

    foreach {var val} $data {
      if {$var == "ted" || $ted == "suspend"} {
        if {$var == "BUFFER"} {
          set $var [split $val "\n"]
        } elseif {
          $var == "undoBuffer"    ||
          $var == "redoBuffer"    ||
          $var == "searchhistory" ||
          $var == "gotohistory"
        } {
          set $var "[string map {\000 \n} [split $val \n]]"
        } else {
          set $var $val
        }
      }
    }
    return $ted
  }

  ################################
  # Key bindings
  ################################
  proc handleEscapes {} {
  uplevel 1 {
    set seq ""
    set found 0
    while {[set ch [readbuf keybuffer]] != ""} {
      append seq $ch

      switch -exact -- $seq {
        "1" - "2" - "3" -
        "4" - "5" - "6" { ;# Alt-1,Alt-2..Alt-6 (select autocomplete)
          substAutoComplete [expr {$seq-1}]
          handleRedraw edit
          set found 1; break
        }
        "`" { ;# hack to handle unavailability of Alt-1 on ubuntu:
          substAutoComplete 0
          handleRedraw edit
          set found 1; break
        }
        "\[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
        }
        "OH" -
        "\[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
        }
        "OF" -
        "\[F" -
        "\[K" -
        "\[8~" -
        "\[4~" { ;# end
          set bufCol [string length [lindex $BUFFER $bufRow]]
          handleRedraw line
          set found 1; break
        }
        "\[5~" { ;# 5 Prev screen
          handlePageUp
          set found 1; break
        }
        "\[6~" { ;# 6 Next screen
          handlePageDown
          set found 1; break
        }
        "OR" -
        "\[13~" { ;# F3
          handleSearch
          set found 1; break
        }
        "\[1;5B" { ;# ^-down arrow
          goToDef
          set found 1; break
        }
        "\[1;5A" { ;# ^-up arrow
          # Return from Def
          # This is basically the same as quit but
          # only when we come from another file.

          global comeFrom
          if {$comeFrom != ""} {
            saveFile
            doExit
          }
          set found 1; break
        }
      }
    }
    if {$found == 0} {
      status "Unhandled sequence:$seq ([string length $seq])"
      flush stdout
    }
  }
  }

  proc handleControls {} {
  global statusmessage
  set old_statusmessage $statusmessage
  uplevel 1 {
    # Control chars start at a == \u0001 and count up.
    switch -exact -- $char {
      \u001a { ;# ^z - undo
        handleUndo undoBuffer redoBuffer
      }
      \u0019 { ;# ^y - redo
        handleUndo redoBuffer undoBuffer
      }
      \u001c { ;# ^| - dump undoBuffer (for dubugging)
        global undoBuffer redoBuffer filename tags gotohistory
        clear
        goto home
        puts $::ABOUT
        puts "File: $filename"
        puts "Autocomplete: $::autoCompleteMatches"
        puts "\033\[7mUndo buffer ([llength $undoBuffer] actions):\033\[0m"
        if {[llength $undoBuffer] > 10} {puts ...}
        foreach x [lrange $undoBuffer end-5 end] {
          puts $x
        }
        puts "\033\[7mRedo buffer ([llength $redoBuffer] actions):\033\[0m"
        if {[llength $redoBuffer] > 10} {puts ...}
        foreach x [lrange $redoBuffer end-5 end] {
          puts $x
        }
        puts "\033\[7mGoto history ([llength $gotohistory]):\033\[0m"
        if {[llength $gotohistory] > 10} {puts ...}
        foreach x [lrange $gotohistory end-5 end] {
          puts $x
        }
        puts "\033\[7mCTags ([array size tags] tags):\033\[0m"
        foreach {x y} [lrange [array get tags] 0 13] {
          puts "$x -> [lindex $y 0]"
        }
        status "Press ESC to exit this screen"
        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
        status ""
        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] && $writable} {
          set oldline [lindex $BUFFER $bufRow]
          set BUFFER [lreplace $BUFFER $bufRow $bufRow]

          registerUndo D $bufRow 0 "$oldline\n"

          handleRedraw partial

          if {$bufRow >= [llength $BUFFER] && $bufRow > 0} {
            incr bufRow -1
            incr viewRow -1
            handleRedraw partial
          }
        }
      }
      \u0005 { ;# ^e - end of line
        set bufCol [string length [lindex $BUFFER $bufRow]]
        handleRedraw line
      }
      \u0006 { ;# ^f - find/search
        global searchpattern searchhistory
        set searchpattern [getInput keybuffer "Search:" searchhistory]
        historyAppend searchhistory $searchpattern
        handleSearch
      }
      \u0007 { ;# ^g - goto line
        global gotohistory
        set n [getInput keybuffer "Goto Line:" gotohistory]
        set n [regexp -inline {\S+} $n]
        
        # Support here index for bookmarking.
        if {$n == "here"} {
          set n [expr {$bufRow+1}]
        }
        
        if {[string is integer -strict $n]} {
          set theLine [lindex $BUFFER [expr {$n-1}]]
          historyAppend gotohistory "$n : [string trim $theLine]"
          
          handleGotoLine $n
        } else {
          status ""
          handleRedraw
        }
      }
      \u000f { ;# ^o - page up
        handlePageUp
      }
      \u0010 { ;# ^p - page down
        handlePageDown
      }
      \u0013 { ;# ^s - save file
        saveFile
      }
      \u0017 { ;# ^w - suspend
        # Suspend saves the current BUFFER along with most other
        # internal variables like the undo and redo buffers to a
        # file which can be later opened to resume editing.
        # Suspend does not save the original file.
        suspend
      }
      \u0008 -
      \u007f { ;# ^h && backspace ?
        handleDelete -
      }
      \u001b { ;# ESC - handle escape sequences
        after 10
        append keybuffer [read stdin]
        handleEscapes
      }
      default {
        binary scan $char c ch
        status "Unhandled control character:[format 0x%x $ch]"
        flush stdout
      }
    }
    
    # Rate limiter:
    set firstEsc [string last \u001b $keybuffer]
    if {$firstEsc == -1} {
      set keybuffer ""
    } else {
      set keybuffer [string range $keybuffer $firstEsc end]
    }
  }
  # Reset autocomplete:
  global tabCompleteWord autoCompleteMatches
  set tabCompleteWord ""
  if {$autoCompleteMatches != ""} {
    set autoCompleteMatches ""
    if {$statusmessage == $old_statusmessage} {
      status ""
      flush stdout
    }
  }
  }

  ################################
  # 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 line at a time to avoid causing the terminal to hang:
    set d [split $drawBuffer \n]
    foreach line [lrange $d 0 end-1] {
      puts $line
    }
    puts -nonewline [lindex $d end]
    
    flush stdout
  }

  ################################
  # main()
  ################################
  proc edittext {} {
    global BUFFER IDX viewRow viewCol bufRow bufCol writable tabCompleteWord
    global init_commands

    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
    
    foreach cmd $init_commands {
      eval $cmd
    }

    while {$char != "\u0011"} {
      append keybuffer [read stdin]
      if {[eof stdin]} {return done}
      if {$keybuffer == ""} {
        set now [clock seconds]
        if {$now != $timestamp} {
          set timestamp $now
          set changed 0
          getRowColMax
          if {$changed} {
            status
            idx $bufRow $bufCol
            set IDX(ROWLAST) -1 ;# force redraw
            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)}]
    }
  }
  }

  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 ]
        fconfigure $outfile
        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)"

        # Delete suspended file:
        if {[file exists $filename.tsuspend]} {
          file delete $filename.tsuspend
        }

        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
  }

  array set tags {}
  set tags_root [pwd]

  proc loadTags {fileName} {
    global tags tags_root
    
    while {[set dir [file dirname $fileName]] != "/"} {
      if {[file isfile $dir/tags] && [file readable $dir/tags]} {
        set f [open $dir/tags]
        set txt [read $f]
        close $f
        
        set tags_root $dir
        
        foreach line [split $txt \n] {
          if {![regexp {^!_TAG_} $line]} {
            lassign [split $line \t] tagName tagLocation searchSpec
            
            if {$tagName != ""} {
              if {![info exists tags($tagName)]} {
                set tags($tagName) [list $tagLocation $searchSpec]
              } else {
                lappend tags($tagName) $tagLocation $searchSpec
              }
            }
          }
        }
        
        return
      }
      set fileName $dir
    }
  }

  proc console_edit {fileName} {
    global BUFFER IDX tabstop bufRow bufCol writable
    global filename fileext comeFrom

    set IDX(ROWMAX) 24
    set IDX(COLMAX) 80
    set IDX(ROWCOLLEN) 18
    set changed 1
    set BUFFER ""

    getRowColMax

    if {[file isfile $fileName]} {
      if {[file readable $fileName]} {
        set mode ""
        set f [open $fileName r]
        fconfigure $f
        set data [read $f]
        if {[file extension $fileName] == ".tsuspend"} {
          set mode [resume $data]
        }
        if {$mode != "suspend"} {
          set BUFFER [split $data "\n"]
        } else {
          set fileName "$filename RESUMED"
        }
        close $f
        if {[file writable $filename] == 0} {
          set writable 0
        }
        if {$writable} {
          status "Opened: $fileName"
        } else {
          status "Opened: $fileName, READ ONLY!"
        }
        loadTags [file normalize $fileName]
      } else {
        puts "Can't read file: \"$fileName\""
        exit
      }
    } else {
      status "New file: $fileName"
    }

    if {$fileext == ""} {
      set topline [lindex $BUFFER 0]
      if {[string range $topline 0 1] == "#!"} {
        set fileext [lindex [split $topline "/"] end]
      } else {
        set fileext [lindex [split [file tail $filename] "."] end]
      }
    }
    initSyntaxRules $fileext

    trace variable BUFFER w bufferModified

    fconfigure stdin -buffering none -blocking 0
    fconfigure stdout -buffering full -translation crlf

    # Set window title:
    puts -nonewline "\033\]0;$comeFrom$filename\007"

    exec stty raw -echo
    set err [catch edittext]

    if {$err == 0} {
      saveFile
    } else {
      global errorInfo
      puts $errorInfo
    }

    doExit $err
  }

  proc doExit {{err 0}} {
    # Reset terminal:
    puts -nonewline "\033c\033\[2J"
    if {$err} {
      if {[info exists $::errorInfo]} {
        puts $::errorInfo
      }
    }
    flush stdout
    exec stty -raw echo
    after 100
    exit 0
  }

  proc initSyntaxRules {fileext} {
    global syntaxRules hilight fg bg style STRINGS NUMBERS COMMENT_FORMAT

    set hilight ""
    foreach {filepattern rule} [
      string map [
        list \
          {$STRINGS} $STRINGS \
          {$NUMBERS} $NUMBERS \
          {$COMMENT_FORMAT} $COMMENT_FORMAT
      ] $syntaxRules
    ] {
      if {[regexp $filepattern $fileext]} {
        foreach {pattern attr} $rule {
          lappend hilight $pattern [subst $attr]
        }
      }
    }
  }

  # Parse command line arguments:
  set cmdline $argv
  set argv ""
  set init_commands {}
  while {[llength $cmdline]} {
    set arg [shift cmdline]
    switch -exact -- $arg {
      -s {
        set f [open [shift cmdline] r]
        append syntaxRules "\n[read $f]"
        close $f
      }
      -S {
        set f [open [shift cmdline] r]
        set syntaxRules [read $f]
        close $f
      }
      -f {set fileext [shift cmdline]}
      -r {set writable 0}
      -define {
        set var [shift cmdline]
        global $var
        set $var [shift cmdline]
      }
      -G {
        lappend init_commands "handleGotoLine [shift cmdline]"
      }
      -F {
        set searchpattern [shift cmdline]
        lappend init_commands "handleSearch"
      }
      --help {
        puts "tcled: editor written in tcl"
        puts "usage: tcled ?options? filename\n"
        puts "Where options are:"
        puts "  -s file    append syntax rules from file"
        puts "  -S file    replace syntax rules with rules from file"
        puts "  -f ext     pretend file extension is ext"
        puts "  -r         open file as read-only"
        puts "  -G line    go to line number"
        puts "  -F regex   find"
        exit
      }
      default {lappend argv $arg}
    }
  }

  set syntaxRules [stripComments $syntaxRules]

  if {[llength $argv] == 0} {
    puts "Please specify a filename:"
    gets stdin filename
    if {$filename != ""} {
      console_edit $filename
    }
  } else {
    foreach filename $argv {
      console_edit $filename
    }
  }
======

----
'''Syntax Hilighting Rules:'''

The rules for syntax hilighting are currently hardcoded in the file and contained within the variable '''syntaxRules ''' located at the top of the code. The syntax rules is in the form:

''{filepattern} {{regexp} {formatting}..}''

Comments (after #) 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 the 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)}'''.

Also, due to the way the renderig engine works, the syntax hilighting rules cannot distinguish between tabs and spaces. So for the purpose of writing the syntax regexp " ", "\s", "\t" and "[[[[:space:]]]]" are synonymous.

----

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

[HJG] 2009-08-11  If you try this program on Windows, it complains about not being able to execute stty, as it is not wrapped in catch{}.

[LV] 2009-Aug-11 When I try this program on a SPARC Solaris machine, depending on which Tcl I use, the program either quits without reporting why, or writes parts of escape sequences within the file.

It might be worthwhile for the program to take note of the value of $TERM, and, the first time encountering a particular value, queries the user to press the function keys, and then sets the appropriate values in a file for future use.

[slebetman] Yes, this doesn't work on Windows without stty support and it probably doesn't work in the COMSPEC shell by itself. This is meant to be hosted on Linux, though you can use it from Windows to edit files on a Linux machine by telnetting via Hyperterminal or ssh via PuTTY. As for the $TERM support, this supports any terminal capable of VT100 emulation. Anything beyond that gets very complicated very quickly and requires the use or development of libraries like curses and ncurses. Currently this is tested and works with xterm (the original and most compatible), rxvt, various Linux terminals, xfce terminal, Hyperterminal and PuTTY. Another issue is trying to use this on other Unices. Getting raw mode is done differently on different platforms. I'm only doing it right on Linux. To do it properly will again need libraries like curses or ncurses.

[LV] Alas, I'm using xterm on SPARC Solaris and can't get it to work. But it is a great idea - keep up the great work!

[slebetman] It's probably an issue with getting raw mode. After googling I see that Solaris does in fact have stty. On Linux I can get raw mode by doing [[exec stty raw -echo]]. If you know how to do it on Solaris then you can replace that line with the correct invocation. Just remember to reset the terminal to cooked mode before exiting (stty -raw echo).

----
[MHo] 2011-11-08: Does someone know what to do to make the editor respect the current console dimensions? Regardless of what size my console window is, the editor is still using 80x25 dimensions it seems...

[AK]: If you are on unix the "tput" command can be used to query terminal settings. "tput lines" and "tput cols" return the current number of lines and columns, respectively. There are also the environment variables LINES and COLUMNS which contain the same data. Regarding windows, IIRC [twapi] provides commands to manipulate and query windows console(s), and maybe there is returning the geometry too.

[MHo]: I simply altered the regexp in `getRowColMax {}` to: `regexp {rows '''=''' (\d+); columns '''=''' (\d+)} $err -> rows cols` and it works under Solaris! Thanks for advice.

[AMG]: I changed the source below to be universal.  It still works on Linux.  With luck, it'll also work on Solaris.  Give it a try and let us know how it goes.

[MHo] 2011-06-24: what a pity that [TIP #305: ANSI Escape Sequence Support for Windows's Console Channel Driver] isn't implemented! So no one can use this editor on M$ Windows!

----
[AMG]: This editor allows a sort of backspacing ''before'' the start of the file. At the beginning of the file, press backspace a few times, then type that many characters. The cursor will remain at the start of the file, and each character will be inserted before the ones typed before it. After the number of characters inserted exceeds the number of backspaces, or after the cursor is moved, normal editing will resume.

[slebetman] 12 March 2014: Thanks for perfectly describing the bug. I've seen this behavior from time to time but didn't associate it with backspace being pressed at the beginning of file. So I couldn't reproduce the bug and therefore couldn't fix the bug. I'll file this on github and see if I can fix it this weekend.

<<categories>> Editor utility | Application