Overview | Index by: file name |
procedure name |
procedure call |
annotation
cli.tcl
(annotations | original source)
#
# Copyright (C) 2010 Alexandros Stergiakis <alsterg@gmail.com>
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU Affero General Public License as
# published by the Free Software Foundation, either version 3 of the
# License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Affero General Public License for more details.
#
# You should have received a copy of the GNU Affero General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
#//#
# Procedures for dealing with CLI user interactions.
#
# This file covers the following functions:
# * Command line processing
# * Execution of commands
# * help via "?"
# * command completion with TAB
# * history
# * readline-style editing
# * and other editing conveniences
#
# We don't perform command and variable substitutions during command line editing.
# Substitutions are performed however when command is executed (either as a MirkoConf command or Tcl script).
#
# We introduce this limitation because in order to provide TAB expansions and ? feedback
# we need to know in advance the exact string of the command. With command
# substitution we would have to execute the subcommands before we can know what the
# command string really is. Variable substitutions, on the other hand, could trigger variable traces and
# change the state of the interpreter as a result of '?' or TAB.
#
# In effect, '?' & TAB cannot be used with MirkoConf commands that have subcommands
# or variables. Simply the will report unrecognized strings. However, if the user enters the command without
# this help facilities and executes it afterwards, substituions will be performed as normal and the result will be parsed again
# (first the subcommands and then going up to the root command). If the substituted command gives a legal MikroConf or Tcl command,
# it will be executed as normal. The result of these commands will take the place of [ ] as expected.
#
# Also notice that command line help facilities, like '?' and TAB can only be used when entering
# a MikroConf command. Neither incomplete Tcl commands, nor incomplete variable names are considered.
#
# @assume VT100/ANSI/xterm/linux terminal or compatible.
#
# References:
# http://foldoc.org/foldoc.cgi?ASCII+character+table
# http://www.termsys.demon.co.uk/vtansi.htm
#
#//#
# Note: The global variable "sid" stores the sessionId that corresponds to this thread.
# and the global variable "ptid" stores the thread Id of the Master.
namespace eval cli {
namespace export handleAction
# Uses procedures from the ::sysconf and ::session.
# CMDLINE: Stores the current entered text on the command line
# CMDLINE_CURSOR: Stores the current location (int) of the pointer in the command line (from 0 to CMDLINE length)
# CMDLINE_LINES: Stores a tuple of integers. The first corresponds to the total number of lines the command occupies,
# and the second is the number of lines away from the last command line, that the cursor is.
# CMDLINE_BUFFER: We store here the last deleted command line text due to a ^K ^U ^W line editing command.
# This is recovered with the ^Y line editing command.
# CMDLINE_PREV:The previous command text before a user pressed any key. If the same, we dont reprint the same command,
# avoiding cluttering the screen.
# CMDLINE_SAVED: The state of the command line (command text and cursor position) before the user started looking in the history.
# It is used in order to restore the original state if the user returns without picking one of the older commands.
# ESC : The octal ascii code for ESC
variable CMDLINE {}
variable CMDLINE_CURSOR 0
variable CMDLINE_LINES [list 0 0]
variable CMDLINE_BUFFER {}
variable CMDLINE_PREV {}
variable CMDLINE_SAVED {}
variable CMDLINE_PROMPT {}
variable ESC "\033"
variable special 0
################################
# Terminal handling procedures
################################
# Return and remove the first character from a FILO string.
#
# @assume The variable named $txt exists in the context of the caller.
#
# @param txt The buffer to read from, passed by name for performance reasons.
# @return The first character of the string; if empty, the empty list is returned.
proc readbuf {txt} {
upvar 1 $txt STRING
set ret [string index $STRING 0]
set STRING [string range $STRING 1 end]
return $ret
}
# Set the cursor to (row, col) coordinates. Numbering starts from zero for both dimentions.
#
# @assume row and col values are sane with respect to maximum terminal height and width at the time of invocation (e.g. 80x24)
#
# @param row Send the cursor to absolute row $row; e.g from 0 to 24, for an 24 rows terminal.
# @param col Send the cursor to absolute col $col, or beginning of line if not specified; e.g from 0 to 79, for an 80 columns terminal.
proc goto {row {col 1}} {
variable ESC
switch -- $row {
"home" {set row 1}
}
if {$row > 0 && $col > 0} {
puts -nonewline "${ESC}\[${row};${col}H"
}
}
# Set the cursor to col; same row.
#
# @assume col value is sane with respect to maximum terminal width at the time of invocation (e.g. 80)
#
# @param col The column to place the cursor at. e.g from 0 to 79, for an 80 columns terminal.
proc gotocol {col} {
variable ESC
puts -nonewline "\r"
if {$col > 0} {
puts -nonewline "${ESC}\[${col}C"
}
}
# Clears screen, leaving the cursor at the last row, first column.
proc clear {} {
variable ESC
puts -nonewline "${ESC}\[2J"
goto home
}
# Removes any character printed before the position of the cursor, and send the cursor at the beginning of the line (like CTLR^U).
proc clearline {} {
variable ESC
puts -nonewline "${ESC}\[2K\r"
}
# Get formatted information about the system.
#
# @assume Parent scope has arrays Uname & Sysinfo defined, with expected contents.
#
# @param name A name that identifies the info to be requested
# @return The formatted info
proc getinfo {name} {
upvar Uname Uname
upvar Sysinfo Sysinfo
if {[catch {
switch -exact -- $name {
"hostname" { ;# localhost
set result $Uname(node-name)
}
"domain" { ;# example.com
set result $Uname(network-name)
}
"machine" { ;# x86_64
set result $Uname(machine-name)
}
"osrelease" { ;# 2.6.22.17-0.1-default
set result $Uname(kernel-release)
}
"osname" { ;# Linux
set result $Uname(kernel-name)
}
"osversion" { ;# #1 SMP 2008/02/10 20:01:04 UTC
set result $Uname(kernel-version)
}
"date" { ;# 19/03/08
set result "[clock format [clock seconds] -format %d/%m/%y]"
}
"time" { ;# 12:04
set result "[clock format [clock seconds] -format %H:%M]"
}
"uptime" { ;# 4D+21H
set uptime $Sysinfo(uptime)
#for minutes: [expr {(($uptime % 86400) % 3600) / 60}]M"
set result "[expr {$uptime / 86400}]D+[expr {($uptime % 86400) / 3600}]H"
}
"loadavg" { ;# 1min:0.4, 5min:0.3, 15min:0.4
lassign $Sysinfo(loads) 1min 5min 15min
set loadavg [expr {$1min + $5min + $15min}]
set result [format {1min:%.1f, 5min:%.1f, 15min:%.1f} [expr {$1min / double($loadavg)}] [expr {$5min / double($loadavg)}] [expr {$15min / double($loadavg)}]]
}
"freeram" { ;# 0.17%
set result [format {%.2f%%} [expr {$Sysinfo(freeram) / double($Sysinfo(totalram))}]]
}
"freeswap" { ;# 0.62%
if {[catch {
# The following will return an error if the system doesn't have swap.
set result [format {%.2f%%} [expr {$Sysinfo(freeswap) / double($Sysinfo(totalswap))}]]
}]} {
set result "NOSWAP"
}
}
"users" { ;# Returns a list of the users currently logged in the system.
set users [list]
foreach entry [who] {
lappend users [dict get $entry user]
}
set result [lsort -unique $users]
}
"sessions" { ;# Returns the number of on-going sessions currently in the system, NOT the distinct number of users logged-in.
set result [llength [who]]
}
default {
error "unrecognized option"
}
}
} errMsg errStack]} {
# XXX Halts if enabled and an error occurs:
#log::Error -stack $errStack $errMsg
return
}
return $result
}
# Render the prompt from the prompt specifications set in PROMPT Shared Global Variable.
# Prompt is updated with every command execution (pressed Enter to execute command).
proc makePrompt {} {
global sid
variable CMDLINE_PROMPT
Session $sid PROMPT CONFSTRING AUTHSTRING USERNAME
array set Uname [uname]
array set Sysinfo [sysinfo]
# Read in session.tcl for the syntax that PROMPT supports.
# ZZZ
set CMDLINE_PROMPT [string map " \
%% {%} \
%u {$USERNAME} \
%h {[getinfo hostname]} \
%d {[getinfo domain]} \
%c {$CONFSTRING} \
%p {$AUTHSTRING} \
%s { } \
%t { } \
%n {\n} \
%D {[getinfo date]} \
%T {[getinfo time]} \
%M {[getinfo machine]} \
%R {[getinfo osrelease]} \
%N {[getinfo osname]} \
%V {[getinfo osversion]} \
%U {[getinfo uptime]} \
%L {[getinfo loadavg]} \
%P {[getinfo freeram]} \
%W {[getinfo freeswap]} \
%E {[getinfo users]} \
%S {[getinfo sessions]} \
" $PROMPT] ;# Set the prompt, making substitutions first
}
# This procedure prints the existing command text and command prompt. It can handle multiline commands,
# splitting lines as necessary to fit in the columns of the current terminal. Also It places the cursor at the right place.
# If the user merely moved the cursor, then the command string is not re-printed, otherwise (no matter how small the
# change is) the whole command will be re-printed (including the prompt - possibly different).
#
# @param type Type of prompt: "new" (prompt) or "redraw" (the existing).
proc prompt {type} {
global sid
variable CMDLINE
variable CMDLINE_CURSOR
variable CMDLINE_LINES
variable CMDLINE_PREV
variable CMDLINE_PROMPT
variable ESC
Session $sid COLUMNS
if {$type eq "new"} {
makePrompt
}
set cursorLen [expr {$CMDLINE_CURSOR + [string length $CMDLINE_PROMPT]}] ;# The distance of cursor from the start of the prompt
# (spanning in multiple lines)
set txt ${CMDLINE_PROMPT}${CMDLINE} ;# The string to display
# We need to store this information for the sole purpose of erasing the excess lines of the command line
# as it was on the previous invocation of this procedure. This can happen when we browse the history.
set old_lines [lindex $CMDLINE_LINES 0] ;# The total number of lines the command occupied in the previous invocation of prompt.
set old_row [lindex $CMDLINE_LINES 1] ;# The relative position of the cursor (in rows) from the last command
# line row, during the previous invocation.
set lines -1 ;# The number of lines on the terminal that the command occupies up to the current point of processing.
set totalLen 0 ;# Total length of all the lines that make up a command up to the current point of processing.
set row 0 ;# The number of rows the cursor should be placed relatively to the end of the command.
set col 0 ;# The number of columns the cursor should be placed relatively to the start of the same line.
set found 0 ;# The position of the cursor has been encountered at the present point of processing.
set out {} ;# This list stores the rendered command line-by-line. This means that possibly more \n are present, than the original txt,
# to accomodate for longer than screen-width commands.
# Render output line-by-line to $out
foreach line [split $txt "\n"] {
set len [expr {[string length $line]+1}] ;# Length of the of the current line to be processed. +1 is for the newline which is trancated by
# the split command above.
incr totalLen $len
# Do the following if the line where the cursor resides is the one being processed.
# The goal here is to set values to the col & row variables to correspond to the position
# where the cursor should be displayed on the final output.
if {! $found && $totalLen >= $cursorLen} {
# cursorPos is the distance from the beginning of its line, without counting any other previous lines.
set cursorPos [expr {$cursorLen - ($totalLen - $len)}]
# Since the input line might be longer than the terminal supports, we have to split it into many smaller lines if necessary.
set col [expr {$cursorPos % $COLUMNS}]
set row [expr {$lines + ($cursorPos / $COLUMNS) + 1}] ;# The a+1 is for the -1 of n
# If cursor reaches end of line, then it should be appear at the start of the line bellow
# This can only happen when the command occupied all the width of the screen, and the cursor is at the end of it (width + 1).
if {$cursorPos >= $len} {
set col 0
incr row
}
set found 1
}
# We add to the total number of lines, the total number of lines the currenly processed line will occupy.
# This can be more than 1 because a line can be longer that the terminal width, and so we have to further
# split it in other lines.
incr lines [expr { int( ceil( double($len) / $COLUMNS ) ) }]
# We split the line into as many smaller lines as necessary to fit in our terminal's width.
while {$len > 0} {
lappend out [string range $line 0 [expr {$COLUMNS - 1}]]
set line [string range $line $COLUMNS end]
set len [expr {$len-$COLUMNS}]
}
}
# From the absolute row possition of cursor, now it becomes the lines away from the end of output
set row [expr {$lines - $row}]
# Now if different from last time, we print the command line.
switch -exact -- $type {
"redraw" {
if {! [string equal $CMDLINE_PREV $CMDLINE]} {
# Reserve space for display, according to the previous commad txt (previous invocation). (Hence the need to store those values).
# Assuming that we are editing a multi-line command (without pressing enter yet), we need to clear the previous lines, before
# displaying the new ones (which might be more or less in number). Hence, we move the cursor to the last line (forward $old_row),
# and then we go at the beginning, by clearing up each line.
if {$old_lines} {
if {$old_row} {
# Move ${old_row} number of rows down, so that we can start errasing line-by-line from end to start
puts -nonewline "${ESC}\[${old_row}B"
}
for {set n 0} {$n < $old_lines} {incr n} {
clearline
puts -nonewline "${ESC}\[1A" ;# Move to previous row, same column
}
}
clearline
puts -nonewline "\r[join $out "\n"]"
set CMDLINE_PREV $CMDLINE
# If cursor is not at the end of the command line, then go back $row number of lines.
if {$row} {
puts -nonewline "${ESC}\[${row}A" ;# Move $row number of rows back, but same column
}
} else { ;# Otherwise we don't print anything, but simply move the cursor
# If the calculated $row from previous invocation is different to the current value,
# then we changed line, and we move to next or previous line accordingly.
set offset [expr {abs($row - $old_row)}]
if {$row < $old_row} {
puts -nonewline "${ESC}\[${offset}B"
} elseif {$row > $old_row} {
puts -nonewline "${ESC}\[${offset}A"
}
}
}
"new" {
puts -nonewline "\r[join $out "\n"]"
set CMDLINE_PREV $CMDLINE
}
default {
error "Unrecognized command"
}
} ;# switch
gotocol $col ;# Now align on columns also
set CMDLINE_LINES [list $lines $row]
}
################################
# Key bindings and editing conveniences
################################
# Command line editing action handlers
#
# @param action the action to which we should respond
proc handleAction {action} {
global sid
variable CMDLINE
variable CMDLINE_CURSOR
variable CMDLINE_BUFFER
switch -exact -- $action {
"EraseLine" {
set CMDLINE {}
set CMDLINE_CURSOR 0
}
"Bell" {
puts -nonewline "\u7"
}
"CursorUp" {
browseHistory -back
}
"CursorDown" {
browseHistory -forth
}
"CursorRight" {
if {$CMDLINE_CURSOR < [string length $CMDLINE]} {
incr CMDLINE_CURSOR
}
}
"CursorLeft" {
if {$CMDLINE_CURSOR > 0} {
incr CMDLINE_CURSOR -1
}
}
"LineHome" {
set CMDLINE_CURSOR 0
}
"LineEnd" {
set CMDLINE_CURSOR [string length $CMDLINE]
}
"PageUp" {
browseHistory -oldest
}
"PageDown" {
browseHistory -newest
}
"Backspace" {
if {$CMDLINE_CURSOR > 0} {
incr CMDLINE_CURSOR -1
set CMDLINE [string replace $CMDLINE $CMDLINE_CURSOR $CMDLINE_CURSOR]
}
}
"Delete" {
if {$CMDLINE_CURSOR < [string length $CMDLINE]} {
set CMDLINE [string replace $CMDLINE $CMDLINE_CURSOR $CMDLINE_CURSOR]
}
}
"DeleteTillStart" {
if {$CMDLINE_CURSOR > 0} {
set CMDLINE_BUFFER [string range $CMDLINE 0 [expr {$CMDLINE_CURSOR - 1}]]
set CMDLINE [string range $CMDLINE $CMDLINE_CURSOR end]
set CMDLINE_CURSOR 0
}
}
"DeleteTillEnd" {
if {$CMDLINE_CURSOR < [string length $CMDLINE]} {
set CMDLINE_BUFFER [string range $CMDLINE $CMDLINE_CURSOR end]
set CMDLINE [string range $CMDLINE 0 [expr {$CMDLINE_CURSOR - 1}]]
}
}
"DeleteWordLeft" {
if {$CMDLINE_CURSOR > 0} {
set firstchar [string wordstart $CMDLINE $CMDLINE_CURSOR]
set wordlen [expr {$CMDLINE_CURSOR - $firstchar}]
set prevchar [expr {$CMDLINE_CURSOR - 1}]
set CMDLINE_BUFFER [string range $CMDLINE $firstchar $prevchar]
set CMDLINE [string replace $CMDLINE $firstchar $prevchar]
set CMDLINE_CURSOR [expr {$CMDLINE_CURSOR - $wordlen}]
}
}
"PasteDeleted" { ;# Paste the most recently deleted characters by using either ^K or ^U or ^W
if {$CMDLINE_BUFFER ne ""} {
set temp $CMDLINE ;# We need to store the original before it is being modified
set CMDLINE [string range $temp 0 [expr {$CMDLINE_CURSOR - 1}]]
append CMDLINE $CMDLINE_BUFFER
append CMDLINE [string range $temp $CMDLINE_CURSOR end]
set CMDLINE_CURSOR [expr {$CMDLINE_CURSOR + [string length $CMDLINE_BUFFER]}]
}
}
"RedrawLine" {
prompt redraw
}
"ClearScreen" -
"RedrawScreen" {
variable ESC
puts -nonewline "${ESC}c${ESC}\[2J"
prompt new
}
"BreakCommand" {
# Since we are here, it means that prompt is not blocked, and user has control. Nothing to break from.
# Other cases are handled in session.tcl.
}
"ResetTerminal" {
# Handled in session.tcl.
}
"ResizeTerminal" {
# Handled in session.tcl.
}
"SwitchLeft" {
if {$CMDLINE_CURSOR > 0} {
set prev [expr {$CMDLINE_CURSOR - 1}] ;# The points to the immediate char on the left where the cursor is
# We need to save this
set current [string index $CMDLINE $CMDLINE_CURSOR]
set CMDLINE [string replace $CMDLINE $CMDLINE_CURSOR $CMDLINE_CURSOR [string index $CMDLINE $prev]]
set CMDLINE [string replace $CMDLINE $prev $prev $current]
}
}
"Exit_CarriageReturn" { ;# Exit ConfMode, but first apply the entered command
puts "" ;# newline
execute_cmd $CMDLINE
sysconf confmode $sid exit
handleAction EraseLine
prompt new
}
"Exit_NoCarriageReturn" { ;# Exit ConfMode, without appling the entered command
puts "" ;# newline
sysconf confmode $sid exit
handleAction EraseLine
prompt new
}
default {
error "Unknown action"
}
}
return 0
}
# Handle escape sequences: Sequences prepended by escape that have special meaning
#
# @assume keybuffer variable exists on uplevel 2
proc handleEscapes {} {
set seq {}
upvar 2 keybuffer keybuffer
while {[set ch [readbuf keybuffer]] ne ""} {
append seq $ch
switch -exact -- $seq {
"\[A" { ;# Arrow Up key
handleAction CursorUp
}
"\[B" { ;# Arrow Down key
handleAction CursorDown
}
"\[C" { ;# Arrow Right key
handleAction CursorRight
}
"\[D" { ;# Arrow Left key
handleAction CursorLeft
}
"\[H" { ;# Home key
# "\[1~"
# "\[7~"
handleAction LineHome
}
"\[3~" { ;# Delete key
handleAction Delete
}
"\[F" { ;# End key
# "\[K" -
# "\[8~" -
# "\[4~"
handleAction LineEnd
}
"\[5~" { ;# Page Up key
handleAction PageUp
}
"\[6~" { ;# Page Down key
handleAction PageDown
}
}
}
}
# Handle special sequences which start with Ctrl + ^ combination
#
# @assume keybuffer variable exists on uplevel 2
#
# @param The special character.
proc handleSpecial {char} {
switch -exact -- $char {
\u0078 { ;# Ctrl + ^ and then 'x'
handleAction BreakCommand
}
\u0073 { ;# Ctrl + ^ and then 's'
handleAction ResizeTerminal
}
\u0072 { ;# Ctrl + ^ and then 'r'
handleAction ResetTerminal
}
}
}
# Handle control characters (single byte characters with special meaning)
#
# @assume char variable exists on uplevel 1
proc handleControls {} {
upvar 1 char char
# Control chars start at a == \u0001 and count up.
switch -exact -- $char {
\u0001 { ;# ^A
handleAction LineHome
}
\u0002 { ;# ^B
handleAction CursorLeft
}
\u0003 { ;# ^C
handleAction Exit_NoCarriageReturn
}
\u0005 { ;# ^E
handleAction LineEnd
}
\u0006 { ;# ^F
handleAction CursorRight
}
\u0004 { ;# ^D
handleAction Delete
}
\u0008 -
\u007f { ;# ^H && backspace
handleAction Backspace
}
\u000b { ;# ^K
handleAction DeleteTillEnd
}
\u000c { ;# ^L (clear screen and redraw line)
handleAction RedrawScreen
}
\u000e { ;# ^N
handleAction CursorDown
}
\u0010 { ;# ^P
handleAction CursorUp
}
\u0012 { ;# ^R
handleAction RedrawLine
}
\u0014 { ;# ^T
handleAction SwitchLeft
}
\u0015 { ;# ^U
handleAction DeleteTillStart
}
\u0017 { ;# ^W
handleAction DeleteWordLeft
}
\u0018 { ;# ^X
handleAction DeleteTillStart
}
\u0019 { ;# ^Y
handleAction PasteDeleted
}
\u001a { ;# ^Z
handleAction Exit_CarriageReturn
}
\u001b { ;# ESC - handle escape sequences
handleEscapes
}
\u001e { ;# Ctrl + ^
variable special
set special 1
}
}
}
# Implements TAB expansion and display of available options for command names and argument values.
proc handleCompletion {} {
global sid
variable CMDLINE
variable CMDLINE_CURSOR
# Check if cursor does not point to any word, but is placed on the whilespace
if {[string index $CMDLINE $CMDLINE_CURSOR] eq " " &&
[string index $CMDLINE $CMDLINE_CURSOR-1] eq " "} { ;# if "string index" out of bounds, returns the empty list
handleAction Bell
}
if {[catch {
if {! [info complete $CMDLINE] || ! [string is list $CMDLINE]} {
error "incomplete command; check for unclosed quotes, braces, brackets, array element names, or extra characters after close-brace"
}
# The whole purpose of the next line is to find the list index of the word
# the cursor is placed at (right space counts as part of the previous word).
set wordIndex [pos2index $CMDLINE $CMDLINE_CURSOR]
} errMsg]} {
# An error occured. $result holds the error message.
# We suppress the error because it can only be the user's fault, and not the system's.
puts "\n[ansi $sid -color red -bold -- $errMsg]"
handleAction Bell
return
}
if {[catch {
# The next is outside "catch" because if it fails, it is likely a system failure,
# and we let it propagate.
set matches [sysconf match $sid -values $CMDLINE $wordIndex]
} errMsg errStack]} {
#We are not really interested, as it can generated foolishly by the user: log::Error -stack $errStack "Tab-completion help error: " $errMsg
puts "\n[ansi $sid -color red -bold -- $errMsg]"
handleAction Bell
return
}
if {[llength $matches] == 0} { ;# No match at all
handleAction Bell
return
}
set shortest [::textutil::longestCommonPrefixList $matches]
set word [lindex $CMDLINE $wordIndex]
if {$word eq $shortest} { ;# If we already match the shortest,
if {[llength $matches] > 1} { ;# but there are still more options:
puts "\n[ansi $sid -color white -bold -- $matches]"
} else { ;# However, if a single option is available, meaning that the word is already complete:
# Move the cursor at the beginning of the next word (if present)
set sp_pos [string first " " $CMDLINE $CMDLINE_CURSOR]
if {$sp_pos == -1} { ;# can happen if cursor at end of line, and no space entered yet at the end of the last word.
set sp_pos [string length $CMDLINE]
}
set CMDLINE_CURSOR [expr {$sp_pos + 1}]
# Note: +1 because "string first" looks first on the startIndex and returns that if found, that would take us on the
# space at the end of the word, but we wont to move one position further.
# The following can happen if we were at the end of the command line, so there is no next word, and thus we
# need to extend CMDLINE
if {[string length $CMDLINE] - 1 < $CMDLINE_CURSOR} {
append CMDLINE { }
}
}
} else { ;# If we need some chars in order to match the shortest common string:
set diff [string range $shortest [string length $word] [string length $shortest]]
if {$CMDLINE_CURSOR == [string length $CMDLINE]} { ;# we are at the end of line, just append
append CMDLINE $diff
incr CMDLINE_CURSOR [string length $diff]
} else { ;# find the end of the word and insert there.
set wordend [string first " " $CMDLINE $CMDLINE_CURSOR]
cmdline_insert $diff $wordend
}
# Move also the cursor to the start of the next word, or if end of line, append a new space.
if {[llength $matches] == 1} {
if {$CMDLINE_CURSOR == [string length $CMDLINE]} {
append CMDLINE " "
incr CMDLINE_CURSOR
} else {
incr CMDLINE_CURSOR
}
}
}
}
# Remove unecessary spaces between words on the command line. They need to be removed, because
# in pos2index we treat the command line string as a list, and spaces should not appear at first place. This function only
# operates when the command line is a Tcl list (regardless of any extra spaces and newlines).
# If it is not a list, it means that some brace is open, and we have to wait until it becomes a list
# again. Of course spaces within braces are fine, cause they are part of a single list item.
#
# Note that if the command contains backslashes, they are not substituted, meaning that an escaped newline,
# for example, will be treated as if it was a command name.
#
# @assume $cmdline is a well-formed Tcl command & list.
#
# @param cmdline Command line.
# @param cursor Cursor position in the command line
# @return A list: <new cmdline list> <adjusted position of the cursor>
# @error
proc remove_spaces {cmdline cursor} {
# The following algorithm is sort of heristic, a better algorithm is welcome.
# We split the cmdline string in two parts: left and right of the cursor. The cursor position is part of the left. We transform the strings into
# lists, which trims any unecessary spaces, and concatanate the resulting lists. We count the number
# of characters the left string is smaller than originally, and reduce that many times the cursor position.
#
# As a requirement, when we split the cmdline into two parts, these parts should also be lists, otherwise it means
# that the cursor is somewhere inside a list item that has spaces and confuses the algorith, for example:
# Cmdline: one two { _ } three
# Curpos: at the '_'
#
# We identify three cases:
# 1. Cursor is on a space between two words, with no word right on the left side.
# In this case we point to a virtual not-yet-existing word between the left and right word.
# 2. Cursor is on a space between two words, just on the right of a word.
# In this case we point to the word or the right.
# 3. Cursor is on the last character of a word
# In this case we point to the word which include the character the cursor is on.
# 4. Cursor is on any other place, which means somewhere on a word, but not on the last character
# In this case we point to the word where the cursor is placed at.
# Depending on the case we take slightly different actions.
# We add this so that if the cursor is two columns away from the last word, it won't be
# considered placed on the last word, but on a "virtual" word.
if {[string index $cmdline end] eq { }} {
append cmdline "END"
} else {
append cmdline " END"
}
# Note: "string range" gives an empty list if a range of characters cannot be found (e.g. string range {123} 0 -1)
set left [string range $cmdline 0 $cursor] ;# including the cursor position
set right [string range $cmdline $cursor+1 end]
if {! ([info complete $left] && [string is list $cmdline]) || ! ([info complete $right] && [string is list $cmdline])} {
error "cannot get list of alternatives for constructs within quotes, braces, brackets or array element names"
}
set left2 [list {*}$left]
set right2 [list {*}$right]
set line $left2
if {[string index $cmdline $cursor] eq { } && [string index $cmdline $cursor-1] eq { }} { ;# Case 1
lappend line {} {*}$right2 ;# e.g. if left="word1" & right="word2" then line="word1 {} word2"
} elseif {([string index $cmdline $cursor] eq { } && [string index $cmdline $cursor-1] ne { }) ||
([string index $cmdline $cursor+1] eq { } && [string index $cmdline $cursor] ne { })} { ;# Case 2 & 3
lappend line {*}$right2 ;# e.g. if left="word1" & right="word2" then line="word1 word2"
} else { ;# Case 4
append line $right2 ;# e.g. if left="wo" & right="rd" then line="word"
}
set pos [expr {$cursor - ([string length $left] - [string length $left2])}]
if {[string index $cmdline $cursor] eq { }} { ;# Case 2
incr pos
}
if {[string index $cmdline $cursor-1] eq { }} { ;# Case 1
incr pos
}
return [list [lrange $line 0 end-1] $pos]
}
# Returns the index in the list of the item that the string position $pos points to.
# The space between list items is considered part of the item on the left.
# If pos points somewhere after the list, (including the space on the right of
# the last word) then the llength of the list + 1 is returned.
#
# @assume $lst is a list
#
# @param lst A list
# @param pos A number pointing in the list as a string. zero-based.
# @return The list index; zero-based.
proc pos2index {lst pos} {
lassign [remove_spaces $lst $pos] lst pos
# Check if pos points outside of the list (also after the column on the right of the last word)
if {$pos > ([string length $lst])} { ;# without +1 because $pos is zero based. Rember that the space on the right of the last word is part of it.
return [llength $lst] ;# No need for +1 because llength is 1-based, and lindex is 0-based.
}
set index 0
for {set i 0} {$i < [llength $lst]} {incr i} {
set len [string length [lrange $lst 0 $i]]
if {$pos <= $len} { ;# without +1 because $pos is zero based.
set index $i
break
}
}
return $index
}
# Displays in-line help for MikroConf commands & arguments.
# Help is not provided for anything else.
proc handleHelp {} {
global sid
variable CMDLINE
variable CMDLINE_CURSOR
# The associated help message with its name
set Found {}
# See the corresponding section in handleCompletion for the rationale around the next "catch" .
if {[catch {
if {! [info complete $CMDLINE] || ! [string is list $CMDLINE]} {
error "incomplete command; check for unclosed quotes, braces, brackets, array element names, or extra characters after close-brace"
}
# The whole purpose of the next line is to find the list index of the word
# the cursor is placed at (right space counts as part of the previous word).
set wordIndex [pos2index $CMDLINE $CMDLINE_CURSOR]
} errMsg]} {
# An error occured. $result holds the error message.
if {! [lempty $errMsg]} {
puts "\n[ansi $sid -color red -bold -- $errMsg]"
}
handleAction Bell
return
}
if {[catch {
if {$wordIndex == [llength $CMDLINE]} {
lassign [sysconf match $sid {-help -final} $CMDLINE $wordIndex] matches final
} else {
set matches [sysconf match $sid -help $CMDLINE $wordIndex]
# By asking again for the complete string we can display the ENTER option
# even when the cursor is not placed on the end of string. (We ask for final
# as if the cursor were actually at the end of command line string.)
# Errors in the rest of the line (after $wordIndex) are ignored. They will be
# caught when the user will execute the command. However if there is an
# error, the ENTER is not listed as an option.
if {[catch {
set final [sysconf match $sid -final $CMDLINE [llength $CMDLINE]]
}]} {
set final 0
}
}
} errMsg errStack]} {
#We are not really interested, as it can generated foolishly by the user: log::Error -stack $errStack "In-line help error: " $errMsg
if {! [lempty $errMsg]} {
puts "\n[ansi $sid -color red -bold -- $errMsg]"
}
handleAction Bell
return
}
if {$final} {
lappend matches [list ENTER {Press Enter to execute the command}]
}
if {[llength $matches] == 0} { ;# No match at all
handleAction Bell
return
}
set longest 0
foreach match $matches {
lassign $match name help
set name [ansi $sid -color white -bold -- $name]
set len [string length $name]
if {$len > $longest} {set longest $len}
lappend Found $name $help
}
puts "" ;# newline
foreach {name help} $Found {
append txt [format " %-*s %s\n" $longest $name $help]
}
more -nonewline $txt
}
################################
# History handling functions
################################
# Handle history action: go to the previous entry, next, first or last
#
# @param direction action specification: one of "-back", "-forth", "-newest", "-oldest"
proc browseHistory {direction} {
global sid
Session $sid HISTORY HISTORY_ENTRIES
Session -rw $sid HISTORY_LEVEL
variable CMDLINE
variable CMDLINE_CURSOR
variable CMDLINE_SAVED
switch -exact -- $direction {
"-back" {
if {$HISTORY_LEVEL == 0} {
set CMDLINE_SAVED [list $CMDLINE $CMDLINE_CURSOR]
}
if {$HISTORY_LEVEL < $HISTORY_ENTRIES} {
incr HISTORY_LEVEL
} else {return}
}
"-forth" {
if {$HISTORY_LEVEL > 0} {
incr HISTORY_LEVEL -1
} else {return}
}
"-newest" {
if {$HISTORY_LEVEL > 0} {
set HISTORY_LEVEL 0
} else {return}
}
"-oldest" {
if {$HISTORY_LEVEL == 0} {
set CMDLINE_SAVED [list $CMDLINE $CMDLINE_CURSOR]
}
if {$HISTORY_LEVEL < $HISTORY_ENTRIES} {
set HISTORY_LEVEL $HISTORY_ENTRIES
} else {return}
}
default {
error "Unknown history subcommand"
}
}
# Recover the past command
if {$HISTORY_LEVEL > 0} {
set pos [expr $HISTORY_LEVEL - 1]
set CMDLINE [lindex $HISTORY end-$pos]
set CMDLINE_CURSOR [string length $CMDLINE]
} else { ;# We returned to HISTORY_LEVEL 0
lassign $CMDLINE_SAVED CMDLINE CMDLINE_CURSOR
}
}
# Add a command to the history buffer. The command itself might actually be already in the history, in a different position.
# No two same consecutive entries can be present.
#
# @param cmdline the command line to be stored in the history buffer
proc appendHistory {cmdline} {
global sid
Session $sid HISTORY_SIZE
Session -rw $sid HISTORY HISTORY_ENTRIES HISTORY_LEVEL
# Ignore empty commands and when history is deactivated (history buffer is set to zero).
if {[lempty $cmdline] || $HISTORY_SIZE == 0} { return }
# Filter consecutive repetitions of the same command
if {[lindex $HISTORY end] ne $cmdline} {
lappend HISTORY $cmdline
# We increase the number of entries stored in the history buffer
incr HISTORY_ENTRIES
if {$HISTORY_ENTRIES > $HISTORY_SIZE} {
set HISTORY_ENTRIES $HISTORY_SIZE
set HISTORY [lrange $HISTORY end+[expr {-1*$HISTORY_SIZE+1}] end]
}
}
set HISTORY_LEVEL 0
}
################################
# main()
################################
# We check if a '?' that is pressed is preceeded by '\', in which case it loses its special function
proc notEscaped {} {
variable CMDLINE
variable CMDLINE_CURSOR
if {[string index $CMDLINE $CMDLINE_CURSOR-1] eq "\\"} { ;# If out of bounds it will return the empty list
return 0
}
return 1
}
# Execute the provided command. Suspend stdin fileevent, and restore correct
# settings afterwards (using an execution trace).
#
# @param cmdline The command string to execute.
# @return The result and options of the evaluated command.
proc execute_cmd {cmdline} {
global sid
# Check if command is complete
if {! [info complete $cmdline]} {
puts "incomplete command; check for unclosed quotes, braces, brackets or array element names"
return
}
if {[lempty $cmdline]} {
return
}
Session $sid SLAVE
# Suspend fileevent, so that the command to be executed can use stdin
fileevent stdin readable {}
# Let the error propagate back, as well as the return value
# Note: "interp eval" blocks the event loop.
# This evaluation will apply all kinds of substitutions on the command line string.
set err [catch { $SLAVE eval $cmdline } result options]
if {[interp exists $SLAVE]} { ;# close_sesssion might have been executed due to a "exit" command.
$SLAVE invokehidden set _ $result ;# Should not fail with an error.
$SLAVE invokehidden set __ $options ;# Should not fail with an error.
if {! [lempty $result]} {
if {$err} {
more -nonewline [ansi $sid -color red -bold -- $result]
} else {
more -nonewline $result
}
if {[string index $result end] ne "\n"} {
puts "" ;# newline
}
}
# Restore correct stdin settings.
fileevent stdin readable ::cli::ready
}
# Emitted after a command is executed.
# Handly for detailed loggin & auditing of every executed command and its results.
#
# @param sid The session within which the command was executed.
# @param cmdline The command string as entered in the command line.
# @param err True if command returned an error.
# @param result The command result.
# @param options Set to the command error options if an error occured.
event generate CLI COMMAND_EXECUTED [list $sid $cmdline $err $result $options]
}
# Insert a string into the specified position in CMDLINE, and update CMDLINE_CURSOR
# to point at the end of the inserted string
#
# @param str The string to insert
# @param pos The position to insert the string
proc cmdline_insert {str pos} {
variable CMDLINE
variable CMDLINE_CURSOR
set trailing [string range $CMDLINE $pos end]
set CMDLINE [string replace $CMDLINE $pos end]
append CMDLINE $str
append CMDLINE $trailing
set CMDLINE_CURSOR [expr {$pos + [string length $str]}]
}
# A helper procedure to display the "event not found" message and reset prompt.
proc event_not_found {} {
variable CMDLINE
variable CMDLINE_CURSOR
set CMDLINE {}
set CMDLINE_CURSOR 0
puts "\nevent not found"
prompt new
return -code return
}
# The main procedure to listen and handle command line input.
# It hooks on session's STDIN channel with a fileevent.
proc ready {} {
global sid
variable special
variable CMDLINE
variable CMDLINE_CURSOR
Session $sid BUSY
set char ""
set keybuffer [read stdin]
if {[eof stdin]} {
fileevent stdin readable {}
exit "Connection with shell was lost"
return
}
# Otherwise read one-by-one the characters from the buffer.
while {$keybuffer ne {}} {
set char [readbuf keybuffer]
if {$char eq {}} {
# Sleep for a bit to reduce CPU utilization when user is giving too much input, too fast.
# This means that every time there is some input in the buffer,
# after the input has been consumed there will be a pause of 40ms. Usually the input will consist of
# one character. So, effectively, every one key the user presses, there will be 40ms pause.
# This in practice is not noticable.
after 40 ;# ms (@magic-number)
continue
}
if {$special} {
handleSpecial $char
set special 0
return
}
if {$char eq "?" && [notEscaped]} {
handleHelp
prompt new
} elseif {$char eq "\t"} {
handleCompletion
prompt new
} elseif {[string is print $char]} {
# Any space at the start of the command line is ignore and not printed.
if {$CMDLINE_CURSOR == 0 && [string is space $char]} { continue }
cmdline_insert $char $CMDLINE_CURSOR
prompt redraw
} elseif {$char eq "\n" || $char eq "\r"} {
# We don't want to save it in the real CMDLINE.
set trailing [string range $CMDLINE $CMDLINE_CURSOR end]
set cmdline [string replace $CMDLINE $CMDLINE_CURSOR end] ;# remove.
append cmdline $char
append cmdline $trailing
if {! [info complete $cmdline]} {
# Command is not complete
set CMDLINE $cmdline
incr CMDLINE_CURSOR
prompt redraw
continue
}
# else execute the command.
Session $sid HIST_SUBSTITUTIONS
# Note: "puts {a}n" is a complete command (info complete), but NOT a list (string is list).
# We let eval to report this condition. But we have to skip the history substitution code
# in this case, as it is using list commands.
# Implement history substitution: !!, !n, !-n, !prefix, ^old^new
# This is based on the original code in unknown. That code there is not executed due to [info script]
if {[string is list $CMDLINE] && $HIST_SUBSTITUTIONS} {
Session $sid HISTORY HISTORY_ENTRIES
set name [lindex $CMDLINE 0]
if {$name eq "!!"} {
if {[llength $HISTORY] == 0} { ;# Nothing in the history.
event_not_found
}
set CMDLINE [lindex $HISTORY end]
} elseif {[regexp {^!(.+)$} $name -> event]} { ;# !n !-n !prefix # TODO: Although the build-in behavior, it attempts to match from the oldest to newest. Reverse this.
if {[string is integer $event]} { ;# !n !-n
if {$event == 0 || abs($event) > [llength $HISTORY]} {
event_not_found
} elseif {$event < 0} { ;# !-n
set pos [expr $event + 1]
set CMDLINE [lindex $HISTORY end-$pos]
} else { ;# !n
set pos [expr $event - 1]
set CMDLINE [lindex $HISTORY $pos]
}
} else { ;# !prefix
if {[llength $HISTORY] == 0} { ;# Nothing in the history.
event_not_found
}
for {set i [expr {$HISTORY_ENTRIES - 1}]} {$i >= 0} {incr i -1} { ;# loop from last to first
set pastcmd [lindex $HISTORY $i]
if {[string match "$event*" $pastcmd]} {
set CMDLINE [lindex $HISTORY end-$pos]
}
}
}
} elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name -> old new]} {
set CMDLINE [lindex $HISTORY end] ;# TODO: The standard behaviour is to apply to all previous commands in reverse order entered.
catch {regsub -all -- $old $CMDLINE $new CMDLINE}
}
}
set CMDLINE_CURSOR [string length $CMDLINE ]
prompt redraw
puts "" ;# newline
# Append HISTORY:
appendHistory $CMDLINE ;# Command is saved after history substitutions. (but not after variable and backslash substitutions)
# Needs to be done before execute_cmd:
set cmdline $CMDLINE
set CMDLINE ""
set CMDLINE_CURSOR 0
set CMDLINE_LINES {0 0}
set CMDLINE_SAVED {{} 0}
# Buffer synchronous sputs, during execution of the command.
set BUSY 1
execute_cmd $cmdline
# Stop buffering synchronous sputs.
set BUSY 0
# Print any buffered sputs.
if {[bufsize]} {
foreach job [popbuf] {
puts $job
}
}
prompt new
} else { ;# Not a printable character
handleControls
# There is no problem with displaying the prompt when a user action in handleControls has caused execution of ::session::session_close
# (e.g. pressing Ctlr^Z on root CONFMODE). This is because session_close will send a message for execution of "exit" in the Session
# event loop. Thus until we return from this function, the exit will not be executed, and session will remain open. If this was not the case
# then standard I/O would not be available when we would try to print the prompt.
# Same applies for the user explicit termination of Session via "exit" command.
prompt redraw
}
}
}
################################
# Session initialization code
################################
prompt new
fileevent stdin readable ::cli::ready
} ;# End of Namespace
Overview | Index by: file name |
procedure name |
procedure call |
annotation
File generated 2010-03-13 at 22:28.