Index: COPYING ================================================================== --- COPYING +++ COPYING @@ -1,22 +1,22 @@ - - Copyright (c) 1998 - 2001, Johannes Zellner + + Copyright (c) 1998 - 2014, Johannes Zellner All rights reserved. - + Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - + * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Johannes Zellner nor the names of contributors to this software may be used to endorse or promote products derived from this software without specific prior written permission. - + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, Index: Makefile.am ================================================================== --- Makefile.am +++ Makefile.am @@ -1,14 +1,12 @@ ## -*- automake -*- -## FILE: "/home/joze/src/tclreadline/Makefile.am" -## LAST MODIFICATION: "Mit, 10 Jan 2001 06:29:33 +0100 (joze)" -## (C) 2000 - 2001 by Johannes Zellner, +## FILE: Makefile.am ## $Id$ ## --- ## tclreadline -- gnu readline for tcl ## http://www.zellner.org/tclreadline/ -## Copyright (c) 1998 - 2001, Johannes Zellner +## Copyright (c) 1998 - 2014, Johannes Zellner ## This software is copyright under the BSD license. ## --- ## AUTOMAKE_OPTIONS = foreign Index: README ================================================================== --- README +++ README @@ -1,16 +1,14 @@ -FILE: "/home/joze/src/tclreadline/README" -LAST MODIFICATION: "Mit, 10 Jan 2001 06:29:33 +0100 (joze)" -(C) 1998 - 2001 by Johannes Zellner, +FILE: README $Id$ --- - tclreadline -- gnu readline for tcl http://www.zellner.org/tclreadline/ -Copyright (c) 1998 - 2001, Johannes Zellner - +Copyright (c) 1998 - 2014, Johannes Zellner This software is copyright under the BSD license. +--- + tclreadline @@ -50,20 +48,20 @@ (d) Optionally (or additionally) you can build the executables tclshrl and / or wishrl which are a readline enhanced replacement for tclsh and wish. To compile these executable you should type - ./configure --enable-tclshrl --enable-wishrl + ./configure --enable-tclshrl --enable-wishrl - (or one of these if you want just tclshrl or wishrl). - NOTE that these executables need an installed version of - tclreadline because they need some script files to run - so you can't test tclshrl/wishrl before installing - the tclreadline scripts. + (or one of these if you want just tclshrl or wishrl). + NOTE that these executables need an installed version of + tclreadline because they need some script files to run + so you can't test tclshrl/wishrl before installing + the tclreadline scripts. Building statically linked executables is DISCOURAGED - but necessary on systems which don't support shared libs. + but necessary on systems which don't support shared libs. 4. Using tclreadline for interactive tcl scripting. --------------------------------------------------- @@ -77,46 +75,46 @@ 4. History and Changes. ----------------------- tclreadline-1.2 0: (Mar 2000) - switched to a BSD type license, introduced a new read-only - variable `license' in the tclreadline namespace. + switched to a BSD type license, introduced a new read-only + variable `license' in the tclreadline namespace. tclreadline-1.1 0: (Mar 2000) - code cleanup and checked that it compiles with tcl8.3 + code cleanup and checked that it compiles with tcl8.3 tclreadline-1.0.1: (Sep 1999) - changes: - - tclreadline::readline bell. + changes: + - tclreadline::readline bell. Ring the terminal bell, obeying the setting - of bell-style -- audible or visible. + of bell-style -- audible or visible. tclreadline-1.0.0: (Sep 1999) - note: - - the script completer procs are written. - this is `sort of a first usable release'. + note: + - the script completer procs are written. + this is `sort of a first usable release'. fixes: - - some minor configure.in fixes. + - some minor configure.in fixes. tclreadline-0.9.3: (Sep 1999) changes: - - tk completion. - - multiple fallback completion routines for unknown - commands. - - readline reset-terminal sub-function. + - tk completion. + - multiple fallback completion routines for unknown + commands. + - readline reset-terminal sub-function. fixes: - - another revision of procession events and macros. - includes a hack using a readline's internal - variable _rl_executing_macro. + - another revision of procession events and macros. + includes a hack using a readline's internal + variable _rl_executing_macro. tclreadline-0.9.2: (Aug 1999) changes: @@ -161,13 +159,13 @@ - tclreadline::readline eofchar - variable, array and '[' command completion by the script tclreadline::ScriptCompleter. See the man page or try typing "puts $env" ... Command completion currently only works, if a '[' preceeds immediately a non-white character. - - the redefinition of the command `cd' was removed due to + - the redefinition of the command `cd' was removed due to multiple requests. This redefinition can be found in the - file `sample.tclshrc' and can be uncommented, if desired. + file `sample.tclshrc' and can be uncommented, if desired. - the definition of the command `ls' was moved outside the proc tclreadline::Setup and can be used with the command namespace import tclreadline::ls (see sample.tclshrc). bug fixes: Index: SCENARIO ================================================================== --- SCENARIO +++ SCENARIO @@ -6,23 +6,23 @@ puts $ puts $ + a list of all variables ... puts $t puts $t + a list of all variables - beginning with t ... + beginning with t ... puts $tcl_pl puts $tcl_platform( - + a list of all array names of - tcl_platform + + a list of all array names of + tcl_platform puts $tcl_platform(b puts $tcl_platform(byteOrder) === SCENARIO 2 === button .b button .b -.b co .b configure +.b co .b configure .b co .b configure + a list of all button options ... -.b co-r .b configure -relief +.b co-r .b configure -relief .b co-rg .b configure -relief groove Index: autogen.sh ================================================================== --- autogen.sh +++ autogen.sh @@ -1,10 +1,14 @@ #!/bin/sh -# FILE: "/home/joze/src/tclreadline/autogen.sh" -# LAST MODIFICATION: "Mit, 10 Jan 2001 06:28:43 +0100 (joze)" -# (C) 2000 - 2001 by Johannes Zellner, +# FILE: autogen.sh # $Id$ +# --- +# tclreadline -- gnu readline for tcl +# http://www.zellner.org/tclreadline/ +# Copyright (c) 1998 - 2014, Johannes Zellner +# This software is copyright under the BSD license. +# --- srcdir=`dirname $0` test -z "$srcdir" && srcdir=. ORIGDIR=`pwd` @@ -14,41 +18,43 @@ FILE=tclreadline.c DIE=0 (autoconf --version) < /dev/null > /dev/null 2>&1 || { - echo - echo "You must have autoconf installed to compile $PROJECT." - echo "Download the appropriate package for your distribution," - echo "or get the source tarball at ftp://ftp.gnu.org/pub/gnu/" - DIE=1 + echo + echo "You must have autoconf installed to compile $PROJECT." + echo "Download the appropriate package for your distribution," + echo "or get the source tarball at ftp://ftp.gnu.org/pub/gnu/" + DIE=1 } (automake --version) < /dev/null > /dev/null 2>&1 || { - echo - echo "You must have automake installed to compile $PROJECT." - echo "Get ftp://sourceware.cygnus.com/pub/automake/automake-1.4.tar.gz" - echo "(or a newer version if it is available)" - DIE=1 + echo + echo "You must have automake installed to compile $PROJECT." + echo "Get ftp://sourceware.cygnus.com/pub/automake/automake-1.4.tar.gz" + echo "(or a newer version if it is available)" + DIE=1 } if test "$DIE" -eq 1; then - exit 1 + exit 1 fi test $TEST_TYPE $FILE || { - echo "You must run this script in the top-level $PROJECT directory" - exit 1 + echo "You must run this script in the top-level $PROJECT directory" + exit 1 } if test -z "$*"; then - echo "I am going to run ./configure with no arguments - if you wish " - echo "to pass any to it, please specify them on the $0 command line." + echo "I am going to run ./configure with no arguments - if you wish " + echo "to pass any to it, please specify them on the $0 command line." fi case $CC in -*xlc | *xlc\ * | *lcc | *lcc\ *) am_opt=--include-deps;; + *xlc | *xlc\ * | *lcc | *lcc\ *) + am_opt=--include-deps + ;; esac aclocal $ACLOCAL_FLAGS # optionally feature autoheader Index: aux/tcltags ================================================================== --- aux/tcltags +++ aux/tcltags @@ -1,14 +1,18 @@ #!/usr/local/bin/tclsh -# FILE: "/home/joze/bin/script/tcltags" -# LAST MODIFIED: "Mon Sep 28 10:09:29 1998 (joze)" +# FILE: aux/tcltags # $Id$ # --- +# tclreadline -- gnu readline for tcl +# http://www.zellner.org/tclreadline/ +# Copyright (c) 1998 - 2014, Johannes Zellner +# This software is copyright under the BSD license. +# --- set tags [open "tags" a+] #set tags stdout -#_BoxHandle Z_Box.c /^int _BoxHandle (Box *boxPtr, Tcl_Interp *interp, int argc, char **argv)$/;" f +#_BoxHandle Z_Box.c /^int _BoxHandle (Box *boxPtr, Tcl_Interp *interp, int argc, char **argv)$/;" f foreach file "$argv" { if {[file exists $file]} { Index: aux/vimtags ================================================================== --- aux/vimtags +++ aux/vimtags @@ -1,20 +1,22 @@ #!/usr/local/bin/tclsh # ================================================================== -# FILE: "/home/joze/bin/script/vimtags" -# LAST MODIFIED: "Thu Oct 01 13:20:11 1998 (joze)" -# (c) 1998 by Johannes Zellner -# Johannes.Zellner@physik.uni-karlsruhe.de +# FILE: aux/vimtags # $Id$ -# ================================================================== +# --- +# tclreadline -- gnu readline for tcl +# http://www.zellner.org/tclreadline/ +# Copyright (c) 1998 - 2014, Johannes Zellner +# This software is copyright under the BSD license. +# ================================================================== if [file readable tags] { set tags [open tags r] set vim [open tags.vim w] while {[gets $tags line] != -1} { - if [regexp "^\(\[^ !\]*\)\[ \]" $line all proc] { + if [regexp "^\(\[^ !\]*\)\[ \]" $line all proc] { set proc [string trim $proc] if {$proc != ""} { puts $vim "syntax keyword Tag $proc" } } Index: configure.ac ================================================================== --- configure.ac +++ configure.ac @@ -1,15 +1,14 @@ dnl -*- autoconf -*- -dnl FILE: "/home/joze/src/tclreadline/configure.in" -dnl LAST MODIFICATION: "Mit, 10 Jan 2001 06:26:43 +0100 (joze)" -dnl (C) 1998 - 2001 by Johannes Zellner, +dnl FILE: configure.in dnl $Id$ dnl --- dnl tclreadline -- gnu readline for tcl dnl http://www.zellner.org/tclreadline/ -dnl Copyright (c) 1998 - 2001, Johannes Zellner +dnl Copyright (c) 1998 - 2014, Johannes Zellner dnl This software is copyright under the BSD license. +dnl --- AC_INIT(tclreadline.c) AC_CONFIG_HEADERS(config.h) AC_PREREQ(2.13) AC_REVISION($Revision$) @@ -142,15 +141,15 @@ done dnl look directly in the include dirs for readline.h if test -z "$READLINE_INCLUDE_DIR"; then for dir in $rl_includes /usr/local/include /usr/include ; do - if test -r $dir/readline.h; then - READLINE_INCLUDE_DIR=$dir - AC_DEFINE_UNQUOTED(READLINE_LIBRARY, 1, [ Define if we have libreadline. ]) - break - fi + if test -r $dir/readline.h; then + READLINE_INCLUDE_DIR=$dir + AC_DEFINE_UNQUOTED(READLINE_LIBRARY, 1, [ Define if we have libreadline. ]) + break + fi done fi if test -z "$READLINE_INCLUDE_DIR"; then AC_MSG_ERROR([ @@ -159,18 +158,18 @@ containing readline.h on your system.]) fi AC_ARG_WITH(readline-library, [ --with-readline-library=DIR - lib spec to readline (e.g. '-L/usr/local/lib -lreadline')], + lib spec to readline (e.g. '-L/usr/local/lib -lreadline')], LIBS="$LIBS $withval", AC_SEARCH_LIBS(rl_callback_read_char, readline, , - AC_MSG_RESULT([ - Your readline version does not support readline's alternate interface. - Please upgrade to readline >= 2.2 and retry. - ]) - exit + AC_MSG_RESULT([ + Your readline version does not support readline's alternate interface. + Please upgrade to readline >= 2.2 and retry. + ]) + exit ) ) @@ -225,42 +224,42 @@ AC_ARG_ENABLE(tclshrl, [ --enable-tclshrl build statically linked tclshrl], [dnl action if given - case "${enableval}" in - yes) enable_static=true ;; - no) enable_static=false ;; - *) AC_MSG_ERROR(bad value ${enableval} for --enable-static) ;; - esac + case "${enableval}" in + yes) enable_static=true ;; + no) enable_static=false ;; + *) AC_MSG_ERROR(bad value ${enableval} for --enable-static) ;; + esac ], [dnl action if not given - enable_static=false + enable_static=false ] ) AM_CONDITIONAL(STATIC_TCLSHRL, test x$enable_static = xtrue) AC_ARG_ENABLE(wishrl, [ --enable-wishrl build statically linked wishrl], [dnl action if given - case "${enableval}" in - yes) - enable_static=true - dnl source the tkConfig.sh which defines TK_LIB_SPEC - . $TCL_LIB_DIR/tkConfig.sh - AC_SUBST(TK_LIB_SPEC) - ;; - no) enable_static=false ;; - *) AC_MSG_ERROR(bad value ${enableval} for --enable-static) ;; - esac + case "${enableval}" in + yes) + enable_static=true + dnl source the tkConfig.sh which defines TK_LIB_SPEC + . $TCL_LIB_DIR/tkConfig.sh + AC_SUBST(TK_LIB_SPEC) + ;; + no) enable_static=false ;; + *) AC_MSG_ERROR(bad value ${enableval} for --enable-static) ;; + esac ], [dnl action if not given - enable_static=false + enable_static=false ] ) AM_CONDITIONAL(STATIC_WISHRL, test x$enable_static = xtrue) AC_SUBST(TCL_INCLUDE_DIR) AC_SUBST(TCL_LIB_SPEC) AC_SUBST(READLINE_INCLUDE_DIR) AC_OUTPUT(Makefile tclreadline.h tclreadlineInit.tcl tclreadlineSetup.tcl tclreadline.n pkgIndex.tcl) Index: pkgIndex.tcl.in ================================================================== --- pkgIndex.tcl.in +++ pkgIndex.tcl.in @@ -1,12 +1,11 @@ -# FILE: "/home/joze/src/tclreadline/pkgIndex.tcl.in" -# LAST MODIFICATION: "Mit, 10 Jan 2001 06:29:33 +0100 (joze)" -# (C) 1998 - 2001 by Johannes Zellner, +# FILE: pkgIndex.tcl.in # $Id$ # --- # tclreadline -- gnu readline for tcl # http://www.zellner.org/tclreadline/ -# Copyright (c) 1998 - 2001, Johannes Zellner +# Copyright (c) 1998 - 2014, Johannes Zellner # This software is copyright under the BSD license. +# --- package ifneeded tclreadline @VERSION@ \ [list source [file join $dir tclreadlineInit.tcl]] Index: sample.tclshrc ================================================================== --- sample.tclshrc +++ sample.tclshrc @@ -1,11 +1,16 @@ #!/bin/sh -# FILE: "/home/joze/src/tclreadline/sample.tclshrc" -# LAST MODIFICATION: "Thu, 23 Mar 2000 21:13:08 +0100 (joze)" -# (C) 1998 - 2000 by Johannes Zellner, +# FILE: sample.tclshrc # $Id$ -# vim:set ft=tcl: \ +# --- +# tclreadline -- gnu readline for tcl +# http://www.zellner.org/tclreadline/ +# Copyright (c) 1998 - 2014, Johannes Zellner +# This software is copyright under the BSD license. +# --- + +# exec with tclsh \ exec tclsh "$0" "$@" if {$tcl_interactive} { @@ -56,5 +61,6 @@ # go to tclrealdine's main loop. # tclreadline::Loop } +# vim:set ft=tcl: Index: tclreadline.c ================================================================== --- tclreadline.c +++ tclreadline.c @@ -1,45 +1,42 @@ - /* ================================================================== - FILE: "/home/joze/src/tclreadline/tclreadline.c" - LAST MODIFICATION: "Mit, 10 Jan 2001 06:29:33 +0100 (joze)" - (C) 1998 - 2001 by Johannes Zellner, + FILE: tclreadline.c $Id$ --- tclreadline -- gnu readline for tcl http://www.zellner.org/tclreadline/ - Copyright (c) 1998 - 2001, Johannes Zellner + Copyright (c) 1998 - 2014, Johannes Zellner This software is copyright under the BSD license. - ================================================================== */ + ================================================================== */ #ifdef HAVE_CONFIG_H -# include "config.h" +# include "config.h" #endif #include #include #include #include #if defined (READLINE_LIBRARY) -# include -# include +# include +# include #else -# include -# include +# include +# include #endif /* - * this prototype is missing + * this prototype may be missing * in readline.h */ void rl_extend_line_buffer(int len); #ifdef EXECUTING_MACRO_HACK /** - * this prototype is private in readline's file `macro.c'. + * this prototype may be private in readline's file `macro.c'. * We need it here to decide, if we should read more * characters from a macro. Dirty, but it should work. */ extern char* EXECUTING_MACRO_NAME; #endif @@ -47,12 +44,12 @@ #include "tclreadline.h" static const char* tclrl_library = TCLRL_LIBRARY; static const char* tclrl_version_str = TCLRL_VERSION_STR; static const char* tclrl_patchlevel_str = TCLRL_PATCHLEVEL_STR; -#define MALLOC(size) malloc((int) size) -#define FREE(ptr) if (ptr) { free((char*) ptr); ptr = 0; } +#define MALLOC(size) malloc(size) +#define FREE(ptr) free(ptr); ptr = NULL enum { _CMD_SET = (1 << 0), _CMD_GET = (1 << 1) }; @@ -84,11 +81,11 @@ static char* TclReadline0generator(char* text, int state); static char* TclReadlineKnownCommands(char* text, int state, int mode); static int TclReadlineParse(char** args, int maxargs, char* buf); -enum { +enum { LINE_PENDING = -1, LINE_EOF = (1 << 8), LINE_COMPLETE = (1 << 9) }; @@ -137,22 +134,22 @@ static char* stripleft(char* in) { char* ptr = in; while (*ptr && *ptr <= ' ') - ptr++; + ptr++; if (in != ptr) - memmove(in, ptr, strlen(ptr) + 1); + memmove(in, ptr, strlen(ptr) + 1); return in; } static char* stripright(char* in) { char* ptr; for (ptr = strchr(in, '\0') - 1; ptr >= in && *ptr <= ' '; ptr--) - *ptr = '\0'; + *ptr = '\0'; return in; } static char* stripwhite(char* in) @@ -183,374 +180,373 @@ int i, len = strlen(quotechars); Tcl_DString result; Tcl_DStringInit(&result); for (ptr = text; ptr && *ptr; ptr++) { - for (i = 0; i < len; i++) { - if (quotechars[i] == *ptr) { - Tcl_DStringAppend(&result, "\\", 1); - break; - } - } - Tcl_DStringAppend(&result, ptr, 1); + for (i = 0; i < len; i++) { + if (quotechars[i] == *ptr) { + Tcl_DStringAppend(&result, "\\", 1); + break; + } + } + Tcl_DStringAppend(&result, ptr, 1); } result_c = strdup(Tcl_DStringValue(&result)); return result_c; } -static int TclReadlineCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]) +static int +TclReadlineCmd(ClientData clientData, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[]) { int obj_idx, status; static char *subCmds[] = { - "read", "initialize", "write", "add", "complete", - "customcompleter", "builtincompleter", "eofchar", - "reset-terminal", "bell", "text", "update", - (char *) NULL + "read", "initialize", "write", "add", "complete", + "customcompleter", "builtincompleter", "eofchar", + "reset-terminal", "bell", "text", "update", + (char *) NULL }; enum SubCmdIdx { - TCLRL_READ, TCLRL_INITIALIZE, TCLRL_WRITE, TCLRL_ADD, TCLRL_COMPLETE, - TCLRL_CUSTOMCOMPLETER, TCLRL_BUILTINCOMPLETER, TCLRL_EOFCHAR, - TCLRL_RESET_TERMINAL, TCLRL_BELL, TCLRL_TEXT, TCLRL_UPDATE + TCLRL_READ, TCLRL_INITIALIZE, TCLRL_WRITE, TCLRL_ADD, TCLRL_COMPLETE, + TCLRL_CUSTOMCOMPLETER, TCLRL_BUILTINCOMPLETER, TCLRL_EOFCHAR, + TCLRL_RESET_TERMINAL, TCLRL_BELL, TCLRL_TEXT, TCLRL_UPDATE }; Tcl_ResetResult(interp); /* clear the result space */ if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); - return TCL_ERROR; + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); + return TCL_ERROR; } status = Tcl_GetIndexFromObj - (interp, objv[1], subCmds, "option", 0, (int *) &obj_idx); + (interp, objv[1], subCmds, "option", 0, (int *) &obj_idx); - if (status != TCL_OK) { - return status; - } + if (status != TCL_OK) + return status; switch (obj_idx) { - case TCLRL_READ: - - rl_callback_handler_install( - objc == 3 ? Tcl_GetStringFromObj(objv[2], 0) - : "% ", 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()) { + case TCLRL_READ: + + rl_callback_handler_install( + objc == 3 ? Tcl_GetStringFromObj(objv[2], 0) + : "% ", 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_NAME - /** - * check first, if more characters are - * available from _rl_executing_macro, - * because Tcl_DoOneEvent() will (naturally) - * not detect this `event'. - */ - if (EXECUTING_MACRO_NAME) - TclReadlineReadHandler((ClientData) NULL, TCL_READABLE); - else + /** + * check first, if more characters are + * available from _rl_executing_macro, + * because Tcl_DoOneEvent() will (naturally) + * not detect this `event'. + */ + if (EXECUTING_MACRO_NAME) + 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 != objc) { - Tcl_WrongNumArgs(interp, 2, objv, "historyfile"); - return TCL_ERROR; - } else { - return TclReadlineInitialize(interp, - Tcl_GetStringFromObj(objv[2], 0)); - } - break; - - case TCLRL_WRITE: - if (3 != objc) { - Tcl_WrongNumArgs(interp, 2, objv, "historyfile"); - return TCL_ERROR; - } else if (write_history(Tcl_GetStringFromObj(objv[2], 0))) { - Tcl_AppendResult(interp, "unable to write history to `", - Tcl_GetStringFromObj(objv[2], 0), "'\n", (char*) NULL); - return TCL_ERROR; - } - if (tclrl_history_length >= 0) { - history_truncate_file(Tcl_GetStringFromObj(objv[2], 0), - tclrl_history_length); - } - return TCL_OK; - break; - - case TCLRL_ADD: - if (3 != objc) { - Tcl_WrongNumArgs(interp, 2, objv, "completerLine"); - return TCL_ERROR; - } else if (TclReadlineKnownCommands( - Tcl_GetStringFromObj(objv[2], 0), - (int) 0, _CMD_SET)) { - Tcl_AppendResult(interp, "unable to add command \"", - Tcl_GetStringFromObj(objv[2], 0), "\"\n", (char*) NULL); - } - break; - - case TCLRL_COMPLETE: - if (3 != objc) { - Tcl_WrongNumArgs(interp, 2, objv, "line"); - return TCL_ERROR; - } else if (Tcl_CommandComplete(Tcl_GetStringFromObj(objv[2], 0))) { - Tcl_AppendResult(interp, "1", (char*) NULL); - } else { - Tcl_AppendResult(interp, "0", (char*) NULL); - } - break; - - case TCLRL_CUSTOMCOMPLETER: - if (objc > 3) { - Tcl_WrongNumArgs(interp, 2, objv, "?scriptCompleter?"); - return TCL_ERROR; - } else if (3 == objc) { - if (tclrl_custom_completer) - FREE(tclrl_custom_completer); - if (!blank_line(Tcl_GetStringFromObj(objv[2], 0))) - tclrl_custom_completer = - stripwhite(strdup(Tcl_GetStringFromObj(objv[2], 0))); - } - Tcl_AppendResult(interp, tclrl_custom_completer, (char*) NULL); - break; - - case TCLRL_BUILTINCOMPLETER: - if (objc > 3) { - Tcl_WrongNumArgs(interp, 2, objv, "?boolean?"); - return TCL_ERROR; - } else if (3 == objc) { - int bool = tclrl_use_builtin_completer; - if (TCL_OK != Tcl_GetBoolean(interp, - Tcl_GetStringFromObj(objv[2], 0), - &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 (objc > 3) { - Tcl_WrongNumArgs(interp, 2, objv, "?script?"); - return TCL_ERROR; - } else if (3 == objc) { - if (tclrl_eof_string) - FREE(tclrl_eof_string); - if (!blank_line(Tcl_GetStringFromObj(objv[2], 0))) - tclrl_eof_string = - stripwhite(strdup(Tcl_GetStringFromObj(objv[2], 0))); - } - Tcl_AppendResult(interp, tclrl_eof_string, (char*) NULL); - break; - - case TCLRL_RESET_TERMINAL: - /* TODO: add this to the completer */ - if (objc > 3) { - Tcl_WrongNumArgs(interp, 2, objv, "?terminal-name?"); - return TCL_ERROR; - } - if (3 == objc) { - /* - * - tcl8.0 doesn't have Tcl_GetStringFromObj() - * - rl_reset_terminal() might be defined - * to take no arguments. This might produce - * a compiler warning. - */ - rl_reset_terminal(Tcl_GetStringFromObj(objv[2], 0)); + 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 != objc) { + Tcl_WrongNumArgs(interp, 2, objv, "historyfile"); + return TCL_ERROR; + } else { + return TclReadlineInitialize(interp, + Tcl_GetStringFromObj(objv[2], 0)); + } + break; + + case TCLRL_WRITE: + if (3 != objc) { + Tcl_WrongNumArgs(interp, 2, objv, "historyfile"); + return TCL_ERROR; + } else if (write_history(Tcl_GetStringFromObj(objv[2], 0))) { + Tcl_AppendResult(interp, "unable to write history to `", + Tcl_GetStringFromObj(objv[2], 0), "'\n", (char*) NULL); + return TCL_ERROR; + } + if (tclrl_history_length >= 0) { + history_truncate_file(Tcl_GetStringFromObj(objv[2], 0), + tclrl_history_length); + } + return TCL_OK; + break; + + case TCLRL_ADD: + if (3 != objc) { + Tcl_WrongNumArgs(interp, 2, objv, "completerLine"); + return TCL_ERROR; + } else if (TclReadlineKnownCommands( + Tcl_GetStringFromObj(objv[2], 0), + (int) 0, _CMD_SET)) { + Tcl_AppendResult(interp, "unable to add command \"", + Tcl_GetStringFromObj(objv[2], 0), "\"\n", (char*) NULL); + } + break; + + case TCLRL_COMPLETE: + if (3 != objc) { + Tcl_WrongNumArgs(interp, 2, objv, "line"); + return TCL_ERROR; + } else if (Tcl_CommandComplete(Tcl_GetStringFromObj(objv[2], 0))) { + Tcl_AppendResult(interp, "1", (char*) NULL); + } else { + Tcl_AppendResult(interp, "0", (char*) NULL); + } + break; + + case TCLRL_CUSTOMCOMPLETER: + if (objc > 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?scriptCompleter?"); + return TCL_ERROR; + } else if (3 == objc) { + if (tclrl_custom_completer) + FREE(tclrl_custom_completer); + if (!blank_line(Tcl_GetStringFromObj(objv[2], 0))) + tclrl_custom_completer = + stripwhite(strdup(Tcl_GetStringFromObj(objv[2], 0))); + } + Tcl_AppendResult(interp, tclrl_custom_completer, (char*) NULL); + break; + + case TCLRL_BUILTINCOMPLETER: + if (objc > 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?boolean?"); + return TCL_ERROR; + } else if (3 == objc) { + int bool = tclrl_use_builtin_completer; + if (TCL_OK != Tcl_GetBoolean(interp, + Tcl_GetStringFromObj(objv[2], 0), + &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 (objc > 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?script?"); + return TCL_ERROR; + } else if (3 == objc) { + if (tclrl_eof_string) + FREE(tclrl_eof_string); + if (!blank_line(Tcl_GetStringFromObj(objv[2], 0))) + tclrl_eof_string = + stripwhite(strdup(Tcl_GetStringFromObj(objv[2], 0))); + } + Tcl_AppendResult(interp, tclrl_eof_string, (char*) NULL); + break; + + case TCLRL_RESET_TERMINAL: + /* TODO: add this to the completer */ + if (objc > 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?terminal-name?"); + return TCL_ERROR; + } + if (3 == objc) { + /* + * - tcl8.0 doesn't have Tcl_GetStringFromObj() + * - rl_reset_terminal() might be defined + * to take no arguments. This might produce + * a compiler warning. + */ + rl_reset_terminal(Tcl_GetStringFromObj(objv[2], 0)); #ifdef CLEANUP_AFER_SIGNAL - } else { - rl_cleanup_after_signal(); + } else { + rl_cleanup_after_signal(); #endif - } - break; - - case TCLRL_BELL: - if (objc != 2) { - Tcl_WrongNumArgs(interp, 2, objv, ""); - return TCL_ERROR; - } - - - /* - * ring the terminal bell obeying the current - * settings -- audible or visible. - */ - - ding(); - break; + } + break; + + case TCLRL_BELL: + if (objc != 2) { + Tcl_WrongNumArgs(interp, 2, objv, ""); + return TCL_ERROR; + } + + + /* + * ring the terminal bell obeying the current + * settings -- audible or visible. + */ + + ding(); + break; case TCLRL_UPDATE: - if (objc != 2) { - Tcl_WrongNumArgs(interp, 2, objv, ""); - return TCL_ERROR; - } - - /* Update the input line */ - - if (rl_line_buffer) { - rl_forced_update_display(); - } - - break; + if (objc != 2) { + Tcl_WrongNumArgs(interp, 2, objv, ""); + return TCL_ERROR; + } + + /* Update the input line */ + + if (rl_line_buffer) { + rl_forced_update_display(); + } + + break; case TCLRL_TEXT: - if (objc != 2) { - Tcl_WrongNumArgs(interp, 2, objv, ""); - return TCL_ERROR; - } - - /* Return the current input line */ - Tcl_SetObjResult(interp, - Tcl_NewStringObj(rl_line_buffer ? rl_line_buffer : "", -1)); - break; - - default: - goto BAD_COMMAND; - /* NOTREACHED */ - break; + if (objc != 2) { + Tcl_WrongNumArgs(interp, 2, objv, ""); + return TCL_ERROR; + } + + /* Return the current input line */ + Tcl_SetObjResult(interp, + Tcl_NewStringObj(rl_line_buffer ? rl_line_buffer : "", -1)); + break; + + default: + goto BAD_COMMAND; + /* NOTREACHED */ + break; } return TCL_OK; BAD_COMMAND: Tcl_AppendResult(interp, - "wrong # args: should be \"readline option ?arg ...?\"", - (char*) NULL); + "wrong # args: should be \"readline option ?arg ...?\"", + (char*) NULL); return TCL_ERROR; } static void TclReadlineReadHandler(ClientData clientData, int mask) { if (mask & TCL_READABLE) { #ifdef EXECUTING_MACRO_NAME - do { + do { #endif - rl_callback_read_char(); + rl_callback_read_char(); #ifdef EXECUTING_MACRO_NAME - /** - * check, if we're inside a macro and - * if so, read all macro characters - * until the next eol. - */ - } while (EXECUTING_MACRO_NAME && !TclReadlineLineComplete()); + /** + * check, if we're inside a macro and + * if so, read all macro characters + * until the next eol. + */ + } while (EXECUTING_MACRO_NAME && !TclReadlineLineComplete()); #endif } } static void TclReadlineLineCompleteHandler(char* ptr) { if (!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 >= 2) { - /* TODO: make this a valid tcl output */ - printf("%s\n", expansion); - free(ptr); - free(expansion); - return; - } else if (status <= -1) { - Tcl_AppendResult - (tclrl_interp, "error in history expansion: ", expansion, "\n", (char*) NULL); - TclReadlineTerminate(TCL_ERROR); - free(ptr); - free(expansion); - return; - } else { - Tcl_AppendResult(tclrl_interp, expansion, (char*) NULL); - } - -#ifdef EXECUTING_MACRO_NAME - /** - * don't stuff macro lines - * into readline's history. - */ - if(!EXECUTING_MACRO_NAME) { -#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_NAME - } -#endif - /** - * tell the calling routines to terminate. - */ - TclReadlineTerminate(LINE_COMPLETE); - FREE(ptr); - FREE(expansion); + 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 >= 2) { + /* TODO: make this a valid tcl output */ + printf("%s\n", expansion); + FREE(ptr); + FREE(expansion); + return; + } else if (status <= -1) { + Tcl_AppendResult + (tclrl_interp, "error in history expansion: ", expansion, "\n", (char*) NULL); + TclReadlineTerminate(TCL_ERROR); + FREE(ptr); + FREE(expansion); + return; + } else { + Tcl_AppendResult(tclrl_interp, expansion, (char*) NULL); + } + + #ifdef EXECUTING_MACRO_NAME + /** + * don't stuff macro lines + * into readline's history. + */ + if(!EXECUTING_MACRO_NAME) { + #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_NAME + } + #endif + /** + * tell the calling routines to terminate. + */ + TclReadlineTerminate(LINE_COMPLETE); + FREE(ptr); + FREE(expansion); } } int Tclreadline_SafeInit(Tcl_Interp *interp) @@ -561,38 +557,38 @@ int Tclreadline_Init(Tcl_Interp *interp) { int status; Tcl_CreateObjCommand(interp, "::tclreadline::readline", TclReadlineCmd, - (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); tclrl_interp = interp; if (TCL_OK != (status = Tcl_LinkVar(interp, "::tclreadline::historyLength", - (char*) &tclrl_history_length, TCL_LINK_INT))) - return status; + (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; + (char*) &tclrl_library, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) + return status; if (TCL_OK != (status = Tcl_LinkVar(interp, "::tclreadline::version", - (char*) &tclrl_version_str, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) - return status; + (char*) &tclrl_version_str, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) + return status; if (TCL_OK != (status = Tcl_LinkVar(interp, "::tclreadline::patchLevel", - (char*) &tclrl_patchlevel_str, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) - return status; + (char*) &tclrl_patchlevel_str, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) + return status; if (TCL_OK != (status = Tcl_LinkVar(interp, "::tclreadline::license", - (char*) &tclrl_license, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) - return status; + (char*) &tclrl_license, 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; + (char*) &tclrl_library, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) + return status; if (TCL_OK != (status = Tcl_LinkVar(interp, "tclreadline_version", - (char*) &tclrl_version_str, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) - return status; + (char*) &tclrl_version_str, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) + return status; if (TCL_OK != (status = Tcl_LinkVar(interp, "tclreadline_patchLevel", - (char*) &tclrl_patchlevel_str, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) - return status; + (char*) &tclrl_patchlevel_str, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) + return status; return Tcl_PkgProvide(interp, "tclreadline", (char*)tclrl_version_str); } static int @@ -602,11 +598,11 @@ /* rl_special_prefixes = "${\"["; */ rl_special_prefixes = "$"; /** * default is " \t\n\"\\'`@$><=;|&{(" * removed "(" <-- arrays - * removed "{" <-- `${' variables + * removed "{" <-- `${' variables * removed "<" <-- completion lists with < ... > * added "[]" * added "}" */ /* 11.Sep rl_basic_word_break_characters = " \t\n\"\\@$}=;|&[]"; */ @@ -629,34 +625,34 @@ rl_filename_quoting_desired = 1; */ using_history(); if (!tclrl_eof_string) - tclrl_eof_string = strdup("puts {}; exit"); + tclrl_eof_string = strdup("puts {}; exit"); /* * try to read historyfile in home * directory. If this failes, this * is *not* an error. */ rl_attempted_completion_function = (CPPFunction *) TclReadlineCompletion; if (read_history(historyfile)) { - if (write_history(historyfile)) { - Tcl_AppendResult (interp, "warning: `", - historyfile, "' is not writable.", (char*) NULL); - } + if (write_history(historyfile)) { + Tcl_AppendResult (interp, "warning: `", + historyfile, "' is not writable.", (char*) NULL); + } } return TCL_OK; } static int blank_line(char* str) { char* ptr; for (ptr = str; ptr && *ptr; ptr++) { - if (!ISWHITE(*ptr)) - return 0; + if (!ISWHITE(*ptr)) + return 0; } return 1; } static char** @@ -665,96 +661,94 @@ char** matches = (char**) NULL; int status; rl_completion_append_character = ' '; /* reset, just in case ... */ if (text && ('!' == text[0] - || (start && rl_line_buffer[start - 1] == '!' /* for '$' */))) { - char* expansion = (char*) NULL; - int oldlen = strlen(rl_line_buffer); - status = history_expand(rl_line_buffer, &expansion); - if (status >= 1) { - rl_extend_line_buffer(strlen(expansion) + 1); - strcpy(rl_line_buffer, expansion); - rl_end = strlen(expansion); - rl_point += strlen(expansion) - oldlen; - FREE(expansion); - /* - * TODO: - * because we return 0 == matches, - * the filename completer will still beep. - rl_inhibit_completion = 1; - */ - return matches; - } - FREE(expansion); + || (start && rl_line_buffer[start - 1] == '!' /* for '$' */))) { + char* expansion = (char*) NULL; + int oldlen = strlen(rl_line_buffer); + status = history_expand(rl_line_buffer, &expansion); + if (status >= 1) { + rl_extend_line_buffer(strlen(expansion) + 1); + strcpy(rl_line_buffer, expansion); + rl_end = strlen(expansion); + rl_point += strlen(expansion) - oldlen; + FREE(expansion); + /* + * TODO: + * because we return 0 == matches, + * the filename completer will still beep. + rl_inhibit_completion = 1; + */ + return matches; + } + FREE(expansion); } 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 */ - state = Tcl_VarEval(tclrl_interp, tclrl_custom_completer, - " \"", quoted_text, "\" ", start_s, " ", end_s, - " \"", quoted_rl_line_buffer, "\"", (char*) NULL); - 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); - free(quoted_text); - free(quoted_rl_line_buffer); - return matches; - } - free(quoted_text); - quoted_text = NULL; - free(quoted_rl_line_buffer); - quoted_rl_line_buffer = NULL; - obj = Tcl_GetObjResult(tclrl_interp); - status = Tcl_ListObjGetElements(tclrl_interp, obj, &objc, &objv); - if (TCL_OK != status) - return matches; - - if (objc) { - int i, length; - matches = (char**) MALLOC(sizeof(char*) * (objc + 1)); - for (i = 0; i < objc; i++) { - matches[i] = strdup(Tcl_GetStringFromObj(objv[i], &length)); - if (1 == objc && !strlen(matches[i])) { - FREE(matches[i]); - FREE(matches); - Tcl_ResetResult(tclrl_interp); /* clear result space */ - return (char**) NULL; - } - } - - /** - * this is a special one: - * if the script returns exactly two arguments - * and the second argument is the empty string, - * the rl_completion_append_character is set - * temporaryly to NULL. - */ - if (2 == objc && !strlen(matches[1])) { - i--; - FREE(matches[1]); - rl_completion_append_character = '\0'; - } - - matches[i] = (char*) NULL; /* terminate */ - } - Tcl_ResetResult(tclrl_interp); /* clear result space */ + 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 */ + state = Tcl_VarEval(tclrl_interp, tclrl_custom_completer, + " \"", quoted_text, "\" ", start_s, " ", end_s, + " \"", quoted_rl_line_buffer, "\"", (char*) NULL); + 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); + FREE(quoted_text); + FREE(quoted_rl_line_buffer); + return matches; + } + FREE(quoted_text); + FREE(quoted_rl_line_buffer); + obj = Tcl_GetObjResult(tclrl_interp); + status = Tcl_ListObjGetElements(tclrl_interp, obj, &objc, &objv); + if (TCL_OK != status) + return matches; + + if (objc) { + int i, length; + matches = (char**) MALLOC(sizeof(char*) * (objc + 1)); + for (i = 0; i < objc; i++) { + matches[i] = strdup(Tcl_GetStringFromObj(objv[i], &length)); + if (1 == objc && !strlen(matches[i])) { + FREE(matches[i]); + FREE(matches); + Tcl_ResetResult(tclrl_interp); /* clear result space */ + return (char**) NULL; + } + } + + /** + * this is a special one: + * if the script returns exactly two arguments + * and the second argument is the empty string, + * the rl_completion_append_character is set + * temporarily to NULL. + */ + if (2 == objc && !strlen(matches[1])) { + i--; + FREE(matches[1]); + rl_completion_append_character = '\0'; + } + + matches[i] = (char*) NULL; /* terminate */ + } + Tcl_ResetResult(tclrl_interp); /* clear result space */ } if (!matches && tclrl_use_builtin_completer) { - matches = rl_completion_matches(text, (rl_compentry_func_t *)TclReadline0generator); + matches = rl_completion_matches(text, (rl_compentry_func_t *)TclReadline0generator); } return matches; } @@ -778,116 +772,117 @@ int sub; switch (mode) { - case _CMD_SET: - - new = (cmds_t *) MALLOC(sizeof(cmds_t)); - new->next = (cmds_t *) NULL; - - if (!cmds) { - cmds = new; - cmds->prev = new; - } - else { - cmds->prev->next = new; - cmds->prev = new; - } - - tmp = strdup(text); - argc = TclReadlineParse(args, sizeof(args), tmp); - - new->cmd = (char**) MALLOC(sizeof(char*) * (argc + 1)); - - for (i = 0; i < argc; i++) - new->cmd[i] = args[i]; - - new->cmd[argc] = (char*) NULL; - - return (char*) NULL; - break; - - - case _CMD_GET: - - local_line = strdup(rl_line_buffer); - sub = TclReadlineParse(args, sizeof(args), local_line); - - if (0 == sub || (1 == sub && '\0' != text[0])) { - if (!state) { - new = cmds; - len = strlen(text); - } - while (new && (name = new->cmd)) { - new = new->next; - if (!strncmp(name[0], text, len)) - return strdup(name[0]); - } - return (char*) NULL; - } else { - - if (!state) { - - new = cmds; - len = strlen(text); - - while (new && (name = new->cmd)) { - if (!strcmp(name[0], args[0])) - break; - new = new->next; - } - - if (!new) - return (char*) NULL; - - for (i = 0; new->cmd[i]; i++) /* EMPTY */; - - if (sub < i && !strncmp(new->cmd[sub], text, len)) - return strdup(new->cmd[sub]); - else - return (char*) NULL; - - } - else - return (char*) NULL; - - /* NOTREACHED */ - break; - } - - - default: - return (char*) NULL; - break; - - } - /* NOTREACHED */ + case _CMD_SET: + + new = (cmds_t *) MALLOC(sizeof(cmds_t)); + new->next = (cmds_t *) NULL; + + if (!cmds) { + cmds = new; + cmds->prev = new; + } else { + cmds->prev->next = new; + cmds->prev = new; + } + + tmp = strdup(text); + argc = TclReadlineParse(args, sizeof(args), tmp); + + new->cmd = (char**) MALLOC(sizeof(char*) * (argc + 1)); + + for (i = 0; i < argc; i++) + new->cmd[i] = args[i]; + + new->cmd[argc] = (char*) NULL; + + return (char*) NULL; + /* NOTREACHED */ + break; + + + case _CMD_GET: + + local_line = strdup(rl_line_buffer); + sub = TclReadlineParse(args, sizeof(args), local_line); + + if (0 == sub || (1 == sub && '\0' != text[0])) { + if (!state) { + new = cmds; + len = strlen(text); + } + while (new && (name = new->cmd)) { + new = new->next; + if (!strncmp(name[0], text, len)) + return strdup(name[0]); + } + return (char*) NULL; + } else { + + if (!state) { + + new = cmds; + len = strlen(text); + + while (new && (name = new->cmd)) { + if (!strcmp(name[0], args[0])) + break; + new = new->next; + } + + if (!new) + return (char*) NULL; + + for (i = 0; new->cmd[i]; i++) /* EMPTY */; + + if (sub < i && !strncmp(new->cmd[sub], text, len)) + return strdup(new->cmd[sub]); + else + return (char*) NULL; + + } + else + return (char*) NULL; + } + + /* NOTREACHED */ + break; + + + default: + return (char*) NULL; + /* NOTREACHED */ + break; + + } } static int TclReadlineParse(char** args, int maxargs, char* buf) { int nr = 0; while (*buf != '\0' && nr < maxargs) { - /* - * Strip whitespace. Use nulls, so - * that the previous argument is terminated - * automatically. - */ - while (ISWHITE(*buf)) - *buf++ = '\0'; - - if (!(*buf)) /* don't count the terminating NULL */ - break; - - *args++ = buf; - nr++; - - while (('\0' != *buf) && !ISWHITE(*buf)) - buf++; + /* + * Strip whitespace. Use nulls, so + * that the previous argument is terminated + * automatically. + */ + while (ISWHITE(*buf)) + *buf++ = '\0'; + + if (!(*buf)) /* don't count the terminating NULL */ + break; + + *args++ = buf; + nr++; + + while (('\0' != *buf) && !ISWHITE(*buf)) + buf++; } *args = '\0'; return nr; } + Index: tclreadline.h.in ================================================================== --- tclreadline.h.in +++ tclreadline.h.in @@ -1,18 +1,14 @@ - /* ================================================================== - FILE: "/home/joze/src/tclreadline/tclreadline.h.in" - LAST MODIFICATION: "Mit, 10 Jan 2001 06:29:33 +0100 (joze)" - (C) 1998 - 2001 by Johannes Zellner, + FILE: tclreadline.h.in $Id$ - vim:set ft=c: --- tclreadline -- gnu readline for tcl http://www.zellner.org/tclreadline/ - Copyright (c) 1998 - 2001, Johannes Zellner + Copyright (c) 1998 - 2014, Johannes Zellner This software is copyright under the BSD license. - ================================================================== */ + ================================================================== */ #ifndef TCLREADLINE_H_ #define TCLREADLINE_H_ #include Index: tclreadline.n.in ================================================================== --- tclreadline.n.in +++ tclreadline.n.in @@ -1,25 +1,24 @@ .TH tclreadline n "@PATCHLEVEL_STR@" "Johannes Zellner" -.\" FILE: "/home/joze/src/tclreadline/tclreadline.n.in" -.\" LAST MODIFICATION: "Mit, 10 Jan 2001 06:29:33 +0100 (joze)" -.\" (C) 1998 - 2001 by Johannes Zellner, +.\" FILE: tclreadline.n.in .\" $Id$ .\" --- .\" tclreadline -- gnu readline for tcl .\" http://www.zellner.org/tclreadline/ -.\" Copyright (c) 1998 - 2001, Johannes Zellner +.\" Copyright (c) 1998 - 2014, Johannes Zellner .\" This software is copyright under the BSD license. +.\" --- -.\" # CS - begin code excerpt +.\" # CS - begin code excerpt .de CS .RS .nf .ta .25i .5i .75i 1i .. -.\" # CE - end code excerpt +.\" # CE - end code excerpt .de CE .fi .RE .. @@ -195,16 +194,16 @@ .TP 5 \fB::tclreadline::Loop\fP [\fIhistoryfile\fP] enter the tclreadline main loop. This command is typically called from the startup resource file (something .tclshrc, depending on the interpreter you use, see the file `sample.tclshrc'). The main loop sets up some -completion characteristics as variable -- try something like "puts $b" -- +completion characteristics as variable -- try something like "puts $b" -- and command completion -- try "puts [in". If the optional argument \fIhistoryfile\fP is given, this file will be used for reading and writing the command history instead of the default \fB.tclsh-history\fP. -\fB::tclreadline::Loop\fP will normally not return. +\fB::tclreadline::Loop\fP will normally not return. If you want to write your own main loop and/or own custom completers, it is probably a good idea to start with tclreadline::Loop (see the file tclreadlineSetup.tcl). .TP 5 @@ -297,11 +296,11 @@ .PP the \fB.inputrc\fP file in the users HOME directory. This file is used normally for all programs which use the gnu readline (e.g. bash). The `global' readline settings there will be valid also for \fBtclreadline\fP. Additionally the .inputrc might hold conditional -settings for the implementation name \fBtclreadline\fP. Example of +settings for the implementation name \fBtclreadline\fP. Example of some lines in your .inputrc: .CS $if tclreadline "\\C-xp": "puts $env(PATH)" $endif Index: tclreadlineCompleter.tcl ================================================================== --- tclreadlineCompleter.tcl +++ tclreadlineCompleter.tcl @@ -1,102 +1,96 @@ # -*- tclsh -*- -# FILE: "/home/joze/src/tclreadline/tclreadlineCompleter.tcl" -# LAST MODIFICATION: "Mit, 10 Jan 2001 06:29:33 +0100 (joze)" -# (C) 1998 - 2001 by Johannes Zellner, +# FILE: tclreadlineCompleter.tcl # $Id$ -# vim:set ts=4: # --- -# # tclreadline -- gnu readline for tcl # http://www.zellner.org/tclreadline/ -# Copyright (c) 1998 - 2001, Johannes Zellner -# +# Copyright (c) 1998 - 2014, Johannes Zellner # This software is copyright under the BSD license. -# -# ================================================================== +# --- # TODO: # -# - tcltest is missing -# - better completion for CompleteListFromList: -# RemoveUsedOptions ... -# - namespace eval fred {... <-- continue with a -# substitution in fred. -# - set tclreadline::pro doesn't work -# set ::tclreadline::pro does +# - tcltest is missing +# - better completion for CompleteListFromList: +# RemoveUsedOptions ... +# - namespace eval fred {... <-- continue with a +# substitution in fred. +# - set tclreadline::pro doesn't work +# set ::tclreadline::pro does # # - TextObj ... # namespace eval tclreadline { - # the following three are from the icccm - # and used in complete(selection) and - # descendants. - # - variable selection-selections { - PRIMARY SECONDARY CLIPBOARD - } - variable selection-types { - ADOBE_PORTABLE_DOCUMENT_FORMAT - APPLE_PICT - BACKGROUND - BITMAP - CHARACTER_POSITION - CLASS - CLIENT_WINDOW - COLORMAP - COLUMN_NUMBER - COMPOUND_TEXT - DELETE - DRAWABLE - ENCAPSULATED_POSTSCRIPT - ENCAPSULATED_POSTSCRIPT_INTERCHANGE - FILE_NAME - FOREGROUND - HOST_NAME - INSERT_PROPERTY - INSERT_SELECTION - LENGTH - LINE_NUMBER - LIST_LENGTH - MODULE - MULTIPLE - NAME - ODIF - OWNER_OS - PIXMAP - POSTSCRIPT - PROCEDURE - PROCESS - STRING - TARGETS - TASK - TEXT - TIMESTAMP - USER - } - variable selection-formats { - APPLE_PICT - ATOM - ATOM_PAIR - BITMAP - COLORMAP - COMPOUND_TEXT - DRAWABLE - INTEGER - NULL - PIXEL - PIXMAP7 - SPAN - STRING - TEXT - WINDOW - } + # the following three are from the icccm + # and used in complete(selection) and + # descendants. + # + variable selection-selections { + PRIMARY SECONDARY CLIPBOARD + } + variable selection-types { + ADOBE_PORTABLE_DOCUMENT_FORMAT + APPLE_PICT + BACKGROUND + BITMAP + CHARACTER_POSITION + CLASS + CLIENT_WINDOW + COLORMAP + COLUMN_NUMBER + COMPOUND_TEXT + DELETE + DRAWABLE + ENCAPSULATED_POSTSCRIPT + ENCAPSULATED_POSTSCRIPT_INTERCHANGE + FILE_NAME + FOREGROUND + HOST_NAME + INSERT_PROPERTY + INSERT_SELECTION + LENGTH + LINE_NUMBER + LIST_LENGTH + MODULE + MULTIPLE + NAME + ODIF + OWNER_OS + PIXMAP + POSTSCRIPT + PROCEDURE + PROCESS + STRING + TARGETS + TASK + TEXT + TIMESTAMP + USER + } + variable selection-formats { + APPLE_PICT + ATOM + ATOM_PAIR + BITMAP + COLORMAP + COMPOUND_TEXT + DRAWABLE + INTEGER + NULL + PIXEL + PIXMAP7 + SPAN + STRING + TEXT + WINDOW + } namespace export \ TryFromList CompleteFromList DisplayHints Rehash \ PreviousWord CommandCompletion RemoveUsedOptions \ HostList ChannelId InChannelId OutChannelId \ @@ -111,76 +105,76 @@ # want to enable tracing every entry to a proc. # variable trace_procs if {[info exists trace_procs] && $trace_procs} { - ::proc proc {name arguments body} { - ::proc $name $arguments [subst -nocommands { - TraceText [lrange [info level 0] 1 end] - $body - }] - } + ::proc proc {name arguments body} { + ::proc $name $arguments [subst -nocommands { + TraceText [lrange [info level 0] 1 end] + $body + }] + } } else { ;# !$trace_procs - catch {rename ::tclreadline::proc ""} + catch {rename ::tclreadline::proc ""} } if {[info exists trace] && $trace} { - ::proc TraceReconf {args} { - eval .tclreadline_trace.scroll set $args - .tclreadline_trace.text see end - } - - ::proc AssureTraceWindow {} { - variable trace - if {![info exists trace]} { - return 0 - } - if {!$trace} { - return 0 - } - if {![winfo exists .tclreadline_trace.text]} { - toplevel .tclreadline_trace - text .tclreadline_trace.text \ - -yscrollcommand { tclreadline::TraceReconf } \ - -wrap none - scrollbar .tclreadline_trace.scroll \ - -orient vertical \ - -command { .tclreadline_trace.text yview } - pack .tclreadline_trace.text -side left -expand yes -fill both - pack .tclreadline_trace.scroll -side right -expand yes -fill y - } else { - raise .tclreadline_trace - } - return 1 - } - - ::proc TraceVar vT { - if {![AssureTraceWindow]} { - return - } - upvar $vT v - if {[info exists v]} { - .tclreadline_trace.text insert end \ - "([lindex [info level -1] 0]) $vT=|$v|\n" - } - # silently ignore unset variables. - } - - ::proc TraceText txt { - if {![AssureTraceWindow]} { - return - } - .tclreadline_trace.text insert end \ - [format {%32s %s} ([lindex [info level -1] 0]) $txt\n] - } - -} else { - ::proc TraceReconf args {} - ::proc AssureTraceWindow args {} - ::proc TraceVar args {} - ::proc TraceText args {} + ::proc TraceReconf {args} { + eval .tclreadline_trace.scroll set $args + .tclreadline_trace.text see end + } + + ::proc AssureTraceWindow {} { + variable trace + if {![info exists trace]} { + return 0 + } + if {!$trace} { + return 0 + } + if {![winfo exists .tclreadline_trace.text]} { + toplevel .tclreadline_trace + text .tclreadline_trace.text \ + -yscrollcommand { tclreadline::TraceReconf } \ + -wrap none + scrollbar .tclreadline_trace.scroll \ + -orient vertical \ + -command { .tclreadline_trace.text yview } + pack .tclreadline_trace.text -side left -expand yes -fill both + pack .tclreadline_trace.scroll -side right -expand yes -fill y + } else { + raise .tclreadline_trace + } + return 1 + } + + ::proc TraceVar vT { + if {![AssureTraceWindow]} { + return + } + upvar $vT v + if {[info exists v]} { + .tclreadline_trace.text insert end \ + "([lindex [info level -1] 0]) $vT=|$v|\n" + } + # silently ignore unset variables. + } + + ::proc TraceText txt { + if {![AssureTraceWindow]} { + return + } + .tclreadline_trace.text insert end \ + [format {%32s %s} ([lindex [info level -1] 0]) $txt\n] + } + +} else { + ::proc TraceReconf args {} + ::proc AssureTraceWindow args {} + ::proc TraceVar args {} + ::proc TraceText args {} } #** # TryFromList will return an empty string, if # the text typed so far does not match any of the @@ -191,44 +185,44 @@ # formatted such that readline will not insert # a space after a complete (single) match. # proc TryFromList {text lst {allow ""} {inhibit 0}} { - # puts stderr "(CompleteFromList) \ntext=|$text|" - # puts stderr "(CompleteFromList) lst=|$lst|" - set pre [GetQuotedPrefix ${text}] - set matches [MatchesFromList ${text} ${lst} ${allow}] - - # puts stderr "(CompleteFromList) matches=|$matches|" - if {1 == [llength $matches]} { ; # unique match - # puts stderr \nunique=$matches\n - # puts stderr "\n|${pre}${matches}[Right ${pre}]|\n" - set null [string index $matches 0] - if {("<" == ${null} || "?" == ${null}) && \ - -1 == [string first ${null} ${allow}] - } { - set completion [string trim "[list $text] $lst"] - } else { - set completion [string trim ${pre}${matches}[Right ${pre}]] - } - if {$inhibit} { - return [list $completion {}] - } else { - return $completion - } - } elseif {"" != ${matches}} { - # puts stderr \nmore=$matches\n - set longest [CompleteLongest ${matches}] - # puts stderr longest=|$longest| - if {"" == $longest} { - return [string trim "[list $text] ${matches}"] - } else { - return [string trim "${pre}${longest} ${matches}"] - } - } else { - return ""; # nothing to complete - } + # puts stderr "(CompleteFromList) \ntext=|$text|" + # puts stderr "(CompleteFromList) lst=|$lst|" + set pre [GetQuotedPrefix ${text}] + set matches [MatchesFromList ${text} ${lst} ${allow}] + + # puts stderr "(CompleteFromList) matches=|$matches|" + if {1 == [llength $matches]} { ; # unique match + # puts stderr \nunique=$matches\n + # puts stderr "\n|${pre}${matches}[Right ${pre}]|\n" + set null [string index $matches 0] + if {("<" == ${null} || "?" == ${null}) && \ + -1 == [string first ${null} ${allow}] + } { + set completion [string trim "[list $text] $lst"] + } else { + set completion [string trim ${pre}${matches}[Right ${pre}]] + } + if {$inhibit} { + return [list $completion {}] + } else { + return $completion + } + } elseif {"" != ${matches}} { + # puts stderr \nmore=$matches\n + set longest [CompleteLongest ${matches}] + # puts stderr longest=|$longest| + if {"" == $longest} { + return [string trim "[list $text] ${matches}"] + } else { + return [string trim "${pre}${longest} ${matches}"] + } + } else { + return ""; # nothing to complete + } } #** # CompleteFromList will never return an empty string. # completes, if a completion can be done, or ring @@ -235,30 +229,30 @@ # the bell if not. If inhibit is non-zero, the result # will be formatted such that readline will not insert # a space after a complete (single) match. # proc CompleteFromList {text lst {allow ""} {inhibit 0}} { - set result [TryFromList ${text} ${lst} ${allow} ${inhibit}] - if {![llength ${result}]} { - Alert - # return [string trim [list ${text}] ${lst}"] - if {[llength ${lst}]} { - return [string trim "${text} ${lst}"] - } else { - return [string trim [list ${text} {}]] - } - } else { - return ${result} - } + set result [TryFromList ${text} ${lst} ${allow} ${inhibit}] + if {![llength ${result}]} { + Alert + # return [string trim [list ${text}] ${lst}"] + if {[llength ${lst}]} { + return [string trim "${text} ${lst}"] + } else { + return [string trim [list ${text} {}]] + } + } else { + return ${result} + } } #** # CompleteBoolean does a CompleteFromList # with a list of all valid boolean values. # proc CompleteBoolean {text} { - return [CompleteFromList $text {yes no true false 1 0}] + return [CompleteFromList $text {yes no true false 1 0}] } #** # build a list of all executables which can be # found in $env(PATH). This is (naturally) a bit @@ -265,32 +259,32 @@ # slow, and should not called frequently. Instead # it is a good idea to check if the variable # `executables' exists and then just use it's # content instead of calling Rehash. # (see complete(exec)). -# +# proc Rehash {} { - global env - variable executables - - if {![info exists env] || ![array exists env]} { - return - } - if {![info exists env(PATH)]} { - return - } - - set executables 0 - foreach dir [split $env(PATH) :] { - if {[catch [list set files [glob -nocomplain ${dir}/*]]]} { continue } - foreach file $files { - if {[file executable $file]} { - lappend executables [file tail ${file}] - } - } - } + global env + variable executables + + if {![info exists env] || ![array exists env]} { + return + } + if {![info exists env(PATH)]} { + return + } + + set executables 0 + foreach dir [split $env(PATH) :] { + if {[catch [list set files [glob -nocomplain ${dir}/*]]]} { continue } + foreach file $files { + if {[file executable $file]} { + lappend executables [file tail ${file}] + } + } + } } #** # build a list hosts from the /etc/hosts file. # this is only done once. This is sort of a @@ -297,39 +291,39 @@ # 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 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] - } - } - close ${id} - } - } - } - return ${hosts} + # read the host table only once. + # + variable hosts + if {![info exists hosts]} { + catch { + 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] + } + } + close ${id} + } + } + } + return ${hosts} } #** # never return an empty string, never complete. # This is useful for showing options lists for example. # proc DisplayHints {lst} { - return [string trim "{} ${lst}"] + return [string trim "{} ${lst}"] } #** # find (partial) matches for `text' in `lst'. Ring # the bell and return the whole list, if the user @@ -339,27 +333,27 @@ # for passing to the readline completer. Thus, # MatchesFromList should not be called directly but # from formatting routines as TryFromList. # proc MatchesFromList {text lst {allow ""}} { - set result "" - set text [StripPrefix $text] - set null [string index $text 0] - foreach char {< ?} { - if {$char == $null && -1 == [string first $char $allow]} { - Alert - return $lst - } - } - # puts stderr "(MatchesFromList) text=$text" - # puts stderr "(MatchesFromList) lst=$lst" - foreach word $lst { - if {[string match ${text}* ${word}]} { - lappend result ${word} - } - } - return [string trim $result] + set result "" + set text [StripPrefix $text] + set null [string index $text 0] + foreach char {< ?} { + if {$char == $null && -1 == [string first $char $allow]} { + Alert + return $lst + } + } + # puts stderr "(MatchesFromList) text=$text" + # puts stderr "(MatchesFromList) lst=$lst" + 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. @@ -372,83 +366,83 @@ # @return list of options for cmd # @date Sep-14-1999 # proc TrySubCmds {text cmd} { - set trystring ---- - - # try the command with and w/o trystring. - # Some commands, e.g. - # .canvas bind - # return an error if invoked w/o arguments - # but not, if invoked with arguments. Breaking - # the loop is eventually done at the end ... - # - for {set str ${trystring}} {1} {set str ""} { - - set code [catch {set result [eval ${cmd} ${str}]} msg] - set result "" - - if {$code} { - set tcmd [string trim ${cmd}] - # puts stderr msg=$msg - # XXX see - # tclIndexObj.c - # tkImgPhoto.c - # XXX - if {[regexp \ - {(bad|ambiguous|unrecognized) .*"----": *must *be( .*$)} \ - ${msg} all junk 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} - } - } - if {[string length ${result}] && \ - -1 == [string first ${trystring} ${result}] - } { - return [TryFromList ${text} ${result}] - } - - } elseif {[regexp \ - "wrong # args: should be \"?${tcmd}\[^ \t\]*\(.*\[^\"\]\)" \ - ${msg} all hint] - - } { - - # XXX see tclIndexObj.c XXX - if {-1 == [string first ${trystring} ${hint}]} { - return [DisplayHints [list <[string trim $hint]>]] - } - } else { - # check, if it's a blt error msg ... - # - set msglst [split ${msg} \n] - foreach line ${msglst} { - if {[regexp "${tcmd}\[ \t\]\+\(\[^ \t\]*\)\[^:\]*$" \ - ${line} all sub] - } { - lappend result [list ${sub}] - } - } - if {[string length ${result}] && \ - -1 == [string first ${trystring} ${result}] - } { - return [TryFromList ${text} ${result}] - } - } - } - if {"" == ${str}} { - break - } - } - return "" + set trystring ---- + + # try the command with and w/o trystring. + # Some commands, e.g. + # .canvas bind + # return an error if invoked w/o arguments + # but not, if invoked with arguments. Breaking + # the loop is eventually done at the end ... + # + for {set str ${trystring}} {1} {set str ""} { + + set code [catch {set result [eval ${cmd} ${str}]} msg] + set result "" + + if {$code} { + set tcmd [string trim ${cmd}] + # puts stderr msg=$msg + # XXX see + # tclIndexObj.c + # tkImgPhoto.c + # XXX + if {[regexp \ + {(bad|ambiguous|unrecognized) .*"----": *must *be( .*$)} \ + ${msg} all junk 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} + } + } + if {[string length ${result}] && \ + -1 == [string first ${trystring} ${result}] + } { + return [TryFromList ${text} ${result}] + } + + } elseif {[regexp \ + "wrong # args: should be \"?${tcmd}\[^ \t\]*\(.*\[^\"\]\)" \ + ${msg} all hint] + + } { + + # XXX see tclIndexObj.c XXX + if {-1 == [string first ${trystring} ${hint}]} { + return [DisplayHints [list <[string trim $hint]>]] + } + } else { + # check, if it's a blt error msg ... + # + set msglst [split ${msg} \n] + foreach line ${msglst} { + if {[regexp "${tcmd}\[ \t\]\+\(\[^ \t\]*\)\[^:\]*$" \ + ${line} all sub] + } { + lappend result [list ${sub}] + } + } + if {[string length ${result}] && \ + -1 == [string first ${trystring} ${result}] + } { + return [TryFromList ${text} ${result}] + } + } + } + if {"" == ${str}} { + break + } + } + return "" } #** # try to get casses for commands which # allow `configure' (cget). @@ -457,25 +451,25 @@ # @return number of options # @date Sat-Sep-18 # proc ClassTable {cmd} { - # first we build an option table. - # We always use `configure' here, - # because cget will not return the - # option table. - # - if {[catch [list set option_table [eval ${cmd} configure]] msg]} { - return "" - } - set classes "" - foreach optline ${option_table} { - if {5 != [llength ${optline}]} continue else { - lappend classes [lindex ${optline} 2] - } - } - return ${classes} + # first we build an option table. + # We always use `configure' here, + # because cget will not return the + # option table. + # + if {[catch [list set option_table [eval ${cmd} configure]] msg]} { + return "" + } + set classes "" + foreach optline ${option_table} { + if {5 != [llength ${optline}]} continue else { + lappend classes [lindex ${optline} 2] + } + } + return ${classes} } #** # try to get options for commands which # allow `configure' (cget). @@ -483,34 +477,34 @@ # @param optionsT where the table will be stored. # @return number of options # @date Sep-14-1999 # proc OptionTable {cmd optionsT} { - upvar $optionsT options - # first we build an option table. - # We always use `configure' here, - # because cget will not return the - # option table. - # - if {[catch [list set option_table [eval ${cmd} configure]] msg]} { - return 0 - } - set retval 0 - foreach optline ${option_table} { - if {5 == [llength ${optline}]} { - # tk returns a list of length 5 - lappend options(switches) [lindex ${optline} 0] - lappend options(value) [lindex ${optline} 4] - incr retval - } elseif {3 == [llength ${optline}]} { - # itcl returns a list of length 3 - lappend options(switches) [lindex ${optline} 0] - lappend options(value) [lindex ${optline} 2] - incr retval - } - } - return $retval + upvar $optionsT options + # first we build an option table. + # We always use `configure' here, + # because cget will not return the + # option table. + # + if {[catch [list set option_table [eval ${cmd} configure]] msg]} { + return 0 + } + set retval 0 + foreach optline ${option_table} { + if {5 == [llength ${optline}]} { + # tk returns a list of length 5 + lappend options(switches) [lindex ${optline} 0] + lappend options(value) [lindex ${optline} 4] + incr retval + } elseif {3 == [llength ${optline}]} { + # itcl returns a list of length 3 + lappend options(switches) [lindex ${optline} 0] + lappend options(value) [lindex ${optline} 2] + incr retval + } + } + return $retval } #** # try to complete a `cmd configure|cget ..' from the command's options. # @param text start line cmd, standard tclreadlineCompleter arguments. @@ -518,143 +512,143 @@ # @return resultT -- a tclreadline completer formatted string. # @date Sep-14-1999 # proc CompleteFromOptions {text start line resultT} { - upvar ${resultT} result - set result "" - - # check if either `configure' or `cget' is present. - # - set lst [ProperList ${line}] - foreach keyword {configure cget} { - set idx [lsearch ${lst} ${keyword}] - if {-1 != ${idx}} { - break - } - } - if {-1 == ${idx}} { - return 0 - } - - if {[regexp {(cget|configure)$} ${line}]} { - # we are at the end of (configure|cget) - # but there's no space yet. - # - set result ${text} - return 1 - } - - # separate the command, but exclude (cget|configure) - # because cget won't return the option table. Instead - # OptionTable always uses `configure' to get the - # option table. - # - set cmd [lrange ${lst} 0 [expr ${idx} - 1]] - - TraceText ${cmd} - if {0 < [OptionTable ${cmd} options]} { - - set prev [PreviousWord ${start} ${line}] - if {-1 != [set found [lsearch -exact $options(switches) ${prev}]]} { - - # complete only if the user has not - # already entered something here. - # - if {![llength ${text}]} { - - # check first, if the SpecificSwitchCompleter - # knows something about this switch. (note that - # `prev' contains the switch). The `0' as last - # argument makes the SpecificSwitchCompleter - # returning "" if it knows nothing specific - # about this switch. - # - set values [SpecificSwitchCompleter \ - ${text} ${start} ${line} ${prev} 0] - - if [string length ${values}] { - set result ${values} - return 1 - } else { - set val [lindex $options(value) ${found}] - if [string length ${val}] { - # return the old value only, if it's non-empty. - # Use this double list to quote option - # values which have to be quoted. - # - set result [list [list ${val}]] - return 1 - } else { - set result "" - return 1 - } - } - } else { - set result [SpecificSwitchCompleter \ - ${text} ${start} ${line} ${prev} 1] - return 1 - } - - } else { - set result [CompleteFromList ${text} \ - [RemoveUsedOptions ${line} $options(switches)]] - return 1 - } - } - return 1 + upvar ${resultT} result + set result "" + + # check if either `configure' or `cget' is present. + # + set lst [ProperList ${line}] + foreach keyword {configure cget} { + set idx [lsearch ${lst} ${keyword}] + if {-1 != ${idx}} { + break + } + } + if {-1 == ${idx}} { + return 0 + } + + if {[regexp {(cget|configure)$} ${line}]} { + # we are at the end of (configure|cget) + # but there's no space yet. + # + set result ${text} + return 1 + } + + # separate the command, but exclude (cget|configure) + # because cget won't return the option table. Instead + # OptionTable always uses `configure' to get the + # option table. + # + set cmd [lrange ${lst} 0 [expr ${idx} - 1]] + + TraceText ${cmd} + if {0 < [OptionTable ${cmd} options]} { + + set prev [PreviousWord ${start} ${line}] + if {-1 != [set found [lsearch -exact $options(switches) ${prev}]]} { + + # complete only if the user has not + # already entered something here. + # + if {![llength ${text}]} { + + # check first, if the SpecificSwitchCompleter + # knows something about this switch. (note that + # `prev' contains the switch). The `0' as last + # argument makes the SpecificSwitchCompleter + # returning "" if it knows nothing specific + # about this switch. + # + set values [SpecificSwitchCompleter \ + ${text} ${start} ${line} ${prev} 0] + + if [string length ${values}] { + set result ${values} + return 1 + } else { + set val [lindex $options(value) ${found}] + if [string length ${val}] { + # return the old value only, if it's non-empty. + # Use this double list to quote option + # values which have to be quoted. + # + set result [list [list ${val}]] + return 1 + } else { + set result "" + return 1 + } + } + } else { + set result [SpecificSwitchCompleter \ + ${text} ${start} ${line} ${prev} 1] + return 1 + } + + } else { + set result [CompleteFromList ${text} \ + [RemoveUsedOptions ${line} $options(switches)]] + return 1 + } + } + return 1 } proc ObjectClassCompleter {text start end line pos resultT} { - upvar ${resultT} result - set cmd [Lindex ${line} 0] - if {"." == [string index ${line} 0]} { - # it's a widget. Try to get it's class name. - # - if {![catch [list set class [winfo class [Lindex ${line} 0]]]]} { - if {[string length [info proc ${class}Obj]]} { - set result [${class}Obj ${text} ${start} ${end} ${line} ${pos}] - # puts stderr result=|$result| - # joze, Thu Sep 30 16:43:17 1999 - if {[string length $result]} { - return 1 - } else { - return 0 - } - } else { - return 0 - } - } - } - if {![catch {set type [image type $cmd]}]} { - switch -- ${type} { - photo { - set result [PhotoObj ${text} ${start} ${end} ${line} ${pos}] - return 1 - } - default { - # let the fallback completers do the job. - return 0 - } - } - } - return 0 + upvar ${resultT} result + set cmd [Lindex ${line} 0] + if {"." == [string index ${line} 0]} { + # it's a widget. Try to get it's class name. + # + if {![catch [list set class [winfo class [Lindex ${line} 0]]]]} { + if {[string length [info proc ${class}Obj]]} { + set result [${class}Obj ${text} ${start} ${end} ${line} ${pos}] + # puts stderr result=|$result| + # joze, Thu Sep 30 16:43:17 1999 + if {[string length $result]} { + return 1 + } else { + return 0 + } + } else { + return 0 + } + } + } + if {![catch {set type [image type $cmd]}]} { + switch -- ${type} { + photo { + set result [PhotoObj ${text} ${start} ${end} ${line} ${pos}] + return 1 + } + default { + # let the fallback completers do the job. + return 0 + } + } + } + return 0 } proc CompleteFromOptionsOrSubCmds {text start end line pos} { - if [CompleteFromOptions ${text} ${start} ${line} from_opts] { - # always return, if CompleteFromOptions returns non-zero, - # that means (configure|cget) were present. This ensures - # that TrySubCmds will not configure something by chance. - # - return ${from_opts} - } else { - # puts stderr \n\n[lrange [ProperList ${line}] 0 [expr $pos - 1]]\n - return [TrySubCmds ${text} \ - [lrange [ProperList ${line}] 0 [expr $pos - 1]]] - } - return "" + if [CompleteFromOptions ${text} ${start} ${line} from_opts] { + # always return, if CompleteFromOptions returns non-zero, + # that means (configure|cget) were present. This ensures + # that TrySubCmds will not configure something by chance. + # + return ${from_opts} + } else { + # puts stderr \n\n[lrange [ProperList ${line}] 0 [expr $pos - 1]]\n + return [TrySubCmds ${text} \ + [lrange [ProperList ${line}] 0 [expr $pos - 1]]] + } + return "" } #** # TODO: shit. make this better! # @param text, a std completer argument (current word). @@ -666,251 +660,251 @@ # @return a formatted completer string. # @date Sep-15-1999 # proc CompleteListFromList {text fullpart lst pre sep post} { - # puts stderr "" - # puts stderr text=|$text| - # puts stderr lst=|$lst| - # puts stderr pre=|$pre| - # puts stderr sep=|$sep| - # puts stderr post=|$post| - - if {![string length ${fullpart}]} { - - # nothing typed so far. Insert a $pre - # and inhibit further completion. - # - return [list ${pre} {}] - - } elseif {${post} == [String index ${text} end]} { - - # finalize, append the post and a space. - # - set diff \ - [expr [CountChar ${fullpart} ${pre}] - [CountChar ${fullpart} ${post}]] - for {set i 0} {${i} < ${diff}} {incr i} { - append text ${post} - } - append text " " - return ${text} - - } elseif {![regexp -- ^\(.*\[${pre}${sep}\]\)\(\[^${pre}${sep}\]*\)$ \ - ${text} all left right] - } { - set left {} - set right ${text} - } - - # TraceVar left - # TraceVar right - - # puts stderr \nleft=|$left| - # puts stderr \nright=|$right| - set exact_matches [MatchesFromList ${right} ${lst}] - # TODO this is awkward. Think of making it better! - # - if {1 == [llength ${exact_matches}] && -1 != [lsearch ${lst} ${right}] - } { - #set completion [CompleteFromList ${right} [list ${sep} ${post}] 1] - return [list ${left}${right}${sep} {}] - } else { - set completion [CompleteFromList ${right} ${lst} "" 1] - } - # puts stderr \ncompletion=|$completion| - if {![string length [lindex $completion 0]]} { - return [concat [list ${left}] [lrange $completion 1 end]] - } elseif {[string length ${left}]} { - return [list ${left}]${completion} - } else { - return ${completion} - } - return "" + # puts stderr "" + # puts stderr text=|$text| + # puts stderr lst=|$lst| + # puts stderr pre=|$pre| + # puts stderr sep=|$sep| + # puts stderr post=|$post| + + if {![string length ${fullpart}]} { + + # nothing typed so far. Insert a $pre + # and inhibit further completion. + # + return [list ${pre} {}] + + } elseif {${post} == [String index ${text} end]} { + + # finalize, append the post and a space. + # + set diff \ + [expr [CountChar ${fullpart} ${pre}] - [CountChar ${fullpart} ${post}]] + for {set i 0} {${i} < ${diff}} {incr i} { + append text ${post} + } + append text " " + return ${text} + + } elseif {![regexp -- ^\(.*\[${pre}${sep}\]\)\(\[^${pre}${sep}\]*\)$ \ + ${text} all left right] + } { + set left {} + set right ${text} + } + + # TraceVar left + # TraceVar right + + # puts stderr \nleft=|$left| + # puts stderr \nright=|$right| + set exact_matches [MatchesFromList ${right} ${lst}] + # TODO this is awkward. Think of making it better! + # + if {1 == [llength ${exact_matches}] && -1 != [lsearch ${lst} ${right}] + } { + #set completion [CompleteFromList ${right} [list ${sep} ${post}] 1] + return [list ${left}${right}${sep} {}] + } else { + set completion [CompleteFromList ${right} ${lst} "" 1] + } + # puts stderr \ncompletion=|$completion| + if {![string length [lindex $completion 0]]} { + return [concat [list ${left}] [lrange $completion 1 end]] + } elseif {[string length ${left}]} { + return [list ${left}]${completion} + } else { + return ${completion} + } + return "" } 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 { - incr expr_pos - } - } - return ${expr_pos} + set expr_pos 1 + foreach word [lrange ${line} 1 end] {; # 0 is the command itself + if {"-" != [string index ${word} 0]} { + break + } else { + incr expr_pos + } + } + return ${expr_pos} } proc RemoveUsedOptions {line opts {terminate {}}} { - if {[llength ${terminate}]} { - if {[regexp -- ${terminate} ${line}]} { - return "" - } - } - set new "" - foreach word ${opts} { - if {-1 == [string first ${word} ${line}]} { - lappend new ${word} - } - } - - # check if the last word in the line is an options - # and if this word is at the very end of the line, - # that means no space after. - # If this is so, the word is stuffed into the result, - # so that it can be completed -- probably with a space. - # - set last [Lindex ${line} end] - if {[expr [string last ${last} ${line}] + [string length ${last}]] == \ - [string length ${line}] - } { - if {-1 != [lsearch ${opts} ${last}]} { - lappend new ${last} - } - } - - return [string trim ${new}] + if {[llength ${terminate}]} { + if {[regexp -- ${terminate} ${line}]} { + return "" + } + } + set new "" + foreach word ${opts} { + if {-1 == [string first ${word} ${line}]} { + lappend new ${word} + } + } + + # check if the last word in the line is an options + # and if this word is at the very end of the line, + # that means no space after. + # If this is so, the word is stuffed into the result, + # so that it can be completed -- probably with a space. + # + set last [Lindex ${line} end] + if {[expr [string last ${last} ${line}] + [string length ${last}]] == \ + [string length ${line}] + } { + if {-1 != [lsearch ${opts} ${last}]} { + lappend new ${last} + } + } + + return [string trim ${new}] } proc Alert {} { - ::tclreadline::readline bell + ::tclreadline::readline bell } #** # get the longest common completion # e.g. str == {tcl_version tclreadline_version tclreadline_library} # --> [CompleteLongest ${str}] == "tcl" # proc CompleteLongest {str} { - # puts stderr str=$str - set match0 [lindex ${str} 0] - set len0 [string length $match0] - set no_matches [llength ${str}] - set part "" - for {set i 0} {$i < $len0} {incr i} { - set char [string index $match0 $i] - for {set j 1} {$j < $no_matches} {incr j} { - if {$char != [string index [lindex ${str} $j] $i]} { - break - } - } - if {$j < $no_matches} { - break - } else { - append part $char - } - } - # puts stderr part=$part - return ${part} + # puts stderr str=$str + set match0 [lindex ${str} 0] + set len0 [string length $match0] + set no_matches [llength ${str}] + set part "" + for {set i 0} {$i < $len0} {incr i} { + set char [string index $match0 $i] + for {set j 1} {$j < $no_matches} {incr j} { + if {$char != [string index [lindex ${str} $j] $i]} { + break + } + } + if {$j < $no_matches} { + break + } else { + append part $char + } + } + # puts stderr part=$part + return ${part} } proc SplitLine {start line} { - set depth 0 - # puts stderr SplitLine - for {set i $start} {$i >= 0} {incr i -1} { - set c [string index $line $i] - if {{;} == $c} { - incr i; # discard command break character - return [list [expr $start - $i] [String range $line $i end]] - } elseif {{]} == $c} { - incr depth - } elseif {{[} == $c} { - incr depth -1 - if {$depth < 0} { - incr i; # discard command break character - return [list [expr $start - $i] [String range $line $i end]] - } - } - } - return "" + set depth 0 + # puts stderr SplitLine + for {set i $start} {$i >= 0} {incr i -1} { + set c [string index $line $i] + if {{;} == $c} { + incr i; # discard command break character + return [list [expr $start - $i] [String range $line $i end]] + } elseif {{]} == $c} { + incr depth + } elseif {{[} == $c} { + incr depth -1 + if {$depth < 0} { + incr i; # discard command break character + return [list [expr $start - $i] [String range $line $i end]] + } + } + } + return "" } proc IsWhite {char} { - if {" " == $char || "\n" == $char || "\t" == $char} { - return 1 - } else { - return 0 - } + if {" " == $char || "\n" == $char || "\t" == $char} { + return 1 + } else { + return 0 + } } proc PreviousWordOfIncompletePosition {start line} { - return [lindex [ProperList [string range ${line} 0 ${start}]] end] + return [lindex [ProperList [string range ${line} 0 ${start}]] end] } proc PreviousWord {start line} { - incr start -1 - set found 0 - for {set i $start} {$i > 0} {incr i -1} { - set c [string index $line $i] - if {${found} && [IsWhite $c]} { - break - } elseif {!${found} && ![IsWhite $c]} { - set found 1 - } - } - return [string trim [string range ${line} $i $start]] + 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 Quote {value left} { - set right [Right ${left}] - if {1 < [llength $value] && "" == $right} { - return [list \"${value}\"] - } else { - return [list ${left}${value}${right}] - } + set right [Right ${left}] + if {1 < [llength $value] && "" == $right} { + return [list \"${value}\"] + } else { + return [list ${left}${value}${right}] + } } # the following two channel proc's make use of # the brandnew (Sep 99) `file channels' command # but have some fallback behaviour for older # tcl version. # proc InChannelId {text {switches ""}} { - if [catch {set chs [file channels]}] { - set chs {stdin} - } - set result "" - foreach ch $chs { - if {![catch {fileevent $ch readable}]} { - lappend result $ch - } - } - return [ChannelId ${text} $result $switches] + if [catch {set chs [file channels]}] { + set chs {stdin} + } + set result "" + foreach ch $chs { + if {![catch {fileevent $ch readable}]} { + lappend result $ch + } + } + return [ChannelId ${text} $result $switches] } proc OutChannelId {text {switches ""}} { - if [catch {set chs [file channels]}] { - set chs {stdout stderr} - } - set result "" - foreach ch $chs { - if {![catch {fileevent $ch writable}]} { - lappend result $ch - } - } - return [ChannelId ${text} $result $switches] + if [catch {set chs [file channels]}] { + set chs {stdout stderr} + } + set result "" + foreach ch $chs { + if {![catch {fileevent $ch writable}]} { + lappend result $ch + } + } + return [ChannelId ${text} $result $switches] } proc ChannelId {text {descript } {chs ""} {switches ""}} { - if {"" == ${chs}} { - # the `file channels' command is present - # only in pretty new versions. - # - if [catch {set chs [file channels]}] { - set chs {stdin stdout stderr} - } - } - if {[llength [set channel [TryFromList ${text} "${chs} ${switches}"]]]} { - return ${channel} - } else { - return [DisplayHints [string trim "${descript} ${switches}"]] - } + if {"" == ${chs}} { + # the `file channels' command is present + # only in pretty new versions. + # + if [catch {set chs [file channels]}] { + set chs {stdin stdout stderr} + } + } + if {[llength [set channel [TryFromList ${text} "${chs} ${switches}"]]]} { + return ${channel} + } else { + return [DisplayHints [string trim "${descript} ${switches}"]] + } } proc QuoteQuotes {line} { - regsub -all -- \" $line {\"} line - regsub -all -- \{ $line {\{} line; # \}\} (keep the editor happy) - return $line + regsub -all -- \" $line {\"} line + regsub -all -- \{ $line {\{} line; # \}\} (keep the editor happy) + return $line } #** # get the word position. # @return the word position @@ -927,58 +921,58 @@ # line == "put $b" # [PartPosition] should return 0 # proc PartPosition {partT startT endT lineT} { - upvar $partT part $startT start $endT end $lineT line - EventuallyEvaluateFirst part start end line - return [Llength [string range $line 0 [expr $start - 1]]] + upvar $partT part $startT start $endT end $lineT line + EventuallyEvaluateFirst part start end line + return [Llength [string range $line 0 [expr $start - 1]]] -# +# # set local_start [expr $start - 1] # set local_start_chr [string index $line $local_start] # if {"\"" == $local_start_chr || "\{" == $local_start_chr} { # incr local_start -1 # } -# +# # set pre_text [QuoteQuotes [string range $line 0 $local_start]] # return [llength $pre_text] -# +# } proc Right {left} { - # puts left=$left - if {"\"" == $left} { - return "\"" - } elseif {"\\\"" == $left} { - return "\\\"" - } elseif {"\{" == $left} { - return "\}" - } elseif {"\\\{" == $left} { - return "\\\}" - } - return "" + # puts left=$left + if {"\"" == $left} { + return "\"" + } elseif {"\\\"" == $left} { + return "\\\"" + } elseif {"\{" == $left} { + return "\}" + } elseif {"\\\{" == $left} { + return "\\\}" + } + return "" } proc GetQuotedPrefix {text} { - set null [string index $text 0] - if {"\"" == $null || "\{" == $null} { - return \\$null - } else { - return {} - } + set null [string index $text 0] + if {"\"" == $null || "\{" == $null} { + return \\$null + } else { + return {} + } } proc CountChar {line char} { - # puts stderr char=|$char| - set found 0 - set pos 0 - while {-1 != [set pos [string first $char $line $pos]]} { - incr pos - incr found - } - return $found + # puts stderr char=|$char| + set found 0 + set pos 0 + while {-1 != [set pos [string first $char $line $pos]]} { + incr pos + incr found + } + return $found } #** # make a proper tcl list from an icomplete # string, that is: remove the junk. This is @@ -986,33 +980,33 @@ # e.g.: # for {set i 1} " # --> for {set i 1} # proc ProperList {line} { - set last [expr [string length $line] - 1] - for {set i $last} {$i >= 0} {incr i -1} { - if {![catch {llength [string range $line 0 $i]}]} { - break - } - } - return [string range $line 0 $i] + set last [expr [string length $line] - 1] + for {set i $last} {$i >= 0} {incr i -1} { + if {![catch {llength [string range $line 0 $i]}]} { + break + } + } + return [string range $line 0 $i] } #** # return the last part of a line which # prevents the line from beeing a list. # This is complementary to `ProperList'. # proc IncompleteListRemainder {line} { - set last [expr [string length $line] - 1] - for {set i $last} {$i >= 0} {incr i -1} { - if {![catch {llength [string range $line 0 $i]}]} { - break - } - } - incr i - return [String range $line $i end] + set last [expr [string length $line] - 1] + for {set i $last} {$i >= 0} {incr i -1} { + if {![catch {llength [string range $line 0 $i]}]} { + break + } + } + incr i + return [String range $line $i end] } #** # save `lindex'. works also for non-complete lines # with opening parentheses or quotes. @@ -1019,48 +1013,48 @@ # usage as `lindex'. # Eventually returns the Rest of an incomplete line, # if the index is `end' or == [Llength $line]. # proc Lindex {line pos} { - if {[catch [list set sub [lindex ${line} ${pos}]]]} { - if {"end" == ${pos} || [Llength ${line}] == ${pos}} { - return [IncompleteListRemainder ${line}] - } - set line [ProperList ${line}] - # puts stderr \nproper_line=|$proper_line| - if {[catch [list set sub [lindex ${line} ${pos}]]]} { return {} } - } - return ${sub} + if {[catch [list set sub [lindex ${line} ${pos}]]]} { + if {"end" == ${pos} || [Llength ${line}] == ${pos}} { + return [IncompleteListRemainder ${line}] + } + set line [ProperList ${line}] + # puts stderr \nproper_line=|$proper_line| + if {[catch [list set sub [lindex ${line} ${pos}]]]} { return {} } + } + return ${sub} } #** # save `llength' (see above). # proc Llength {line} { - if {[catch [list set len [llength ${line}]]]} { - set line [ProperList ${line}] - if {[catch [list set len [llength ${line}]]]} { return {} } - } - # puts stderr \nline=$line - return ${len} + if {[catch [list set len [llength ${line}]]]} { + set line [ProperList ${line}] + if {[catch [list set len [llength ${line}]]]} { return {} } + } + # puts stderr \nline=$line + return ${len} } #** # save `lrange' (see above). # proc Lrange {line first last} { - if {[catch [list set range [lrange ${line} ${first} ${last}]]]} { - set rest [IncompleteListRemainder ${line}] - set proper [ProperList ${line}] - if {[catch [list set range [lindex ${proper} ${first} ${last}]]]} { - return {} - } - if {"end" == ${last} || [Llength ${line}] == ${last}} { - append sub " ${rest}" - } - } - return ${range} + if {[catch [list set range [lrange ${line} ${first} ${last}]]]} { + set rest [IncompleteListRemainder ${line}] + set proper [ProperList ${line}] + if {[catch [list set range [lindex ${proper} ${first} ${last}]]]} { + return {} + } + if {"end" == ${last} || [Llength ${line}] == ${last}} { + append sub " ${rest}" + } + } + return ${range} } #** # Lunique -- remove duplicate entries from a sorted list # @param list @@ -1067,17 +1061,17 @@ # @return unique list # @author Johannes Zellner # @date Sep-19-1999 # proc Lunique lst { - set unique "" - foreach element ${lst} { - if {${element} != [lindex ${unique} end]} { - lappend unique ${element} - } - } - return ${unique} + set unique "" + foreach element ${lst} { + if {${element} != [lindex ${unique} end]} { + lappend unique ${element} + } + } + return ${unique} } #** # string function, which works also for older versions # of tcl, which don't have the `end' index. @@ -1085,232 +1079,232 @@ # the builtin `string' which worked, but slowed down # things considerably. So I decided to call `String' # only if I really need the `end' index. # proc String args { - if {[info tclversion] < 8.2} { - switch [lindex $args 1] { - range - - index { - if {"end" == [lindex $args end]} { - set str [lindex $args 2] - lreplace args end end [expr [string length $str] - 1] - } - } - } - } - return [eval string $args] + if {[info tclversion] < 8.2} { + switch [lindex $args 1] { + range - + index { + if {"end" == [lindex $args end]} { + set str [lindex $args 2] + lreplace args end end [expr [string length $str] - 1] + } + } + } + } + return [eval string $args] } proc StripPrefix {text} { - # puts "(StripPrefix) text=|$text|" - set null [string index $text 0] - if {"\"" == $null || "\{" == $null} { - return [String range $text 1 end] - } else { - return $text - } + # puts "(StripPrefix) text=|$text|" + set null [string index $text 0] + if {"\"" == $null || "\{" == $null} { + return [String range $text 1 end] + } else { + return $text + } } proc VarCompletion {text {level -1}} { - if {"#" != [string index ${level} 0]} { - if {-1 == ${level}} { - set level [info level] - } else { - incr level - } - } - set pre [GetQuotedPrefix ${text}] - set var [StripPrefix ${text}] - # puts stderr "(VarCompletion) pre=|$pre|" - # puts stderr "(VarCompletion) var=|$var|" - - # 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}([CompleteLongest ${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 - return [CompleteFromList ${text} ${matches}] - } else { - return ""; # nothing to complete - } + if {"#" != [string index ${level} 0]} { + if {-1 == ${level}} { + set level [info level] + } else { + incr level + } + } + set pre [GetQuotedPrefix ${text}] + set var [StripPrefix ${text}] + # puts stderr "(VarCompletion) pre=|$pre|" + # puts stderr "(VarCompletion) var=|$var|" + + # 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}([CompleteLongest ${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 + return [CompleteFromList ${text} ${matches}] + } else { + return ""; # nothing to complete + } } proc CompleteControlStatement {text start end line pos mod pre new_line} { - set pre [GetQuotedPrefix ${pre}] - set cmd [Lindex $new_line 0] - set diff [expr \ - [string length $line] - [string length $new_line]] - if {$diff == [expr $start + 1]} { - set mod1 $mod - } else { - set mod1 $text - set pre "" - } - set new_end [expr $end - $diff] - set new_start [expr $new_end - [string length $mod1]] - # puts "" - # puts new_start=$new_start - # puts new_end=$new_end - # puts new_line=$new_line - # puts mod1=$mod1 - if {$new_start < 0} { - return ""; # when does this occur? - } - # puts stderr "" - # puts stderr start=|$start| - # puts stderr end=|$end| - # puts stderr mod=|$mod| - # puts stderr new_start=|$new_start| - # puts stderr new_end=|$new_end| - # puts stderr new_line=|$new_line| - # puts stderr "" - set res [ScriptCompleter $mod1 $new_start $new_end $new_line] - # puts stderr \n\${pre}\${res}=|${pre}${res}| - if {[string length [Lindex ${res} 0]]} { - return ${pre}${res} - } else { - return ${res} - } - return "" + set pre [GetQuotedPrefix ${pre}] + set cmd [Lindex $new_line 0] + set diff [expr \ + [string length $line] - [string length $new_line]] + if {$diff == [expr $start + 1]} { + set mod1 $mod + } else { + set mod1 $text + set pre "" + } + set new_end [expr $end - $diff] + set new_start [expr $new_end - [string length $mod1]] + # puts "" + # puts new_start=$new_start + # puts new_end=$new_end + # puts new_line=$new_line + # puts mod1=$mod1 + if {$new_start < 0} { + return ""; # when does this occur? + } + # puts stderr "" + # puts stderr start=|$start| + # puts stderr end=|$end| + # puts stderr mod=|$mod| + # puts stderr new_start=|$new_start| + # puts stderr new_end=|$new_end| + # puts stderr new_line=|$new_line| + # puts stderr "" + set res [ScriptCompleter $mod1 $new_start $new_end $new_line] + # puts stderr \n\${pre}\${res}=|${pre}${res}| + if {[string length [Lindex ${res} 0]]} { + return ${pre}${res} + } else { + return ${res} + } + return "" } proc BraceOrCommand {text start end line pos mod} { - if {![string length [Lindex $line $pos]]} { - return [list \{ {}]; # \} - } else { - set new_line [string trim [IncompleteListRemainder $line]] - if {![regexp {^([\{\"])(.*)$} $new_line all pre new_line]} { - set pre "" - } - return [CompleteControlStatement $text \ - $start $end $line $pos $mod $pre $new_line] - } + if {![string length [Lindex $line $pos]]} { + return [list \{ {}]; # \} + } else { + set new_line [string trim [IncompleteListRemainder $line]] + if {![regexp {^([\{\"])(.*)$} $new_line all pre new_line]} { + set pre "" + } + return [CompleteControlStatement $text \ + $start $end $line $pos $mod $pre $new_line] + } } proc FullQualifiedMatches {qualifier matchlist} { - set new "" - if {"" != $qualifier && ![regexp ::$ $qualifier]} { - append qualifier :: - } - foreach entry ${matchlist} { - set full ${qualifier}${entry} - if {"" != [namespace which ${full}]} { - lappend new ${full} - } - } - return ${new} + set new "" + if {"" != $qualifier && ![regexp ::$ $qualifier]} { + append qualifier :: + } + foreach entry ${matchlist} { + set full ${qualifier}${entry} + if {"" != [namespace which ${full}]} { + lappend new ${full} + } + } + return ${new} } proc ProcsOnlyCompletion {cmd} { - return [CommandCompletion ${cmd} procs] + return [CommandCompletion ${cmd} procs] } proc CommandsOnlyCompletion {cmd} { - return [CommandCompletion ${cmd} commands] + return [CommandCompletion ${cmd} commands] } proc CommandCompletion {cmd {action both} {spc ::}} { - # get the leading colons in `cmd'. - regexp {^:*} ${cmd} pre - return [CommandCompletionWithPre $cmd $action $spc $pre] + # 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|" - - set cmd [StripPrefix ${cmd}] - set quali [namespace qualifiers ${cmd}] - if {[string length ${quali}]} { - # puts stderr \nquali=|$quali| - 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 all_commands [namespace eval $spc [list info commands ${cmd}]] - # puts stderr all_commands=|$all_commands| - set commands "" - foreach command $all_commands { - if {[namespace eval $spc [list namespace origin $command]] == \ - [namespace eval $spc [list namespace which $command]]} { - lappend commands $command - } - } - } else { - 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 $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 [CommandCompletionWithPre {} ${action} ${namespaces} ${pre}] - # puts stderr \nmatches=|$matches| - return $matches - } - - # make `namespaces' having exactly - # the same number of colons as `cmd'. - # - regsub -all {^:*} $spc $pre spc - - set matches [FullQualifiedMatches ${spc} ${matches}] - # puts stderr \nmatches3=|$matches| - return [string trim "${matches} ${namespaces}"] + # puts stderr "(CommandCompletion) cmd=|$cmd|" + # puts stderr "(CommandCompletion) action=|$action|" + # puts stderr "(CommandCompletion) spc=|$spc|" + + set cmd [StripPrefix ${cmd}] + set quali [namespace qualifiers ${cmd}] + if {[string length ${quali}]} { + # puts stderr \nquali=|$quali| + 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 all_commands [namespace eval $spc [list info commands ${cmd}]] + # puts stderr all_commands=|$all_commands| + set commands "" + foreach command $all_commands { + if {[namespace eval $spc [list namespace origin $command]] == \ + [namespace eval $spc [list namespace which $command]]} { + lappend commands $command + } + } + } else { + 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 $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 [CommandCompletionWithPre {} ${action} ${namespaces} ${pre}] + # puts stderr \nmatches=|$matches| + return $matches + } + + # make `namespaces' having exactly + # the same number of colons as `cmd'. + # + regsub -all {^:*} $spc $pre spc + + set matches [FullQualifiedMatches ${spc} ${matches}] + # puts stderr \nmatches3=|$matches| + return [string trim "${matches} ${namespaces}"] } #** # check, if the first argument starts with a '[' # and must be evaluated before continuing. @@ -1317,43 +1311,43 @@ # NOTE: trims the `line'. # eventually modifies all arguments. # DATE: Sep-06-1999 # proc EventuallyEvaluateFirst {partT startT endT lineT} { - # return; # disabled - upvar $partT part $startT start $endT end $lineT line - - set oldlen [string length ${line}] - # set line [string trim ${line}] - set line [string trimleft ${line}] - set diff [expr [string length $line] - $oldlen] - incr start $diff - incr end $diff - - set char [string index ${line} 0] - if {{[} != ${char} && {$} != ${char}} {return} - - set pos 0 - while {-1 != [set idx [string first {]} ${line} ${pos}]]} { - set cmd [string range ${line} 0 ${idx}] - if {[info complete ${cmd}]} { - break; - } - set pos [expr ${idx} + 1] - } - - if {![info exists cmd]} {return} - if {![info complete ${cmd}]} {return} - set cmd [string range ${cmd} 1 [expr [string length ${cmd}] - 2]] - set rest [String range ${line} [expr ${idx} + 1] end] - - if {[catch [list set result [string trim [eval ${cmd}]]]]} {return} - - set line ${result}${rest} - set diff [expr [string length ${result}] - ([string length ${cmd}] + 2)] - incr start ${diff} - incr end ${diff} + # return; # disabled + upvar $partT part $startT start $endT end $lineT line + + set oldlen [string length ${line}] + # set line [string trim ${line}] + set line [string trimleft ${line}] + set diff [expr [string length $line] - $oldlen] + incr start $diff + incr end $diff + + set char [string index ${line} 0] + if {{[} != ${char} && {$} != ${char}} {return} + + set pos 0 + while {-1 != [set idx [string first {]} ${line} ${pos}]]} { + set cmd [string range ${line} 0 ${idx}] + if {[info complete ${cmd}]} { + break; + } + set pos [expr ${idx} + 1] + } + + if {![info exists cmd]} {return} + if {![info complete ${cmd}]} {return} + set cmd [string range ${cmd} 1 [expr [string length ${cmd}] - 2]] + set rest [String range ${line} [expr ${idx} + 1] end] + + if {[catch [list set result [string trim [eval ${cmd}]]]]} {return} + + set line ${result}${rest} + set diff [expr [string length ${result}] - ([string length ${cmd}] + 2)] + incr start ${diff} + incr end ${diff} } # if the line entered so far is # % puts $b # part == $b @@ -1361,211 +1355,211 @@ # end == 7 # line == "$puts $b" # proc ScriptCompleter {part start end line} { - # puts stderr "(ScriptCompleter) |$part| $start $end |$line|" - - # if the character before the cursor is a terminating - # quote and the user wants completion, we insert a white - # space here. - # - set char [string index $line [expr $end - 1]] - if {"\}" == $char} { - append $part " " - return [list $part] - } - - if {{$} == [string index $part 0]} { - - # check for a !$ history event - # - if {$start > 0} { - if {{!} == [string index $line [expr $start - 1]]} { - return "" - } - } - # variable completion. Check first, if the - # variable starts with a plain `$' or should - # be enclosed in braces. - # - set var [String range $part 1 end] - - # check if $var is an array name, which - # already has already a "(" somewhere inside. - # - if {"" != [set vc [VarCompletion $var]]} { - 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 - # start == 10 - # end == 13 - # line == "puts bla; put $b" - # [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]]} { - - # XXX - # note that line will be [string trimleft'ed] - # after PartPosition. - # XXX - - # 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 - # set namespc ""; # widgets are always in the global - # } else { - - # the double `lindex' strips {} or quotes. - # the subst enables variables containing - # command names. - # - set alias [uplevel [info level] \ - subst [lindex [lindex [QuoteQuotes ${line}] 0] 0]] - - # make `alias' a fully qualified name. - # this can raise an error, if alias is - # no valid command. - # - if {[catch {set alias [namespace origin $alias]}]} { - return "" - } - - # strip leading ::'s. - # - regsub -all {^::} $alias {} alias - set namespc [namespace qualifiers $alias] - set alias [namespace tail $alias] - # } - - # try first a specific completer, then, and only then - # the tclreadline_complete_unknown. - # - foreach cmd [list ${alias} tclreadline_complete_unknown] { - # puts stderr ${namespc}complete(${cmd}) - if {"" != [namespace eval ::tclreadline::${namespc} \ - [list info procs complete(${cmd})]] - } { - # puts found=|complete($cmd)| - # to be more error-proof, we check here, - # if complete($cmd) takes exactly 5 arguments. - # - if {6 != [set arguments [llength \ - [namespace eval ::tclreadline::${namespc} \ - [list info args complete($cmd)]]]] - } { - error [list complete(${cmd}) takes ${arguments} \ - arguments, but should take exactly 6.] - } - - # remove leading quotes - # - set mod [StripPrefix $part] - # puts stderr mod=$mod - - if {[catch [list set script_result \ - [namespace eval ::tclreadline::${namespc} \ - [list complete(${cmd}) $part $start $end $line $pos $mod]]]\ - ::tclreadline::errorMsg] - } { - error [list error during evaluation of `complete(${cmd})'] - } - # puts stderr \nscript_result=|${script_result}| - if {![string length ${script_result}] && \ - "tclreadline_complete_unknown" == ${cmd} - } { - # as we're here, the tclreadline_complete_unknown - # returned an empty string. Fall thru and try - # further fallback completers. - # - } else { - # return also empty strings, if - # they're from a specific completer. - # - TraceText script_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 ${namespc}]} { - set namespc :: - } - if {[string length [uplevel [info level] \ - namespace eval ${namespc} [list ::info proc $alias]]] - } { - if ![string length [string trim $part]] { - set args [uplevel [info level] \ - namespace eval ${namespc} [list info args $alias]] - set arg [lindex $args [expr $pos - 1]] - if {"" != $arg && "args" != $arg} { - if {[uplevel [info level] namespace eval \ - ${namespc} [list info default $alias $arg junk]]} { - return [DisplayHints ?$arg?] - } else { - return [DisplayHints <$arg>] - } - } - } else { - return ""; # enable file name completion - } - } - - # check if the command is an object of known class. - # - if [ObjectClassCompleter ${part} ${start} ${end} ${line} ${pos} res] { - return ${res} - } - - # Ok, also no proc. Try to do the same as for widgets now: - # try to complete from the option table if the subcommand - # is `configure' or `cget' otherwise try to get further - # subcommands. - # - return [CompleteFromOptionsOrSubCmds \ - ${part} ${start} ${end} ${line} ${pos}] - } - error "{NOTREACHED (this is probably an error)}" + # puts stderr "(ScriptCompleter) |$part| $start $end |$line|" + + # if the character before the cursor is a terminating + # quote and the user wants completion, we insert a white + # space here. + # + set char [string index $line [expr $end - 1]] + if {"\}" == $char} { + append $part " " + return [list $part] + } + + if {{$} == [string index $part 0]} { + + # check for a !$ history event + # + if {$start > 0} { + if {{!} == [string index $line [expr $start - 1]]} { + return "" + } + } + # variable completion. Check first, if the + # variable starts with a plain `$' or should + # be enclosed in braces. + # + set var [String range $part 1 end] + + # check if $var is an array name, which + # already has already a "(" somewhere inside. + # + if {"" != [set vc [VarCompletion $var]]} { + 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 + # start == 10 + # end == 13 + # line == "puts bla; put $b" + # [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]]} { + + # XXX + # note that line will be [string trimleft'ed] + # after PartPosition. + # XXX + + # 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 + # set namespc ""; # widgets are always in the global + # } else { + + # the double `lindex' strips {} or quotes. + # the subst enables variables containing + # command names. + # + set alias [uplevel [info level] \ + subst [lindex [lindex [QuoteQuotes ${line}] 0] 0]] + + # make `alias' a fully qualified name. + # this can raise an error, if alias is + # no valid command. + # + if {[catch {set alias [namespace origin $alias]}]} { + return "" + } + + # strip leading ::'s. + # + regsub -all {^::} $alias {} alias + set namespc [namespace qualifiers $alias] + set alias [namespace tail $alias] + # } + + # try first a specific completer, then, and only then + # the tclreadline_complete_unknown. + # + foreach cmd [list ${alias} tclreadline_complete_unknown] { + # puts stderr ${namespc}complete(${cmd}) + if {"" != [namespace eval ::tclreadline::${namespc} \ + [list info procs complete(${cmd})]] + } { + # puts found=|complete($cmd)| + # to be more error-proof, we check here, + # if complete($cmd) takes exactly 5 arguments. + # + if {6 != [set arguments [llength \ + [namespace eval ::tclreadline::${namespc} \ + [list info args complete($cmd)]]]] + } { + error [list complete(${cmd}) takes ${arguments} \ + arguments, but should take exactly 6.] + } + + # remove leading quotes + # + set mod [StripPrefix $part] + # puts stderr mod=$mod + + if {[catch [list set script_result \ + [namespace eval ::tclreadline::${namespc} \ + [list complete(${cmd}) $part $start $end $line $pos $mod]]]\ + ::tclreadline::errorMsg] + } { + error [list error during evaluation of `complete(${cmd})'] + } + # puts stderr \nscript_result=|${script_result}| + if {![string length ${script_result}] && \ + "tclreadline_complete_unknown" == ${cmd} + } { + # as we're here, the tclreadline_complete_unknown + # returned an empty string. Fall thru and try + # further fallback completers. + # + } else { + # return also empty strings, if + # they're from a specific completer. + # + TraceText script_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 ${namespc}]} { + set namespc :: + } + if {[string length [uplevel [info level] \ + namespace eval ${namespc} [list ::info proc $alias]]] + } { + if ![string length [string trim $part]] { + set args [uplevel [info level] \ + namespace eval ${namespc} [list info args $alias]] + set arg [lindex $args [expr $pos - 1]] + if {"" != $arg && "args" != $arg} { + if {[uplevel [info level] namespace eval \ + ${namespc} [list info default $alias $arg junk]]} { + return [DisplayHints ?$arg?] + } else { + return [DisplayHints <$arg>] + } + } + } else { + return ""; # enable file name completion + } + } + + # check if the command is an object of known class. + # + if [ObjectClassCompleter ${part} ${start} ${end} ${line} ${pos} res] { + return ${res} + } + + # Ok, also no proc. Try to do the same as for widgets now: + # try to complete from the option table if the subcommand + # is `configure' or `cget' otherwise try to get further + # subcommands. + # + return [CompleteFromOptionsOrSubCmds \ + ${part} ${start} ${end} ${line} ${pos}] + } + error "{NOTREACHED (this is probably an error)}" } # explicit command completers # @@ -1573,205 +1567,205 @@ # ------------------------------------- # TCL # ------------------------------------- proc complete(after) {text start end line pos mod} { - set sub [Lindex $line 1] - # puts \npos=$pos - switch -- $pos { - 1 { - return [CompleteFromList ${text} { cancel idle info}] - } - 2 { - switch -- $sub { - cancel { - return [CompleteFromList $text "