/* ==================================================================

    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, <johannes@zellner.org>
    $Id$
    ---

    tclreadline -- gnu readline for tcl
    Copyright (C) 1999  Johannes Zellner

/*
 * 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);
int Tclreadline_SafeInit(Tcl_Interp* interp);
int Tclreadline_Init(Tcl_Interp* interp);
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);
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;


char*
stripleft(char* in)

char*
stripwhite(char* in)
{
    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;
    char* result_c;
    int i, len = strlen(quotechars);

    }
    result_c = strdup(Tcl_DStringValue(&result));
    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                         */
    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 *));
    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) {
        

    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);

        char* expansion = (char*) NULL;
        int status;
        
        tclrl_line_complete = LINE_PENDING;
        tclrl_state = TCL_OK;
        rl_callback_handler_install(argc == 3 ? argv[2] : "%",
    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,
            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);
        }
            /**
             * 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);
            Tcl_DeleteFileHandler(0);

        if (TCL_OK != tclrl_state)
            switch (tclrl_state) {
            return tclrl_state; /* !! */

	if ((LINE_EOF == tclrl_line_complete) && tclrl_eof_string) {
	    Tcl_Eval(interp, tclrl_eof_string);
            return tclrl_state;
	}

                case LINE_COMPLETE:

                    return TCL_OK;
                    /* NOTREACHED */
                    break;

                case LINE_EOF:
        status = history_expand(tclrl_line, &expansion);
        if (status >= 1) {
#if 0
                    if (tclrl_eof_string)
            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
                        return Tcl_Eval(interp, tclrl_eof_string);
                    else
            printf("%s\n", expansion);
#endif
                        return TCL_OK;
                    /* NOTREACHED */
                    break;
        }
        else if (status == -1) {
            Tcl_AppendResult
                (interp, "error in history expansion\n", (char*) NULL);
            return tclrl_state;
        }

                default:
                    return tclrl_state;
                    /* NOTREACHED */
                    break;
            }
        /**
         * TODO: status == 2 ...
         */
        
            break;
        if (expansion && *expansion)
            add_history(expansion);

        Tcl_SetResult(interp, expansion, TCL_VOLATILE);

        case TCLRL_INITIALIZE:
        FREE(tclrl_line);
        FREE(expansion);
        return tclrl_state;
    } else if (c == 'i'  && strncmp(argv[1], "initialize", length) == 0) {
        if (3 != argc)
            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) {
                Tcl_WrongNumArgs(interp, 2, objv, "historyfile");
                return TCL_ERROR;
            } else {
                return TclReadlineInitialize(interp, argv[2]);
            }
            break;

        case TCLRL_WRITE:
            if (3 != argc) {
            goto BAD_COMMAND;
        }  else if (write_history(argv[2])) {
            Tcl_AppendResult(interp, "unable to write history to `",
                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;
    } else if (c == 'a'  && strncmp(argv[1], "add", length) == 0) {
        if (3 != argc)
                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) {
            goto BAD_COMMAND;
        else if (TclReadlineKnownCommands(argv[2], (int) 0, _CMD_SET))
            Tcl_AppendResult(interp, "unable to add command \"",
                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;
    } else if (c == 'c'  && strncmp(argv[1], "complete", length) == 0) {
        if (3 != argc)

        case TCLRL_COMPLETE:
            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)
                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) {
            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)
                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) {
            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)
                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) {
            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;
                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:
    Tcl_AppendResult(interp,
        "wrong # args: should be \"readline option ?arg ...?\"",
        (char*) NULL);
    return TCL_ERROR;

}

void
TclReadlineReadHandler(ClientData clientData, int mask)
{
    if (mask & TCL_READABLE) {
#ifdef EXECUTING_MACRO_HACK
        do {
#endif
        rl_callback_read_char();
            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) {
            /**
             * check, if we're inside a macro and
             * if so, read all macro characters
             * until the next eol.
             */
        } while (_rl_executing_macro && !TclReadlineLineComplete());
            rl_callback_read_char();
        }
#endif
    }
}

void
TclReadlineLineCompleteHandler(char* ptr)
{
#if 1
    if (!ptr) { /* <c-d> */
        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
            /* TODO: make this a valid tcl output */
            printf("%s\n", expansion);
#endif
    if (ptr && *ptr) {
        tclrl_line_complete = 1;
        rl_callback_handler_remove();
        tclrl_line = ptr;
    }
        } 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)
{
    return Tclreadline_Init(interp);
}

    return Tcl_PkgProvide(interp, "tclreadline", TCLRL_VERSION);
}

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 
     * removed "<" <-- completion lists with < ... >
     * added "[]"
     * added "}"
     */
    /* 11.Sep rl_basic_word_break_characters = " \t\n\"\\@$}=;|&[]"; */
    /* 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";

    rl_filename_quoting_function

    }

    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) {
        if (TCL_OK != state) {
            rl_callback_handler_remove();
            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)
            return matches;

#!/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, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999  Johannes Zellner
#

    }
}

#**
# 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]
                    }
                }

    foreach word $lst {
        if {[string match ${text}* ${word}]} {
            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]} {
            break
        } else {

    return [CommandCompletion ${cmd} procs]
}

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}]*
    # puts stderr \ncmd=|$cmd|\n
    if {"procs" != ${action}} {

        set commands ""
    }
    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
    # the same number of colons as `cmd'.
    #

    # [SplitLine] --> {1 " put $b"} == sub
    # new_start = [lindex $sub 0] == 1
    # new_end   = [expr $end - ($start - $new_start)] == 4
    # new_part  == $part == put
    # new_line  = [lindex $sub 1] == " put $b"
    # 
    } elseif {"" != [set sub [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|
        #
        if {"." == [string index [string trim ${line}] 0]} {
            set alias WIDGET

                    error [list error during evaluation of `complete(${cmd})']
                }
                # 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)}"
}

    switch -- $pos {
        1 { return [DisplayHints <script>] }
        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 {
            return [CompleteFromList $text {clicks format scan seconds}]
        }

                names {}
                unknown { return [DisplayHints ?command?] }
                vcompare -
                vsatisfies { return [DisplayHints <version1>] }
            }
        }
        3 {
            set versions ""
            catch [list set versions [package versions [Lindex $line 2]]]
            switch -- $cmd {
                forget {}
                ifneeded {
                    if {"" != $versions} {
                        return [CompleteFromList ${text} $versions]
                    } else {
                ifneeded { return [DisplayHints <version>] }
                provide { return [DisplayHints ?version?] }
                        return [DisplayHints <version>]
                    }
                }
                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 {
                        if {"" != $versions} {
                            return [CompleteFromList ${text} $versions]
                        } else {
                        return [DisplayHints ?version?]
                            return [DisplayHints ?version?]
                        }
                    }
                }
                names {}
                unknown {}
                vcompare -
                vsatisfies { return [DisplayHints <version2>] }
            }

                }
            }
        }
    }
    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 <completerLine>] }
                completer { return [DisplayHints <line>] }
                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} {
    switch -- $pos {
        1 { return [DisplayHints <script>] }

    return ""
}

# -------------------------------------
#                  TK
# -------------------------------------

# generic widget configuration
# GENERIC WIDGET CONFIGURATION

proc TrySubCmds {cmd} {
proc WidgetChildren {pattern} {
    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}]
    regsub {^([^\.])} ${pattern} {\.\1} pattern
    if {![string length ${pattern}]} {
            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}
                }

            }
        set pattern .
    }
        } 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} {
    regsub {^([^\.])} ${pattern} {\.\1} pattern
    if {[winfo exists ${pattern}]} {
        return [winfo children ${pattern}]
    } else {
        regsub {.[^.]*$} $pattern {} pattern
        if {[winfo exists ${pattern}]} {
            return [winfo children ${pattern}]
        } else {
            return ""
        }
    }
}

proc 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]

    # first we build an option table
    #
    if {[catch [list set option_table [${widget} configure]] msg]} {
        return ""
    }
    foreach optline ${option_table} {
        if {5 != [llength ${optline}]} continue else {
            lappend options(switches) [lindex ${optline} 0]
            lappend options(value)    [lindex ${optline} 4]
        }
    }

    switch -- $pos {
    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)]
        }
    }
        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]
    switch -- $pos {
    if {1 >= ${pos}} {
        set cmds [TrySubCmds winfo]
        if {[llength ${cmds}]} {
            return [TryFromList ${mod} ${cmds}]
        }
    } elseif {2 == ${pos}} {
        return [TryFromList ${mod} [WidgetList ${mod}]]
        1 {
            set cmds [TrySubCmds winfo]
            if {[llength ${cmds}]} {
                return [TryFromList ${text} ${cmds}]
            }
        }
        2 {
            return [TryFromList ${text} [WidgetChildren ${text}]]
        }
    }
    return ""
}

}; # namespace tclreadline

#!/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, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999  Johannes Zellner
#

#
# johannes@zellner.org
# 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

    # Save the values of errorCode and errorInfo variables, since they

            } ::tclreadline::errorMsg]} {
                puts stderr [list tclreadline::Loop: error. \
                $::tclreadline::errorMsg]
                continue
            }

            # Magnus Eriksson <magnus.eriksson@netinsight.se> proposed
            # 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
                history add $LINE
            }

            if [catch {
                set result [eval $LINE]
                if {$result != "" && [tclreadline::Print]} {
                    puts $result
                }
                set result ""