Historical Interest Only edit
See instead: Pure-tcl readline2.aspect 2013-09-18: The code on this page seems to be entirely obsoleted by the page linked above, and the content has little of value expect the Linux Console Text Editor In Pure TCL link. Any gnomes agree strongly enough to delete the page?slebetman: Here's my first attempt at a pure-tcl implementation of readline-like capabilities. Save this into a file tclline.tcl and source it from an interactive tclsh.The good news is that console programs like vi and links and even the Linux Console Text Editor In Pure TCL works perfectly with this.If you are brave enough with it you can even source it from your .tclshrc file.ak: Note that the 'exec stty ...' is unix specific. It is also the one part we cannot do in pure Tcl. It is either the exec, or a C extension (like Expect (I think Expect can do the same changes to the pty stty is able of. IIRC)). (slebetman: ak, I edited out your comment on colors since it no longer applies to the current code. Hope you don't mind. I'll edit out my comment here as well in a couple of days if nobody objects)slebetman: Quite true ;) I guess this really should be called Unix/Linux Readline in Pure Tcl. Actually, stty is not the only dependency. This also assumes a VT100/ANSI/xterm/linux terminal. The escape sequences won't work with things like the COMSPEC shell or even Tkcon.slebetman 10 Mar 2009: Fixed glob * substitution to not substitute in braces{}. This is so that the expand operator {*} and regexps don't need to be backslash escaped.slebetman 14 Jul 2006: Implemented proper (not so buggy) word completion. Word completion first searches the filesystem, then falls back to tcl commands & procs and finally to (global?) variables. Implemented the alias and unalias commands. I needed them to support coloring in ls and vi (so I can do: alias ls {ls --color=auto}). Also made history persistent by saving to a .tclline_history file and implemented a .tcllinerc file. The only remaining major features that's not yet implemented are long line editing and multi-line editing.slebetman: New version. This now properly supports long line editing. Word completion now colours hints: commands are green, variables magenta everything else not coloured. I've also implemented "universal" command substitution which substitutes not only Tcl commands and procs but also substitutes executables via exec. So now you can do things like: set x [split [cat /etc/mtab] \n]. Multi-line editing is still not implemented.slebetman 18 Jul 2006: Finally, multi-line editing is implemented! The main loop is also now a fileevent so this should use even less CPU time. Also implemented glob substitution of * and ~ (if you need literal * or ~ on the command line they can be escaped using backslashes: \* and \~. Also fixed a bug with alias handling in unknown.slebetman 20 Jul 2006: Tclline now uses Tclx if available to prevent SIGINT from causing the shell to exit. Also fixed a bug in command completion (basically I forgot to put -- in glob). With this modification, I'm now using tclsh as my login shell.Code edit
#! /usr/bin/env tclsh # tclline: An attempt at a pure tcl readline. # Use Tclx if available: catch { package require Tclx # Prevent sigint from killing our shell: signal ignore SIGINT } # Initialise our own env variables: foreach {var val} { PROMPT ">" HISTORY "" HISTORY_BUFFER 100 COMPLETION_MATCH "" } { if {![info exists env($var)]} { set env($var) $val } } foreach {var val} { CMDLINE "" CMDLINE_CURSOR 0 CMDLINE_LINES 0 HISTORY_LEVEL -1 } { set env($var) $val } unset var val array set ALIASES {} set forever 0 # Resource & history files: set HISTFILE $env(HOME)/.tclline_history set RCFILE $env(HOME)/.tcllinerc proc ESC {} { return "\033" } 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] return $ret } proc goto {row {col 1}} { switch -- $row { "home" {set row 1} } print "[ESC]\[${row};${col}H" nowait } proc gotocol {col} { print "\r" nowait if {$col > 0} { print "[ESC]\[${col}C" nowait } } proc clear {} { print "[ESC]\[2J" nowait goto home } proc clearline {} { print "[ESC]\[2K\r" nowait } proc getColumns {} { set cols 0 if {![catch {exec stty -a} err]} { regexp {rows \d+; columns (\d+)} $err -> cols } return $cols } proc prompt {{txt ""}} { global env set prompt [subst $env(PROMPT)] set txt "$prompt$txt" foreach {end mid} $env(CMDLINE_LINES) break # Calculate how many extra lines we need to display. # Also calculate cursor position: set n -1 set totalLen 0 set cursorLen [expr {$env(CMDLINE_CURSOR)+[string length $prompt]}] set row 0 set col 0 # Render output line-by-line to $out then copy back to $txt: set found 0 set out [list] foreach line [split $txt "\n"] { set len [expr {[string length $line]+1}] incr totalLen $len if {$found == 0 && $totalLen >= $cursorLen} { set cursorLen [expr {$cursorLen - ($totalLen - $len)}] set col [expr {$cursorLen % $env(COLUMNS)}] set row [expr {$n + ($cursorLen / $env(COLUMNS)) + 1}] if {$cursorLen >= $len} { set col 0 incr row } set found 1 } incr n [expr {int(ceil(double($len)/$env(COLUMNS)))}] while {$len > 0} { lappend out [string range $line 0 [expr {$env(COLUMNS)-1}]] set line [string range $line $env(COLUMNS) end] set len [expr {$len-$env(COLUMNS)}] } } set txt [join $out "\n"] set row [expr {$n-$row}] # Reserve spaces for display: if {$end} { if {$mid} { print "[ESC]\[${mid}B" nowait } for {set x 0} {$x < $end} {incr x} { clearline print "[ESC]\[1A" nowait } } clearline set env(CMDLINE_LINES) $n # Output line(s): print "\r$txt" if {$row} { print "[ESC]\[${row}A" nowait } gotocol $col lappend env(CMDLINE_LINES) $row } proc print {txt {wait wait}} { # Sends output to stdout chunks at a time. # This is to prevent the terminal from # hanging if we output too much: while {[string length $txt]} { puts -nonewline [string range $txt 0 2047] set txt [string range $txt 2048 end] if {$wait == "wait"} { after 1 } } } rename unknown _unknown proc unknown {args} { global env ALIASES set name [lindex $args 0] set cmdline $env(CMDLINE) set cmd [string trim [regexp -inline {^\s*[^\s]+} $cmdline]] if {[info exists ALIASES($cmd)]} { set cmd [regexp -inline {^\s*[^\s]+} $ALIASES($cmd)] } set new [auto_execok $name] if {$new != ""} { set redir "" if {$name == $cmd && [info command $cmd] == ""} { set redir ">&@ stdout <@ stdin" } if {[catch { uplevel 1 exec $redir $new [lrange $args 1 end]} ret] } { return } return $ret } eval _unknown $args } proc alias {word command} { global ALIASES set ALIASES($word) $command } proc unalias {word} { global ALIASES array unset ALIASES $word } ################################ # Key bindings ################################ proc handleEscapes {} { global env upvar 1 keybuffer keybuffer set seq "" set found 0 while {[set ch [readbuf keybuffer]] != ""} { append seq $ch switch -exact -- $seq { "\[A" { ;# Cursor Up (cuu1,up) handleHistory 1 set found 1; break } "\[B" { ;# Cursor Down handleHistory -1 set found 1; break } "\[C" { ;# Cursor Right (cuf1,nd) if {$env(CMDLINE_CURSOR) < [string length $env(CMDLINE)]} { incr env(CMDLINE_CURSOR) } set found 1; break } "\[D" { ;# Cursor Left if {$env(CMDLINE_CURSOR) > 0} { incr env(CMDLINE_CURSOR) -1 } set found 1; break } "\[H" - "\[7~" - "\[1~" { ;# home set env(CMDLINE_CURSOR) 0 set found 1; break } "\[3~" { ;# delete if {$env(CMDLINE_CURSOR) < [string length $env(CMDLINE)]} { set env(CMDLINE) [string replace $env(CMDLINE) \ $env(CMDLINE_CURSOR) $env(CMDLINE_CURSOR)] } set found 1; break } "\[F" - "\[K" - "\[8~" - "\[4~" { ;# end set env(CMDLINE_CURSOR) [string length $env(CMDLINE)] set found 1; break } "\[5~" { ;# Page Up } "\[6~" { ;# Page Down } } } return $found } proc handleControls {} { global env upvar 1 char char upvar 1 keybuffer keybuffer # Control chars start at a == \u0001 and count up. switch -exact -- $char { \u0003 { ;# ^c # doExit } \u0008 - \u007f { ;# ^h && backspace ? if {$env(CMDLINE_CURSOR) > 0} { incr env(CMDLINE_CURSOR) -1 set env(CMDLINE) [string replace $env(CMDLINE) \ $env(CMDLINE_CURSOR) $env(CMDLINE_CURSOR)] } } \u001b { ;# ESC - handle escape sequences handleEscapes } } # Rate limiter: set keybuffer "" } proc shortMatch {maybe} { # Find the shortest matching substring: set maybe [lsort $maybe] set shortest [lindex $maybe 0] foreach x $maybe { while {![string match $shortest* $x]} { set shortest [string range $shortest 0 end-1] } } return $shortest } proc handleCompletion {} { global env set vars "" set cmds "" set execs "" set files "" # First find out what kind of word we need to complete: set wordstart [string last " " $env(CMDLINE) \ [expr {$env(CMDLINE_CURSOR)-1}]] incr wordstart set wordend [string first " " $env(CMDLINE) $wordstart] if {$wordend == -1} { set wordend end } else { incr wordend -1 } set word [string range $env(CMDLINE) $wordstart $wordend] if {[string trim $word] == ""} return set firstchar [string index $word 0] # Check if word is a variable: if {$firstchar == "\$"} { set word [string range $word 1 end] incr wordstart # Check if it is an array key: set x [string first "(" $word] if {$x != -1} { set v [string range $word 0 [expr {$x-1}]] incr x set word [string range $word $x end] incr wordstart $x if {[uplevel #0 "array exists $v"]} { set vars [uplevel #0 "array names $v $word*"] } } else { foreach x [uplevel #0 {info vars}] { if {[string match $word* $x]} { lappend vars $x } } } } else { # Check if word is possibly a path: if {$firstchar == "/" || $firstchar == "." || $wordstart != 0} { set files [glob -nocomplain -- $word*] } if {$files == ""} { # Not a path then get all possibilities: if {$firstchar == "\[" || $wordstart == 0} { if {$firstchar == "\["} { set word [string range $word 1 end] incr wordstart } # Check executables: foreach dir [split $env(PATH) :] { foreach f [glob -nocomplain -directory $dir -- $word*] { set exe [string trimleft [string range $f \ [string length $dir] end] "/"] if {[lsearch -exact $execs $exe] == -1} { lappend execs $exe } } } # Check commands: foreach x [info commands] { if {[string match $word* $x]} { lappend cmds $x } } } else { # Check commands anyway: foreach x [info commands] { if {[string match $word* $x]} { lappend cmds $x } } } } if {$wordstart != 0} { # Check variables anyway: set x [string first "(" $word] if {$x != -1} { set v [string range $word 0 [expr {$x-1}]] incr x set word [string range $word $x end] incr wordstart $x if {[uplevel #0 "array exists $v"]} { set vars [uplevel #0 "array names $v $word*"] } } else { foreach x [uplevel #0 {info vars}] { if {[string match $word* $x]} { lappend vars $x } } } } } set maybe [concat $vars $cmds $execs $files] set shortest [shortMatch $maybe] if {"$word" == "$shortest"} { if {[llength $maybe] > 1 && $env(COMPLETION_MATCH) != $maybe} { set env(COMPLETION_MATCH) $maybe clearline set temp "" foreach {match format} { vars "35" cmds "1;32" execs "32" files "0" } { if {[llength [set $match]]} { append temp "[ESC]\[${format}m" foreach x [set $match] { append temp "[file tail $x] " } append temp "[ESC]\[0m" } } print "\n$temp\n" } } else { if {[file isdirectory $shortest] && [string index $shortest end] != "/"} { append shortest "/" } if {$shortest != ""} { set env(CMDLINE) \ [string replace $env(CMDLINE) $wordstart $wordend $shortest] set env(CMDLINE_CURSOR) \ [expr {$wordstart+[string length $shortest]}] } elseif {$env(COMPLETION_MATCH) != " not found "} { set env(COMPLETION_MATCH) " not found " print "\nNo match found.\n" } } } proc handleHistory {x} { global env set hlen [llength $env(HISTORY)] incr env(HISTORY_LEVEL) $x if {$env(HISTORY_LEVEL) > -1} { set env(CMDLINE) [lindex $env(HISTORY) end-$env(HISTORY_LEVEL)] set env(CMDLINE_CURSOR) [string length $env(CMDLINE)] } if {$env(HISTORY_LEVEL) <= -1} { set env(HISTORY_LEVEL) -1 set env(CMDLINE) "" set env(CMDLINE_CURSOR) 0 } elseif {$env(HISTORY_LEVEL) > $hlen} { set env(HISTORY_LEVEL) $hlen } } ################################ # History handling functions ################################ proc getHistory {} { global env return $env(HISTORY) } proc setHistory {hlist} { global env set env(HISTORY) $hlist } proc appendHistory {cmdline} { global env set old [lsearch -exact $env(HISTORY) $cmdline] if {$old != -1} { set env(HISTORY) [lreplace $env(HISTORY) $old $old] } lappend env(HISTORY) $cmdline set env(HISTORY) \ [lrange $env(HISTORY) end-$env(HISTORY_BUFFER) end] } ################################ # main() ################################ proc rawInput {} { fconfigure stdin -buffering none -blocking 0 fconfigure stdout -buffering none -translation crlf exec stty raw -echo } proc lineInput {} { fconfigure stdin -buffering line -blocking 1 fconfigure stdout -buffering line exec stty -raw echo } proc doExit {{code 0}} { global env HISTFILE # Reset terminal: print "[ESC]c[ESC]\[2J" nowait lineInput set hlist [getHistory] if {[llength $hlist] > 0} { set f [open $HISTFILE w] foreach x $hlist { # Escape newlines: puts $f [string map { \n "\\n" "\\" "\\b" } $x] } close $f } exit $code } if {[file exists $RCFILE]} { source $RCFILE } # Load history if available: if {[llength $env(HISTORY)] == 0} { if {[file exists $HISTFILE]} { set f [open $HISTFILE r] set hlist [list] foreach x [split [read $f] "\n"] { if {$x != ""} { # Undo newline escapes: lappend hlist [string map { "\\n" \n "\\\\" "\\" "\\b" "\\" } $x] } } setHistory $hlist unset hlist close $f } } rawInput # This is to restore the environment on exit: # Do not unalias this! alias exit doExit proc tclline {} { global env set char "" set keybuffer [read stdin] set env(COLUMNS) [getColumns] while {$keybuffer != ""} { if {[eof stdin]} return set char [readbuf keybuffer] if {$char == ""} { # Sleep for a bit to reduce CPU time: after 40 continue } if {[string is print $char]} { set x $env(CMDLINE_CURSOR) if {$x < 1 && [string trim $char] == ""} continue set trailing [string range $env(CMDLINE) $x end] set env(CMDLINE) [string replace $env(CMDLINE) $x end] append env(CMDLINE) $char append env(CMDLINE) $trailing incr env(CMDLINE_CURSOR) } elseif {$char == "\t"} { handleCompletion } elseif {$char == "\n" || $char == "\r"} { if {[info complete $env(CMDLINE)] && [string index $env(CMDLINE) end] != "\\"} { lineInput print "\n" nowait uplevel #0 { global env ALIASES # Handle aliases: set cmdline $env(CMDLINE) set cmd [string trim [regexp -inline {^\s*[^\s]+} $cmdline]] if {[info exists ALIASES($cmd)]} { regsub -- "(?q)$cmd" $cmdline $ALIASES($cmd) cmdline } # Perform glob substitutions: set cmdline [string map { "\\*" \0 "\\~" \1 } $cmdline] # Don't substitute * and ~ in braces: foreach x [regexp -inline -all -indices {{.*?}} $cmdline] { foreach {i n} $x break set s [string range $cmdline $i $n] set s [string map { "*" \0 "~" \1 } $s] set cmdline [string replace $cmdline $i $n $s] } while {[regexp -indices \ {([\w/\.]*(?:~|\*)[\w/\.]*)+} $cmdline x] } { foreach {i n} $x break set s [string range $cmdline $i $n] set x [glob -nocomplain -- $s] # If glob can't find anything then don't do # glob substitution, pass * or ~ as literals: if {$x == ""} { set x [string map { "*" \0 "~" \1 } $s] } set cmdline [string replace $cmdline $i $n $x] } set cmdline [string map { \0 "*" \1 "~" } $cmdline] # Run the command: catch $cmdline res if {$res != ""} { print "$res\n" } # Append HISTORY: set env(HISTORY_LEVEL) -1 appendHistory $env(CMDLINE) set env(CMDLINE) "" set env(CMDLINE_CURSOR) 0 set env(CMDLINE_LINES) {0 0} } rawInput } else { set x $env(CMDLINE_CURSOR) if {$x < 1 && [string trim $char] == ""} continue set trailing [string range $env(CMDLINE) $x end] set env(CMDLINE) [string replace $env(CMDLINE) $x end] append env(CMDLINE) $char append env(CMDLINE) $trailing incr env(CMDLINE_CURSOR) } } else { handleControls } } prompt $env(CMDLINE) } tclline fileevent stdin readable tclline vwait forever doExit
Discussion edit
To have tclline automatically available when you start tclsh add the following to your .tclshrc file:if {$tcl_interactive} { source /path/to/your/tclline.tcl }rdt Nice idea, but my question is: Is the if test really necessary? Isn't .tclshrc only read when tclsh is running interactively? Next question: How about adding this into the interactive part of init.tcl ?rdt Another question: I can't really see what you changed in the unknown proc as I have 8.4 and tkdiff on the two procs shows a lot of change in the 8.4 version. So what did you change/add to that proc for your version?slebetman: Only one simple thing: I removed the info level and info script test to allow unknown to call auto_execok from any level after the shell sources tclline. Try running the commands below in an interactive session of tclsh and see if the output makes sense. If it does, that's probably the only editing you need:
set x [info body unknown] set x [regsub -all {if \{.{0,5}info level.{0,10}?&&} $x "if {"] set x [regsub -all {if \{.{0,5}info script.{0,10}?&&} $x "if {"] set x "proc unknown {[info args unknown]} {$x}"rdt 2006.07.13 - With some changes, that is what I did to use the 8.4 unknown. Is there some reason that you did not use the history.tcl present in the distribution or is not present in yours? I made use of it myself.slebetman: I didn't know how to use it. I thought that history would always take the last executed command which also means the code in tclline itself. Now that I've tried it I see that's not really the case. But I still prefer my implementation since it removes duplicate events (This have been my pet peeve with almost all implementations of history, from tcl to bash to DOSKEY). Besides, an implementation of history is really is almost nothing. It is merely an lappend to a list.rdt 2006.07.14 - I understand what you are saying, however: history can be used in at least two ways. Suppose that you need to redo a command from much earlier but don't remember the id. You 'history | grep <something_unique>' and discover that it was 987. You can then '!987' and redo it. You do a few commands and then say '!-3' to redo it again. If you don't put duplicates in the list (or keep up with all the id's for a command), then one of these capabilities gets lost.
I think what you really want is to keep all the items in the list but be able to display the list in several different ways: a) 'history' for the default full list, b) 'history -20' for the 20 most recent, c) 'history -b' for the list without duplicates, but show the first & last id, and d) 'history <some_re>' to show only those items that match <some_re>.SRIV I prefer the current optimized history. Its quick and simple and conforms to the 80/20 rule. A grep-able history is nifty, but If I need that, I shouldn't be doing work in a single console anway. I'd switch my devel work to a gui workstation.slebetman My implementation of history is grep-able anyway (well, regexp-able at least). It's just a list stored in an environment variable!
foreach x $env(HISTORY) {if {[regexp $something_unique $x]} {puts $x}}The only thing I don't have is history substitution (haven't implemented because frankly I've never used it). I believe Tkcon does it via unknown which means we can implement it too.rdt - So you are saying with this implementation, you can't do things '!2', or '!!', or '!-2' which are already implemented in unknown?[jcolburn] - What about putting all this into a namespace? I'm taking a stab at it. Also, I added some emacs ctrl key shortcuts
proc handleControls {} { global env upvar 1 char char upvar 1 keybuffer keybuffer # Control chars start at a == \u0001 and count up. switch -exact -- $char { \u0001 { ;# ^a set env(CMDLINE_CURSOR) 0 } \u0002 { ;# ^b if {$env(CMDLINE_CURSOR) > 0} { incr env(CMDLINE_CURSOR) -1 } } \u0004 { ;# ^d set env(CMDLINE) [string replace $env(CMDLINE) \ $env(CMDLINE_CURSOR) $env(CMDLINE_CURSOR)] } \u0005 { ;# ^e set env(CMDLINE_CURSOR) [string length $env(CMDLINE)] } \u0006 { ;# ^f if {$env(CMDLINE_CURSOR) < [string length $env(CMDLINE)]} { incr env(CMDLINE_CURSOR) } } \u0007 { ;# ^g set env(CMDLINE) "" set env(CMDLINE_CURSOR) 0 } \u000b { ;# ^k set env(YANK) [string range $env(CMDLINE) [expr {$env(CMDLINE_CURSOR) } ] end ] set env(CMDLINE) [string range $env(CMDLINE) 0 [expr {$env(CMDLINE_CURSOR) - 1 } ]] } \u0019 { ;# ^y if { [ info exists env(YANK) ] } { set env(CMDLINE) \ "[string range $env(CMDLINE) 0 [expr {$env(CMDLINE_CURSOR) - 1 } ]]$env(YANK)[string range $env(CMDLINE) $env(CMDLINE_CURSOR) end]" } } \u000e { ;# ^n handleHistory -1 } \u0010 { ;# ^p handleHistory 1 } \u0003 { ;# ^c # doExit } \u0008 - \u007f { ;# ^h && backspace ? if {$env(CMDLINE_CURSOR) > 0} { incr env(CMDLINE_CURSOR) -1 set env(CMDLINE) [string replace $env(CMDLINE) \ $env(CMDLINE_CURSOR) $env(CMDLINE_CURSOR)] } } \u001b { ;# ESC - handle escape sequences handleEscapes } } # Rate limiter: set keybuffer "" }Bezoar - Added the Control-Y (Yank) and updated Ctrl-K (kill to end of line ) for emacs bindingsalsterg - Corrected a small mistake where:
if {[llength $match]} {was used instead of:
if {[llength [set $match]]} {[HGC] I collected the code above a few months back, found it to be quite useful - then made a few changes to my version:
- put the code into a namespace (TclReadLine)
- put the entry point into a proc (TclReadLine::interact) - so I could call it from a script (and/or call it again)
- use the builtin history mechanism (so !!, !-2, etc. - would work as expected)
- handle customized prompts (tcl_prompt1 is handled - but not tcl_prompt2)
[HGC] Done. Note that there is some dead code in the new version; I didn't completely remove the previous 'history' implementation, for example. (Further cleanup is possible.) Further isolation into a slave interp is a good idea.ZB 2010-01-03 If tclline.tcl can replace the "usual" bash (or whichever other shell), I would to make a feature suggestion, that could help us to dispose of all that "exec magic":I think, it could be useful to equip it with ability to recognize "on its own" proper interpreter, looking just at the file extension. Five conditions should be met to trigger such behaviour: if the file has "eXecute" flag set, if the filename has any extension at all, if it's "pure text" file, if there isn't in its first line interpreter choosen explicitly already, and if the interpreter for the files of the given extension is present in the system installation.For example:
- all *.pl files could have default interpreter 'which perl'
- all *.tcl files could have default interpreter 'which tclsh'
- all *.c files could have default interpreter 'which tcc' (TCC compiler will treat C files as scripts)
- ...and so on for Python, Ruby, Lua and many other scripting languages.