mirror of
git://projects.qi-hardware.com/openwrt-xburst.git
synced 2024-12-11 09:35:01 +02:00
547 lines
14 KiB
Plaintext
547 lines
14 KiB
Plaintext
global tcl_interactive
|
|
if {[info exists tcl_interactive] && $tcl_interactive > 0} {
|
|
|
|
# ripped from http://wiki.tcl.tk/16139
|
|
|
|
foreach {var val} {
|
|
PROMPT {tclsh$::tcl_patchLevel> }
|
|
HISTORY ""
|
|
HISTORY_BUFFER 500
|
|
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
|
|
|
|
set forever 0
|
|
|
|
# Resource & history files:
|
|
set HISTFILE $env(HOME)/.tclsh_history
|
|
|
|
proc ESC {} {
|
|
return "\033"
|
|
}
|
|
|
|
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
|
|
}
|
|
}
|
|
}
|
|
|
|
################################
|
|
# 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 {
|
|
\u0004 { ;# ^d
|
|
if { $env(CMDLINE_CURSOR) <= 0 } {
|
|
print "exit\n" nowait
|
|
doExit
|
|
}
|
|
}
|
|
\u0003 { ;# ^c
|
|
print "^C\n" nowait
|
|
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 ""
|
|
|
|
# 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 {
|
|
if {$firstchar == "\[" || $wordstart == 0} {
|
|
if {$firstchar == "\["} {
|
|
set word [string range $word 1 end]
|
|
incr wordstart
|
|
}
|
|
# 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]
|
|
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"
|
|
} {
|
|
if {[llength $match]} {
|
|
append temp "[ESC]\[${format}m"
|
|
foreach x [set $match] {
|
|
append temp "[file tail $x] "
|
|
}
|
|
append temp "[ESC]\[0m"
|
|
}
|
|
}
|
|
print "\n$temp\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
|
|
}
|
|
|
|
# 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
|
|
|
|
rename exit ___exit
|
|
proc exit args 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
|
|
|
|
# Run the command:
|
|
if { [catch $env(CMDLINE) res] } {
|
|
print "[ESC]\[1;31m\[[ESC]\[0;31mError[ESC]\[1;31m\][ESC]\[0m "
|
|
}
|
|
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
|
|
}
|