Index: Makefile.in ================================================================== --- Makefile.in +++ Makefile.in @@ -1,8 +1,8 @@ # -*- make -*- -# FILE: "/krispc6/diska/home/joze/src/tclreadline/Makefile.in" -# LAST MODIFICATION: "Wed Aug 25 17:03:17 1999 (joze)" +# FILE: "/home/joze/src/tclreadline/Makefile.in" +# LAST MODIFICATION: "Sun Aug 29 08:23:45 1999 (joze)" # (C) 1998, 1999 by Johannes Zellner, # $Id$ # --- # # tclreadline -- gnu readline for tcl @@ -254,12 +254,12 @@ ctags: ctags -R -tcltags: ctags $(TCLFILES) - tcltags -a $(TCLFILES) +tcltags: ctags tclreadlineInit.tcl.in tclreadlineSetup.tcl.in + tcltags -a tclreadlineInit.tcl.in tclreadlineSetup.tcl.in vimtags: tcltags vimtags tags: vimtags Index: README ================================================================== --- README +++ README @@ -1,8 +1,8 @@ FILE: "/home/joze/src/tclreadline/README" - LAST MODIFICATION: "Sat Aug 28 23:30:56 1999 (joze)" + LAST MODIFICATION: "Sun Aug 29 01:00:01 1999 (joze)" (C) 1998, 1999 by Johannes Zellner, $Id$ --- tclreadline -- gnu readline for tcl @@ -88,10 +88,14 @@ is no truncation occurs. fixes: - after having at least one character typed, X events were not processed any more until pressing . + - catching `tclreadline::readline read' errors + in tclreadline::Loop. This was necessary, because + the evaluation of the script completer can return + an error. tclreadline-0.9.1: (Aug 1999) changes: Index: configure.in ================================================================== --- configure.in +++ configure.in @@ -1,8 +1,8 @@ # -*- autoconf -*- # FILE: "/home/joze/src/tclreadline/configure.in" -# LAST MODIFICATION: "Sat Aug 28 22:23:57 1999 (joze)" +# LAST MODIFICATION: "Sun Aug 29 08:08:34 1999 (joze)" # (C) 1998, 1999 by Johannes Zellner, # $Id$ # --- # # tclreadline -- gnu readline for tcl @@ -37,10 +37,11 @@ TCLREADLINE_MAJOR_VERSION=0 TCLREADLINE_MINOR_VERSION=9 TCLREADLINE_PATCHLEVEL=2 TCLREADLINE_VERSION=$TCLREADLINE_MAJOR_VERSION.$TCLREADLINE_MINOR_VERSION +TCLREADLINE_PATCHLEVEL_STR=${TCLREADLINE_VERSION}.${TCLREADLINE_PATCHLEVEL} VERSION=$TCLREADLINE_VERSION AC_PREREQ(2.13) AC_CONFIG_AUX_DIR(./aux) @@ -416,10 +417,13 @@ AC_SUBST(TCLREADLINE_MAJOR_VERSION) AC_SUBST(TCLREADLINE_MINOR_VERSION) AC_SUBST(TCLREADLINE_VERSION) AC_SUBST(TCLREADLINE_PATCHLEVEL) +AC_SUBST(TCLREADLINE_LIBRARY) +AC_SUBST(TCLREADLINE_PATCHLEVEL_STR) + AC_SUBST(TCL_LIB_DIR) AC_SUBST(TCL_INCLUDE_DIR) AC_SUBST(READLINE_INCLUDE_DIR) @@ -445,11 +449,10 @@ AC_SUBST(TCLREADLINE_LIB_DIR) AC_SUBST(TCLREADLINE_PKG_FILE) AC_SUBST(TCLREADLINE_PACKAGE_PATH) -AC_SUBST(TCLREADLINE_LIBRARY) AC_OUTPUT(Makefile tclreadline.h tclreadlineInit.tcl tclreadlineSetup.tcl tclreadlineConfig.sh tclreadline.n pkgIndex.tcl) Index: tclreadline.c ================================================================== --- tclreadline.c +++ tclreadline.c @@ -1,10 +1,10 @@ /* ================================================================== FILE: "/home/joze/src/tclreadline/tclreadline.c" - LAST MODIFICATION: "Sat Aug 28 23:56:10 1999 (joze)" + LAST MODIFICATION: "Sun Aug 29 15:04:07 1999 (joze)" (C) 1998, 1999 by Johannes Zellner, $Id$ --- tclreadline -- gnu readline for tcl @@ -26,20 +26,19 @@ , http://www.zellner.org/tclreadline/ ================================================================== */ - #include #include #include #include #define READLINE_LIBRARY #include #include -#include +#include "tclreadline.h" #define MALLOC(size) Tcl_Alloc((int) size) #define FREE(ptr) if (ptr) { Tcl_Free((char*) ptr); ptr = 0; } enum { @@ -68,10 +67,12 @@ int argc, char** argv); void TclReadlineDataAvailableHandler(ClientData clientData, int mask); void TclReadlineLineCompleteHandler(char* ptr); int Tclreadline_SafeInit(Tcl_Interp* interp); int Tclreadline_Init(Tcl_Interp* interp); +char *TclReadlineFilenameQuotingFunction( + char *text, int match_type, char* quote_ptr); int TclReadlineInitialize(Tcl_Interp* interp, char* historyfile); int blank_line(char* str); char** TclReadlineCompletion(char* text, int start, int end); char* TclReadline0generator(char* text, int state); char* TclReadlineKnownCommands(char* text, int state, int mode); @@ -173,20 +174,29 @@ TclReadlineLineCompleteHandler); Tcl_CreateFileHandler(0, TCL_READABLE, TclReadlineDataAvailableHandler, (ClientData) NULL); + /** + * Main Loop. + * XXX each modification of the global variables + * which terminates the main loop must call + * rl_callback_handler_remove() to leave + * readline in a defined state. XXX + */ while (LINE_PENDING == tclrl_line_complete && TCL_OK == tclrl_state && !rl_done) { Tcl_DoOneEvent(0); /* rl_inhibit_completion = 0; */ } - Tcl_DeleteFileHandler(0); + if (TCL_OK != tclrl_state) + return tclrl_state; /* !! */ + if ((LINE_EOF == tclrl_line_complete) && tclrl_eof_string) { Tcl_Eval(interp, tclrl_eof_string); return tclrl_state; } @@ -203,11 +213,11 @@ #endif } else if (status == -1) { Tcl_AppendResult (interp, "error in history expansion\n", (char*) NULL); - return TCL_ERROR; + return tclrl_state; } /** * TODO: status == 2 ... */ @@ -322,11 +332,11 @@ tclrl_line = ptr; } #else if (ptr && *ptr) { tclrl_line_complete = 1; - rl_callback_handler_remove (); + rl_callback_handler_remove(); tclrl_line = ptr; } #endif } @@ -341,31 +351,89 @@ { int status; Tcl_CreateCommand(interp, "::tclreadline::readline", TclReadlineCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); tclrl_interp = interp; - status = Tcl_LinkVar - (interp, "::tclreadline::historyLength", - (char*) &tclrl_history_length, TCL_LINK_INT); - if (TCL_OK != status) + if (TCL_OK != (status = Tcl_LinkVar(interp, "::tclreadline::historyLength", + (char*) &tclrl_history_length, TCL_LINK_INT))) + return status; + if (TCL_OK != (status = Tcl_LinkVar(interp, "::tclreadline::library", + (char*) &TCLRL_LIBRARY, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) + return status; + if (TCL_OK != (status = Tcl_LinkVar(interp, "::tclreadline::version", + (char*) &TCLRL_VERSION, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) + return status; + if (TCL_OK != (status = Tcl_LinkVar(interp, "::tclreadline::patchLevel", + (char*) &TCLRL_PATCHLEVEL, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) + return status; + if (TCL_OK != (status = Tcl_LinkVar(interp, "tclreadline_library", + (char*) &TCLRL_LIBRARY, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) + return status; + if (TCL_OK != (status = Tcl_LinkVar(interp, "tclreadline_version", + (char*) &TCLRL_VERSION, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) + return status; + if (TCL_OK != (status = Tcl_LinkVar(interp, "tclreadline_patchLevel", + (char*) &TCLRL_PATCHLEVEL, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) return status; - return Tcl_PkgProvide(interp, "tclreadline", TCLREADLINE_VERSION); + return Tcl_PkgProvide(interp, "tclreadline", TCLRL_VERSION); +} + +#if 0 +char * +TclReadlineFilenameQuotingFunction +(char *filename, int match_type, char* quote_ptr) +{ + char *res = (char*) malloc(sizeof(char) * (strlen(filename) + 2)); + int i = 0; + fprintf (stderr, "(TclReadlineFilenameQuotingFunction) \n"); + if (quote_ptr && *quote_ptr) { + *res = *quote_ptr; /* leading quote */ + i++; + } + strcpy (res + i, filename); /* name */ +#if 0 + fprintf (stderr, "(Tclreadline_Init) filename=|%s|\n", filename); + fprintf (stderr, "(Tclreadline_Init) *quote_ptr=|%c|\n", *quote_ptr); +#endif + if (quote_ptr && '{' == *quote_ptr) { + *quote_ptr = '}'; + } + return res; + +#if 0 + switch (match_type) { + case SINGLE_MATCH: + break; + default: + } +#endif } +#endif int TclReadlineInitialize(Tcl_Interp* interp, char* historyfile) { rl_readline_name = "tclreadline"; - /* rl_special_prefixes = "${\""; */ - rl_special_prefixes = "${"; + rl_special_prefixes = "${\""; /** * default is " \t\n\"\\'`@$><=;|&{(" - * removed "{(" - * added "[]}" + * removed "(" <-- arrays + * removed "{" <-- `${' variables + * added "[]" */ - rl_basic_word_break_characters = " \t\n\"\\'`@$><=;|&[]}"; - /* rl_completer_quote_characters = "\""; */ + rl_basic_word_break_characters = " \t\n\"\\'`@$><=;|&[]"; + rl_completer_quote_characters = "\""; + /* + rl_filename_quote_characters + = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"; + + rl_filename_quoting_function + = (CPFunction*) TclReadlineFilenameQuotingFunction; + */ + /* + rl_filename_quoting_desired = 1; + */ using_history(); if (!tclrl_eof_string) tclrl_eof_string = strdup("puts {}; exit"); @@ -468,15 +536,16 @@ " \"", quoted_text, "\" ", start_s, " ", end_s, " \"", quoted_rl_line_buffer, "\"", (char*) NULL); FREE(quoted_text); FREE(quoted_rl_line_buffer); if (TCL_OK != tclrl_state) { - fprintf(stderr, "%s\n", Tcl_GetStringResult(tclrl_interp)); + rl_callback_handler_remove(); + Tcl_AppendResult (tclrl_interp, " `", tclrl_custom_completer, + " \"", quoted_text, "\" ", start_s, " ", end_s, + " \"", quoted_rl_line_buffer, "\"' failed.", (char*) NULL); #if 0 - Tcl_AppendResult (tclrl_interp, "`", tclrl_custom_completer, - " {", text, "} ", start_s, " ", end_s, - " {", rl_line_buffer, "}' failed.", (char*) NULL); + fprintf(stderr, "\n|%s|\n", Tcl_GetStringResult(tclrl_interp)); #endif return matches; } obj = Tcl_GetObjResult(tclrl_interp); Tcl_ListObjGetElements(tclrl_interp, obj, &objc, &objv); Index: tclreadline.h.in ================================================================== --- tclreadline.h.in +++ tclreadline.h.in @@ -1,12 +1,13 @@ /* ================================================================== - FILE: "/diska/home/joze/src/tclreadline/tclreadline.h.in" - LAST MODIFICATION: "Wed Aug 25 16:25:25 1999 (joze)" + FILE: "/home/joze/src/tclreadline/tclreadline.h.in" + LAST MODIFICATION: "Sun Aug 29 08:07:04 1999 (joze)" (C) 1998, 1999 by Johannes Zellner, $Id$ + vim:set ft=c: --- tclreadline -- gnu readline for tcl Copyright (C) 1999 Johannes Zellner @@ -27,14 +28,14 @@ johannes@zellner.org http://www.zellner.org/tclreadline/ ================================================================== */ -static char *TCLREADLINE_VERSION = "@TCLREADLINE_VERSION@"; +static char *TCLRL_VERSION = "@TCLREADLINE_VERSION@"; + +static char *TCLRL_LIBRARY = "@TCLREADLINE_LIBRARY@"; /** * NOTE, that PATCHLEVEL is the complete version string. - * (PATCHLEVEL is not really used here). */ -static char *TCLREADLINE_PATCHLEVEL - = "@TCLREADLINE_VERSION@.@TCLREADLINE_PATCHLEVEL@"; +static char *TCLRL_PATCHLEVEL = "@TCLREADLINE_PATCHLEVEL_STR@"; Index: tclreadline.n.in ================================================================== --- tclreadline.n.in +++ tclreadline.n.in @@ -1,10 +1,10 @@ .TH tclreadline n "@TCLREADLINE_VERSION@.@TCLREADLINE_PATCHLEVEL@" "Johannes Zellner" .\" (C) 1999 by Johannes Zellner .\" FILE: "/home/joze/src/tclreadline/tclreadline.n.in" -.\" LAST MODIFICATION: "Sat Aug 28 23:38:44 1999 (joze)" +.\" LAST MODIFICATION: "Sun Aug 29 01:14:06 1999 (joze)" .\" (C) 1998, 1999 by Johannes Zellner, .\" $Id$ .\" --- .\" .\" tclreadline -- gnu readline for the tcl scripting language @@ -167,10 +167,12 @@ .TP 5 \fB::tclreadline::readline read\fP \fIprompt\fP prints the \fIprompt\fP to stdout and enters the tclreadline event loop. Both readline and X events are processed. Returns the (eventually history-expanded) input string. +\fBtclreadline::readline read\fP rises an error, if an +error occurs while evaluating a script completer. .TP 5 \fB::tclreadline::readline write\fP \fIhistoryfile\fP writes the history to the \fIhistoryfile\fP. This command is called automatically from the internal routine ::tclreadline::Exit. Index: tclreadlineInit.tcl.in ================================================================== --- tclreadlineInit.tcl.in +++ tclreadlineInit.tcl.in @@ -1,8 +1,8 @@ #!/usr/local/bin/tclsh # FILE: "/home/joze/src/tclreadline/tclreadlineInit.tcl.in" -# LAST MODIFICATION: "Sun Aug 29 00:03:22 1999 (joze)" +# LAST MODIFICATION: "Sun Aug 29 08:11:24 1999 (joze)" # (C) 1998, 1999 by Johannes Zellner, # $Id$ # --- # # tclreadline -- gnu readline for tcl @@ -33,27 +33,10 @@ namespace export Init } proc ::tclreadline::Init {} { - global tclreadline_version - global tclreadline_library - global tclreadline_patchLevel - - variable version - variable library - variable patchLevel - - set tclreadline_version @TCLREADLINE_VERSION@ - set version @TCLREADLINE_VERSION@ - set tclreadline_library @TCLREADLINE_LIBRARY@ - set library @TCLREADLINE_LIBRARY@ - # NOTE, that tclreadline_patchLevel is the complete patchlevel string. - # - set tclreadline_patchLevel @TCLREADLINE_VERSION@.@TCLREADLINE_PATCHLEVEL@ - set patchLevel @TCLREADLINE_VERSION@.@TCLREADLINE_PATCHLEVEL@ - if [catch {load @TCLREADLINE_LIBRARY@/@TCLREADLINE_LIB_FILE@} msg] { puts stderr $msg exit 2 } } Index: tclreadlineSetup.tcl.in ================================================================== --- tclreadlineSetup.tcl.in +++ tclreadlineSetup.tcl.in @@ -1,8 +1,8 @@ #!/usr/local/bin/tclsh # FILE: "/home/joze/src/tclreadline/tclreadlineSetup.tcl.in" -# LAST MODIFICATION: "Sat Aug 28 23:58:03 1999 (joze)" +# LAST MODIFICATION: "Sun Aug 29 16:28:35 1999 (joze)" # (C) 1998, 1999 by Johannes Zellner, # $Id$ # --- # # tclreadline -- gnu readline for tcl @@ -25,11 +25,68 @@ # johannes@zellner.org # http://www.zellner.org/tclreadline/ # # ================================================================== -package provide tclreadline @TCLREADLINE_VERSION@ +# done: +# +# - append +# - array +# - bgerror +# - binary +# - break +# - catch +# - cd +# - clock +# - close +# - concat +# - continue +# - (ddd is only on M$) +# - encoding +# - eof +# - error +# - eval +# - exec +# - exit +# - expr +# - fblocked +# - fconfigure +# - fcopy +# - file +# - fileevent +# - flush +# - for # TODO +# - foreach # TODO +# - format # TODO +# - gets +# - glob +# - global +# - if # TODO +# - incr +# - index +# - info +# - interp +# - join +# - lappend +# - llength +# - linsert +# - list +# - load +# - lrange +# - lreplace +# - lsearch +# - lsort +# - history +# - load +# - namespace +# - set +# - unset +# + + +# package provide tclreadline @TCLREADLINE_VERSION@ +package provide tclreadline 0.9 proc unknown args { global auto_noexec auto_noload env unknown_pending tcl_interactive global errorCode errorInfo @@ -135,10 +192,26 @@ } namespace eval tclreadline:: { namespace export Setup Glob Loop InitCmds InitTclCmds InitTkCmds Print ls } + +proc tclreadline::FmtFindInList {text lst} { + return \ + [tclreadline::Format [tclreadline::FindInList $text $lst] $text] +} + +proc tclreadline::FindInList {text lst} { + set result "" + foreach word $lst { + if {[string match ${text}* ${word}]} { + lappend result ${word} + } + } + return $result +} + # get the longest common completion # e.g. str == {tcl_version tclreadline_version tclreadline_library} # --> [tclreadline::GetCommon ${str}] == "tcl" # @@ -182,10 +255,68 @@ } } } 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} {stdin}] +} + +proc tclreadline::OutChannelId {text} { + return [ChannelId ${text} {stdout stderr}] +} + +proc tclreadline::ChannelId { + text {default } {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 # % bla put $b # % put $b # part == put @@ -193,20 +324,172 @@ # 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] - regsub -all -- \" $line {\"} line + set line [QuoteQuotes $line] # puts stderr "(tclreadline::PartPosition) line=|$line|" set result [llength $line] # puts stderr $result return $result } + +proc tclreadline::Right {left} { + if {"\"" == $left} { + return "" + } elseif {"\{" == $left} { + return "\}" + } elseif {"\\\{" == $left} { + return "\\\}" + } + return "" +} + +proc tclreadline::GetPrefix {text} { + set null [string index $text 0] + # puts null=|$null| + if {"\"" == $null} { + # puts stderr \neins\n + set pre "\\\"" + } elseif {"\{" == $null} { + # puts stderr \nzwei\n + set pre "\\\{" + } else { + # puts stderr \ndrei\n + set pre "" + } + return ${pre} +} + +proc tclreadline::Format {matches {part {}}} { + # puts matches=|$matches| + # puts stderr \npart=|$part|\n + set pre [GetPrefix ${part}] + if {1 == [llength $matches]} { ; # unique match + # puts stderr \nunique=$matches\n + # puts stderr "\n|${pre}${matches}[Right ${pre}]|\n" + return ${pre}${matches}[Right ${pre}] + } elseif {"" != ${matches}} { + # puts stderr \nmore=$matches\n + set common [tclreadline::GetCommon ${matches}] + # puts stderr common=|$common| + if {"" == $common} { + return [string trim "[list $part] ${matches}"] + } else { + return [string trim "${pre}${common} ${matches}"] + } + } else { + return ""; # nothing to complete + } +} + +proc tclreadline::ListCompletion {text {level -1}} { + # TODO + return "" + # return [VarCompletion ${text} ${level}] +} + +proc tclreadline::VarCompletion {text {level -1}} { + if {-1 == ${level}} { + set level [info level] + } else { + incr level + } + set pre [GetPrefix ${text}] + + if {"" == ${pre}} { + set var ${text} + } else { + set var [string range ${text} 1 end] + } + + # arrays + # + if {[regexp {([^(]*)\((.*)} ${var} all array name]} { + set names [uplevel ${level} array names ${array} ${name}*] + if {1 == [llength $names]} { ; # unique match + return "${array}(${names})" + } elseif {"" != ${names}} { + return "${array}([tclreadline::GetCommon ${names}] ${names}" + } else { + return ""; # nothing to complete + } + } + + # non-arrays + # + regsub ":$" ${var} "::" var + set namespaces [namespace children :: ${var}*] + if {[llength ${namespaces}] && "::" != [string range ${var} 0 1]} { + foreach name ${namespaces} { + regsub "^::" ${name} "" name + if {[string length ${name}]} { + lappend new ${name}:: + } + } + set namespaces ${new} + unset new + } + set matches \ + [string trim "[uplevel ${level} info vars ${var}*] ${namespaces}"] + if {1 == [llength $matches]} { ; # unique match + # check if this unique match is an + # array name, (whith no "(" yet). + # + if {[uplevel ${level} array exists $matches]} { + return [VarCompletion ${matches}( ${level}]; # recursion + } else { + return ${pre}${matches}[Right ${pre}] + } + } elseif {"" != $matches} { ; # more than one match + set common [tclreadline::GetCommon ${matches}] + if {"" == ${common}} { + return [tclreadline::Format ${matches} ${text}] + } else { + return [string trim "${pre}${common} ${matches}"] + } + } else { + return ""; # nothing to complete + } +} + +proc tclreadline::CommandCompletion {cmd} { + # puts stderr \ncmd=|$cmd|\n + set cmd [string trim ${cmd}]* + set commands [info commands [QuoteQuotes ${cmd}]] + # puts stderr commands=|$commands| + set procs [info procs [QuoteQuotes ${cmd}]] + # puts stderr procs=|$procs| + set matches [namespace eval :: concat ${commands} ${procs}] + set namespaces [namespace children :: ${cmd}] + if {![llength ${matches}] && 1 == [llength ${namespaces}]} { + set namespaces [string trim ${namespaces}] + set matches [namespace eval ${namespaces} \ + {concat [info commands] [info procs]}] + if {[llength ${matches}]} { + foreach match ${matches} { + set full ${namespaces}::${match} + if {"" != [namespace which ${full}]} { + lappend new ${namespaces}::${match} + } + } + set matches ${new} + unset new + set namespaces "" + } + } + return [string trim "${matches} ${namespaces}"] +} # if the line entered so far is # % puts $b # part == $b # start == 5 @@ -226,47 +509,32 @@ } # variable completion. Check first, if the # variable starts with a plain `$' or should # be enclosed in braces. # - if {"\{" == [string index $part 1]} { - set var [string range $part 2 end] - set left "\$\{" - set right "\}" - } else { - set left "\$" - set right "" - set var [string range $part 1 end] - } + 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 {[regexp {([^(]*)\((.*)} $var all array name]} { - set matches [uplevel array names ${array} ${name}*] - if {1 == [llength $matches]} { ; # unique match - return "\$${array}(${matches})" - } elseif {"" != ${matches}} { - return \ - "\$${array}([tclreadline::GetCommon ${matches}] ${matches}" - } else { - return ""; # nothing to complete - } - } - set matches [uplevel info vars "${var}*"] - if {1 == [llength $matches]} { ; # unique match - # check if this unique match is an - # array name, (whith no "(" yet). - # - if {[uplevel array exists $matches]} { - return "\$${matches}( [uplevel array names $matches]" - } else { - return [join [list $left $matches $right] ""] - } - } elseif {"" != $matches} { ; # more than one matches - return "${left}[tclreadline::GetCommon ${matches}] ${matches}" - } else { - return ""; # nothing to complete + 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 $b # part == put @@ -287,31 +555,30 @@ 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 cmd "[string trim ${part}]*" - set matches [string trim "[info commands $cmd] [info proc $cmd]"] - # puts matches=|$matches| - if {1 == [llength $matches]} { ; # unique match - return $matches - } elseif {"" != $matches} { - set common [tclreadline::GetCommon ${matches}] - # puts stderr common=|$common| - if {"" == $common} { - return "[list $part] ${matches}" - } else { - return "$common ${matches}" - } - } else { - return ""; # nothing to complete - } + set all [CommandCompletion ${part}] + #puts \nmatches=$matches\n + return [tclreadline::Format $all $part] } else { # try to use $pos further ... - regsub -all -- \" $line {\"} thisline + # regsub -all -- \" $line {\"} thisline + set thisline [QuoteQuotes $line] set cmd [lindex $thisline 0] - if {"" != [array names known_cmds $cmd]} { + if {"" != [namespace eval ::tclreadline "info procs complete($cmd)"]} { + # to be more error-proof, we could check here, + # if complete($cmd) takes exactly 5 arguments. + if {"\"" == [string index $part 0] \ + || "\{" == [string index $part 0]} { + set mod [string range $part 1 end] + } else { + set mod $part + } + return \ + [::tclreadline::complete($cmd) $part $start $end $line $pos $mod] + } elseif {"" != [array names known_cmds $cmd]} { set current [lindex $known_cmds($cmd) $pos] if {"" != $current && "" == [string trim $part]} { return $current } else { return "" @@ -461,10 +728,11 @@ 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 %] @@ -473,10 +741,14 @@ 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 proposed history add $::tclreadline::LINE if [catch { @@ -521,40 +793,49 @@ 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?" - "clock option ?arg ...?" - "close channelId" - "eof channelId" + "cd" + "clock" + "close " + "concat" + "continue" + "encoding" + "eof " "error message ?errorInfo? ?errorCode?" "eval arg ?arg ...?" "exec ?switches? arg ?arg ...?" + "exit ?returnCode?" "expr arg ?arg ...?" - "fblocked channelId" - "fconfigure channelId ?optionName? ?value? ?optionName value?..." + "fblocked " + "fconfigure ?optionName? ?value? ?optionName value?..." "fcopy input output ?-size size? ?-command callback?" - "file option ?arg ...?" + "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 ?switches? name ?name ...?" + "glob" "global varName ?varName ...?" + "history option" "incr varName ?increment?" "info option ?arg arg ...?" "interp cmd ?arg ...?" "join list ?joinString?" "lappend varName ?value value ...?" "lindex list index" - "linsert list index element ?element ...?" + "linsert list ?element ...?" + "list" "llength list" - "load fileName ?packageName? ?interp?" + "load" "lrange list first last" "lreplace list first last ?element element ...?" "lsearch ?mode? list pattern" "lsort ?options? list" "namespace subcommand ?arg ...?" @@ -632,5 +913,672 @@ set known_cmds([lindex $line 0]) [lrange $line 1 end] } rename tclreadline::InitTkCmds "" } + +namespace eval tclreadline { + +# explicit command completers +# + +# --- +# TCL +# --- + +proc complete(append) {text start end line pos mod} { + if {1 == $pos} { + return [VarCompletion ${text}] + } + return "" +} + +proc complete(if) {text start end line pos mod} { + # TODO: this is not good yet. + if {2 == $pos} { + return [FmtFindInList $text {then}] + } elseif {$pos > 2} { + set prev [PreviousWord ${start} ${line}] + switch $prev { + then - + else - + elseif { return "" } + } + return [FmtFindInList $text {then else elseif}] + } +} + +proc complete(incr) {text start end line pos mod} { + if {1 == $pos} { + set matches [uplevel 2 info vars "${mod}*"] + set final "" + # check for integers + # + foreach match $matches { + if {[uplevel 2 array exists $match]} { + continue + } + if {[regexp {^[0-9]+$} [uplevel 2 set $match]]} { + lappend final $match + } + } + return [Format ${final} $text] + } +} + +proc complete(array) {text start end line pos mod} { + if {1 == $pos} { + set cmds { + anymore donesearch exists get names + nextelement set size startsearch + } + return [FmtFindInList $text $cmds] + } elseif {2 == $pos} { + set cmd [lindex $line 1] + switch -- $cmd { + anymore - + donesearch - + exists - + get - + names - + nextelement - + set - + size - + startsearch { + set matches "" + set vars [uplevel [info level] info vars ${mod}*] + foreach var ${vars} { + if {[uplevel [info level] array exists ${var}]} { + lappend matches ${var} + } + } + return [Format ${matches} ${text}] + } + } + } elseif {3 == $pos} { + set cmd [lindex $line 1] + switch -- $cmd { + get - + names { + if {[catch { + set names [uplevel [info level] \ + array names [lindex $line 2] [lindex $line 3]*]}]} { + return "" + } else { + set common [GetCommon ${names}] + if {"" == ${common}} { + return [Format ${names} ${text}] + } else { + return [string trim "${common} ${names}"] + } + } + } + } + } + return "" +} + +proc complete(binary) {text start end line pos mod} { + if {1 == $pos} { + set cmds { + format scan + } + return [FmtFindInList $text $cmds] +# +# } elseif {2 == $pos} { +# set cmd [lindex $line 1] +# switch -- $cmd { +# format - +# scan - +# } +# + } + return "" +} + +proc complete(clock) {text start end line pos mod} { + if {1 == $pos} { + set cmds {clicks format scan seconds} + return [FmtFindInList $text $cmds] + } elseif {2 == $pos} { + set cmd [lindex $line 1] + switch -- $cmd { + clicks {} + format { + if {"" == [lindex $line 2]} { + return + } + } + scan { + if {"" == [lindex $line 2]} { + return + } + } + 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 + } + } + -encoding { + set enc [encoding names] + return [FmtFindInList ${text} ${enc}] + } + -eofchar { + if {![llength ${text}]} { + return [list {{ }}] + } + } + -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 } + } + -command { + if {![llength ${mod}]} { return } + } + } + 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 + } + return "" +} + +proc complete(info) {text start end line pos mod} { + if {1 == $pos} { + set cmds { + args body cmdcount commands complete default exists + globals hostname level library loaded locals nameofexecutable + patchlevel procs script sharedlibextension tclversion vars} + return [FmtFindInList $text $cmds] + } elseif {2 == $pos} { + set cmd [lindex $line 1] + switch -- $cmd { + args - + body - + default - + procs { + set matches [uplevel 2 info procs ${mod}*] + return [Format $matches $text] + } + complete { ; # TODO + } + level { ; # TODO + } + loaded { ;# TODO + } + commands - + exists - + globals - + locals - + vars { + if {"exists" == $cmd} { + set do vars + } else { + set do $cmd + } + return \ + [Format [uplevel 2 info ${do} "${mod}*"] $text] + } + } + } + return "" +} + +proc complete(interp) {text start end line pos mod} { + set cmd [lindex $line 1] + if {1 == $pos} { + set cmds { + alias aliases create delete eval exists expose hide hidden + issafe invokehidden marktrusted slaves share target transfer} + return [FmtFindInList $text $cmds] + } elseif {2 == $pos} { + switch -- $cmd { + create { + return [FmtFindInList $text {-safe -- ?path?}] + } + + eval - + exists - + expose - + hide - + hidden - + invokehidden - + marktrusted - + target {if {![llength ${mod}]} { return }} + + aliases - + delete - + issafe - + slaves {if {![llength ${mod}]} { return ?path? }} + + alias - + share - + transfer {if {![llength ${mod}]} { return }} + } + } elseif {3 == $pos} { + switch -- $cmd { + + alias {if {![llength ${mod}]} { return }} + + create { + return [FmtFindInList $text {-safe -- ?path?}] + } + + eval {if {![llength ${mod}]} { return }} + delete {if {![llength ${mod}]} { return ?path? }} + + expose {if {![llength ${mod}]} { return }} + hide {if {![llength ${mod}]} { return }} + + invokehidden { + return \ + [FmtFindInList $text {?-global? }} + + exists {} + hidden {} + marktrusted {} + aliases {} + issafe {} + slaves {} + + share - + tranfer {return [ChannelId ${mod}]} + } + } elseif {4 == $pos} { + switch -- $cmd { + + alias {if {![llength ${mod}]} { return }} + + 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 "" + } elseif {3 == $pos && ![llength ${mod}]} { + return "" + } + return "" +} + +proc complete(lrange) {text start end line pos mod} { + if {1 == $pos} { + return [ListCompletion ${text}] + } elseif {2 == $pos && ![llength ${mod}]} { + return "" + } elseif {3 == $pos && ![llength ${mod}]} { + return "" + } + return "" +} + +proc complete(lreplace) {text start end line pos mod} { + if {1 == $pos} { + return [ListCompletion ${text}] + } elseif {2 == $pos && ![llength ${mod}]} { + return "" + } elseif {3 == $pos && ![llength ${mod}]} { + return "" + } elseif {![llength ${mod}]} { + return "?element?" + } + return "" +} + +proc complete(lsearch) {text start end line pos mod} { + set options [FmtFindInList $text {-exact -glob -regexp}] + if {![llength ${mod}]} { + # remove the common match `-' + set options [lrange ${options} 1 end] + } + set opt [lindex ${line} 1] + set option [FmtFindInList $opt {-exact -glob -regexp}] + if {1 == $pos} { + set matches [ListCompletion ${text}] + return [string trim "${matches} ${options}"] + } elseif {2 == $pos && ![llength ${mod}]} { + if {[llength ${option}]} { + return "" + } else { + return "" + } + } elseif {3 == $pos && ![llength ${mod}]} { + if {[llength ${option}]} { + return "" + } + } + return "" +} + +proc complete(lsort) {text start end line pos mod} { + set options [FmtFindInList $text { + -ascii -dictionary -integer -real -command + -increasing -decreasing -index + }] + if {![llength ${mod}]} { + # remove the common match `-' + set options [lrange ${options} 1 end] + } + set matches [ListCompletion ${text}] + return [string trim "${matches} ${options}"] +} + +proc complete(history) {text start end line pos mod} { + if {1 == $pos} { + set cmds {add change clear event info keep nextid redo} + return [FmtFindInList $text $cmds] + } elseif {2 == ${pos}} { + set cmd [lindex $line 1] + switch -- $cmd { + add { if {![llength ${mod}]} { return } } + change { if {![llength ${mod}]} { return } } + + info - + keep { if {![llength ${mod}]} { return ?count? } } + + event - + redo { if {![llength ${mod}]} { return ?event? } } + + clear - + nextid { return "" } + } + } +} + +proc complete(namespace) {text start end line pos mod} { + if {1 == $pos} { + set cmds { + children code current delete eval export forget + import inscope origin parent qualifiers tail which} + return [FmtFindInList $text $cmds] + } elseif {2 == $pos} { + set cmd [lindex $line 1] + # TODO dosn't work ??? + # puts stderr \nmod=|$mod|\n + # set matches [namespace children ::] + # puts stderr \nmatches=$matches\n + set space_matches [namespace children :: [string trim ${mod}]\*] + switch -- $cmd { + children - + delete - + eval - + inscope - + parent { + return [FmtFindInList $text $space_matches] + } + code { + return "" + } + current {} + export { + } + forget { + } + import { + } + origin { + } + qualifiers { + } + tail { + } + which { + } + } + # TODO + return "" + } + return "" +} + +proc complete(set) {text start end line pos mod} { + # puts stderr "\ntext=|$text| $start $end\n" + # puts stderr \nline=|$line|\n + # puts stderr \npos=|$pos|\n + # puts stderr \nmod=|$mod|\n + if {1 == $pos} { + return [VarCompletion ${text}] + } elseif {2 == $pos && ($text == "" || $text == "\"" || $text == "\{")} { + set line [QuoteQuotes $line] + if {[catch "set value [list [uplevel [info level] set [lindex $line 1]]]" msg]} { + return "" + } else { + return [Quote $value ${text}] + } + } + return "" +} + +proc complete(unset) {text start end line pos mod} { + return [VarCompletion ${text}] +} + +}; # namespace tclreadline