#!/usr/local/bin/tclsh
# FILE: "/home/joze/src/tclreadline/tclreadlineSetup.tcl.in"
# LAST MODIFICATION: "Sun Aug 29 16:28:35 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999 Johannes Zellner
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# 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 General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
# johannes@zellner.org
# http://www.zellner.org/tclreadline/
#
# ==================================================================
# done:
#
# - append
# - array
# - bgerror
# - binary
# - break
# - catch
# - cd
# - clock
# - close
# - concat
# - continue
# - (ddd is only on M$)
# - encoding
# - eof
# - error
# - eval
# - exec
# - exit
# - expr
# - fblocked
# - fconfigure
# - fcopy
# - file
# - fileevent
# - flush
# - for # TODO
# - foreach # TODO
# - format # TODO
# - gets
# - glob
# - global
# - if # TODO
# - incr
# - index
# - info
# - interp
# - join
# - lappend
# - llength
# - linsert
# - list
# - load
# - lrange
# - lreplace
# - lsearch
# - lsort
# - history
# - load
# - namespace
# - set
# - unset
#
# package provide tclreadline @TCLREADLINE_VERSION@
package provide tclreadline 0.9
proc unknown args {
global auto_noexec auto_noload env unknown_pending tcl_interactive
global errorCode errorInfo
# Save the values of errorCode and errorInfo variables, since they
# may get modified if caught errors occur below. The variables will
# be restored just before re-executing the missing command.
set savedErrorCode $errorCode
set savedErrorInfo $errorInfo
set name [lindex $args 0]
if ![info exists auto_noload] {
#
# Make sure we're not trying to load the same proc twice.
#
if [info exists unknown_pending($name)] {
return -code error "self-referential recursion in \"unknown\" for command \"$name\""
}
set unknown_pending($name) pending
set ret [catch {auto_load $name [uplevel 1 {namespace current}]} msg]
unset unknown_pending($name)
if {$ret != 0} {
return -code $ret -errorcode $errorCode \
"error while autoloading \"$name\": $msg"
}
if ![array size unknown_pending] {
unset unknown_pending
}
if $msg {
set errorCode $savedErrorCode
set errorInfo $savedErrorInfo
set code [catch {uplevel 1 $args} msg]
if {$code == 1} {
#
# Strip the last five lines off the error stack (they're
# from the "uplevel" command).
#
set new [split $errorInfo \n]
set new [join [lrange $new 0 [expr [llength $new] - 6]] \n]
return -code error -errorcode $errorCode \
-errorinfo $new $msg
} else {
return -code $code $msg
}
}
}
# REMOVED THE [info script] TEST (joze, SEP 98)
if {([info level] == 1) \
&& [info exists tcl_interactive] && $tcl_interactive} {
if ![info exists auto_noexec] {
set new [auto_execok $name]
if {$new != ""} {
set errorCode $savedErrorCode
set errorInfo $savedErrorInfo
set redir ""
if {[info commands console] == ""} {
set redir ">&@stdout <@stdin"
}
# LOOK FOR GLOB STUFF IN $ARGS (joze, SEP 98)
return [uplevel eval exec $redir $new \
[::tclreadline::Glob [lrange $args 1 end]]]
}
}
set errorCode $savedErrorCode
set errorInfo $savedErrorInfo
if {$name == "!!"} {
set newcmd [history event]
} elseif {[regexp {^!(.+)$} $name dummy event]} {
set newcmd [history event $event]
} elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new]} {
set newcmd [history event -1]
catch {regsub -all -- $old $newcmd $new newcmd}
}
if [info exists newcmd] {
tclLog $newcmd
history change $newcmd 0
return [uplevel $newcmd]
}
set ret [catch {set cmds [info commands $name*]} msg]
if {[string compare $name "::"] == 0} {
set name ""
}
if {$ret != 0} {
return -code $ret -errorcode $errorCode \
"error in unknown while checking if \"$name\" is a unique command abbreviation: $msg"
}
if {[llength $cmds] == 1} {
return [uplevel [lreplace $args 0 0 $cmds]]
}
if {[llength $cmds] != 0} {
if {$name == ""} {
return -code error "empty command name \"\""
} else {
return -code error \
"ambiguous command name \"$name\": [lsort $cmds]"
}
}
}
return -code error "invalid command name \"$name\""
}
namespace eval tclreadline:: {
namespace export Setup Glob Loop InitCmds InitTclCmds InitTkCmds Print ls
}
proc tclreadline::FmtFindInList {text lst} {
return \
[tclreadline::Format [tclreadline::FindInList $text $lst] $text]
}
proc tclreadline::FindInList {text lst} {
set result ""
foreach word $lst {
if {[string match ${text}* ${word}]} {
lappend result ${word}
}
}
return $result
}
# get the longest common completion
# e.g. str == {tcl_version tclreadline_version tclreadline_library}
# --> [tclreadline::GetCommon ${str}] == "tcl"
#
proc tclreadline::GetCommon {str} {
# puts stderr str=$str
set match0 [lindex ${str} 0]
set len0 [string length $match0]
set no_matches [llength ${str}]
set part ""
for {set i 0} {$i < $len0} {incr i} {
set char [string index $match0 $i]
for {set j 1} {$j < $no_matches} {incr j} {
if {$char != [string index [lindex ${str} $j] $i]} {
break
}
}
if {$j < $no_matches} {
break
} else {
append part $char
}
}
# puts stderr part=$part
return ${part}
}
proc tclreadline::SubCmd {start line} {
set depth 0
for {set i $start} {$i > 0} {incr i -1} {
set c [string index $line $i]
if {{;} == $c} {
incr i; # discard command break character
return [list [expr $start - $i] [string range $line $i end]]
} elseif {{]} == $c} {
incr depth
} elseif {{[} == $c} {
incr depth -1
if {$depth < 0} {
incr i; # discard command break character
return [list [expr $start - $i] [string range $line $i end]]
}
}
}
return ""
}
proc tclreadline::IsWhite {char} {
if {" " == $char || "\n" == $char || "\t" == $char} {
return 1
} else {
return 0
}
}
proc tclreadline::PreviousWord {start line} {
incr start -1
set found 0
for {set i $start} {$i > 0} {incr i -1} {
set c [string index $line $i]
if {${found} && [IsWhite $c]} {
break
} elseif {!${found} && ![IsWhite $c]} {
set found 1
}
}
return [string trim [string range ${line} $i $start]]
}
proc tclreadline::Quote {value left} {
set right [tclreadline::Right ${left}]
if {1 < [llength $value] && "" == $right} {
return [list \"${value}\"]
} else {
return [list ${left}${value}${right}]
}
}
proc tclreadline::InChannelId {text} {
return [ChannelId ${text} <inChannel> {stdin}]
}
proc tclreadline::OutChannelId {text} {
return [ChannelId ${text} <outChannel> {stdout stderr}]
}
proc tclreadline::ChannelId {
text {default <channelId>} {chs {stdin stdout stderr}}} {
if {[llength ${text}]} {
set channel [FmtFindInList $text ${chs}]
if {[llength [lindex ${channel} 0]]} {
return ${channel}
} else {
return ""
}
}
return ${default}
}
proc tclreadline::QuoteQuotes {line} {
regsub -all -- \" $line {\"} line
regsub -all -- \{ $line {\{} line
return $line
}
# % p<TAB>
# % bla put<TAB> $b
# % put<TAB> $b
# part == put
# start == 0
# end == 3
# line == "put $b"
# [PartPosition] should return 0
#
proc tclreadline::PartPosition {part start end line} {
# puts stderr "(tclreadline::PartPosition) line\[start\]=[string index $line $start]"
# puts stderr "(tclreadline::PartPosition) part=|$part|"
incr start -1
if {"\"" == [string index $line $start]} {
incr start -1
}
# puts stderr "(tclreadline::PartPosition) line=|$line|"
# puts stderr "(tclreadline::PartPosition) start=$start"
set line [string range $line 0 $start]
set line [QuoteQuotes $line]
# puts stderr "(tclreadline::PartPosition) line=|$line|"
set result [llength $line]
# puts stderr $result
return $result
}
proc tclreadline::Right {left} {
if {"\"" == $left} {
return ""
} elseif {"\{" == $left} {
return "\}"
} elseif {"\\\{" == $left} {
return "\\\}"
}
return ""
}
proc tclreadline::GetPrefix {text} {
set null [string index $text 0]
# puts null=|$null|
if {"\"" == $null} {
# puts stderr \neins\n
set pre "\\\""
} elseif {"\{" == $null} {
# puts stderr \nzwei\n
set pre "\\\{"
} else {
# puts stderr \ndrei\n
set pre ""
}
return ${pre}
}
proc tclreadline::Format {matches {part {}}} {
# puts matches=|$matches|
# puts stderr \npart=|$part|\n
set pre [GetPrefix ${part}]
if {1 == [llength $matches]} { ; # unique match
# puts stderr \nunique=$matches\n
# puts stderr "\n|${pre}${matches}[Right ${pre}]|\n"
return ${pre}${matches}[Right ${pre}]
} elseif {"" != ${matches}} {
# puts stderr \nmore=$matches\n
set common [tclreadline::GetCommon ${matches}]
# puts stderr common=|$common|
if {"" == $common} {
return [string trim "[list $part] ${matches}"]
} else {
return [string trim "${pre}${common} ${matches}"]
}
} else {
return ""; # nothing to complete
}
}
proc tclreadline::ListCompletion {text {level -1}} {
# TODO
return ""
# return [VarCompletion ${text} ${level}]
}
proc tclreadline::VarCompletion {text {level -1}} {
if {-1 == ${level}} {
set level [info level]
} else {
incr level
}
set pre [GetPrefix ${text}]
if {"" == ${pre}} {
set var ${text}
} else {
set var [string range ${text} 1 end]
}
# arrays
#
if {[regexp {([^(]*)\((.*)} ${var} all array name]} {
set names [uplevel ${level} array names ${array} ${name}*]
if {1 == [llength $names]} { ; # unique match
return "${array}(${names})"
} elseif {"" != ${names}} {
return "${array}([tclreadline::GetCommon ${names}] ${names}"
} else {
return ""; # nothing to complete
}
}
# non-arrays
#
regsub ":$" ${var} "::" var
set namespaces [namespace children :: ${var}*]
if {[llength ${namespaces}] && "::" != [string range ${var} 0 1]} {
foreach name ${namespaces} {
regsub "^::" ${name} "" name
if {[string length ${name}]} {
lappend new ${name}::
}
}
set namespaces ${new}
unset new
}
set matches \
[string trim "[uplevel ${level} info vars ${var}*] ${namespaces}"]
if {1 == [llength $matches]} { ; # unique match
# check if this unique match is an
# array name, (whith no "(" yet).
#
if {[uplevel ${level} array exists $matches]} {
return [VarCompletion ${matches}( ${level}]; # recursion
} else {
return ${pre}${matches}[Right ${pre}]
}
} elseif {"" != $matches} { ; # more than one match
set common [tclreadline::GetCommon ${matches}]
if {"" == ${common}} {
return [tclreadline::Format ${matches} ${text}]
} else {
return [string trim "${pre}${common} ${matches}"]
}
} else {
return ""; # nothing to complete
}
}
proc tclreadline::CommandCompletion {cmd} {
# puts stderr \ncmd=|$cmd|\n
set cmd [string trim ${cmd}]*
set commands [info commands [QuoteQuotes ${cmd}]]
# puts stderr commands=|$commands|
set procs [info procs [QuoteQuotes ${cmd}]]
# puts stderr procs=|$procs|
set matches [namespace eval :: concat ${commands} ${procs}]
set namespaces [namespace children :: ${cmd}]
if {![llength ${matches}] && 1 == [llength ${namespaces}]} {
set namespaces [string trim ${namespaces}]
set matches [namespace eval ${namespaces} \
{concat [info commands] [info procs]}]
if {[llength ${matches}]} {
foreach match ${matches} {
set full ${namespaces}::${match}
if {"" != [namespace which ${full}]} {
lappend new ${namespaces}::${match}
}
}
set matches ${new}
unset new
set namespaces ""
}
}
return [string trim "${matches} ${namespaces}"]
}
# if the line entered so far is
# % puts $b<TAB>
# part == $b
# start == 5
# end == 7
# line == "$puts $b"
#
proc tclreadline::ScriptCompleter {part start end line} {
# puts stderr "(ScriptCompleter) |$part| $start $end |$line|"
variable known_cmds
if {{$} == [string index $part 0]} {
# check for a !$ history event
#
if {$start > 0} {
if {{!} == [string index $line [expr $start - 1]]} {
return ""
}
}
# variable completion. Check first, if the
# variable starts with a plain `$' or should
# be enclosed in braces.
#
set var [string range $part 1 end]
#
# if {"\{" == [string index $part 1]} {
# set var [string range $part 2 end]
# set left "\{"
# } else {
# set left ""
# set var [string range $part 1 end]
# }
#
# check if $var is an array name, which
# already has already a "(" somewhere inside.
#
if {"" != [set vc [VarCompletion $var]]} {
if {"" == [lindex $vc 0]} {
return "\$ [lrange ${vc} 1 end]"
} else {
return \$${vc}
}
# puts stderr vc=|$vc|
} else {
return ""
}
# SCENARIO:
#
# % puts bla; put<TAB> $b
# part == put
# start == 10
# end == 13
# line == "puts bla; put $b"
# [SubCmd] --> {1 " put $b"} == sub
# new_start = [lindex $sub 0] == 1
# new_end = [expr $end - ($start - $new_start)] == 4
# new_part == $part == put
# new_line = [lindex $sub 1] == " put $b"
#
} elseif {"" != [set sub [tclreadline::SubCmd $start $line]]} {
set new_start [lindex $sub 0]
set new_end [expr $end - ($start - $new_start)]
set new_line [lindex $sub 1]
# puts stderr "(SubCmd) $new_start $new_end $new_line"
return \
[tclreadline::ScriptCompleter $part $new_start $new_end $new_line]
} elseif {0 == [set pos [tclreadline::PartPosition $part $start $end $line]]} {
# puts stderr "(PartPosition) $part $start $end $line"
# set matches [array names known_cmds "[string trim ${part}]*"]
set all [CommandCompletion ${part}]
#puts \nmatches=$matches\n
return [tclreadline::Format $all $part]
} else {
# try to use $pos further ...
# regsub -all -- \" $line {\"} thisline
set thisline [QuoteQuotes $line]
set cmd [lindex $thisline 0]
if {"" != [namespace eval ::tclreadline "info procs complete($cmd)"]} {
# to be more error-proof, we could check here,
# if complete($cmd) takes exactly 5 arguments.
if {"\"" == [string index $part 0] \
|| "\{" == [string index $part 0]} {
set mod [string range $part 1 end]
} else {
set mod $part
}
return \
[::tclreadline::complete($cmd) $part $start $end $line $pos $mod]
} elseif {"" != [array names known_cmds $cmd]} {
set current [lindex $known_cmds($cmd) $pos]
if {"" != $current && "" == [string trim $part]} {
return $current
} else {
return ""
}
} else {
return ""
}
}
return "{NOTREACHED (this is probably an error)}"
}
proc tclreadline::ls {args} {
if {[exec uname -s] == "Linux"} {
eval exec ls --color -FC [::tclreadline::Glob $args]
} else {
eval exec ls -FC [::tclreadline::Glob $args]
}
}
proc ::tclreadline::Setup {args} {
uplevel #0 {
if {[info commands ::tclreadline::readline] == ""} {
::tclreadline::Init
}
tclreadline::readline customcompleter tclreadline::ScriptCompleter
if {[catch {set a [::tclreadline::prompt1]}] \
&& [info nameofexecutable] != ""} {
namespace eval ::tclreadline {
variable prompt_string
set base [file tail [info nameofexecutable]]
if {$base == "tclsh" && [info exists tcl_version]} {
set prompt_string \
"\[0;91m$base$tcl_version\[0m"
} elseif {$base == "wish" && [info exists tk_version]} {
set prompt_string "\[0;94m$base$tk_version\[0m"
} else {
set prompt_string "\[0;91m$base\[0m"
}
}
if {"" == [info procs ::tclreadline::prompt1]} {
proc ::tclreadline::prompt1 {} {
variable prompt_string
global env
if {[catch {set pwd [pwd]} tmp]} {
set pwd "unable to get pwd"
}
if [info exists env(HOME)] {
regsub $env(HOME) $pwd "~" pwd
}
return "$prompt_string \[$pwd\]"
}
}
}
if {[info procs exit] == ""} {
catch {rename ::tclreadline::Exit ""}
rename exit ::tclreadline::Exit
proc exit {args} {
if {[catch {
::tclreadline::readline write \
[::tclreadline::HistoryFileGet]
} msg]} {
puts stderr $msg
}
if [catch "eval ::tclreadline::Exit $args" message] {
puts stderr "error:"
puts stderr "$message"
}
# NOTREACHED
}
}
}
global env
variable historyfile
if {[string trim [llength ${args}]]} {
set historyfile ""
catch {
set historyfile [file nativename [lindex ${args} 0]]
}
if {"" == [string trim $historyfile]} {
set historyfile [lindex ${args} 0]
}
} else {
if [info exists env(HOME)] {
set historyfile $env(HOME)/.tclsh-history
} else {
set historyfile .tclsh-history
}
}
set msg [::tclreadline::readline initialize $historyfile]
if {$msg != ""} {
puts stderr "$msg"
}
::tclreadline::InitCmds
rename ::tclreadline::Setup ""
}
proc ::tclreadline::HistoryFileGet {} {
variable historyfile
return $historyfile
}
proc ::tclreadline::Glob {string} {
set commandstring ""
foreach name $string {
set replace [glob -nocomplain -- $name]
if {$replace == ""} {
lappend commandstring $name
} else {
lappend commandstring $replace
}
}
# return $commandstring
# Christian Krone <krischan@sql.de> proposed
return [eval concat $commandstring]
}
proc ::tclreadline::Loop {args} {
eval ::tclreadline::Setup ${args}
uplevel #0 {
while {1} {
if [info exists tcl_prompt2] {
set ::tclreadline::prompt2 $tcl_prompt2
} else {
set ::tclreadline::prompt2 ">"
}
if {[catch {
if {[namespace eval ::tclreadline {[info procs prompt1]}] != ""} {
set ::tclreadline::LINE [::tclreadline::readline read \
[::tclreadline::prompt1]]
} else {
set ::tclreadline::LINE [::tclreadline::readline read %]
}
while {![::tclreadline::readline complete $::tclreadline::LINE]} {
append ::tclreadline::LINE "\n"
append ::tclreadline::LINE [::tclreadline::readline read \
${::tclreadline::prompt2}]
}
} msg]} {
puts stderr \n$msg
continue
}
# Magnus Eriksson <magnus.eriksson@netinsight.se> proposed
history add $::tclreadline::LINE
if [catch {
set result [eval $::tclreadline::LINE]
if {$result != "" && [::tclreadline::Print]} {
puts $result
}
set result ""
} msg] {
puts stderr $msg
}
}
}
}
proc ::tclreadline::Print {args} {
variable PRINT
if ![info exists PRINT] {
set ::tclreadline::PRINT yes
}
if [regexp -nocase \(true\|yes\|1\) $args] {
set ::tclreadline::PRINT yes
} elseif [regexp -nocase \(false\|no\|0\) $args] {
set ::tclreadline::PRINT no
}
return $PRINT
}
proc ::tclreadline::InitCmds {} {
global tcl_version tk_version
if {[info exists tcl_version]} {
::tclreadline::InitTclCmds
}
if {[info exists tk_version]} {
::tclreadline::InitTkCmds
}
rename tclreadline::InitCmds ""
}
proc ::tclreadline::InitTclCmds {} {
variable known_cmds
foreach line {
"after option ?arg arg ...?"
"append varName ?value value ...?"
"array option arrayName ?arg ...?"
"bgerror"
"binary option ?arg arg ...?"
"break"
"catch command ?varName?"
"cd"
"clock"
"close <channelId>"
"concat"
"continue"
"encoding"
"eof <channelId>"
"error message ?errorInfo? ?errorCode?"
"eval arg ?arg ...?"
"exec ?switches? arg ?arg ...?"
"exit ?returnCode?"
"expr arg ?arg ...?"
"fblocked <channelId>"
"fconfigure <channelId> ?optionName? ?value? ?optionName value?..."
"fcopy input output ?-size size? ?-command callback?"
"file"
"fileevent channelId event ?script?"
"flush channelId"
"for start test next command"
"foreach varList list ?varList list ...? command"
"format formatString ?arg arg ...?"
"gets channelId ?varName?"
"glob"
"global varName ?varName ...?"
"history option"
"incr varName ?increment?"
"info option ?arg arg ...?"
"interp cmd ?arg ...?"
"join list ?joinString?"
"lappend varName ?value value ...?"
"lindex list index"
"linsert list <index> <element> ?element ...?"
"list"
"llength list"
"load"
"lrange list first last"
"lreplace list first last ?element element ...?"
"lsearch ?mode? list pattern"
"lsort ?options? list"
"namespace subcommand ?arg ...?"
"open fileName ?access? ?permissions?"
"package option ?arg arg ...?"
"proc name args body"
"puts ?-nonewline? ?channelId? string"
"read ?-nonewline? channelId"
"regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"
"regsub ?switches? exp string subSpec varName"
"rename oldName newName"
"scan string format ?varName varName ...?"
"seek channelId offset ?origin?"
"set varName ?newValue?"
"socket ?-myaddr addr? ?-myport myport? ?-async? host port"
"socket -server command ?-myaddr addr? port"
"source fileName"
"split string ?splitChars?"
"string option arg ?arg ...?"
"subst ?-nobackslashes? ?-nocommands? ?-novariables? string"
"switch ?switches? string pattern body ... ?default body?"
"tell channelId"
"time command ?count?"
"trace option \[arg arg ...\]"
"unset varName ?varName ...?"
"uplevel ?level? command ?arg ...?"
"upvar ?level? otherVar localVar ?otherVar localVar ...?"
"vwait name"
"while test command"
} {
tclreadline::readline add $line
set known_cmds([lindex $line 0]) [lrange $line 1 end]
}
rename tclreadline::InitTclCmds ""
}
proc ::tclreadline::InitTkCmds {} {
variable known_cmds
foreach line {
"bind window ?pattern? ?command?"
"bindtags window ?tags?"
"button pathName ?options?"
"canvas pathName ?options?"
"checkbutton pathName ?options?"
"clipboard option ?arg arg ...?"
"entry pathName ?options?"
"event option ?arg1?"
"font option ?arg?"
"frame pathName ?options?"
"grab option ?arg arg ...?"
"grid option arg ?arg ...?"
"image option ?args?"
"label pathName ?options?"
"listbox pathName ?options?"
"lower window ?belowThis?"
"menu pathName ?options?"
"menubutton pathName ?options?"
"message pathName ?options?"
"option cmd arg ?arg ...?"
"pack option arg ?arg ...?"
"radiobutton pathName ?options?"
"raise window ?aboveThis?"
"scale pathName ?options?"
"scrollbar pathName ?options?"
"selection option ?arg arg ...?"
"send ?options? interpName arg ?arg ...?"
"text pathName ?options?"
"tk option ?arg?"
"tkwait variable|visibility|window name"
"toplevel pathName ?options?"
"winfo option ?arg?"
"wm option window ?arg ...?"
} {
tclreadline::readline add $line
set known_cmds([lindex $line 0]) [lrange $line 1 end]
}
rename tclreadline::InitTkCmds ""
}
namespace eval tclreadline {
# explicit command completers
#
# ---
# TCL
# ---
proc complete(append) {text start end line pos mod} {
if {1 == $pos} {
return [VarCompletion ${text}]
}
return ""
}
proc complete(if) {text start end line pos mod} {
# TODO: this is not good yet.
if {2 == $pos} {
return [FmtFindInList $text {then}]
} elseif {$pos > 2} {
set prev [PreviousWord ${start} ${line}]
switch $prev {
then -
else -
elseif { return "" }
}
return [FmtFindInList $text {then else elseif}]
}
}
proc complete(incr) {text start end line pos mod} {
if {1 == $pos} {
set matches [uplevel 2 info vars "${mod}*"]
set final ""
# check for integers
#
foreach match $matches {
if {[uplevel 2 array exists $match]} {
continue
}
if {[regexp {^[0-9]+$} [uplevel 2 set $match]]} {
lappend final $match
}
}
return [Format ${final} $text]
}
}
proc complete(array) {text start end line pos mod} {
if {1 == $pos} {
set cmds {
anymore donesearch exists get names
nextelement set size startsearch
}
return [FmtFindInList $text $cmds]
} elseif {2 == $pos} {
set cmd [lindex $line 1]
switch -- $cmd {
anymore -
donesearch -
exists -
get -
names -
nextelement -
set -
size -
startsearch {
set matches ""
set vars [uplevel [info level] info vars ${mod}*]
foreach var ${vars} {
if {[uplevel [info level] array exists ${var}]} {
lappend matches ${var}
}
}
return [Format ${matches} ${text}]
}
}
} elseif {3 == $pos} {
set cmd [lindex $line 1]
switch -- $cmd {
get -
names {
if {[catch {
set names [uplevel [info level] \
array names [lindex $line 2] [lindex $line 3]*]}]} {
return ""
} else {
set common [GetCommon ${names}]
if {"" == ${common}} {
return [Format ${names} ${text}]
} else {
return [string trim "${common} ${names}"]
}
}
}
}
}
return ""
}
proc complete(binary) {text start end line pos mod} {
if {1 == $pos} {
set cmds {
format scan
}
return [FmtFindInList $text $cmds]
#
# } elseif {2 == $pos} {
# set cmd [lindex $line 1]
# switch -- $cmd {
# format -
# scan -
# }
#
}
return ""
}
proc complete(clock) {text start end line pos mod} {
if {1 == $pos} {
set cmds {clicks format scan seconds}
return [FmtFindInList $text $cmds]
} elseif {2 == $pos} {
set cmd [lindex $line 1]
switch -- $cmd {
clicks {}
format {
if {"" == [lindex $line 2]} {
return <clockValue>
}
}
scan {
if {"" == [lindex $line 2]} {
return <dateString>
}
}
seconds {}
}
} elseif {3 == $pos} {
set cmd [lindex $line 1]
switch -- $cmd {
clicks {}
format {
set sub [lindex $line 3]
set subcmds {-fmt -gmt}
return [FmtFindInList $text $subcmds]
}
scan {
set sub [lindex $line 3]
set subcmds {-base -gmt}
return [FmtFindInList $text $subcmds]
}
seconds {}
}
}
return ""
}
proc complete(encoding) {text start end line pos mod} {
if {1 == $pos} {
set cmds {convertfrom convertto names system}
return [FmtFindInList $text $cmds]
} elseif {2 == $pos} {
set cmd [lindex $line 1]
switch -- $cmd {
names {}
convertfrom -
convertto -
system {
set enc [encoding names]
return [FmtFindInList ${text} ${enc}]
}
}
}
return ""
}
proc complete(expr) {text start end line pos mod} {
set cmds {
acos cos hypot sinh
asin cosh log sqrt
atan exp log10 tan
atan2 floor pow tanh
ceil fmod sin abs
double int rand round
srand
}
return [FmtFindInList $text $cmds]
}
proc complete(fconfigure) {text start end line pos mod} {
if {1 == $pos} {
return [ChannelId ${mod}]
} else {
set option [PreviousWord ${start} ${line}]
switch -- $option {
-blocking {
return [FmtFindInList ${text} {yes no}]
}
-buffering {
return [FmtFindInList ${text} {full line none}]
}
-buffersize {
if {![llength ${text}} {
return <newSize>
}
}
-encoding {
set enc [encoding names]
return [FmtFindInList ${text} ${enc}]
}
-eofchar {
if {![llength ${text}]} {
return [list {{<inChar> <outChar>}}]
}
}
-translation {
return [FmtFindInList ${text} {auto binary cr crlf lf}]
}
}
set cmds {
-blocking
-buffering
-buffersize
-encoding
-eofchar
-translation
}
return [FmtFindInList $text $cmds]
}
return ""
}
proc complete(fcopy) {text start end line pos mod} {
if {1 == $pos} {
return [InChannelId ${mod}]
} elseif {2 == $pos} {
return [OutChannelId ${mod}]
} else {
set option [PreviousWord ${start} ${line}]
switch -- $option {
-size {
if {![llength ${mod}]} { return <size> }
}
-command {
if {![llength ${mod}]} { return <callback> }
}
}
return [FmtFindInList $text {-size -command}]
}
return ""
}
proc complete(file) {text start end line pos mod} {
if {1 == $pos} {
set cmds {
atime attributes copy delete dirname executable exists
extension isdirectory isfile join lstat mtime mkdir
nativename owned pathtype readable readlink rename
rootname size split stat tail type volumes writable
}
return [FmtFindInList $text $cmds]
} elseif {2 == $pos} {
set cmd [lindex $line 1]
switch -- $cmd {
atime -
attributes -
dirname -
executable -
exists -
extension -
isdirectory -
isfile -
join -
lstat -
mtime -
mkdir -
nativename -
owned -
pathtype -
readable -
readlink -
rootname -
size -
split -
stat -
tail -
type -
volumes -
writable {
return ""
}
copy -
delete -
rename {
set match [FmtFindInList ${mod} {-force}]
if {[llength ${match}] && [llength ${mod}]} {
return ${match}
} else {
return ""
}
}
}
}
}
proc complete(fileevent) {text start end line pos mod} {
if {1 == $pos} {
return [ChannelId ${mod}]
} elseif {2 == $pos} {
return [FmtFindInList ${mod} {readable writable}]
}
}
proc complete(flush) {text start end line pos mod} {
if {1 == $pos} {
return [ChannelId ${mod}]
}
}
proc complete(gets) {text start end line pos mod} {
if {1 == $pos} {
return [InChannelId ${mod}]
}
}
proc complete(glob) {text start end line pos mod} {
if {1 == $pos} {
set matches [FmtFindInList ${mod} {-nocomplain --}]
if {[llength [string trim ${mod}]] && [llength ${matches}]} {
return ${matches}
}
}
return ""
}
proc complete(global) {text start end line pos mod} {
return [VarCompletion ${text}]
}
proc complete(index) {text start end line pos mod} {
if {1 == $pos} {
return [VarCompletion ${text}]
} elseif {2 == $pos && ![llength ${mod}]} {
return <index>
}
return ""
}
proc complete(info) {text start end line pos mod} {
if {1 == $pos} {
set cmds {
args body cmdcount commands complete default exists
globals hostname level library loaded locals nameofexecutable
patchlevel procs script sharedlibextension tclversion vars}
return [FmtFindInList $text $cmds]
} elseif {2 == $pos} {
set cmd [lindex $line 1]
switch -- $cmd {
args -
body -
default -
procs {
set matches [uplevel 2 info procs ${mod}*]
return [Format $matches $text]
}
complete { ; # TODO
}
level { ; # TODO
}
loaded { ;# TODO
}
commands -
exists -
globals -
locals -
vars {
if {"exists" == $cmd} {
set do vars
} else {
set do $cmd
}
return \
[Format [uplevel 2 info ${do} "${mod}*"] $text]
}
}
}
return ""
}
proc complete(interp) {text start end line pos mod} {
set cmd [lindex $line 1]
if {1 == $pos} {
set cmds {
alias aliases create delete eval exists expose hide hidden
issafe invokehidden marktrusted slaves share target transfer}
return [FmtFindInList $text $cmds]
} elseif {2 == $pos} {
switch -- $cmd {
create {
return [FmtFindInList $text {-safe -- ?path?}]
}
eval -
exists -
expose -
hide -
hidden -
invokehidden -
marktrusted -
target {if {![llength ${mod}]} { return <path> }}
aliases -
delete -
issafe -
slaves {if {![llength ${mod}]} { return ?path? }}
alias -
share -
transfer {if {![llength ${mod}]} { return <srcPath> }}
}
} elseif {3 == $pos} {
switch -- $cmd {
alias {if {![llength ${mod}]} { return <srcCmd> }}
create {
return [FmtFindInList $text {-safe -- ?path?}]
}
eval {if {![llength ${mod}]} { return <arg> }}
delete {if {![llength ${mod}]} { return ?path? }}
expose {if {![llength ${mod}]} { return <hiddenName> }}
hide {if {![llength ${mod}]} { return <exposedCmdName> }}
invokehidden {
return \
[FmtFindInList $text {?-global? <hiddenCmdName}]
}
target {if {![llength ${mod}]} { return <alias> }}
exists {}
hidden {}
marktrusted {}
aliases {}
issafe {}
slaves {}
share -
tranfer {return [ChannelId ${mod}]}
}
} elseif {4 == $pos} {
switch -- $cmd {
alias {if {![llength ${mod}]} { return <targetPath> }}
create {
return [FmtFindInList $text {-safe -- path}]
}
expose {if {![llength ${mod}]} { return ?exposedCmdName? }}
hide {if {![llength ${mod}]} { return ?hiddenCmdName? }}
share -
tranfer {if {![llength ${mod}]} { return ?destPath? }}
}
}
return ""
}
proc complete(join) {text start end line pos mod} {
if {1 == $pos} {
return [VarCompletion ${text}]
}
return ""
}
proc complete(lappend) {text start end line pos mod} {
if {1 == $pos} {
return [ListCompletion ${text}]
}
return ""
}
proc complete(linsert) {text start end line pos mod} {
if {1 == $pos} {
return [ListCompletion ${text}]
}
return ""
}
proc complete(llength) {text start end line pos mod} {
if {1 == $pos} {
return [ListCompletion ${text}]
}
return ""
}
proc complete(load) {text start end line pos mod} {
if {1 == $pos} {
return ""; # filename
} elseif {2 == $pos && ![llength ${mod}]} {
return "<packageName>"
} elseif {3 == $pos && ![llength ${mod}]} {
return "<interp>"
}
return ""
}
proc complete(lrange) {text start end line pos mod} {
if {1 == $pos} {
return [ListCompletion ${text}]
} elseif {2 == $pos && ![llength ${mod}]} {
return "<first>"
} elseif {3 == $pos && ![llength ${mod}]} {
return "<last>"
}
return ""
}
proc complete(lreplace) {text start end line pos mod} {
if {1 == $pos} {
return [ListCompletion ${text}]
} elseif {2 == $pos && ![llength ${mod}]} {
return "<first>"
} elseif {3 == $pos && ![llength ${mod}]} {
return "<last>"
} elseif {![llength ${mod}]} {
return "?element?"
}
return ""
}
proc complete(lsearch) {text start end line pos mod} {
set options [FmtFindInList $text {-exact -glob -regexp}]
if {![llength ${mod}]} {
# remove the common match `-'
set options [lrange ${options} 1 end]
}
set opt [lindex ${line} 1]
set option [FmtFindInList $opt {-exact -glob -regexp}]
if {1 == $pos} {
set matches [ListCompletion ${text}]
return [string trim "${matches} ${options}"]
} elseif {2 == $pos && ![llength ${mod}]} {
if {[llength ${option}]} {
return "<list>"
} else {
return "<pattern>"
}
} elseif {3 == $pos && ![llength ${mod}]} {
if {[llength ${option}]} {
return "<pattern>"
}
}
return ""
}
proc complete(lsort) {text start end line pos mod} {
set options [FmtFindInList $text {
-ascii -dictionary -integer -real -command
-increasing -decreasing -index
}]
if {![llength ${mod}]} {
# remove the common match `-'
set options [lrange ${options} 1 end]
}
set matches [ListCompletion ${text}]
return [string trim "${matches} ${options}"]
}
proc complete(history) {text start end line pos mod} {
if {1 == $pos} {
set cmds {add change clear event info keep nextid redo}
return [FmtFindInList $text $cmds]
} elseif {2 == ${pos}} {
set cmd [lindex $line 1]
switch -- $cmd {
add { if {![llength ${mod}]} { return <newValue> } }
change { if {![llength ${mod}]} { return <newValue> } }
info -
keep { if {![llength ${mod}]} { return ?count? } }
event -
redo { if {![llength ${mod}]} { return ?event? } }
clear -
nextid { return "" }
}
}
}
proc complete(namespace) {text start end line pos mod} {
if {1 == $pos} {
set cmds {
children code current delete eval export forget
import inscope origin parent qualifiers tail which}
return [FmtFindInList $text $cmds]
} elseif {2 == $pos} {
set cmd [lindex $line 1]
# TODO dosn't work ???
# puts stderr \nmod=|$mod|\n
# set matches [namespace children ::]
# puts stderr \nmatches=$matches\n
set space_matches [namespace children :: [string trim ${mod}]\*]
switch -- $cmd {
children -
delete -
eval -
inscope -
parent {
return [FmtFindInList $text $space_matches]
}
code {
return ""
}
current {}
export {
}
forget {
}
import {
}
origin {
}
qualifiers {
}
tail {
}
which {
}
}
# TODO
return ""
}
return ""
}
proc complete(set) {text start end line pos mod} {
# puts stderr "\ntext=|$text| $start $end\n"
# puts stderr \nline=|$line|\n
# puts stderr \npos=|$pos|\n
# puts stderr \nmod=|$mod|\n
if {1 == $pos} {
return [VarCompletion ${text}]
} elseif {2 == $pos && ($text == "" || $text == "\"" || $text == "\{")} {
set line [QuoteQuotes $line]
if {[catch "set value [list [uplevel [info level] set [lindex $line 1]]]" msg]} {
return ""
} else {
return [Quote $value ${text}]
}
}
return ""
}
proc complete(unset) {text start end line pos mod} {
return [VarCompletion ${text}]
}
}; # namespace tclreadline