Navigation in der Tcl-Shell
In der Tcl-Shell tclsh
ist es ziemlich nervend, dass es keine History gibt, durch die man mit den Pfeiltasten navigieren kann. Ganz unverständlich ist, dass man den Cursor nicht einmal mit den Pfeiltasten nach rechts und links bewegen kann. Es erscheinen hier per Standard nur die Zeichencodes der Tasten: ^[[A^[[B^[[C^[[D
.
Im Tcler's Wiki habe ich ein Skript von Adly Abdullah gefunden, was dies ausbessert. Das Skript muss nur per Copy&Paste in eine Datei ~/bin/tclline.tcl
(oder wo immer man es haben will) gespeichert und ausführbar gemacht werden. Danach muss noch die Zeile
source ~/bin/tclline.tcl
in die Datei ~/.tclshrc
eingefügt werden.
Unten stehend ist meine Version des Skriptes, da ich noch kleinere Änderungen vornehmen musste/wollte:
- Prompt beginnt mit "%", nicht ">"
- [Pos1] und [Ende] haben bei mir andere Zeichencodes
- [Strg]+[C] und [Strg]+[D] beenden die Shell
- Navigation über mehrere Wörter per [Strg]+[Cursor rechts] bzw. [Strg]+[Cursor links] <l/i>
- beim Beenden der Shell wird der Bildschirminhalt nicht mehr gelöscht
#! /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 } "\[OH" - "\[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 } "\[OF" - "\[F" - "\[K" - "\[8~" - "\[4~" { ;# end set env(CMDLINE_CURSOR) [string length $env(CMDLINE)] set found 1; break } "\[5~" { ;# Page Up } "\[6~" { ;# Page Down } "\[2~" { ;# Insert } "\[1;5C" { ;# Strg+Cursor right jumpToNonAlphaNum 1 set found 1; break } "\[1;5D" { ;# Strg+Cursor left jumpToNonAlphaNum 0 set found 1; break } } } return $found } # return true if word only contains alphanumeric characters # the empty string will return 0 proc isAlphaNum { word } { return [regexp {^\w+$} $word] } # jump to the next non alphanumeric character in the current line # if forward is not 0 we go to the right # if forward is 0 we go to the left and will stop at the begin of a word proc jumpToNonAlphaNum { forward } { global env set found 0 # if the current string is not a alphanumeric character # we must go to the first alphanumeric character and start our search there if { ![isAlphaNum [string index $env(CMDLINE) $env(CMDLINE_CURSOR)]] } { if { $forward } { # search forward for { set ii $env(CMDLINE_CURSOR) } { $ii <= [string length $env(CMDLINE)] } { incr ii } { if { [isAlphaNum [string index $env(CMDLINE) $ii]] } { set env(CMDLINE_CURSOR) $ii set found 1 break } } } else { # search backward for { set ii $env(CMDLINE_CURSOR) } { $ii >= 0 } { incr ii -1 } { if { [isAlphaNum [string index $env(CMDLINE) $ii]] } { set env(CMDLINE_CURSOR) $ii set found 1 break } } } } else { set found 1 } if { $found } { # now search for the first non alphanumeric character set found 0 if { $forward } { # search forward for { set ii $env(CMDLINE_CURSOR) } { $ii <= [string length $env(CMDLINE)] } { incr ii } { if { ![isAlphaNum [string index $env(CMDLINE) $ii]] } { set env(CMDLINE_CURSOR) $ii set found 1 break } } } else { # search backward for { set ii $env(CMDLINE_CURSOR) } { $ii >= 0 } { incr ii -1 } { if { ![isAlphaNum [string index $env(CMDLINE) $ii]] } { set env(CMDLINE_CURSOR) $ii set found 1 break } } } } # if not found we jump to the start or end if { !$found } { if { $forward } { set env(CMDLINE_CURSOR) [string length $env(CMDLINE)] } else { set env(CMDLINE_CURSOR) 0 } } } proc handleControls {} { global env upvar 1 char char upvar 1 keybuffer keybuffer # Control chars start at a == \u0001 and count up. switch -exact -- $char { \u0004 - \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 "\n" 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
Kommentare
Ansicht der Kommentare: Linear | Verschachtelt