Index: tclreadlineCompleter.tcl
==================================================================
--- tclreadlineCompleter.tcl
+++ tclreadlineCompleter.tcl
@@ -1,8 +1,8 @@
# -*- tclsh -*-
-# FILE: "/home/joze/src/tclreadline/tclreadlineCompleter.tcl"
-# LAST MODIFICATION: "Thu Sep 16 22:17:38 1999 (joze)"
+# FILE: "/disk01/home/joze/src/tclreadline/tclreadlineCompleter.tcl"
+# LAST MODIFICATION: "Fri Sep 17 18:41:10 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
@@ -33,10 +33,12 @@
# - tcltest is missing
# - better completion for CompleteListFromList:
# RemoveUsedOptions ...
# - namespace eval fred {... <-- continue with a
# substitution in fred.
+# - set tclreadline::pro<tab> geht *nicht*
+# set ::tclreadline::pro<tab> geht
#
#
@@ -314,11 +316,14 @@
proc TrySubCmds {cmd} {
set trystring ____
set result ""
if [catch {set result [eval ${cmd} ${trystring}]} msg] {
set tcmd [string trim ${cmd}]
- if {[regexp {bad *option.*____.*: *must *be( .*$)} ${msg} all raw]} {
+ # puts stderr msg=$msg
+ if {[regexp {(bad|ambiguous) .*"____": *must *be( .*$)} ${msg} \
+ all junk raw]
+ } {; # XXX see tclIndexObj.c XXX
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}]
@@ -327,11 +332,11 @@
}
}
} elseif {[regexp "wrong # args: should be \"${tcmd}\(.*\)\"" \
${msg} all hint]
- } {
+ } {; # XXX see tclIndexObj.c XXX
set result [string trim $hint]
} else {
# check, if it's a blt error msg ...
#
set msglst [split ${msg} \n]
@@ -413,18 +418,18 @@
# puts stderr SplitLine
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]]
+ 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 [list [expr $start - $i] [String range $line $i end]]
}
}
}
return ""
}
@@ -610,11 +615,11 @@
if {![catch {llength [string range $line 0 $i]}]} {
break
}
}
incr i
- return [string range $line $i end]
+ return [String range $line $i end]
}
#**
# save `lindex'. works also for non-complete lines
# with opening parentheses or quotes.
@@ -643,16 +648,35 @@
if {[catch [list set len [llength $line]]]} { return {} }
}
# puts stderr \nline=$line
return $len
}
+
+#**
+# string function, which works also for older versions
+# of tcl, which don't have the `end' index.
+#
+proc String args {
+ if {[info tclversion] < 8.2} {
+ switch [lindex $args 1] {
+ range -
+ index {
+ if {"end" == [lindex $args end]} {
+ set str [lindex $args 2]
+ lreplace args end end [expr [string length $str] - 1]
+ }
+ }
+ }
+ }
+ return [eval string $args]
+}
proc StripPrefix {text} {
# puts "(StripPrefix) text=|$text|"
set null [string index $text 0]
if {"\"" == $null || "\{" == $null} {
- return [string range $text 1 end]
+ return [String range $text 1 end]
} else {
return $text
}
}
@@ -885,11 +909,11 @@
}
if {![info exists cmd]} {return}
if {![info complete ${cmd}]} {return}
set cmd [string range ${cmd} 1 [expr [string length ${cmd}] - 2]]
- set rest [string range ${line} [expr ${idx} + 1] end]
+ set rest [String range ${line} [expr ${idx} + 1] end]
if {[catch [list set result [string trim [eval ${cmd}]]]]} {return}
set line ${result}${rest}
set diff [expr [string length ${result}] - ([string length ${cmd}] + 2)]
@@ -929,11 +953,11 @@
}
# variable completion. Check first, if the
# variable starts with a plain `$' or should
# be enclosed in braces.
#
- set var [string range $part 1 end]
+ 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]]} {
@@ -980,14 +1004,14 @@
} else {
# try to use $pos further ...
# puts stderr |$line|
#
- if {"." == [string index [string trim ${line}] 0]} {
- set alias WIDGET
- set namespc ""; # widgets are always in the global
- } else {
+ # if {"." == [string index [string trim ${line}] 0]} {
+ # set alias WIDGET
+ # set namespc ""; # widgets are always in the global
+ # } else {
# the double `lindex' strips {} or quotes.
# the subst enables variables containing
# command names.
#
@@ -1005,11 +1029,11 @@
# strip leading ::'s.
#
regsub -all {^::} $alias {} alias
set namespc [namespace qualifiers $alias]
set alias [namespace tail $alias]
- }
+ # }
# try first a specific completer, then, and only then
# the tclreadline_complete_unknown.
#
foreach cmd [list ${alias} tclreadline_complete_unknown] {
@@ -1406,16 +1430,11 @@
ceil fmod sin abs
double int rand round
srand
}
- if {[info tclversion] >= 8.2} {
- set end end
- } else {
- set end [expr [string length $text] - 1]
- }
- if {")" == [string index $text $end] && -1 != [lsearch $cmds $left]} {
+ if {")" == [String index $text end] && -1 != [lsearch $cmds $left]} {
return "$text "; # append a space after a closing ')'
}
switch -- $left {
rand { return "rand() " }
@@ -2999,11 +3018,11 @@
initialize {}
write {}
add { return [DisplayHints <completerLine>] }
completer { return [DisplayHints <line>] }
customcompleter { return [DisplayHints ?scriptCompleter?] }
- builtincompleter { return [DisplayHints ?boolean?] }
+ builtincompleter { return [CompleteBoolean ${text}] }
eofchar { return [DisplayHints ?script?] }
reset-terminal {
if {[info exists ::env(TERM)]} {
return [CompleteFromList ${text} $::env(TERM)]
} else {
@@ -3222,13 +3241,16 @@
# @return number of options
# @date Sep-14-1999
#
proc OptionTable {cmd optionsT} {
upvar $optionsT options
- # first we build an option table
+ # first we build an option table.
+ # We always use `configure' here,
+ # because cget will not return the
+ # option table.
#
- if {[catch [list set option_table [eval ${cmd}]] msg]} {
+ if {[catch [list set option_table [eval ${cmd} configure]] msg]} {
return 0
}
foreach optline ${option_table} {
if {5 != [llength ${optline}]} continue else {
lappend options(switches) [lindex ${optline} 0]
@@ -3256,12 +3278,19 @@
}
}
if {-1 == ${idx}} {
return
}
- set cmd [lrange ${lst} 0 ${idx}]
- # puts stderr cmd=|$cmd|
+
+ # separate the command, but exclude (cget|configure)
+ # because cget won't return the option table. Instead
+ # OptionTable always uses `configure' to get the
+ # option table.
+ #
+ set cmd [lrange ${lst} 0 [expr ${idx} - 1]]
+
+ TraceText $cmd
if {0 < [OptionTable ${cmd} options]} {
set prev [PreviousWord ${start} ${line}]
if {-1 != [set found [lsearch -exact $options(switches) ${prev}]]} {
@@ -3286,41 +3315,27 @@
proc CompleteFromOptionsOrSubCmds {text start end line pos} {
set from_opts [CompleteFromOptions ${text} ${start} ${line}]
if {[string length ${from_opts}]} {
return ${from_opts}
} else {
+ # puts stderr \n\n[lrange [ProperList ${line}] 0 [expr $pos - 1]]\n
set cmds [TrySubCmds [lrange [ProperList ${line}] 0 [expr $pos - 1]]]
- # puts stderr cmds=|$cmds|
if {[llength ${cmds}]} {
return [TryFromList ${text} ${cmds}]
}
}
return ""
}
-proc complete(WIDGET) {text start end line pos mod} {
- # set widget [Lindex ${line} 0]
- # set cmds [TrySubCmds ${widget}]
- # if {[llength ${cmds}]} {
- # return [TryFromList ${mod} ${cmds}]
- # }
+# TODO
+# write a dispatcher here, which gets the widget class name
+# and calls specific completers.
+#
+proc complete(WIDGET_COMMAND) {text start end line pos mod} {
return [CompleteFromOptionsOrSubCmds ${text} ${start} ${end} ${line} ${pos}]
}
-# SPECIFIC TK COMMAND COMPLETERS
-
-proc complete(bell) {text start end line pos mod} {
- switch -- ${pos} {
- 1 { return [CompleteFromList ${text} -displayof] }
- 2 {
- if {"-displayof" == [PreviousWord ${start} ${line}]} {
- return [CompleteFromList ${text} [ToplevelWindows]]
- }
- }
- }
-}
-
proc EventuallyInsertLeadingDot {text fallback} {
if {![string length ${text}]} {
return [list . {}]
} else {
return [DisplayHints $fallback]
@@ -3327,18 +3342,18 @@
}
}
#**
# TODO: shit. make this better!
-# @param text, a std completer argument (current word).
-# @param fullpart, the full text of the current position.
-# @param lst, the list to complete from.
-# @param pre, leading `quote'.
-# @param sep, word separator.
-# @param post, trailing `quote'.
+# @param text, a std completer argument (current word).
+# @param fullpart, the full text of the current position.
+# @param lst, the list to complete from.
+# @param pre, leading `quote'.
+# @param sep, word separator.
+# @param post, trailing `quote'.
# @return a formatted completer string.
-# @date Sep-15-1999
+# @date Sep-15-1999
#
proc CompleteListFromList {text fullpart lst pre sep post} {
# puts stderr ""
# puts stderr text=|$text|
@@ -3396,10 +3411,77 @@
} else {
return ${completion}
}
return ""
}
+
+#**
+# SpecificSwitchCompleter
+# ---
+# @param text -- the word to complete.
+# @param start -- the char index of text's start in line
+# @param line -- the line gathered so far.
+# @param switch -- the switch to complete for.
+# @return a std tclreadline formatted completer string.
+# @sa CompleteWidgetConfigurations
+# @date Sep-17-1999
+#
+proc SpecificSwitchCompleter {text start line switch} {
+ # TODO:
+ # go to the `options' man page and look for possible values
+ switch -- ${switch} {
+ -takefocus -
+ -exportselection { return [CompleteBoolean ${text}] }
+ -xscrollcommand -
+ -yscrollcommand {
+ # return [BraceOrCommand ${text} \
+ # ${start} ${end} ${line} ${pos} ${mod}]
+ }
+ -relief {
+ return [CompleteFromList ${text} {
+ raised sunken flat ridge solid groove
+ }]
+ }
+ default { return [DisplayHints <[String range ${prev} 1 end]>] }
+ }
+}
+
+#**
+# CompleteWidgetConfigurations
+# ---
+# @param text -- the word to complete.
+# @param start -- the actual cursor position.
+# @param line -- the line gathered so far.
+# @param lst -- a list of possible completions.
+# @return a std tclreadline formatted completer string.
+# @sa SpecificSwitchCompleter
+# @date Sep-17-1999
+#
+proc CompleteWidgetConfigurations {text start line lst} {
+ set prev [PreviousWord ${start} ${line}]
+ if {"-" == [string index ${prev} 0]} {
+ return [SpecificSwitchCompleter ${text} ${start} ${line} ${prev}]
+ } else {
+ return [CompleteFromList ${text} \
+ [RemoveUsedOptions ${line} ${lst}]]
+ }
+}
+
+# --------------------------------------
+# === SPECIFIC TK COMMAND COMPLETERS ===
+# --------------------------------------
+
+proc complete(bell) {text start end line pos mod} {
+ switch -- ${pos} {
+ 1 { return [CompleteFromList ${text} -displayof] }
+ 2 {
+ if {"-displayof" == [PreviousWord ${start} ${line}]} {
+ return [CompleteFromList ${text} [ToplevelWindows]]
+ }
+ }
+ }
+}
proc complete(bind) {text start end line pos mod} {
switch -- ${pos} {
1 {
set widgets [WidgetChildren ${text}]
@@ -3452,27 +3534,267 @@
}
}
return ""
}
-proc CompleteWidgetConfigurations {text start line lst} {
- prev [PreviousWord ${start} ${line}]
-}
-
proc complete(button) {text start end line pos mod} {
switch -- ${pos} {
1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
default {
- return [CompleteWidgetConfigurations ${text} {
+ return [CompleteWidgetConfigurations ${text} ${start} ${line} {
+ -activebackground -activeforeground -anchor
+ -background -bitmap -borderwidth -cursor
+ -disabledforeground -font -foreground
+ -highlightbackground -highlightcolor
+ -highlightthickness -image -justify
+ -padx -pady -relief -takefocus -text
+ -textvariable -underline -wraplength
+ -command -default -height -state -width
+ }]
+ }
+ }
+ return ""
+}
+
+proc complete(canvas) {text start end line pos mod} {
+ switch -- ${pos} {
+ 1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
+ default {
+ return [CompleteWidgetConfigurations ${text} ${start} ${line} {
+ -background -borderwidth -cursor -highlightbackground
+ -highlightcolor -highlightthickness -insertbackground
+ -insertborderwidth -insertofftime -insertontime
+ -insertwidth -relief -selectbackground -selectborderwidth
+ -selectforeground -takefocus -xscrollcommand -yscrollcommand
+ -closeenough -confine -height -scrollregion -width
+ -xscrollincrement -yscrollincrement
+ }]
+ }
+ }
+ return ""
+}
+
+proc complete(checkbutton) {text start end line pos mod} {
+ switch -- ${pos} {
+ 1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
+ default {
+ return [CompleteWidgetConfigurations ${text} ${start} ${line} {
+ -activebackground activeBackground Foreground
+ -activeforeground -anchor -background -bitmap
+ -borderwidth -cursor -disabledforeground -font
+ -foreground -highlightbackground -highlightcolor
+ -highlightthickness -image -justify -padx -pady
+ -relief -takefocus -text -textvariable -underline
+ -wraplength -command -height -indicatoron -offvalue
+ -onvalue -selectcolor -selectimage -state -variable
+ -width
+ }]
+ }
+ }
+ return ""
+}
+
+proc complete(entry) {text start end line pos mod} {
+ switch -- ${pos} {
+ 1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
+ default {
+ return [CompleteWidgetConfigurations ${text} ${start} ${line} {
+ -background -borderwidth -cursor -exportselection
+ -font -foreground -highlightbackground -highlightcolor
+ -highlightthickness -insertbackground -insertborderwidth
+ -insertofftime -insertontime -insertwidth -justify -relief
+ -selectbackground -selectborderwidth -selectforeground
+ -takefocus -textvariable -xscrollcommand -show -state
+ -width
+ }]
+ }
+ }
+ return ""
+}
+
+proc complete(frame) {text start end line pos mod} {
+ switch -- ${pos} {
+ 1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
+ default {
+ return [CompleteWidgetConfigurations ${text} ${start} ${line} {
+ -borderwidth -cursor -highlightbackground -highlightcolor
+ -highlightthickness -relief -takefocus -background
+ -class -colormap -container -height -visual -width
+ }]
+ }
+ }
+ return ""
+}
+
+proc complete(label) {text start end line pos mod} {
+ switch -- ${pos} {
+ 1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
+ default {
+ return [CompleteWidgetConfigurations ${text} ${start} ${line} {
+ -anchor -background -bitmap -borderwidth -cursor -font
+ -foreground -highlightbackground -highlightcolor
+ -highlightthickness -image -justify -padx -pady -relief
+ -takefocus -text -textvariable -underline -wraplength
+ -height -width
+ }]
+ }
+ }
+ return ""
+}
+
+proc complete(listbox) {text start end line pos mod} {
+ switch -- ${pos} {
+ 1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
+ default {
+ return [CompleteWidgetConfigurations ${text} ${start} ${line} {
+ -background -borderwidth -cursor -exportselection -font
+ -foreground -height -highlightbackground -highlightcolor
+ -highlightthickness -relief -selectbackground
+ -selectborderwidth -selectforeground -setgrid -takefocus
+ -width -xscrollcommand -yscrollcommand -height -selectmode
+ -width
+ }]
+ }
+ }
+ return ""
+}
+
+proc complete(menu) {text start end line pos mod} {
+ switch -- ${pos} {
+ 1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
+ default {
+ return [CompleteWidgetConfigurations ${text} ${start} ${line} {
+ -activebackground -activeborderwidth -activeforeground
+ -background -borderwidth -cursor -disabledforeground
+ -font -foreground -relief -takefocus -postcommand
+ -selectcolor -tearoff -tearoffcommand -title -type
+ }]
+ }
+ }
+ return ""
+}
+
+proc complete(menubutton) {text start end line pos mod} {
+ switch -- ${pos} {
+ 1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
+ default {
+ return [CompleteWidgetConfigurations ${text} ${start} ${line} {
+ -activebackground -activeforeground -anchor -background
+ -bitmap -borderwidth -cursor -disabledforeground -font
+ -foreground -highlightbackground -highlightcolor
+ -highlightthickness -image -justify -padx -pady -relief
+ -takefocus -text -textvariable -underline -wraplength
+ -direction -height -indicatoron -menu -state -width
+ }]
+ }
+ }
+ return ""
+}
+
+proc complete(message) {text start end line pos mod} {
+ switch -- ${pos} {
+ 1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
+ default {
+ return [CompleteWidgetConfigurations ${text} ${start} ${line} {
+ -anchor -background -borderwidth -cursor -font -foreground
+ -highlightbackground -highlightcolor -highlightthickness
+ -padx -pady -relief -takefocus -text -textvariable -width
+ -aspect -justify -width
+ }]
+ }
+ }
+ return ""
+}
+
+proc complete(radiobutton) {text start end line pos mod} {
+ switch -- ${pos} {
+ 1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
+ default {
+ return [CompleteWidgetConfigurations ${text} ${start} ${line} {
+ -activebackground -activeforeground -anchor -background
+ -bitmap -borderwidth -cursor -disabledforeground -font
+ -foreground -highlightbackground -highlightcolor
+ -highlightthickness -image -justify -padx -pady -relief
+ -takefocus -text -textvariable -underline -wraplength -command
+ -height -indicatoron -selectcolor -selectimage -state -value
+ -variable -width
+ }]
+ }
+ }
+ return ""
+}
+
+proc complete(scale) {text start end line pos mod} {
+ switch -- ${pos} {
+ 1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
+ default {
+ return [CompleteWidgetConfigurations ${text} ${start} ${line} {
+ -activebackground -background -borderwidth -cursor -font
+ -foreground -highlightbackground -highlightcolor
+ -highlightthickness -orient -relief -repeatdelay
+ -repeatinterval -takefocus -troughcolor -bigincrement
+ -command -digits -from -label -length -resolution
+ -showvalue -sliderlength -sliderrelief -state -tickinterval
+ -to -variable -width
+ }]
+ }
+ }
+ return ""
+}
+
+proc complete(scrollbar) {text start end line pos mod} {
+ switch -- ${pos} {
+ 1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
+ default {
+ return [CompleteWidgetConfigurations ${text} ${start} ${line} {
+ -activebackground -background -borderwidth -cursor
+ -highlightbackground -highlightcolor -highlightthickness
+ -jump -orient -relief -repeatdelay -repeatinterval
+ -takefocus -troughcolor -activerelief -command
+ -elementborderwidth -width
+ }]
+ }
+ }
+ return ""
+}
+
+proc complete(text) {text start end line pos mod} {
+ switch -- ${pos} {
+ 1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
+ default {
+ return [CompleteWidgetConfigurations ${text} ${start} ${line} {
+ -background -borderwidth -cursor -exportselection -font
+ -foreground -highlightbackground -highlightcolor
+ -highlightthickness -insertbackground -insertborderwidth
+ -insertofftime -insertontime -insertwidth -padx -pady
+ -relief -selectbackground -selectborderwidth
+ -selectforeground -setgrid -takefocus -xscrollcommand
+ -yscrollcommand -height -spacing1 -spacing2 -spacing3
+ -state -tabs -width -wrap
+ }]
+ }
+ }
+ return ""
+}
+
+proc complete(toplevel) {text start end line pos mod} {
+ switch -- ${pos} {
+ 1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
+ default {
+ return [CompleteWidgetConfigurations ${text} ${start} ${line} {
+ -borderwidth -cursor -highlightbackground -highlightcolor
+ -highlightthickness -relief -takefocus -background
+ -class -colormap -container -height -menu -screen
+ -use -visual -width
}]
}
}
return ""
}
proc complete(image) {text start end line pos mod} {
- set sub [Lindex ${line} 1]
+set sub [Lindex ${line} 1]
switch -- ${pos} {
1 { return [CompleteFromList ${text} [TrySubCmds image]] }
2 {
switch -- ${sub} {
create { return [CompleteFromList ${text} [image types]] }