#!/usr/locanl/bin/tclsh
# FILE: "/home/joze/src/tclreadline/tclreadlineSetup.tcl.in"
# LAST MODIFICATION: "Mon Aug 30 01:34:07 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
# - open
# - package
# - pkg_mkIndex
# - proc
# - puts
# - pwd
# - pid
# - read
# - regexp
# - (registry is only on M$)
# - regsub
# - rename
# - (resource is on mac only)
# - return
# - scan # TODO
# - seek
# - socket
# - split # TODO
# - string
# - subst
# - switch
# - tell
# - time # TODO ??
# - trace
# - set
# - unknown
# - unset
# - update
# - uplevel
# - upvar
# - variable
# - vwait
# - while # TODO
#
# 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::FirstNonOption {line} {
set expr_pos 1
foreach word [lrange ${line} 1 end] {; # 0 is the command itself
if {"-" != [string index ${word} 0]} {
break
} else {
incr expr_pos
}
}
return ${expr_pos}
}
proc tclreadline::FmtFindInList {text lst} {
return [string trim [tclreadline::Format \
[tclreadline::FindInList $text $lst] $text]]
}
proc tclreadline::RemoveUsedOptions {line opts {terminate {}}} {
if {[llength ${terminate}]} {
if {[regexp -- ${terminate} ${line}]} {
return ""
}
}
set new ""
foreach word ${opts} {
if {![regexp -- ${word} ${line}]} {
lappend new ${word}
}
}
return [string trim ${new}]
}
proc tclreadline::FmtFindInListSpecial {text lst} {
if {![llength ${text}]} {
return [string trim "{} ${lst}"]
} else {
return [string trim [FmtFindInList ${text} ${lst}]]
}
}
proc tclreadline::FindInList {text lst} {
set result ""
foreach word $lst {
if {[string match ${text}* ${word}]} {
lappend result ${word}
}
}
return [string trim $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::FullQualifiedMatches {qualifier matchlist} {
set new ""
foreach entry ${matchlist} {
set full ${qualifier}::${entry}
if {"" != [namespace which ${full}]} {
lappend new ${full}
}
}
return ${new}
}
proc tclreadline::ProcsOnlyCompletion {cmd} {
return [tclreadline::CommandCompletion ${cmd} procs]
}
proc tclreadline::CommandsOnlyCompletion {cmd} {
return [tclreadline::CommandCompletion ${cmd} commands]
}
proc tclreadline::CommandCompletion {cmd {action both} {spc ::}} {
set quali [namespace qualifiers ${cmd}]
if {[llength ${quali}]} {
set rec [CommandCompletion [namespace tail ${cmd}] ${action} ${quali}]
return [FullQualifiedMatches ${quali} ${rec}]
}
# puts stderr \ncmd=|$cmd|\n
set cmd [string trim ${cmd}]*
if {"procs" != ${action}} {
set commands [namespace eval $spc "info commands [QuoteQuotes ${cmd}]"]
# puts stderr commands=|$commands|
} else {
set commands ""
}
if {"commands" != ${action}} {
set procs [namespace eval $spc "info procs [QuoteQuotes ${cmd}]"]
# puts stderr procs=|$procs|
} else {
set procs ""
}
set matches [namespace eval $spc concat ${commands} ${procs}]
#
# foreach match ${matches} {
# set full ${spc}::${match}
# if {"" != [namespace which ${full}]} {
# lappend new bla::${full}
# }
# }
#
set namespaces [namespace children $spc ${cmd}]
if {![llength ${matches}] && 1 == [llength ${namespaces}]} {
set namespaces [string trim ${namespaces}]
regsub {^([^:])} $namespaces {::\1} namespaces
# set matches [namespace eval ${namespaces} \
# {concat [info commands] [info procs]}]
if {"procs" != ${action}} {
set n_commands [namespace eval ${namespaces} "info commands"]
} else {
set n_commands ""
}
if {"commands" != ${action}} {
set n_procs [namespace eval ${namespaces} "info procs"]
} else {
set n_procs ""
}
set matches [string trim "${n_commands} ${n_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 matches [FullQualifiedMatches ${namespaces} ${matches}]
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 {"." == [string index [lindex ${line} 0] 0]} {
set alias WIDGET
} else {
set alias ${cmd}
}
if {"" != [namespace eval ::tclreadline \
"info procs complete($alias)"]} {
# 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
}
if {[catch [list set script_result \
[::tclreadline::complete($alias) $part \
$start $end $line $pos $mod]] msg]} {
error "error during evaluation of `complete($alias)'"
}
return ${script_result}
} elseif {"" != [array names known_cmds $cmd]} {
set current [lindex $known_cmds($cmd) $pos]
if {"" != $current && "" == [string trim $part]} {
return $current
} else {
return ""
}
} else {
return ""
}
}
error "{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"
"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 ...?"
"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"
"lrange list first last"
"lreplace list first last ?element element ...?"
"lsearch ?mode? list pattern"
"lsort ?options? list"
"namespace"
"package option ?arg arg ...?"
"proc name args body"
"read ?-nonewline? channelId"
"regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"
"rename oldName newName"
"scan <string> <format> ?varName varName ...?"
"set varName ?newValue?"
"source <fileName>"
"split <string> ?splitChars?"
"subst ?-nobackslashes? ?-nocommands? ?-novariables? string"
"switch ?switches? string pattern body ... ?default body?"
"time <command> ?count?"
"unknown <cmdName> ?arg? ?...?"
"uplevel ?level? command ?arg ...?"
"vwait name"
"while test command"
} {
tclreadline::readline add $line
set known_cmds([lindex $line 0]) ${line}
}
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]) ${line}
}
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 { return [complete(proc) ${text} 0 0 ${line} 1 ${mod}] }
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} {
if {1 == $pos} {
set options [FmtFindInListSpecial ${mod} {
-exact -glob -regexp <list>}]
set matches [ListCompletion ${text}]
return [string trim "${matches} ${options}"]
} else {
if {![llength ${mod}]} {
set opt [lindex ${line} 1]
if {[llength [FmtFindInListSpecial ${opt} {
-exact -glob -regexp }]]} {
incr pos -1
}
if {1 == $pos} {
return <list>
} elseif {2 == $pos} {
return <pattern>
}
}
}
return ""
}
proc complete(lsort) {text start end line pos mod} {
set options [FmtFindInListSpecial ${mod} {
-ascii -dictionary -integer -real -command
-increasing -decreasing -index
}]
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 "" }
}
}
return ""
}
proc complete(namespace) {text start end line pos mod} {
regsub {^([^:])} ${mod} {::\1} mod
# TODO dosn't work ???
set space_matches [namespace children :: [string trim ${mod}*]]
# puts \nspace_matches=|${space_matches}|
set cmd [lindex $line 1]
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} {
switch -- $cmd {
children -
delete -
eval -
inscope -
forget -
parent { return [FmtFindInList ${mod} $space_matches] }
code { return "" }
current {}
export { return [FmtFindInListSpecial ${mod} -clear ?pattern?] }
import { return [FmtFindInListSpecial ${mod} -force] }
origin { if {![llength ${mod}]} { return <command> } }
qualifiers -
tail { if {![llength ${mod}]} { return <string> } }
which { return [FmtFindInListSpecial ${mod} {
-command -variable <name>}] }
}
# forget { if {![llength ${mod}]} { return ?pattern? } }
} elseif {3 == $pos && "inscope" == $cmd} {
if {![llength ${mod}]} { return arg }
} else {
switch -- $cmd {
children { if {![llength ${mod}]} { return ?pattern? } }
delete { return [FmtFindInList $text $space_matches] }
eval { if {![llength ${mod}]} { return ?arg? } }
inscope { if {![llength ${mod}]} { return ?arg? } }
parent {}
code {}
current {}
export { return [FmtFindInListSpecial ${mod} ?pattern?] }
forget -
import { if {![llength ${mod}]} { return ?pattern? } }
origin {}
qualifiers {}
tail {}
which { return [FmtFindInListSpecial $text {
-command -variable <name>}] }
}
}
return ""
}
proc complete(open) {text start end line pos mod} {
if {![llength ${mod}]} {
if {2 == $pos} {
return ?access?
} elseif {3 == $pos} {
return ?permissions?
}
}
return ""
}
proc complete(package) {text start end line pos mod} {
set cmd [lindex $line 1]
if {1 == $pos} {
set cmds {
forget ifneeded names present provide require
unknown vcompare versions vsatisfies}
return [FmtFindInList $text $cmds]
} elseif {2 == $pos} {
switch -- $cmd {
forget -
ifneeded -
provide -
versions { return [FmtFindInListSpecial ${mod} [package names]] }
present -
require {
return [FmtFindInListSpecial ${mod} "-exact [package names]"] }
names {}
unknown { if {![llength ${mod}]} { return ?command? } }
vcompare -
vsatisfies { if {![llength ${mod}]} { return <version1> } }
}
} elseif {3 == $pos} {
switch -- $cmd {
forget {}
ifneeded { if {![llength ${mod}]} { return <version> } }
provide { if {![llength ${mod}]} { return ?version? } }
versions {}
present -
require {
set prev [PreviousWord ${start} ${line}]
if {[llength [FmtFindInListSpecial ${prev} -exact]]} {
return [FmtFindInListSpecial ${mod} [package names]]
} elseif {![llength ${mod}]} {
return ?version?
}
}
names {}
unknown {}
vcompare -
vsatisfies { if {![llength ${mod}]} { return <version2> } }
}
}
return ""
}
proc complete(pkg_mkIndex) {text start end line pos mod} {
set cmds [RemoveUsedOptions ${line} {-direct -load -verbose -- <dir>} {--}]
set res [string trim [FmtFindInListSpecial $text $cmds]]
if {[regexp -- [PreviousWord ${start} ${line}] -load] \
&& ![llength ${mod}]} {
return <pkgPat>
}
if {![llength [join ${res}]]} {
return ""
} else {
return ${res}
}
return ""
}
proc complete(proc) {text start end line pos mod} {
# puts known_procs=|${known_procs}|
if {1 == $pos} {
set known_procs [ProcsOnlyCompletion ${mod}]
set common [GetCommon ${known_procs}]
if {"" == ${common}} {
return [Format ${known_procs} ${text}]
} else {
return [string trim "${common} ${known_procs}"]
}
} elseif {2 == $pos} {
set proc [lindex $line 1]
if {[catch {set args [uplevel 2 info args ${proc}]}]} {
return ""
} else {
return [list "\{${args}\} \{"]
}
}
return ""
}
proc complete(puts) {text start end line pos mod} {
if {1 == $pos} {
return [FmtFindInListSpecial ${mod} "-nonewline [OutChannelId ${mod}]"]
} elseif {2 <= $pos} {
if {![llength ${mod}]} {
set opt [lindex ${line} 1]
if {[llength [FmtFindInListSpecial ${opt} {-nonewline}]]} {
incr pos -1
}
if {1 == $pos} {
return [OutChannelId ${mod}]
} elseif {2 == $pos} {
return <string>
}
}
}
return ""
}
proc complete(read) {text start end line pos mod} {
if {1 == $pos} {
return [FmtFindInListSpecial ${mod} "-nonewline [InChannelId ${mod}]"]
} elseif {2 == $pos} {
if {![llength ${mod}]} {
set opt [lindex ${line} 1]
if {[llength [FmtFindInListSpecial ${opt} {-nonewline}]]} {
return [InChannelId ${mod}]
} elseif {![llength ${mod}]} {
return <numBytes>
}
}
}
return ""
}
proc complete(regexp) {text start end line pos mod} {
set prev [PreviousWord ${start} ${line}]
if {[llength ${prev}] && ("-" == [string index ${prev} 0] || 1 == $pos)} {
set cmds [RemoveUsedOptions ${line} {
-nocase -indices -expanded -line
-linestop -lineanchor -about <expression> --} {--}]
if {[llength ${cmds}]} {
return [string trim [FmtFindInListSpecial $text $cmds]]
}
} else {
set virtual_pos [expr ${pos} - [FirstNonOption ${line}]]
switch -- ${virtual_pos} {
1 { if {![llength ${mod}]} { return <string> } }
2 { if {![llength ${mod}]} { return ?matchVar? } }
default { if {![llength ${mod}]} { return ?subMatchVar? } }
}
}
return ""
}
proc complete(regsub) {text start end line pos mod} {
set prev [PreviousWord ${start} ${line}]
if {[llength ${prev}] && ("-" == [string index ${prev} 0] || 1 == $pos)} {
set cmds [RemoveUsedOptions ${line} {-all -nocase -- <expression>} {--}]
set res [string trim [FmtFindInListSpecial ${mod} ${cmds}]]
if {[llength ${res}]} {
return ${res}
}
} else {
set virtual_pos [expr ${pos} - [FirstNonOption ${line}]]
switch -- ${virtual_pos} {
1 { if {![llength ${mod}]} { return <expression> } }
2 { if {![llength ${mod}]} { return <string> } }
3 { if {![llength ${mod}]} { return <subSpec> } }
4 { if {![llength ${mod}]} { return <varName> } }
}
}
return ""
}
proc complete(rename) {text start end line pos mod} {
if {1 == $pos} {
set all [CommandCompletion ${mod}]
return [tclreadline::Format $all ${mod}]
} elseif {2 == $pos && ![llength ${mod}]} {
return <newName>
}
return ""
}
proc complete(return) {text start end line pos mod} {
# TODO this is not perfect yet
set cmds {-code -errorinfo -errorcode <string>}
set res [FmtFindInListSpecial [PreviousWord ${start} ${line}] ${cmds}]
if {1 == [llength ${res}]} {
switch -- ${res} {
-errorinfo { if {![llength ${mod}]} { return <info> } }
-code -
-errorcode {
set codes {ok error return break continue}
return [FmtFindInList ${mod} ${codes}]
}
}
}
set cmds [RemoveUsedOptions ${line} ${cmds}]
set res [string trim [FmtFindInListSpecial ${mod} ${cmds}]]
if {[llength ${res}]} {
return ${res}
}
return ""
}
proc complete(seek) {text start end line pos mod} {
if {1 == $pos} {
return [ChannelId ${mod}]
} elseif {2 == $pos} {
return [FmtFindInList ${mod} {start current end}]
}
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(socket) {text start end line pos mod} {
set cmd [lindex ${line} 1]
set prev [PreviousWord ${start} ${line}]
if {"-server" == ${cmd}} {
# server sockets
#
if {2 == $pos && ![llength ${mod}]} { return <command> }
switch -- ${prev} {
-myaddr { if {![llength ${mod}]} { return <addr> } }
}
return [FmtFindInList ${mod} [concat {-error -sockname -peername}]]
} else {
# client sockets
#
switch -- ${prev} {
-myaddr { if {![llength ${mod}]} { return <addr> } }
-myport { if {![llength ${mod}]} { return <port> } }
}
# read the host table only once.
#
variable hosts
if {![info exists hosts] && "-server" != ${cmd}} {
set id [open /etc/hosts r]
set hosts ""
if {0 != ${id}} {
while {-1 != [gets ${id} line]} {
regsub {#.*} ${line} {} line
if {[llength ${line}] >= 2} {
lappend hosts [lindex ${line} 1]
}
}
close $id
}
}
set cmds {-myaddr -myport -async -myaddr -error -sockname -peername}
if {$pos <= 1} {
lappend cmds -server
}
return [FmtFindInList ${mod} [concat ${cmds} ${hosts}]]
}
return ""
}
proc complete(string) {text start end line pos mod} {
set cmd [lindex ${line} 1]
set cmds {
compare first index last length match range tolower
totitle toupper trim trimleft trimright wordend wordstart}
if {1 == $pos} {
return [FmtFindInList ${mod} ${cmds}]
} elseif {2 == $pos} {
switch -- $cmd {
compare -
first -
last { if {![llength ${mod}]} { return <string1> } }
match { if {![llength ${mod}]} { return <pattern> } }
index -
length -
range -
tolower -
totitle -
toupper -
trim -
trimleft -
trimright -
wordend -
wordstart { if {![llength ${mod}]} { return <string> } }
}
} elseif {3 == $pos} {
switch -- $cmd {
compare -
first -
last { if {![llength ${mod}]} { return <string2> } }
index { if {![llength ${mod}]} { return <charIndex> } }
length {}
match { if {![llength ${mod}]} { return <string> } }
range { if {![llength ${mod}]} { return <first> } }
tolower -
totitle -
toupper {}
trim -
trimleft { if {![llength ${mod}]} { return ?chars? } }
trimright -
wordend -
wordstart { if {![llength ${mod}]} { return <index> } }
}
}
return ""
}
proc complete(subst) {text start end line pos mod} {
set opts {-nobackslashes -nocommands -novariables}
set opts [RemoveUsedOptions ${line} ${opts}]
return [FmtFindInList ${mod} [concat ${opts} <string>]]
return ""
}
proc complete(switch) {text start end line pos mod} {
set opts {-exact -glob -regexp --}
set opts [RemoveUsedOptions ${line} ${opts} {--}]
return [FmtFindInList ${mod} [concat ${opts} <string>]]
return ""
}
proc complete(tell) {text start end line pos mod} {
if {1 == $pos} {
return [ChannelId ${mod}]
}
return ""
}
proc complete(trace) {text start end line pos mod} {
set cmd [lindex ${line} 1]
if {1 == $pos} {
return [FmtFindInList ${mod} {variable vdelete vinfo}]
} elseif {2 == $pos} {
return [Format [uplevel 2 info vars "${mod}*"] ${mod}]
} elseif {3 == $pos && "variable" == ${cmd}} {
return [FmtFindInList ${mod} {r w u}]
}
return ""
}
proc complete(update) {text start end line pos mod} {
if {1 == $pos && ![llength ${mod}]} {
return ?idletasks?
}
return ""
}
proc complete(uplevel) {text start end line pos mod} {
if {![llength ${mod}]} {
if {1 == $pos} {
return ?level?
} elseif {2 == $pos} {
return <command>
} elseif {3 == $pos} {
return ?arg?
} elseif {4 == $pos} {
return ?...?
}
}
return ""
}
proc complete(upvar) {text start end line pos mod} {
if {![llength ${mod}]} {
if {1 == $pos} {
return ?level?
} elseif {2 == $pos} {
return <otherVar>
} elseif {3 == $pos} {
return <myVar>
} elseif {4 == $pos} {
return ?...?
}
}
return ""
}
proc complete(variable) {text start end line pos mod} {
set modulo [expr $pos % 2]
if {1 == ${modulo}} {
return [VarCompletion ${mod}]
} elseif {0 == ${modulo} && \
($text == "" || $text == "\"" || $text == "\{")} {
set line [QuoteQuotes $line]
incr pos -1
if {[catch \
"set value [list [uplevel [info level] set [lindex $line ${pos}]]]"\
msg]} {
return ""
} else {
return [Quote $value ${mod}]
}
}
return ""
}
proc complete(vwait) {text start end line pos mod} {
if {1 == ${pos}} {
return [VarCompletion ${mod}]
}
}
proc complete(unset) {text start end line pos mod} {
return [VarCompletion ${text}]
}
# -------------------------------------
# TK
# -------------------------------------
# generic widget configuration
proc TrySubCmds cmd {
set trystring ____
set result ""
if [catch {set result [${cmd} ${trystring}]} msg] {
if {[regexp {bad *option.*____.*: *must *be( .*$)} ${msg} all raw]} {
regsub -all -- , ${raw} { } raw
set len [llength ${raw}]
set len_2 [expr ${len} - 2]
for {set i 0} {${i} < ${len}} {incr i} {
set word [lindex ${raw} ${i}]
if {"or" != ${word} && ${i} != ${len_2}} {
lappend result ${word}
}
}
}
}
return ${result}
}
proc WidgetList {pattern} {
regsub {^([^\.])} ${pattern} {\.\1} pattern
if {[winfo exists ${pattern}]} {
return [winfo children ${pattern}]
} else {
regsub {.[^.]*$} $pattern {} pattern
if {[winfo exists ${pattern}]} {
return [winfo children ${pattern}]
} else {
return ""
}
}
}
proc complete(WIDGET) {text start end line pos mod} {
set widget [lindex ${line} 0]
set cmd [lindex ${line} 1]
# first we build an option table
#
if {[catch [list set option_table [${widget} configure]] msg]} {
return ""
}
foreach optline ${option_table} {
if {5 != [llength ${optline}]} continue else {
lappend options(switches) [lindex ${optline} 0]
lappend options(value) [lindex ${optline} 4]
}
}
if {1 >= ${pos}} {
set cmds [TrySubCmds ${widget}]
if {[llength ${cmds}]} {
return [FmtFindInList ${mod} ${cmds}]
}
} elseif {2 <= ${pos} &&
([string match ${cmd}* cget] || \
[string match ${cmd}* configure])} {
set prev [PreviousWord ${start} ${line}]
#puts \nprev=|$prev|
#puts switches=|$options(switches)|
#puts found=[lsearch -exact ${prev} $options(switches)]
if {-1 != [set found [lsearch -exact $options(switches) ${prev}]]} {
if {![llength ${mod}]} {
return [lindex $options(value) ${found}]
}
} else {
return [FmtFindInList ${mod} $options(switches)]
}
}
return ""
}
proc complete(winfo) {text start end line pos mod} {
set cmd [lindex ${line} 1]
if {1 >= ${pos}} {
set cmds [TrySubCmds winfo]
if {[llength ${cmds}]} {
return [FmtFindInList ${mod} ${cmds}]
}
} elseif {2 == ${pos}} {
return [FmtFindInList ${mod} [WidgetList ${mod}]]
}
return ""
}
}; # namespace tclreadline