[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. The following are some of the features of the editor: * 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. * '''^f''' to search. Searching uses Tcl regexp syntax. F3 searches again just like on most Windows/Mac text editors. * '''^g''' to go to a specific line. * '''^s''' saves the file. * '''^d''' deletes the current line. (Removed ^y) * Pressing the '''End''' key moves the cursor to the end of the line. * Pressing the '''Home''' key takes the cursor to the beginning of the line. Pressing '''Home''' a second time moves the cursor to the first non-whitespace character in the line. * 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. There is a worst case delay of 1 second before the editor actually resizes after the window is resized. That is how often I poll ''stty''. * Implemented a simple auto-indenting. When inserting a newline by pressing the '''Enter''' or '''Return''' key the leading whitespace of the previous line will be copied and automatically inserted. * Implemented 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. 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~" Long line editing is still buggy if the line contains tab characters. #! /usr/bin/env tclsh # con-editor.tcl a linux console based editor in pure tcl set filename [lindex $argv 0] set searchpattern "" set statusmessage "" set modified 0 set tabstop 4 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 } # Syntax hilighting: set syntaxRules { # The syntax rules is in the form: # {regexp} {formatting} # Each rule must be on a single line. # Comments will be ignored. # Strings & numbers: {".*?"} {$style(bright);$fg(magenta)} {[0-9]+} {$style(bright);$fg(magenta)} # Script comments/C preprocessing {(?:^|;)\s*#.*$} {$style(bright);$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 variables after a set command: {(?:set|append) ([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)} } 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] } } 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 {} { uplevel 1 { set x [string length [lindex $BUFFER $bufRow]] if {$bufCol > $x} { set bufCol $x } } } proc reprintLine {} { uplevel 1 { goto $viewRow 1 puts -nonewline "\033\[2K[syntaxHilight \ [string range $line 0 $IDX(COLMAX)]]" } } proc getSpaces {line} { lindex [regexp -inline {^[[:space:]]+} $line] 0 } proc viewLength {line} { # Calculates string length, account for tabs global tabstop set n [string length $line] set t [regexp -all "\t" $line] expr {$n-$t+($t*$tabstop)} } proc handleDelete {dir} { upvar 1 bufCol bufCol if {$dir == "-"} { if {$bufCol == 0} { uplevel 1 { if {$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 $upRow $line] set BUFFER [lreplace $BUFFER $bufRow $bufRow] incr viewRow -1 set bufRow $upRow set IDX(COLLAST) -1 ; # force redraw handleRedraw } } return } incr bufCol -1 } uplevel 1 { set line [string replace $line $bufCol $bufCol] set BUFFER [lreplace $BUFFER $bufRow $bufRow $line] handleRedraw line } return } proc syntaxHilight {line} { global hilight set matches "" 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 $line set line {} set prev 0 foreach m [lsort -integer -index 0 $matches] { foreach {s n color} $m break 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] append line "\033\[0m" } append line [string range $oldline $prev end] append line "\033\[0m" return $line } proc handleSearch {} { uplevel 1 { global searchpattern status "Search: $searchpattern" if {$searchpattern != ""} { if {[catch {lsearch -regexp [lrange $BUFFER \ [expr {$bufRow+1}] end] $searchpattern} found]} { # Regexp error: status $found } else { if {$found == -1} { set found [lsearch -regexp $BUFFER $searchpattern] if {$found != -1} { set bufRow $found } } else { incr bufRow $found incr bufRow } if {$found != -1} { set C [regexp -indices -inline $searchpattern \ [lindex $BUFFER $bufRow]] set bufCol [lindex [lindex $C 0] 0] } else { status "Search: $searchpattern (not found!)" } } } if {$bufRow < $viewRow} { set viewRow 0 } } } proc getInput {buffer {txt ""}} { upvar 1 $buffer keybuffer upvar 1 fid fid status "" goto end 1 puts -nonewline "\033\[7m$txt " set ret "" while {[set ch [readbuf keybuffer]] != "\n" && $ch != "\r"} { if {$ch == ""} { after 50 continue } if {$ch == "\u001b"} { # need to ignore escapes: while {[set ch [readbuf keybuffer]] != "~" && $keybuffer != ""} {} continue } elseif {$ch == "\u007f"} { # handle backspace: set ret [string range $ret 0 end-1] } else { append ret $ch } set stat "$txt $ret" status $stat goto end [expr [string length $stat]+1] } return $ret } proc handleEscapes {} { uplevel 1 { set seq "" while {[set ch [readbuf keybuffer]] != ""} { append seq $ch set found 1 switch -exact -- $seq { "\[A" { ;# Cursor Up (cuu1,up) if {$bufRow > 0} { incr bufRow -1 incr viewRow -1 } endLine break } "\[B" { ;# Cursor Down if {$bufRow < [expr {[llength $BUFFER] - 1}]} { incr bufRow 1 incr viewRow 1 } endLine break } "\[C" { ;# Cursor Right (cuf1,nd) if {$bufCol < [string length $line]} { incr bufCol 1 } break } "\[D" { ;# Cursor Left if {$bufCol > 0} { incr bufCol -1 } break } "\[H" { ;# Cursor Home set bufCol 0 set bufRow 0 set viewRow 1 break } "\[1~" { ;# home if {$bufCol == 0} { set line [lindex $BUFFER $bufRow] set bufCol [regexp \ -indices -inline -- \ {^[[:space:]]*} $line] set bufCol [lindex [lindex $bufCol 0] 1] incr bufCol 1 } else { set bufCol 0 } break } "\[3~" { ;# delete handleDelete + break } "\[4~" { ;# end set bufCol [string length [lindex $BUFFER $bufRow]] 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 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 break } "\[13~" { ;# F3 handleSearch break } default { set found 0 } } } if {$found == 0} { status "Unhandled sequence:$seq" } else { # most of the above cause a BUFFER row change set line [lindex $BUFFER $bufRow] } } } proc handleNewline {} { uplevel 1 { # The getSpaces is for auto-indenting: set newline [getSpaces $line] set currline [string range $line 0 [expr {$bufCol - 1}]] set BUFFER [lreplace $BUFFER $bufRow $bufRow $currline] incr bufRow incr viewRow if {$keybuffer == ""} { set len [string length $newline] append newline [string range $line $bufCol end] set bufCol $len } else { set newline [string range $line $bufCol end] } set BUFFER [linsert $BUFFER $bufRow $newline] set IDX(COLLAST) -1 ; # force redraw set line [lindex $BUFFER $bufRow] } } proc handleControls {} { uplevel 1 { # Control chars start at a == \u0001 and count up. switch -exact -- $char { \u0011 { ;# ^q - quit return done } \u0001 { ;# ^a - beginning of line set bufCol 0 } \u0004 { ;# ^d - delete line if {$bufRow < [llength $BUFFER]} { set BUFFER [lreplace $BUFFER $bufRow $bufRow] set IDX(COLLAST) -1 ; # force redraw } } \u0005 { ;# ^e - end of line set bufCol [string length $line] } \u0006 { ;# ^f - find/search global searchpattern set searchpattern [getInput keybuffer "Search:"] handleSearch } \u0007 { ;# ^g - goto line if [string is integer [set n [getInput keybuffer "Goto Line:"]]] { set bufRow [expr {$n-1}] if {$bufRow < $viewRow} { set viewRow 0 } else { set len [llength $BUFFER] if {$bufRow > $len} { set bufRow [expr {$len-1}] } } } } \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]" } } # Rate limiter: set keybuffer "" } } proc handleInsert {} { uplevel 1 { set oldline $line set line [string range $oldline 0 [expr $bufCol - 1]] append line $printbuffer append line [string range $oldline $bufCol end] set BUFFER [lreplace $BUFFER $bufRow $bufRow $line] set len [string length $printbuffer] incr bufCol $len } } proc handleRedraw {{mode "full"}} { uplevel 1 { cursor off # Constrain current view idx if {$viewRow <= 1} {set viewRow 1} if {$viewRow >= ($IDX(ROWMAX) - 1)} { set viewRow [expr {$IDX(ROWMAX) - 1}] } set viewCol [expr {$bufCol + 1}] if {$viewCol >= $IDX(COLMAX)} {set viewCol $IDX(COLMAX)} # start and end view area to display set startRow [expr {$bufRow + 1 - $viewRow}] set startCol [expr {$bufCol + 1 - $viewCol}] } if {$mode == "line"} { uplevel 1 { reprintLine } } else { uplevel 1 { display $startRow $startCol } } uplevel 1 { # translate viewCol to proper index (account for tabs) if {[string match "*\t*" $line]} { set i [viewLength [string range $line \ $startCol [expr {$bufCol - 1}]]] set viewCol [expr {$startCol + 1 + $i}] } idx [expr {$bufRow + 1}] $viewCol goto $viewRow $viewCol cursor on flush stdout } } proc edittext {fid} { global BUFFER IDX set viewRow 1 ; # row idx into view area, 1-based set viewCol 1 ; # col idx into view area, 1-based set bufRow 0 ; # row idx into full buffer, 0-based set bufCol 0 ; # col idx into full buffer, 0-based set IDX(ROWLAST) -1 ; # last row most recently displayed in view set IDX(COLLAST) -1 ; # last col most recently displayed in view set char "" ; # last char received set line [lindex $BUFFER $bufRow] ; # line data of current line display $bufRow $bufCol home; flush stdout 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 line set printbuffer "" } after 50 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 handleRedraw set prevRow $bufRow } } } proc linerange {line start end} { # Get # *visual* chars - account for tabs in line range global tabstop set line [string range $line $start $end] if {[string match "*\t*" $line]} { # let's just brute force over the line set i 0 set end [expr {$end-$start}] set res {} foreach c [split $line ""] { if {[string equal "\t" $c]} { set i [expr {$i+($tabstop-$i%$tabstop)}] ; # align to tabs } else { incr i } append res $c if {$i > $end} { break } } return $res } return $line } proc display {startRow startCol} { global IDX BUFFER home if {($IDX(ROWLAST) != $startRow) || ($IDX(COLLAST) != $startCol)} { # Add display size to get end points set endRow [expr {$startRow + $IDX(ROWMAX) - 1}] set endCol [expr {$startCol + $IDX(COLMAX) - 1}] for {set i $startRow} {$i < $endRow} {incr i} { puts -nonewline "\u001b\[K" ; # erase current line set line [linerange [lindex $BUFFER $i] $startCol $endCol] set line [syntaxHilight $line] puts $line } set IDX(ROWLAST) $startRow set IDX(COLLAST) $startCol } } 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" } 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] # the string must not exceed $IDX(ROWCOLLEN) length set str [string range $str 0 $IDX(ROWCOLLEN)] puts -nonewline "\033\[7m\u001b\[${r};${c}H${str}\033\[0m" } proc home {} { goto 1 1 } proc goto {row col} { global IDX if {$row == "end"} { set row $IDX(ROWMAX) } puts -nonewline "\u001b\[${row};${col}H" } proc clear {} { puts -nonewline "\u001b\[2J" } proc cursor {bool} { puts -nonewline "\u001b\[?[expr \ {$::IDX(ROWMAX)+1}][expr {$bool ? "h" : "j"}]" } #start of console editor program proc 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"} { status " Aborted" break } } fconfigure stdin -blocking 0 } proc bufferModified {args} { global modified set modified 1 } proc console_edit {fileName} { global BUFFER IDX tabstop # Script-Edit by Steve Redler IV 5-30-2001 set IDX(ROWMAX) 24 set IDX(COLMAX) 80 set IDX(ROWCOLLEN) 18 set changed 1 set bufRow 0 set bufCol 0 set infile [open $fileName RDWR] set BUFFER [split [read $infile] "\n"] close $infile trace variable BUFFER w bufferModified getRowColMax # Sets tabstops: puts -nonewline "\033\[3g" for {set x 1} {$x <= $IDX(COLMAX)} {incr x $tabstop} { goto 0 $x puts -nonewline "\033H" } clear ; home status "$fileName loaded" idx [llength $BUFFER] 1 fconfigure stdin -buffering none -blocking 0 -encoding iso8859-1 fconfigure stdout -buffering none -translation crlf -encoding iso8859-1 flush stdout exec stty raw -echo # Unset linewrap: puts -nonewline "\033\[?7l" set err [catch {edittext stdin}] if {$err == 0} { saveFile } # Reset terminal: puts -nonewline "\033c" if {$err} { global errorInfo puts $errorInfo } 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%. ---- [Category Editor utility], [Category Application]