Index: tclreadline.c ================================================================== --- tclreadline.c +++ tclreadline.c @@ -1,10 +1,10 @@ /* ================================================================== - FILE: "/diska/home/joze/src/tclreadline/tclreadline.c" - LAST MODIFICATION: "Mon Sep 13 18:04:01 1999 (joze)" + FILE: "/home/joze/src/tclreadline/tclreadline.c" + LAST MODIFICATION: "Tue Sep 14 00:57:33 1999 (joze)" (C) 1998, 1999 by Johannes Zellner, $Id$ --- tclreadline -- gnu readline for tcl @@ -79,10 +79,12 @@ * forward declarations. */ char* stripleft(char* in); char* stripright(char* in); char* stripwhite(char* in); +int TclReadlineLineComplete(void); +void TclReadlineTerminate(int state); char* TclReadlineQuote(char* text, char* quotechars); int TclReadlineCmd(ClientData clientData, Tcl_Interp* interp, int argc, char** argv); void TclReadlineReadHandler(ClientData clientData, int mask); void TclReadlineLineCompleteHandler(char* ptr); @@ -94,23 +96,22 @@ char* TclReadline0generator(char* text, int state); char* TclReadlineKnownCommands(char* text, int state, int mode); int TclReadlineParse(char** args, int maxargs, char* buf); enum { - LINE_PENDING, - LINE_EOF, - LINE_COMPLETE + LINE_PENDING = -1, + LINE_EOF = (1 << 8), + LINE_COMPLETE = (1 << 9) }; /** * global variables */ -static int tclrl_line_complete = LINE_PENDING; static int tclrl_state = TCL_OK; static char* tclrl_eof_string = (char*) NULL; -static char* tclrl_line = (char*) NULL; static char* tclrl_custom_completer = (char*) NULL; +static char* tclrl_last_line = (char*) NULL; static int tclrl_use_builtin_completer = 1; static int tclrl_history_length = -1; Tcl_Interp* tclrl_interp = (Tcl_Interp*) NULL; @@ -139,10 +140,23 @@ { stripleft(in); stripright(in); return in; } + +int +TclReadlineLineComplete(void) +{ + return !(tclrl_state == LINE_PENDING); +} + +void +TclReadlineTerminate(int state) +{ + tclrl_state = state; + rl_callback_handler_remove(); +} char* TclReadlineQuote(char* text, char* quotechars) { char* ptr; @@ -164,155 +178,205 @@ return result_c; } int TclReadlineCmd( - ClientData clientData, /* Main window associated with interpreter */ - Tcl_Interp* interp, /* Current interpreter */ - int argc, /* Number of arguments */ - char** argv /* Argument strings */ -) -{ - int c, length; - - if (argc < 2) - goto BAD_COMMAND; - - c = argv[1][0]; - length = strlen(argv[1]); - - if (c == 'r' && strncmp(argv[1], "read", length) == 0) { - - char* expansion = (char*) NULL; - int status; - - tclrl_line_complete = LINE_PENDING; - tclrl_state = TCL_OK; - rl_callback_handler_install(argc == 3 ? argv[2] : "%", - TclReadlineLineCompleteHandler); - - Tcl_CreateFileHandler(0, TCL_READABLE, - TclReadlineReadHandler, (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(TCL_ALL_EVENTS); - } - - 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; - } - - status = history_expand(tclrl_line, &expansion); - if (status >= 1) { -#if 0 - Tcl_Channel channel = Tcl_MakeFileChannel(stdout, TCL_WRITABLE); - /* Tcl_RegisterChannel(interp, channel); */ - (void) Tcl_WriteChars(channel, expansion, -1); - Tcl_Flush(channel); - Tcl_Close(interp, channel); -#else - printf("%s\n", expansion); -#endif - } - else if (status == -1) { - Tcl_AppendResult - (interp, "error in history expansion\n", (char*) NULL); - return tclrl_state; - } - /** - * TODO: status == 2 ... - */ - - if (expansion && *expansion) - add_history(expansion); - - Tcl_SetResult(interp, expansion, TCL_VOLATILE); - - FREE(tclrl_line); - FREE(expansion); - return tclrl_state; - } else if (c == 'i' && strncmp(argv[1], "initialize", length) == 0) { - if (3 != argc) - goto BAD_COMMAND; - else - return TclReadlineInitialize(interp, argv[2]); - } else if (c == 'w' && strncmp(argv[1], "write", length) == 0) { - if (3 != argc) { - goto BAD_COMMAND; - } else if (write_history(argv[2])) { - Tcl_AppendResult(interp, "unable to write history to `", - argv[2], "'\n", (char*) NULL); - return TCL_ERROR; - } - if (tclrl_history_length >= 0) { - history_truncate_file(argv[2], tclrl_history_length); - } - return TCL_OK; - } else if (c == 'a' && strncmp(argv[1], "add", length) == 0) { - if (3 != argc) - goto BAD_COMMAND; - else if (TclReadlineKnownCommands(argv[2], (int) 0, _CMD_SET)) - Tcl_AppendResult(interp, "unable to add command \"", - argv[2], "\"\n", (char*) NULL); - } else if (c == 'c' && strncmp(argv[1], "complete", length) == 0) { - if (3 != argc) - goto BAD_COMMAND; - else if (Tcl_CommandComplete(argv[2])) - Tcl_AppendResult(interp, "1", (char*) NULL); - else - Tcl_AppendResult(interp, "0", (char*) NULL); - } else if (c == 'c' && strncmp(argv[1], "customcompleter", length) == 0) { - if (3 != argc && 2 != argc) - goto BAD_COMMAND; - if (3 == argc) { - if (tclrl_custom_completer) - FREE(tclrl_custom_completer); - if (!blank_line(argv[2])) - tclrl_custom_completer = stripwhite(strdup(argv[2])); - } - Tcl_AppendResult(interp, tclrl_custom_completer, (char*) NULL); - } else if (c == 'b' && strncmp(argv[1], "builtincompleter", length) == 0) { - int bool = tclrl_use_builtin_completer; - if (3 != argc && 2 != argc) - goto BAD_COMMAND; - if (3 == argc) { - if (TCL_OK != Tcl_GetBoolean(interp, argv[2], &bool)) { - Tcl_AppendResult(interp, - "wrong # args: should be a boolean value.", (char*) NULL); - return TCL_ERROR; - } else { - tclrl_use_builtin_completer = bool; - } - } - Tcl_AppendResult(interp, tclrl_use_builtin_completer ? "1" : "0", - (char*) NULL); - } else if (c == 'e' && strncmp(argv[1], "eofchar", length) == 0) { - if (3 != argc && 2 != argc) - goto BAD_COMMAND; - if (3 == argc) { - if (tclrl_eof_string) - FREE(tclrl_eof_string); - if (!blank_line(argv[2])) - tclrl_eof_string = stripwhite(strdup(argv[2])); - } - Tcl_AppendResult(interp, tclrl_eof_string, (char*) NULL); - } else { - goto BAD_COMMAND; + ClientData clientData, + Tcl_Interp* interp, /* Current interpreter */ + int argc, /* Number of arguments */ + char** argv /* Argument strings */ +) +{ + int i, obj_idx, status; + Tcl_Obj** objv = (Tcl_Obj**) MALLOC((argc + 1) * sizeof(Tcl_Obj *)); + + static char *subCmds[] = { + "read", "initialize", "write", "add", "complete", + "customcompleter", "builtincompleter", "eofchar", + (char *) NULL + }; + enum SubCmdIdx { + TCLRL_READ, TCLRL_INITIALIZE, TCLRL_WRITE, TCLRL_ADD, TCLRL_COMPLETE, + TCLRL_CUSTOMCOMPLETER, TCLRL_BUILTINCOMPLETER, TCLRL_EOFCHAR + }; + + + Tcl_ResetResult(interp); /* clear the result space */ + + for (i = 0; i < argc; i++) { + Tcl_Obj* objPtr = Tcl_NewStringObj(argv[i], -1); + Tcl_IncrRefCount(objPtr); + objv[i] = objPtr; + } + objv[argc] = 0; /* terminate */ + + if (argc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + return TCL_ERROR; + } + + status = Tcl_GetIndexFromObj + (interp, objv[1], subCmds, "option", 0, (int *) &obj_idx); + + if (status != TCL_OK) { + FREE(objv) + return status; + } + + switch (obj_idx) { + + case TCLRL_READ: + + rl_callback_handler_install(argc == 3 ? argv[2] : "%", + TclReadlineLineCompleteHandler); + + Tcl_CreateFileHandler(0, TCL_READABLE, + TclReadlineReadHandler, (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 + */ + tclrl_state = LINE_PENDING; + + while (!TclReadlineLineComplete()) { +#ifdef EXECUTING_MACRO_HACK + /** + * check first, if more characters are + * available from _rl_executing_macro, + * because Tcl_DoOneEvent() will (naturally) + * not detect this `event'. + */ + if (_rl_executing_macro) + TclReadlineReadHandler((ClientData) NULL, TCL_READABLE); + else +#endif + Tcl_DoOneEvent(TCL_ALL_EVENTS); + } + + Tcl_DeleteFileHandler(0); + + switch (tclrl_state) { + + case LINE_COMPLETE: + + return TCL_OK; + /* NOTREACHED */ + break; + + case LINE_EOF: + if (tclrl_eof_string) + return Tcl_Eval(interp, tclrl_eof_string); + else + return TCL_OK; + /* NOTREACHED */ + break; + + default: + return tclrl_state; + /* NOTREACHED */ + break; + } + break; + + case TCLRL_INITIALIZE: + if (3 != argc) { + Tcl_WrongNumArgs(interp, 2, objv, "historyfile"); + return TCL_ERROR; + } else { + return TclReadlineInitialize(interp, argv[2]); + } + break; + + case TCLRL_WRITE: + if (3 != argc) { + Tcl_WrongNumArgs(interp, 2, objv, "historyfile"); + return TCL_ERROR; + } else if (write_history(argv[2])) { + Tcl_AppendResult(interp, "unable to write history to `", + argv[2], "'\n", (char*) NULL); + return TCL_ERROR; + } + if (tclrl_history_length >= 0) { + history_truncate_file(argv[2], tclrl_history_length); + } + return TCL_OK; + break; + + case TCLRL_ADD: + if (3 != argc) { + Tcl_WrongNumArgs(interp, 2, objv, "completerLine"); + return TCL_ERROR; + } else if (TclReadlineKnownCommands(argv[2], (int) 0, _CMD_SET)) { + Tcl_AppendResult(interp, "unable to add command \"", + argv[2], "\"\n", (char*) NULL); + } + break; + + case TCLRL_COMPLETE: + if (3 != argc) { + Tcl_WrongNumArgs(interp, 2, objv, "line"); + return TCL_ERROR; + } else if (Tcl_CommandComplete(argv[2])) { + Tcl_AppendResult(interp, "1", (char*) NULL); + } else { + Tcl_AppendResult(interp, "0", (char*) NULL); + } + break; + + case TCLRL_CUSTOMCOMPLETER: + if (argc > 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?scriptCompleter?"); + return TCL_ERROR; + } else if (3 == argc) { + if (tclrl_custom_completer) + FREE(tclrl_custom_completer); + if (!blank_line(argv[2])) + tclrl_custom_completer = stripwhite(strdup(argv[2])); + } + Tcl_AppendResult(interp, tclrl_custom_completer, (char*) NULL); + break; + + case TCLRL_BUILTINCOMPLETER: + if (argc > 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?boolean?"); + return TCL_ERROR; + } else if (3 == argc) { + int bool = tclrl_use_builtin_completer; + if (TCL_OK != Tcl_GetBoolean(interp, argv[2], &bool)) { + Tcl_AppendResult(interp, + "wrong # args: should be a boolean value.", + (char*) NULL); + return TCL_ERROR; + } else { + tclrl_use_builtin_completer = bool; + } + } + Tcl_AppendResult(interp, tclrl_use_builtin_completer ? "1" : "0", + (char*) NULL); + break; + + case TCLRL_EOFCHAR: + if (argc > 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?script?"); + return TCL_ERROR; + } else if (3 == argc) { + if (tclrl_eof_string) + FREE(tclrl_eof_string); + if (!blank_line(argv[2])) + tclrl_eof_string = stripwhite(strdup(argv[2])); + } + Tcl_AppendResult(interp, tclrl_eof_string, (char*) NULL); + break; + + default: + goto BAD_COMMAND; + /* NOTREACHED */ + break; } return TCL_OK; BAD_COMMAND: @@ -325,42 +389,97 @@ void TclReadlineReadHandler(ClientData clientData, int mask) { if (mask & TCL_READABLE) { - rl_callback_read_char(); +#ifdef EXECUTING_MACRO_HACK + do { +#endif + rl_callback_read_char(); #ifdef EXECUTING_MACRO_HACK - /** - * check, if we're inside a macro and - * if so, read all macro characters. - */ - while (_rl_executing_macro) { - rl_callback_read_char(); - } + /** + * check, if we're inside a macro and + * if so, read all macro characters + * until the next eol. + */ + } while (_rl_executing_macro && !TclReadlineLineComplete()); #endif } } void TclReadlineLineCompleteHandler(char* ptr) { -#if 1 if (!ptr) { /* */ - tclrl_line_complete = LINE_EOF; - rl_callback_handler_remove(); - } else if (*ptr) { - tclrl_line_complete = LINE_COMPLETE; - rl_callback_handler_remove(); - tclrl_line = ptr; - } + + TclReadlineTerminate(LINE_EOF); + + } else { + + /** + * From version 0.9.3 upwards, all lines are + * returned, even empty lines. (Only non-empty + * lines are stuffed in readline's history.) + * The calling script is responsible for handling + * empty strings. + */ + + char* expansion = (char*) NULL; + int status = history_expand(ptr, &expansion); + + if (status >= 1) { +#if 0 + Tcl_Channel channel = Tcl_MakeFileChannel(stdout, TCL_WRITABLE); + /* Tcl_RegisterChannel(interp, channel); */ + (void) Tcl_WriteChars(channel, expansion, -1); + Tcl_Flush(channel); + Tcl_Close(interp, channel); #else - if (ptr && *ptr) { - tclrl_line_complete = 1; - rl_callback_handler_remove(); - tclrl_line = ptr; - } + /* TODO: make this a valid tcl output */ + printf("%s\n", expansion); +#endif + } else if (-1 == status) { + Tcl_AppendResult + (tclrl_interp, "error in history expansion\n", (char*) NULL); + TclReadlineTerminate(TCL_ERROR); + } + /** + * TODO: status == 2 ... + */ + + Tcl_AppendResult(tclrl_interp, expansion, (char*) NULL); + +#ifdef EXECUTING_MACRO_HACK + /** + * don't stuff macro lines + * into readline's history. + */ + if(!_rl_executing_macro) { +#endif + /** + * don't stuff empty lines + * into readline's history. + * don't stuff twice the same + * line into readline's history. + */ + if (expansion && *expansion && (!tclrl_last_line || + strcmp(tclrl_last_line, expansion))) { + add_history(expansion); + } + if (tclrl_last_line) + free(tclrl_last_line); + tclrl_last_line = strdup(expansion); +#ifdef EXECUTING_MACRO_HACK + } #endif + /** + * tell the calling routines to terminate. + */ + TclReadlineTerminate(LINE_COMPLETE); + FREE(ptr); + FREE(expansion); + } } int Tclreadline_SafeInit(Tcl_Interp *interp) { @@ -400,11 +519,11 @@ 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 "(" <-- arrays * removed "{" <-- `${' variables @@ -416,11 +535,11 @@ /* besser (11. Sept) 2. (removed \") */ /* rl_basic_word_break_characters = " \t\n\\@$}=;|&[]"; */ /* besser (11. Sept) 3. (removed }) */ rl_basic_word_break_characters = " \t\n\\@$=;|&[]"; #if 0 - rl_basic_quote_characters = "\"{"; // XXX ??? XXX + rl_basic_quote_characters = "\"{"; /* XXX ??? XXX */ rl_completer_quote_characters = "\""; #endif /* rl_filename_quote_characters = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"; @@ -494,26 +613,27 @@ if (tclrl_custom_completer) { char start_s[BUFSIZ], end_s[BUFSIZ]; Tcl_Obj* obj; Tcl_Obj** objv; int objc; + int state; char* quoted_text = TclReadlineQuote(text, "$[]{}\""); char* quoted_rl_line_buffer = TclReadlineQuote(rl_line_buffer, "$[]{}\""); sprintf(start_s, "%d", start); sprintf(end_s, "%d", end); Tcl_ResetResult(tclrl_interp); /* clear result space */ - tclrl_state = Tcl_VarEval(tclrl_interp, tclrl_custom_completer, + state = Tcl_VarEval(tclrl_interp, tclrl_custom_completer, " \"", 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) { - rl_callback_handler_remove(); + if (TCL_OK != state) { Tcl_AppendResult (tclrl_interp, " `", tclrl_custom_completer, " \"", quoted_text, "\" ", start_s, " ", end_s, " \"", quoted_rl_line_buffer, "\"' failed.", (char*) NULL); + TclReadlineTerminate(state); return matches; } obj = Tcl_GetObjResult(tclrl_interp); status = Tcl_ListObjGetElements(tclrl_interp, obj, &objc, &objv); if (TCL_OK != status) Index: tclreadlineCompleter.tcl ================================================================== --- tclreadlineCompleter.tcl +++ tclreadlineCompleter.tcl @@ -1,8 +1,8 @@ #!/usr/locanl/bin/tclsh # FILE: "/home/joze/src/tclreadline/tclreadlineCompleter.tcl" -# LAST MODIFICATION: "Mon Sep 13 02:21:21 1999 (joze)" +# LAST MODIFICATION: "Tue Sep 14 01:55:17 1999 (joze)" # (C) 1998, 1999 by Johannes Zellner, # $Id$ # --- # # tclreadline -- gnu readline for tcl @@ -145,19 +145,23 @@ #** # build a list hosts from the /etc/hosts file. # this is only done once. This is sort of a # dirty hack, /etc/hosts is hardcoded ... +# But on the other side, if the user supplies +# a valid host table in tclreadline::hosts +# before entering the event loop, this proc +# will return this list. # proc HostList {} { # read the host table only once. # variable hosts if {![info exists hosts]} { catch { - set id [open /etc/hosts r] set hosts "" + set id [open /etc/hosts r] if {0 != ${id}} { while {-1 != [gets ${id} line]} { regsub {#.*} ${line} {} line if {[llength ${line}] >= 2} { lappend hosts [lindex ${line} 1] @@ -205,10 +209,48 @@ lappend result ${word} } } return [string trim $result] } + +#** +# invoke cmd with a (hopefully) invalid string and +# parse the error message to get an option list. +# +# @param cmd +# @return list of options for cmd +# @date Sep-14-1999 +# +proc TrySubCmds {cmd} { + set trystring ____ + set result "" + if [catch {set result [${cmd} ${trystring}]} msg] { + if {[regexp {bad *option.*____.*: *must *be( .*$)} ${msg} all raw]} { + regsub -all -- , ${raw} { } raw + set len [llength ${raw}] + set len_2 [expr ${len} - 2] + for {set i 0} {${i} < ${len}} {incr i} { + set word [lindex ${raw} ${i}] + if {"or" != ${word} && ${i} != ${len_2}} { + lappend result ${word} + } + + } + } else { + # check, if it's a blt error msg ... + # + set msglst [split ${msg} \n] + foreach line ${msglst} { + if {[regexp "${cmd}\[ \t\]\+\(\[^ \t\]*\)\[^:\]*$" \ + ${line} all sub]} { + lappend result [list ${sub}] + } + } + } + } + return ${result} +} proc FirstNonOption {line} { set expr_pos 1 foreach word [lrange ${line} 1 end] {; # 0 is the command itself if {"-" != [string index ${word} 0]} { @@ -657,26 +699,26 @@ proc CommandsOnlyCompletion {cmd} { return [CommandCompletion ${cmd} commands] } -proc CommandCompletion {cmd {action both} {spc ::} {pre UNDEFINED}} { +proc CommandCompletion {cmd {action both} {spc ::}} { + # get the leading colons in `cmd'. + regexp {^:*} ${cmd} pre + return [CommandCompletionWithPre $cmd $action $spc $pre] +} + +proc CommandCompletionWithPre {cmd action spc pre} { # puts stderr "(CommandCompletion) cmd=|$cmd|" # puts stderr "(CommandCompletion) action=|$action|" # puts stderr "(CommandCompletion) spc=|$spc|" - # get the leading colons in `cmd'. - if {"UNDEFINED" == $pre} { - regexp {^:*} ${cmd} pre - } - # puts stderr \npre=|$pre| - set cmd [StripPrefix ${cmd}] set quali [namespace qualifiers ${cmd}] if {[string length ${quali}]} { # puts stderr \nquali=|$quali| - set matches [CommandCompletion \ + set matches [CommandCompletionWithPre \ [namespace tail ${cmd}] ${action} ${spc}${quali} ${pre}] # puts stderr \nmatches1=|$matches| return $matches } set cmd [string trim ${cmd}]* @@ -697,23 +739,23 @@ if {"commands" != ${action}} { set all_procs [namespace eval $spc [list info procs ${cmd}]] # puts stderr procs=|$procs| set procs "" foreach proc $all_procs { - if {[namespace eval $spc [list namespace origin $command]] == \ - [namespace eval $spc [list namespace which $command]]} { - lappend procs $command + if {[namespace eval $spc [list namespace origin $proc]] == \ + [namespace eval $spc [list namespace which $proc]]} { + lappend procs $proc } } } else { set procs "" } set matches [namespace eval $spc concat ${commands} ${procs}] set namespaces [namespace children $spc ${cmd}] if {![llength ${matches}] && 1 == [llength ${namespaces}]} { - set matches [CommandCompletion {} ${action} ${namespaces} ${pre}] + set matches [CommandCompletionWithPre {} ${action} ${namespaces} ${pre}] # puts stderr \nmatches=|$matches| return $matches } # make `namespaces' having exactly @@ -830,22 +872,26 @@ # new_end = [expr $end - ($start - $new_start)] == 4 # new_part == $part == put # new_line = [lindex $sub 1] == " put $b" # } elseif {"" != [set sub [SplitLine $start $line]]} { + set new_start [lindex $sub 0] set new_end [expr $end - ($start - $new_start)] set new_line [lindex $sub 1] # puts stderr "(SplitLine) $new_start $new_end $new_line" return [ScriptCompleter $part $new_start $new_end $new_line] + } elseif {0 == [set pos [PartPosition part start end line]]} { + # puts stderr "(PartPosition) $part $start $end $line" set all [CommandCompletion ${part}] # puts stderr "(ScriptCompleter) all=$all" #puts \nmatches=$matches\n # return [Format $all $part] return [TryFromList $part $all] + } else { # try to use $pos further ... # puts stderr |$line| # @@ -907,10 +953,41 @@ # puts stderr \nscript_result=|${script_result}| return ${script_result} } # set namespc ""; # no qualifiers for tclreadline_complete_unknown } + + # as we've reached here no valid specific completer + # was found. Check, if it's a proc and return the + # arguments. + # + if {[string length [uplevel [info level] info proc $alias]]} { + set args [uplevel [info level] info args $alias] + set arg [lindex $args [expr $pos - 1]] + if {"" != $arg} { + if {[uplevel [info level] info default $alias $arg junk]} { + return [DisplayHints ?$arg?] + } else { + return [DisplayHints <$arg>] + } + } + } + + + # Ok, also no proc. Try to do the same as for widgets now: + # try to get at least the first option from an error output. + # + switch -- $pos { + 1 { + set cmds [TrySubCmds ${alias}] + if {[llength ${cmds}]} { + return [TryFromList ${part} ${cmds}] + } + } + } + + # no specific command completer found. return "" } error "{NOTREACHED (this is probably an error)}" } @@ -1051,12 +1128,13 @@ 2 { return [DisplayHints ?varName?] } } return "" } -# proc complete(cd) {text start end line pos mod} { -# } +proc complete(cd) {text start end line pos mod} { + return "" +} proc complete(clock) {text start end line pos mod} { set cmd [Lindex $line 1] switch -- $pos { 1 { @@ -2231,21 +2309,39 @@ vcompare - vsatisfies { return [DisplayHints ] } } } 3 { + set versions "" + catch [list set versions [package versions [Lindex $line 2]]] switch -- $cmd { forget {} - ifneeded { return [DisplayHints ] } - provide { return [DisplayHints ?version?] } + ifneeded { + if {"" != $versions} { + return [CompleteFromList ${text} $versions] + } else { + return [DisplayHints ] + } + } + provide { + if {"" != $versions} { + return [CompleteFromList ${text} $versions] + } else { + return [DisplayHints ?version?] + } + } versions {} present - require { if {"-exact" == [PreviousWord ${start} ${line}]} { return [CompleteFromList ${mod} [package names]] } else { - return [DisplayHints ?version?] + if {"" != $versions} { + return [CompleteFromList ${text} $versions] + } else { + return [DisplayHints ?version?] + } } } names {} unknown {} vcompare - @@ -2771,13 +2867,52 @@ } } return "" } +# --- TCLREADLINE PACKAGE --- + +# create a tclreadline namespace inside +# tclreadline and import some commands. +# +namespace eval tclreadline { + catch { + namespace import \ + ::tclreadline::DisplayHints \ + ::tclreadline::CompleteFromList \ + ::tclreadline::Lindex + } +} + +proc tclreadline::complete(readline) {text start end line pos mod} { + set cmd [Lindex $line 1] + switch -- $pos { + 1 { return [CompleteFromList ${text} { + read initialize write add complete + customcompleter builtincompleter eofchar}] + } + 2 { + switch -- $cmd { + read {} + initialize {} + write {} + add { return [DisplayHints ] } + completer { return [DisplayHints ] } + customcompleter { return [DisplayHints ?scriptCompleter?] } + builtincompleter { return [DisplayHints ?boolean?] } + eofchar { return [DisplayHints ?script?] } + } + } + } + return "" +} + +# --- END OF TCLREADLINE PACKAGE --- + proc complete(tell) {text start end line pos mod} { switch -- $pos { - 1 { return [ChannelId ${mod}] } + 1 { return [ChannelId ${text}] } } return "" } proc complete(time) {text start end line pos mod} { @@ -2928,44 +3063,17 @@ # ------------------------------------- # TK # ------------------------------------- -# generic widget configuration - -proc TrySubCmds {cmd} { - set trystring ____ - set result "" - if [catch {set result [${cmd} ${trystring}]} msg] { - if {[regexp {bad *option.*____.*: *must *be( .*$)} ${msg} all raw]} { - regsub -all -- , ${raw} { } raw - set len [llength ${raw}] - set len_2 [expr ${len} - 2] - for {set i 0} {${i} < ${len}} {incr i} { - set word [lindex ${raw} ${i}] - if {"or" != ${word} && ${i} != ${len_2}} { - lappend result ${word} - } - - } - } else { - # check, if it's a blt error msg ... - # - set msglst [split ${msg} \n] - foreach line ${msglst} { - if {[regexp "${cmd}\[ \t\]\+\(\[^ \t\]*\)\[^:\]*$" \ - ${line} all sub]} { - lappend result [list ${sub}] - } - } - } - } - return ${result} -} - -proc WidgetList {pattern} { +# GENERIC WIDGET CONFIGURATION + +proc WidgetChildren {pattern} { regsub {^([^\.])} ${pattern} {\.\1} pattern + if {![string length ${pattern}]} { + set pattern . + } if {[winfo exists ${pattern}]} { return [winfo children ${pattern}] } else { regsub {.[^.]*$} $pattern {} pattern if {[winfo exists ${pattern}]} { @@ -2973,10 +3081,18 @@ } else { return "" } } } + +proc WidgetDescendants {pattern} { + set tree [WidgetChildren ${pattern}] + foreach widget $tree { + append tree " [WidgetDescendants $widget]" + } + return $tree +} proc complete(WIDGET) {text start end line pos mod} { set widget [lindex ${line} 0] set cmd [lindex ${line} 1] @@ -2990,42 +3106,65 @@ lappend options(switches) [lindex ${optline} 0] lappend options(value) [lindex ${optline} 4] } } - if {1 >= ${pos}} { - set cmds [TrySubCmds ${widget}] - if {[llength ${cmds}]} { - return [TryFromList ${mod} ${cmds}] - } - } elseif {2 <= ${pos} && - ([string match ${cmd}* cget] || \ - [string match ${cmd}* configure])} { - set prev [PreviousWord ${start} ${line}] - #puts \nprev=|$prev| - #puts switches=|$options(switches)| - #puts found=[lsearch -exact ${prev} $options(switches)] - if {-1 != [set found [lsearch -exact $options(switches) ${prev}]]} { - if {![llength ${mod}]} { - return [list "[lindex $options(value) ${found}]"] - } - } else { - return [TryFromList ${mod} $options(switches)] + switch -- $pos { + 1 { + set cmds [TrySubCmds ${widget}] + if {[llength ${cmds}]} { + return [TryFromList ${mod} ${cmds}] + } + } + 2 { + if {([string match ${cmd}* cget] || \ + [string match ${cmd}* configure]) + } { + set prev [PreviousWord ${start} ${line}] + #puts \nprev=|$prev| + #puts switches=|$options(switches)| + #puts found=[lsearch -exact ${prev} $options(switches)] + if {-1 != [set found \ + [lsearch -exact $options(switches) ${prev}]] + } { + if {![llength ${mod}]} { + return [list "[lindex $options(value) ${found}]"] + } + } else { + return [TryFromList ${mod} $options(switches)] + } + } } } return "" } + +# 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} [WidgetDescendants ${text}]] + } + } + } +} 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 [TryFromList ${mod} ${cmds}] + switch -- $pos { + 1 { + set cmds [TrySubCmds winfo] + if {[llength ${cmds}]} { + return [TryFromList ${text} ${cmds}] + } } - } elseif {2 == ${pos}} { - return [TryFromList ${mod} [WidgetList ${mod}]] + 2 { + return [TryFromList ${text} [WidgetChildren ${text}]] + } } return "" } }; # namespace tclreadline 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: "Wed Sep 8 18:09:57 1999 (joze)" +# FILE: "/home/joze/src/tclreadline/tclreadlineSetup.tcl.in" +# LAST MODIFICATION: "Mon Sep 13 23:44:55 1999 (joze)" # (C) 1998, 1999 by Johannes Zellner, # $Id$ # --- # # tclreadline -- gnu readline for tcl @@ -26,11 +26,12 @@ # http://www.zellner.org/tclreadline/ # # ================================================================== -package provide tclreadline @TCLREADLINE_VERSION@ +# 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 @@ -296,11 +297,20 @@ $::tclreadline::errorMsg] continue } # Magnus Eriksson proposed - history add $LINE + # to add the line also to tclsh's history. + # + # I decided to add only lines which are different from + # the previous one to the history. This is different + # from tcsh's behaviour, but I found it quite convenient + # while using mshell on os9. + # + if {[string length $LINE] && [history event 0] != $LINE} { + history add $LINE + } if [catch { set result [eval $LINE] if {$result != "" && [tclreadline::Print]} { puts $result