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:
Usage:
Basically the usual navigation keys behaves as expected. The "^" character below denotes pressing the Ctrl key.
Code:
The code is quite messy. 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). 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-existant 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 hilighting rules. This allows different types of files to have different hilighting rules. Like CSS, the rules are cascadable. File patterns are matched against either the tail of the shell magic (#! ...) or the file extension.
#! /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:
# {filepattern} {{regexp} {formatting}...}
# Comments in here are ignored.
# Special empty filepattern matches all files:
{} {
# 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)}
# Email address:
{(?i)(?:[a-z0-9-]+\.\:)*[a-z0-9-]+\@(?:[a-z0-9-]+\.)*[a-z0-9-]+}
{$style(bright)}
}
# Spec file:
{spec} {
{^\w+:} {$fg(yellow)}
{^%(?:desc|pre|build|install|clean|files|post)\w*}
{$bg(cyan);$fg(black)}
}
# Scripts
{sh|perl|cgi|pm|pl|py|spec} {
# Script style variables:
{(?i)\$[a-z_\.\:]\w*} {$style(bright);$fg(cyan)}
{(?i)[\@\%][a-z_\.\:]\w*} {$style(bright);$fg(yellow)}
# Tcl variable names after a command:
{(?:set|append|incr) ([a-zA-Z_\.\:]\w*?\s)} {$fg(cyan)}
{(?:global) ([a-zA-Z_\.][\w ]*)} {$fg(cyan)}
# Functions, procs and subroutines:
{(?:proc|sub|function|rename) ([a-zA-Z_\.\|]\w*)} {$style(bright)}
{([a-zA-Z_\.]\w*)(?:\s*\()} {$style(bright)}
# Backtick exec:
{`.*?`} {$bg(yellow);$fg(black)}
}
# Patch file:
{patch} {
{^(?:\-\-\-|\+\+\+) .*$} {$bg(blue);$fg(white)}
{^\@\@.*$} {$bg(yellow);$fg(black)}
{^\+.*$} {$bg(green);$fg(black)}
{^\-.*$} {$bg(red);$fg(black)}
}
}
################################
# 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 ""
set writable 1
################################
# Utilities
################################
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 getInput {buffer {txt ""}} {
global viewRow viewCol
upvar 1 $buffer keybuffer
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
}
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}]]
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
}
################################
# 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
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 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]
register undoInsert $row $col $bufRow $bufCol
handleRedraw partial
incr viewRow
}
proc handleInsert {} {
global BUFFER bufRow bufCol viewRow
global undoBuffer redoBuffer writable
if {!$writable} return
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 {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 $op]
status ""
} else {
status "$from 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]
}
}
}
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
}
################################
# 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
handlePageUp
set found 1; break
}
"\[6~" { ;# 6 Next screen
handlePageDown
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 undoBuffer redoBuffer
}
\u0019 { ;# ^y - redo
handleUndo redoBuffer undoBuffer
}
\u001c { ;# ^| - dump undoBuffer (for dubugging)
global undoBuffer redoBuffer
clear
goto home
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 "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]
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
}
\u000f { ;# ^o - page up
handlePageUp
}
\u0010 { ;# ^p - page down
handlePageDown
}
\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 {} {
global BUFFER IDX viewRow viewCol bufRow bufCol writable
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 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 ]
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 writable
set IDX(ROWMAX) 24
set IDX(COLMAX) 80
set IDX(ROWCOLLEN) 18
set changed 1
set BUFFER ""
getRowColMax
if {[file exists $fileName]} {
if {[file readable $fileName]} {
set f [open $fileName r]
set BUFFER [split [read $f] "\n"]
close $f
if {[file writable $fileName]} {
status "Opened: $fileName"
set writable 1
} else {
status "Opened: $fileName, READ ONLY!"
set writable 0
}
} else {
puts "Can't read file: \"$fileName\""
exit
}
} else {
status "New file: $fileName"
}
set topline [lindex $BUFFER 0]
if {[string range $topline 0 1] == "#!"} {
set fileext [lindex [split $topline "/"] end]
} else {
set fileext [file extension $filename]
}
initSyntaxRules $fileext
trace variable BUFFER w bufferModified
fconfigure stdin -buffering none -blocking 0 -encoding iso8859-1
fconfigure stdout -buffering full -translation crlf -encoding iso8859-1
exec stty raw -echo
set err [catch edittext]
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
}
proc initSyntaxRules {fileext} {
global syntaxRules hilight fg bg style
set syntaxRules [stripComments $syntaxRules]
set hilight ""
foreach {filepattern rule} $syntaxRules {
if {[regexp $filepattern $fileext]} {
foreach {pattern attr} $rule {
lappend hilight $pattern [subst $attr]
}
}
}
}
if {$filename == ""} {
puts "\nPlease specify a filename"
gets stdin filename
if {$filename == ""} {exit}
}
#SRIV place hostname & filename into the xterms titlebar
puts -nonewline "\033\]0;[info hostname] - [file tail $filename]\007"
console_edit $filename
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!