Index: README ================================================================== --- README +++ README @@ -1,8 +1,8 @@ FILE: "/home/joze/src/tclreadline/README" - LAST MODIFICATION: "Sun Aug 29 01:00:01 1999 (joze)" + LAST MODIFICATION: "Tue Aug 31 03:31:39 1999 (joze)" (C) 1998, 1999 by Johannes Zellner, $Id$ --- tclreadline -- gnu readline for tcl @@ -84,10 +84,17 @@ - if tclreadline::historyLength >= 0, tclreadline::write will truncate the historyfile to this value. By default tclreadline::historyfile == -1, that is no truncation occurs. + - ScriptCompleter largely extended. + calls tclreadline::complete() functions. + - tclreadline::complete(tclreadline_complete_unknown) + - some basic tk completion. + - convenience routines as Menu, CompleteFromList, AttemptFromList + - returning an empty {} will inhibit further + builtin filename completion. fixes: - after having at least one character typed, X events were not processed any more until pressing . - catching `tclreadline::readline read' errors Index: tclreadline.c ================================================================== --- tclreadline.c +++ tclreadline.c @@ -1,10 +1,10 @@ /* ================================================================== FILE: "/home/joze/src/tclreadline/tclreadline.c" - LAST MODIFICATION: "Sun Aug 29 15:04:07 1999 (joze)" + LAST MODIFICATION: "Tue Aug 31 03:22:55 1999 (joze)" (C) 1998, 1999 by Johannes Zellner, $Id$ --- tclreadline -- gnu readline for tcl @@ -222,11 +222,11 @@ */ if (expansion && *expansion) add_history(expansion); - Tcl_AppendResult(interp, expansion, (char*) NULL); + Tcl_SetResult(interp, expansion, TCL_VOLATILE); FREE(tclrl_line); FREE(expansion); return tclrl_state; } else if (c == 'i' && strncmp(argv[1], "initialize", length) == 0) { @@ -465,10 +465,11 @@ char** TclReadlineCompletion(char* text, int start, int end) { char** matches = (char**) NULL; + rl_attempted_completion_over = 0; #if 0 fprintf(stderr, "DEBUG> TclReadlineCompletion: text=|%s|\n", text); fprintf(stderr, "DEBUG> TclReadlineCompletion: start=|%d|\n", start); fprintf(stderr, "DEBUG> TclReadlineCompletion: end=|%d|\n", end); @@ -549,17 +550,23 @@ } obj = Tcl_GetObjResult(tclrl_interp); Tcl_ListObjGetElements(tclrl_interp, obj, &objc, &objv); /* fprintf (stderr, "(TclReadlineCompletion) objc = %d\n", objc); */ if (objc) { - int i, length /* not used */; + int i, length; matches = (char**) MALLOC(sizeof(char*) * (objc + 1)); for (i = 0; i < objc; i++) { matches[i] = strdup(Tcl_GetStringFromObj(objv[i], &length)); + if (1 == objc && !strlen(matches[i])) { + rl_attempted_completion_over = 1; + FREE(matches[i]); + FREE(matches); + return (char**) NULL; + } /* - fprintf (stderr, "(TclReadlineCompletion) matches[%d] = |%s|\n", - i, matches[i]); + fprintf (stderr, "(TclReadlineCompletion) len[%s]=%d\n", + matches[i], strlen(matches[i])); */ } matches[i] = (char*) NULL; /* terminate */ } Tcl_ResetResult(tclrl_interp); /* clear result space */ Index: tclreadlineSetup.tcl.in ================================================================== --- tclreadlineSetup.tcl.in +++ tclreadlineSetup.tcl.in @@ -1,8 +1,8 @@ #!/usr/locanl/bin/tclsh -# FILE: "/diska/home/joze/src/tclreadline/tclreadlineSetup.tcl.in" -# LAST MODIFICATION: "Mon Aug 30 01:54:12 1999 (joze)" +# FILE: "/home/joze/src/tclreadline/tclreadlineSetup.tcl.in" +# LAST MODIFICATION: "Tue Aug 31 03:32:02 1999 (joze)" # (C) 1998, 1999 by Johannes Zellner, # $Id$ # --- # # tclreadline -- gnu readline for tcl @@ -220,15 +220,15 @@ } } return -code error "invalid command name \"$name\"" } -namespace eval tclreadline:: { - namespace export Setup Glob Loop InitCmds InitTclCmds InitTkCmds Print ls -} +namespace eval tclreadline { -proc tclreadline::FirstNonOption {line} { +namespace export Setup Glob Loop InitCmds InitTclCmds InitTkCmds Print ls + +proc FirstNonOption {line} { set expr_pos 1 foreach word [lrange ${line} 1 end] {; # 0 is the command itself if {"-" != [string index ${word} 0]} { break } else { @@ -236,16 +236,11 @@ } } return ${expr_pos} } -proc tclreadline::FmtFindInList {text lst} { - return [string trim [tclreadline::Format \ - [tclreadline::FindInList $text $lst] $text]] -} - -proc tclreadline::RemoveUsedOptions {line opts {terminate {}}} { +proc RemoveUsedOptions {line opts {terminate {}}} { if {[llength ${terminate}]} { if {[regexp -- ${terminate} ${line}]} { return "" } } @@ -256,19 +251,53 @@ } } return [string trim ${new}] } -proc tclreadline::FmtFindInListSpecial {text lst} { +proc Alert {} { + puts -nonewline \a + flush stdout +} + +# AttemptFromList will return an empty string, if +# the text typed so far does not match any of the +# elements in list. This might be used to allow +# subsequent filename completion by the builtin +# completer. +# +proc AttemptFromList {text lst} { + return [string trim [Format [FindInList $text $lst] $text]] +} + +# CompleteFromList will never return an empty string. +# +proc CompleteFromList {text lst} { + set result [AttemptFromList ${text} ${lst}] + if {![llength ${result}]} { + Alert + return [string trim "${text} ${lst}"] + } else { + return ${result} + } +} + +# ??????? +proc MenuFromList {text lst} { if {![llength ${text}]} { return [string trim "{} ${lst}"] } else { - return [string trim [FmtFindInList ${text} ${lst}]] + return [AttemptFromList ${text} ${lst}] } } -proc tclreadline::FindInList {text lst} { +# never return an empty string +# +proc Menu {lst} { + return [string trim "{} ${lst}"] +} + +proc FindInList {text lst} { set result "" foreach word $lst { if {[string match ${text}* ${word}]} { lappend result ${word} } @@ -277,13 +306,13 @@ } # get the longest common completion # e.g. str == {tcl_version tclreadline_version tclreadline_library} -# --> [tclreadline::GetCommon ${str}] == "tcl" +# --> [GetCommon ${str}] == "tcl" # -proc tclreadline::GetCommon {str} { +proc GetCommon {str} { # puts stderr str=$str set match0 [lindex ${str} 0] set len0 [string length $match0] set no_matches [llength ${str}] set part "" @@ -302,11 +331,11 @@ } # puts stderr part=$part return ${part} } -proc tclreadline::SubCmd {start line} { +proc 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 @@ -322,19 +351,19 @@ } } return "" } -proc tclreadline::IsWhite {char} { +proc IsWhite {char} { if {" " == $char || "\n" == $char || "\t" == $char} { return 1 } else { return 0 } } -proc tclreadline::PreviousWord {start line} { +proc 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]} { @@ -344,43 +373,42 @@ } } return [string trim [string range ${line} $i $start]] } -proc tclreadline::Quote {value left} { - set right [tclreadline::Right ${left}] +proc Quote {value left} { + set right [Right ${left}] if {1 < [llength $value] && "" == $right} { return [list \"${value}\"] } else { return [list ${left}${value}${right}] } } -proc tclreadline::InChannelId {text} { +proc InChannelId {text} { return [ChannelId ${text} {stdin}] } -proc tclreadline::OutChannelId {text} { +proc OutChannelId {text} { return [ChannelId ${text} {stdout stderr}] } -proc tclreadline::ChannelId { - text {default } {chs {stdin stdout stderr}}} { +proc ChannelId {text {default } {chs {stdin stdout stderr}}} { if {[llength ${text}]} { - set channel [FmtFindInList $text ${chs}] + set channel [AttemptFromList $text ${chs}] if {[llength [lindex ${channel} 0]]} { return ${channel} } else { return "" } } return ${default} } -proc tclreadline::QuoteQuotes {line} { +proc QuoteQuotes {line} { regsub -all -- \" $line {\"} line - regsub -all -- \{ $line {\{} line + regsub -all -- \{ $line {\{} line; # \}\} (keep the editor happy) return $line } # % p # % bla put $b @@ -389,28 +417,28 @@ # 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|" +proc PartPosition {part start end line} { + # puts stderr "(PartPosition) line\[start\]=[string index $line $start]" + # puts stderr "(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" + # puts stderr "(PartPosition) line=|$line|" + # puts stderr "(PartPosition) start=$start" set line [string range $line 0 $start] set line [QuoteQuotes $line] - # puts stderr "(tclreadline::PartPosition) line=|$line|" + # puts stderr "(PartPosition) line=|$line|" set result [llength $line] # puts stderr $result return $result } -proc tclreadline::Right {left} { +proc Right {left} { if {"\"" == $left} { return "" } elseif {"\{" == $left} { return "\}" } elseif {"\\\{" == $left} { @@ -417,11 +445,11 @@ return "\\\}" } return "" } -proc tclreadline::GetPrefix {text} { +proc GetPrefix {text} { set null [string index $text 0] # puts null=|$null| if {"\"" == $null} { # puts stderr \neins\n set pre "\\\"" @@ -433,21 +461,21 @@ set pre "" } return ${pre} } -proc tclreadline::Format {matches {part {}}} { +proc 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}] + return [string trim ${pre}${matches}[Right ${pre}]] } elseif {"" != ${matches}} { # puts stderr \nmore=$matches\n - set common [tclreadline::GetCommon ${matches}] + set common [GetCommon ${matches}] # puts stderr common=|$common| if {"" == $common} { return [string trim "[list $part] ${matches}"] } else { return [string trim "${pre}${common} ${matches}"] @@ -455,17 +483,17 @@ } else { return ""; # nothing to complete } } -proc tclreadline::ListCompletion {text {level -1}} { +proc ListCompletion {text {level -1}} { # TODO return "" # return [VarCompletion ${text} ${level}] } -proc tclreadline::VarCompletion {text {level -1}} { +proc VarCompletion {text {level -1}} { if {-1 == ${level}} { set level [info level] } else { incr level } @@ -482,11 +510,11 @@ 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}" + return "${array}([GetCommon ${names}] ${names}" } else { return ""; # nothing to complete } } @@ -514,22 +542,22 @@ return [VarCompletion ${matches}( ${level}]; # recursion } else { return ${pre}${matches}[Right ${pre}] } } elseif {"" != $matches} { ; # more than one match - set common [tclreadline::GetCommon ${matches}] + set common [GetCommon ${matches}] if {"" == ${common}} { - return [tclreadline::Format ${matches} ${text}] + return [Format ${matches} ${text}] } else { return [string trim "${pre}${common} ${matches}"] } } else { return ""; # nothing to complete } } -proc tclreadline::FullQualifiedMatches {qualifier matchlist} { +proc FullQualifiedMatches {qualifier matchlist} { set new "" foreach entry ${matchlist} { set full ${qualifier}::${entry} if {"" != [namespace which ${full}]} { lappend new ${full} @@ -536,19 +564,19 @@ } } return ${new} } -proc tclreadline::ProcsOnlyCompletion {cmd} { - return [tclreadline::CommandCompletion ${cmd} procs] +proc ProcsOnlyCompletion {cmd} { + return [CommandCompletion ${cmd} procs] } -proc tclreadline::CommandsOnlyCompletion {cmd} { - return [tclreadline::CommandCompletion ${cmd} commands] +proc CommandsOnlyCompletion {cmd} { + return [CommandCompletion ${cmd} commands] } -proc tclreadline::CommandCompletion {cmd {action both} {spc ::}} { +proc 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}] } @@ -616,11 +644,11 @@ # part == $b # start == 5 # end == 7 # line == "$puts $b" # -proc tclreadline::ScriptCompleter {part start end line} { +proc 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 # @@ -667,51 +695,67 @@ # 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]]} { + } elseif {"" != [set sub [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] + [ScriptCompleter $part $new_start $new_end $new_line] } elseif {0 == \ - [set pos [tclreadline::PartPosition $part $start $end $line]]} { + [set pos [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] + return [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 alias [lindex [QuoteQuotes ${line}] 0] + } + foreach cmd [list ${alias} tclreadline_complete_unknown] { + if {"" != [namespace eval ::tclreadline \ + [list info procs complete(${cmd})]] + } { + # to be more error-proof, we check here, + # if complete($cmd) takes exactly 5 arguments. + # + if {6 != [set arguments [llength \ + [namespace eval ::tclreadline \ + [list info args complete(${cmd})]]]] + } { + error [list complete(${cmd}) takes ${arguments} \ + arguments, but should take exactly 6.] + } + + # remove leading quotes + # + 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 \ + [complete(${cmd}) $part \ + $start $end $line $pos $mod]] msg] + } { + error "error during evaluation of `complete(${cmd})'" + } + return ${script_result} + } + } + # no specific command completer found. + if {"" != [array names known_cmds $cmd]} { set current [lindex $known_cmds($cmd) $pos] if {"" != $current && "" == [string trim $part]} { return $current } else { return "" @@ -721,26 +765,26 @@ } } error "{NOTREACHED (this is probably an error)}" } -proc tclreadline::ls {args} { +proc ls {args} { if {[exec uname -s] == "Linux"} { - eval exec ls --color -FC [::tclreadline::Glob $args] + eval exec ls --color -FC [Glob $args] } else { - eval exec ls -FC [::tclreadline::Glob $args] + eval exec ls -FC [Glob $args] } } -proc ::tclreadline::Setup {args} { +proc Setup {args} { uplevel #0 { - if {[info commands ::tclreadline::readline] == ""} { + if {"" == [info commands ::tclreadline::readline]} { ::tclreadline::Init } - tclreadline::readline customcompleter tclreadline::ScriptCompleter + ::tclreadline::readline customcompleter ::tclreadline::ScriptCompleter if {[catch {set a [::tclreadline::prompt1]}] \ && [info nameofexecutable] != ""} { namespace eval ::tclreadline { @@ -770,13 +814,14 @@ regsub $env(HOME) $pwd "~" pwd } return "$prompt_string \[$pwd\]" } } + # puts body=[info body ::tclreadline::prompt1] } - if {[info procs exit] == ""} { + if {"" == [info procs exit]} { catch {rename ::tclreadline::Exit ""} rename exit ::tclreadline::Exit proc exit {args} { @@ -814,26 +859,26 @@ set historyfile $env(HOME)/.tclsh-history } else { set historyfile .tclsh-history } } - set msg [::tclreadline::readline initialize $historyfile] + set msg [readline initialize $historyfile] if {$msg != ""} { puts stderr "$msg" } - ::tclreadline::InitCmds + InitCmds - rename ::tclreadline::Setup "" + rename Setup "" } -proc ::tclreadline::HistoryFileGet {} { +proc HistoryFileGet {} { variable historyfile return $historyfile } -proc ::tclreadline::Glob {string} { +proc Glob {string} { set commandstring "" foreach name $string { set replace [glob -nocomplain -- $name] if {$replace == ""} { @@ -847,84 +892,83 @@ return [eval concat $commandstring] } -proc ::tclreadline::Loop {args} { +proc Loop {args} { - eval ::tclreadline::Setup ${args} + eval Setup ${args} uplevel #0 { while {1} { if [info exists tcl_prompt2] { - set ::tclreadline::prompt2 $tcl_prompt2 + set prompt2 $tcl_prompt2 } else { - set ::tclreadline::prompt2 ">" + set prompt2 ">" } if {[catch { - if {[namespace eval ::tclreadline {[info procs prompt1]}] != ""} { - set ::tclreadline::LINE [::tclreadline::readline read \ + if {"" != [namespace eval ::tclreadline {info procs prompt1}]} { + set 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}] - } + } else { + set LINE [::tclreadline::readline read %] + } + while {![::tclreadline::readline complete $LINE]} { + append LINE "\n" + append LINE [tclreadline::readline read ${prompt2}] + } } msg]} { - puts stderr \n$msg + puts stderr [list tclreadline::Loop: error. $msg] continue } # Magnus Eriksson proposed - history add $::tclreadline::LINE + history add $LINE if [catch { - set result [eval $::tclreadline::LINE] - if {$result != "" && [::tclreadline::Print]} { + set result [eval $LINE] + if {$result != "" && [tclreadline::Print]} { puts $result } set result "" } msg] { puts stderr $msg + puts stderr [list while evaluating $LINE] } } } } -proc ::tclreadline::Print {args} { +proc Print {args} { variable PRINT if ![info exists PRINT] { - set ::tclreadline::PRINT yes + set PRINT yes } if [regexp -nocase \(true\|yes\|1\) $args] { - set ::tclreadline::PRINT yes + set PRINT yes } elseif [regexp -nocase \(false\|no\|0\) $args] { - set ::tclreadline::PRINT no + set PRINT no } return $PRINT } -proc ::tclreadline::InitCmds {} { +proc InitCmds {} { global tcl_version tk_version if {[info exists tcl_version]} { - ::tclreadline::InitTclCmds + InitTclCmds } if {[info exists tk_version]} { - ::tclreadline::InitTkCmds + InitTkCmds } - rename tclreadline::InitCmds "" + rename InitCmds "" } -proc ::tclreadline::InitTclCmds {} { +proc InitTclCmds {} { variable known_cmds foreach line { "after option ?arg arg ...?" "append varName ?value value ...?" "array option arrayName ?arg ...?" @@ -984,17 +1028,17 @@ "unknown ?arg? ?...?" "uplevel ?level? command ?arg ...?" "vwait name" "while test command" } { - tclreadline::readline add $line + readline add $line set known_cmds([lindex $line 0]) ${line} } - rename tclreadline::InitTclCmds "" + rename InitTclCmds "" } -proc ::tclreadline::InitTkCmds {} { +proc InitTkCmds {} { variable known_cmds foreach line { "bind window ?pattern? ?command?" "bindtags window ?tags?" "button pathName ?options?" @@ -1027,19 +1071,17 @@ "tkwait variable|visibility|window name" "toplevel pathName ?options?" "winfo option ?arg?" "wm option window ?arg ...?" } { - tclreadline::readline add $line + readline add $line set known_cmds([lindex $line 0]) ${line} } -rename tclreadline::InitTkCmds "" + rename InitTkCmds "" } -namespace eval tclreadline { - # explicit command completers # # ------------------------------------- # TCL @@ -1053,19 +1095,19 @@ } proc complete(if) {text start end line pos mod} { # TODO: this is not good yet. if {2 == $pos} { - return [FmtFindInList $text {then}] + return [AttemptFromList $text {then}] } elseif {$pos > 2} { set prev [PreviousWord ${start} ${line}] switch $prev { then - else - elseif { return "" } } - return [FmtFindInList $text {then else elseif}] + return [AttemptFromList $text {then else elseif}] } } proc complete(incr) {text start end line pos mod} { if {1 == $pos} { @@ -1089,11 +1131,11 @@ if {1 == $pos} { set cmds { anymore donesearch exists get names nextelement set size startsearch } - return [FmtFindInList $text $cmds] + return [AttemptFromList $text $cmds] } elseif {2 == $pos} { set cmd [lindex $line 1] switch -- $cmd { anymore - donesearch - @@ -1140,11 +1182,11 @@ proc complete(binary) {text start end line pos mod} { if {1 == $pos} { set cmds { format scan } - return [FmtFindInList $text $cmds] + return [AttemptFromList $text $cmds] # # } elseif {2 == $pos} { # set cmd [lindex $line 1] # switch -- $cmd { # format - @@ -1156,11 +1198,11 @@ } proc complete(clock) {text start end line pos mod} { if {1 == $pos} { set cmds {clicks format scan seconds} - return [FmtFindInList $text $cmds] + return [AttemptFromList $text $cmds] } elseif {2 == $pos} { set cmd [lindex $line 1] switch -- $cmd { clicks {} format { @@ -1180,16 +1222,16 @@ switch -- $cmd { clicks {} format { set sub [lindex $line 3] set subcmds {-fmt -gmt} - return [FmtFindInList $text $subcmds] + return [AttemptFromList $text $subcmds] } scan { set sub [lindex $line 3] set subcmds {-base -gmt} - return [FmtFindInList $text $subcmds] + return [AttemptFromList $text $subcmds] } seconds {} } } return "" @@ -1196,20 +1238,20 @@ } proc complete(encoding) {text start end line pos mod} { if {1 == $pos} { set cmds {convertfrom convertto names system} - return [FmtFindInList $text $cmds] + return [AttemptFromList $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 [AttemptFromList ${text} ${enc}] } } } return "" } @@ -1222,41 +1264,41 @@ atan2 floor pow tanh ceil fmod sin abs double int rand round srand } - return [FmtFindInList $text $cmds] + return [AttemptFromList $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}] + return [AttemptFromList ${text} {yes no}] } -buffering { - return [FmtFindInList ${text} {full line none}] + return [AttemptFromList ${text} {full line none}] } -buffersize { if {![llength ${text}} { return } } -encoding { set enc [encoding names] - return [FmtFindInList ${text} ${enc}] + return [AttemptFromList ${text} ${enc}] } -eofchar { if {![llength ${text}]} { return [list {{ }}] } } -translation { - return [FmtFindInList ${text} {auto binary cr crlf lf}] + return [AttemptFromList ${text} {auto binary cr crlf lf}] } } set cmds { -blocking -buffering @@ -1263,11 +1305,11 @@ -buffersize -encoding -eofchar -translation } - return [FmtFindInList $text $cmds] + return [AttemptFromList $text $cmds] } return "" } proc complete(fcopy) {text start end line pos mod} { @@ -1283,11 +1325,11 @@ } -command { if {![llength ${mod}]} { return } } } - return [FmtFindInList $text {-size -command}] + return [AttemptFromList $text {-size -command}] } return "" } proc complete(file) {text start end line pos mod} { @@ -1296,11 +1338,11 @@ 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] + return [AttemptFromList $text $cmds] } elseif {2 == $pos} { set cmd [lindex $line 1] switch -- $cmd { atime - attributes - @@ -1331,11 +1373,11 @@ } copy - delete - rename { - set match [FmtFindInList ${mod} {-force}] + set match [AttemptFromList ${mod} {-force}] if {[llength ${match}] && [llength ${mod}]} { return ${match} } else { return "" } @@ -1346,11 +1388,11 @@ proc complete(fileevent) {text start end line pos mod} { if {1 == $pos} { return [ChannelId ${mod}] } elseif {2 == $pos} { - return [FmtFindInList ${mod} {readable writable}] + return [AttemptFromList ${mod} {readable writable}] } } proc complete(flush) {text start end line pos mod} { if {1 == $pos} { @@ -1364,11 +1406,11 @@ } } proc complete(glob) {text start end line pos mod} { if {1 == $pos} { - set matches [FmtFindInList ${mod} {-nocomplain --}] + set matches [AttemptFromList ${mod} {-nocomplain --}] if {[llength [string trim ${mod}]] && [llength ${matches}]} { return ${matches} } } return "" @@ -1391,11 +1433,11 @@ 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] + return [AttemptFromList $text $cmds] } elseif {2 == $pos} { set cmd [lindex $line 1] switch -- $cmd { args - body - @@ -1429,15 +1471,15 @@ 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] + return [AttemptFromList $text $cmds] } elseif {2 == $pos} { switch -- $cmd { create { - return [FmtFindInList $text {-safe -- ?path?}] + return [AttemptFromList $text {-safe -- ?path?}] } eval - exists - expose - @@ -1460,11 +1502,11 @@ switch -- $cmd { alias {if {![llength ${mod}]} { return }} create { - return [FmtFindInList $text {-safe -- ?path?}] + return [AttemptFromList $text {-safe -- ?path?}] } eval {if {![llength ${mod}]} { return }} delete {if {![llength ${mod}]} { return ?path? }} @@ -1471,11 +1513,11 @@ expose {if {![llength ${mod}]} { return }} hide {if {![llength ${mod}]} { return }} invokehidden { return \ - [FmtFindInList $text {?-global? }} exists {} @@ -1492,11 +1534,11 @@ switch -- $cmd { alias {if {![llength ${mod}]} { return }} create { - return [FmtFindInList $text {-safe -- path}] + return [AttemptFromList $text {-safe -- path}] } expose {if {![llength ${mod}]} { return ?exposedCmdName? }} hide {if {![llength ${mod}]} { return ?hiddenCmdName? }} @@ -1570,18 +1612,18 @@ return "" } proc complete(lsearch) {text start end line pos mod} { if {1 == $pos} { - set options [FmtFindInListSpecial ${mod} { + set options [MenuFromList ${mod} { -exact -glob -regexp }] set matches [ListCompletion ${text}] return [string trim "${matches} ${options}"] } else { if {![llength ${mod}]} { set opt [lindex ${line} 1] - if {[llength [FmtFindInListSpecial ${opt} { + if {[llength [MenuFromList ${opt} { -exact -glob -regexp }]]} { incr pos -1 } if {1 == $pos} { return @@ -1592,11 +1634,11 @@ } return "" } proc complete(lsort) {text start end line pos mod} { - set options [FmtFindInListSpecial ${mod} { + set options [MenuFromList ${mod} { -ascii -dictionary -integer -real -command -increasing -decreasing -index }] set matches [ListCompletion ${text}] return [string trim "${matches} ${options}"] @@ -1603,11 +1645,11 @@ } 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] + return [AttemptFromList $text $cmds] } elseif {2 == ${pos}} { set cmd [lindex $line 1] switch -- $cmd { add { if {![llength ${mod}]} { return } } change { if {![llength ${mod}]} { return } } @@ -1633,48 +1675,48 @@ 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] + return [AttemptFromList $text $cmds] } elseif {2 == $pos} { switch -- $cmd { children - delete - eval - inscope - forget - - parent { return [FmtFindInList ${mod} $space_matches] } + parent { return [AttemptFromList ${mod} $space_matches] } code { return "" } current {} - export { return [FmtFindInListSpecial ${mod} -clear ?pattern?] } - import { return [FmtFindInListSpecial ${mod} -force] } + export { return [MenuFromList ${mod} -clear ?pattern?] } + import { return [MenuFromList ${mod} -force] } origin { if {![llength ${mod}]} { return } } qualifiers - tail { if {![llength ${mod}]} { return } } - which { return [FmtFindInListSpecial ${mod} { + which { return [MenuFromList ${mod} { -command -variable }] } } # 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] } + delete { return [AttemptFromList $text $space_matches] } eval { if {![llength ${mod}]} { return ?arg? } } inscope { if {![llength ${mod}]} { return ?arg? } } parent {} code {} current {} - export { return [FmtFindInListSpecial ${mod} ?pattern?] } + export { return [MenuFromList ${mod} ?pattern?] } forget - import { if {![llength ${mod}]} { return ?pattern? } } origin {} qualifiers {} tail {} - which { return [FmtFindInListSpecial $text { + which { return [MenuFromList $text { -command -variable }] } } } return "" } @@ -1694,20 +1736,20 @@ set cmd [lindex $line 1] if {1 == $pos} { set cmds { forget ifneeded names present provide require unknown vcompare versions vsatisfies} - return [FmtFindInList $text $cmds] + return [AttemptFromList $text $cmds] } elseif {2 == $pos} { switch -- $cmd { forget - ifneeded - provide - - versions { return [FmtFindInListSpecial ${mod} [package names]] } + versions { return [MenuFromList ${mod} [package names]] } present - require { - return [FmtFindInListSpecial ${mod} "-exact [package names]"] } + return [MenuFromList ${mod} "-exact [package names]"] } names {} unknown { if {![llength ${mod}]} { return ?command? } } vcompare - vsatisfies { if {![llength ${mod}]} { return } } } @@ -1718,12 +1760,12 @@ provide { if {![llength ${mod}]} { return ?version? } } versions {} present - require { set prev [PreviousWord ${start} ${line}] - if {[llength [FmtFindInListSpecial ${prev} -exact]]} { - return [FmtFindInListSpecial ${mod} [package names]] + if {[llength [MenuFromList ${prev} -exact]]} { + return [MenuFromList ${mod} [package names]] } elseif {![llength ${mod}]} { return ?version? } } names {} @@ -1735,11 +1777,11 @@ return "" } proc complete(pkg_mkIndex) {text start end line pos mod} { set cmds [RemoveUsedOptions ${line} {-direct -load -verbose -- } {--}] - set res [string trim [FmtFindInListSpecial $text $cmds]] + set res [string trim [MenuFromList $text $cmds]] if {[regexp -- [PreviousWord ${start} ${line}] -load] \ && ![llength ${mod}]} { return } if {![llength [join ${res}]]} { @@ -1771,34 +1813,35 @@ return "" } proc complete(puts) {text start end line pos mod} { if {1 == $pos} { - return [FmtFindInListSpecial ${mod} "-nonewline [OutChannelId ${mod}]"] + return [MenuFromList ${mod} "-nonewline [OutChannelId ${mod}]"] } elseif {2 <= $pos} { if {![llength ${mod}]} { set opt [lindex ${line} 1] - if {[llength [FmtFindInListSpecial ${opt} {-nonewline}]]} { + if {[llength [MenuFromList ${opt} {-nonewline}]]} { incr pos -1 } if {1 == $pos} { return [OutChannelId ${mod}] } elseif {2 == $pos} { + return [Menu ] return } } } return "" } proc complete(read) {text start end line pos mod} { if {1 == $pos} { - return [FmtFindInListSpecial ${mod} "-nonewline [InChannelId ${mod}]"] + return [MenuFromList ${mod} "-nonewline [InChannelId ${mod}]"] } elseif {2 == $pos} { if {![llength ${mod}]} { set opt [lindex ${line} 1] - if {[llength [FmtFindInListSpecial ${opt} {-nonewline}]]} { + if {[llength [MenuFromList ${opt} {-nonewline}]]} { return [InChannelId ${mod}] } elseif {![llength ${mod}]} { return } } @@ -1811,11 +1854,11 @@ if {[llength ${prev}] && ("-" == [string index ${prev} 0] || 1 == $pos)} { set cmds [RemoveUsedOptions ${line} { -nocase -indices -expanded -line -linestop -lineanchor -about --} {--}] if {[llength ${cmds}]} { - return [string trim [FmtFindInListSpecial $text $cmds]] + return [string trim [MenuFromList $text $cmds]] } } else { set virtual_pos [expr ${pos} - [FirstNonOption ${line}]] switch -- ${virtual_pos} { 1 { if {![llength ${mod}]} { return } } @@ -1828,11 +1871,11 @@ 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 -- } {--}] - set res [string trim [FmtFindInListSpecial ${mod} ${cmds}]] + set res [string trim [MenuFromList ${mod} ${cmds}]] if {[llength ${res}]} { return ${res} } } else { set virtual_pos [expr ${pos} - [FirstNonOption ${line}]] @@ -1847,33 +1890,33 @@ } proc complete(rename) {text start end line pos mod} { if {1 == $pos} { set all [CommandCompletion ${mod}] - return [tclreadline::Format $all ${mod}] + return [Format $all ${mod}] } elseif {2 == $pos && ![llength ${mod}]} { return } return "" } proc complete(return) {text start end line pos mod} { # TODO this is not perfect yet set cmds {-code -errorinfo -errorcode } - set res [FmtFindInListSpecial [PreviousWord ${start} ${line}] ${cmds}] + set res [MenuFromList [PreviousWord ${start} ${line}] ${cmds}] if {1 == [llength ${res}]} { switch -- ${res} { -errorinfo { if {![llength ${mod}]} { return } } -code - -errorcode { set codes {ok error return break continue} - return [FmtFindInList ${mod} ${codes}] + return [AttemptFromList ${mod} ${codes}] } } } set cmds [RemoveUsedOptions ${line} ${cmds}] - set res [string trim [FmtFindInListSpecial ${mod} ${cmds}]] + set res [string trim [MenuFromList ${mod} ${cmds}]] if {[llength ${res}]} { return ${res} } return "" } @@ -1880,11 +1923,11 @@ 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 [AttemptFromList ${mod} {start current end}] } return "" } proc complete(set) {text start end line pos mod} { @@ -1913,11 +1956,11 @@ # if {2 == $pos && ![llength ${mod}]} { return } switch -- ${prev} { -myaddr { if {![llength ${mod}]} { return } } } - return [FmtFindInList ${mod} [concat {-error -sockname -peername}]] + return [AttemptFromList ${mod} [concat {-error -sockname -peername}]] } else { # client sockets # switch -- ${prev} { -myaddr { if {![llength ${mod}]} { return } } @@ -1942,11 +1985,11 @@ } set cmds {-myaddr -myport -async -myaddr -error -sockname -peername} if {$pos <= 1} { lappend cmds -server } - return [FmtFindInList ${mod} [concat ${cmds} ${hosts}]] + return [AttemptFromList ${mod} [concat ${cmds} ${hosts}]] } return "" } proc complete(string) {text start end line pos mod} { @@ -1953,11 +1996,11 @@ 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}] + return [AttemptFromList ${mod} ${cmds}] } elseif {2 == $pos} { switch -- $cmd { compare - first - last { if {![llength ${mod}]} { return } } @@ -2004,18 +2047,18 @@ } proc complete(subst) {text start end line pos mod} { set opts {-nobackslashes -nocommands -novariables} set opts [RemoveUsedOptions ${line} ${opts}] - return [FmtFindInList ${mod} [concat ${opts} ]] + return [AttemptFromList ${mod} [concat ${opts} ]] 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} ]] + return [AttemptFromList ${mod} [concat ${opts} ]] return "" } proc complete(tell) {text start end line pos mod} { if {1 == $pos} { @@ -2025,15 +2068,15 @@ } proc complete(trace) {text start end line pos mod} { set cmd [lindex ${line} 1] if {1 == $pos} { - return [FmtFindInList ${mod} {variable vdelete vinfo}] + return [AttemptFromList ${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 [AttemptFromList ${mod} {r w u}] } return "" } proc complete(update) {text start end line pos mod} { @@ -2159,11 +2202,11 @@ } if {1 >= ${pos}} { set cmds [TrySubCmds ${widget}] if {[llength ${cmds}]} { - return [FmtFindInList ${mod} ${cmds}] + return [AttemptFromList ${mod} ${cmds}] } } elseif {2 <= ${pos} && ([string match ${cmd}* cget] || \ [string match ${cmd}* configure])} { set prev [PreviousWord ${start} ${line}] @@ -2173,11 +2216,11 @@ if {-1 != [set found [lsearch -exact $options(switches) ${prev}]]} { if {![llength ${mod}]} { return [lindex $options(value) ${found}] } } else { - return [FmtFindInList ${mod} $options(switches)] + return [AttemptFromList ${mod} $options(switches)] } } return "" } @@ -2184,15 +2227,14 @@ 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}] + return [AttemptFromList ${mod} ${cmds}] } } elseif {2 == ${pos}} { - return [FmtFindInList ${mod} [WidgetList ${mod}]] + return [AttemptFromList ${mod} [WidgetList ${mod}]] } return "" } - }; # namespace tclreadline