Index: AUTHORS ================================================================== --- AUTHORS +++ AUTHORS @@ -1,1 +1,1 @@ -Johannes Zellner, , http://www.zellner.org/ + Johannes Zellner http://www.zellner.org/ Index: Makefile.in ================================================================== --- Makefile.in +++ Makefile.in @@ -1,8 +1,8 @@ # -*- make -*- -# FILE: "/home/joze/src/tclreadline/Makefile.in.bak" -# LAST MODIFICATION: "Thu, 23 Mar 2000 20:47:35 +0100 (joze)" +# FILE: "/home/joze/src/tclreadline/Makefile.in" +# LAST MODIFICATION: "Thu, 23 Mar 2000 23:26:56 +0100 (joze)" # (C) 1998 - 2000 by Johannes Zellner, # $Id$ # --- # # tclreadline -- gnu readline for tcl @@ -143,11 +143,11 @@ TCL_LIB_SPEC = @TCL_LIB_SPEC@ TK_LIB_SPEC = @TK_LIB_SPEC@ READLINE_INCLUDE_DIR = @READLINE_INCLUDE_DIR@ TCLREADLINE_LIB_FILE = @TCLREADLINE_LIB_FILE@ -READLINE_LIB = -L@READLINE_LIB_DIR@ -lreadline +READLINE_LIB = @READLINE_LIB_DIR@ -lreadline TERMLIB = @TERMLIB@ TERMLIB_DIR = @TERMLIB_DIR@ #---------------------------------------------------------------- # The information below should be usable as is. The configure Index: README ================================================================== --- README +++ README @@ -1,14 +1,14 @@ FILE: "/home/joze/src/tclreadline/README" - LAST MODIFICATION: "Thu Dec 16 22:17:39 1999 (joze)" - (C) 1998, 1999 by Johannes Zellner, + LAST MODIFICATION: "Thu, 23 Mar 2000 21:16:15 +0100 (joze)" + (C) 1998 - 2000 by Johannes Zellner, $Id$ --- tclreadline -- gnu readline for tcl - Copyright (C) 1999 Johannes Zellner + Copyright (C) 1998 - 2000 by Johannes Zellner This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Index: TODO ================================================================== --- TODO +++ TODO @@ -1,16 +1,16 @@ /* ================================================================== - FILE: "/diska/home/joze/src/tclreadline/TODO" - LAST MODIFICATION: "Mon Sep 6 08:44:35 1999 (joze)" - (C) 1998, 1999 by Johannes Zellner, + FILE: "/home/joze/src/tclreadline/TODO" + LAST MODIFICATION: "Thu, 23 Mar 2000 21:16:21 +0100 (joze)" + (C) 1998 - 2000 by Johannes Zellner, $Id$ --- tclreadline -- gnu readline for tcl - Copyright (C) 1999 Johannes Zellner + Copyright (C) 1998 - 2000 by Johannes Zellner This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Index: config.h.in ================================================================== --- config.h.in +++ config.h.in @@ -1,17 +1,17 @@ /* ================================================================== - FILE: "/home/joze/src/tclreadline/config.h.in.bak" - LAST MODIFICATION: "Thu, 23 Mar 2000 20:53:11 +0100 (joze)" + FILE: "/home/joze/src/tclreadline/config.h.in" + LAST MODIFICATION: "Thu, 23 Mar 2000 21:16:34 +0100 (joze)" (C) 1998 - 2000 by Johannes Zellner, $Id$ vim:set ft=c: --- tclreadline -- gnu readline for tcl - Copyright (C) 1998 - 2000 Johannes Zellner + Copyright (C) 1998 - 2000 by Johannes Zellner This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Index: configure.in ================================================================== --- configure.in +++ configure.in @@ -1,14 +1,14 @@ dnl -*- autoconf -*- dnl FILE: "/home/joze/src/tclreadline/configure.in" -dnl LAST MODIFICATION: "Thu, 23 Mar 2000 20:46:59 +0100 (joze)" +dnl LAST MODIFICATION: "Thu, 23 Mar 2000 23:26:48 +0100 (joze)" dnl (C) 1998 - 2000 by Johannes Zellner, dnl $Id$ dnl --- dnl dnl tclreadline -- gnu readline for tcl -dnl Copyright (C) 1998 - 2000 Johannes Zellner +dnl Copyright (C) 1998 - 2000 by Johannes Zellner dnl dnl This program is free software; you can redistribute it and/or dnl modify it under the terms of the GNU General Public License dnl as published by the Free Software Foundation; either version 2 dnl of the License, or (at your option) any later version. @@ -31,11 +31,11 @@ dnl generate the file "configure", which is run during Tk installation dnl to configure the system for the local environment. AC_INIT(tclreadline.c) -AM_CONFIG_HEADER(config.h) +AC_CONFIG_HEADER(config.h) AC_PREREQ(2.13) AC_REVISION($Revision$) AC_CONFIG_AUX_DIR(./aux) TCLREADLINE_MAJOR_VERSION=1 @@ -43,12 +43,10 @@ TCLREADLINE_PATCHLEVEL=0 TCLREADLINE_VERSION=$TCLREADLINE_MAJOR_VERSION.$TCLREADLINE_MINOR_VERSION TCLREADLINE_PATCHLEVEL_STR=${TCLREADLINE_VERSION}.${TCLREADLINE_PATCHLEVEL} VERSION=$TCLREADLINE_VERSION -AM_INIT_AUTOMAKE(libtclreadline, $VERSION) - dnl AM_INIT_AUTOMAKE(tclreadline, $VERSION) AC_CANONICAL_HOST @@ -91,19 +89,19 @@ #-------------------------------------------------------------------- tk_search="no" AC_ARG_WITH( tk, - [ --with-tk=DIR where to look for tclConfig.sh], + [ --with-tk=DIR where to look for tkConfig.sh], tk_search=$withval, tk_search="yes" ) if test "$tk_search" != "no"; then AC_MSG_CHECKING([which tkConfig.sh to use]) TK_LIB_DIR="" - for dir in $tk_search /usr/lib /usr/local/lib $exec_prefix/lib /usr/local/lib/unix /opt/tcl/lib; do + for dir in $tk_search $TCL_LIB_DIR /usr/lib /usr/local/lib $exec_prefix/lib /usr/local/lib/unix /opt/tcl/lib; do if test -r $dir/tkConfig.sh; then TK_LIB_DIR=$dir break fi done @@ -169,11 +167,10 @@ # ----------------------------------------------------------------------- # Check for some programs here. # ----------------------------------------------------------------------- -AM_PROG_LIBTOOL AC_PROG_INSTALL AC_PROG_RANLIB AC_PROG_LN_S @@ -202,36 +199,39 @@ # ----------------------------------------------------------------------- AC_PROG_CPP - -#-------------------------------------------------------------------- -# If this is gcc, add some extra compile flags. -#-------------------------------------------------------------------- - -AC_MSG_CHECKING([whether C compiler is gcc]) -AC_CACHE_VAL(tclreadline_cv_prog_gcc, - AC_EGREP_CPP(_cc_is_gcc_, [ -#ifdef __GNUC__ -_cc_is_gcc_ -#endif -], [tclreadline_cv_prog_gcc=yes], [tclreadline_cv_prog_gcc=no])) -AC_MSG_RESULT([$tclreadline_cv_prog_gcc]) - if test -z "$CFLAGS" ; then CFLAGS=$TCL_CFLAGS_OPTIMIZE fi -if test "$tclreadline_cv_prog_gcc" = "yes" ; then - CFLAGS="$CFLAGS -Wshadow -Wtraditional -Wall" -fi - -AC_MSG_CHECKING([default compiler flags]) -AC_ARG_WITH(cflags, [ --with-cflags=FLAGS set compiler flags to FLAGS], - [CFLAGS="$with_cflags"]) - -AC_MSG_RESULT([$CFLAGS]) + +dnl #-------------------------------------------------------------------- +dnl # If this is gcc, add some extra compile flags. +dnl #-------------------------------------------------------------------- +dnl +dnl AC_MSG_CHECKING([whether C compiler is gcc]) +dnl AC_CACHE_VAL(tclreadline_cv_prog_gcc, +dnl AC_EGREP_CPP(_cc_is_gcc_, [ +dnl #ifdef __GNUC__ +dnl _cc_is_gcc_ +dnl #endif +dnl ], [tclreadline_cv_prog_gcc=yes], [tclreadline_cv_prog_gcc=no])) +dnl AC_MSG_RESULT([$tclreadline_cv_prog_gcc]) +dnl +dnl if test -z "$CFLAGS" ; then +dnl CFLAGS=$TCL_CFLAGS_OPTIMIZE +dnl fi +dnl if test "$tclreadline_cv_prog_gcc" = "yes" ; then +dnl CFLAGS="$CFLAGS -Wshadow -Wtraditional -Wall" +dnl fi +dnl +dnl AC_MSG_CHECKING([default compiler flags]) +dnl AC_ARG_WITH(cflags, [ --with-cflags=FLAGS set compiler flags to FLAGS], +dnl [CFLAGS="$with_cflags"]) +dnl +dnl AC_MSG_RESULT([$CFLAGS]) if test "$TCL_CC" != "$CC" ; then echo "" echo "WARNING: Compiler is $CC but Tcl was compiled with $TCL_CC" echo "" @@ -357,15 +357,25 @@ READLINE_VERSION_SUFFIX="" for dir in $rl_library $TCLREADLINE_LPATH $prefix/lib/readline; do if test -r $dir/libreadline$SHLIB_SUFFIX; then READLINE_LIB_DIR=$dir break + fi + if test -r $dir/libreadline$SHLIB_SUFFIX.4; then + READLINE_VERSION_SUFFIX=".4" + READLINE_LIB_DIR=$dir + break fi if test -r $dir/libreadline$SHLIB_SUFFIX.4.0; then READLINE_VERSION_SUFFIX=".4.0" READLINE_LIB_DIR=$dir break + fi + if test -r $dir/libreadline$SHLIB_SUFFIX.3; then + READLINE_VERSION_SUFFIX=".3" + READLINE_LIB_DIR=$dir + break fi if test -r $dir/libreadline$SHLIB_SUFFIX.3.0; then READLINE_VERSION_SUFFIX=".3.0" READLINE_LIB_DIR=$dir break Index: pkgIndex.tcl.in ================================================================== --- pkgIndex.tcl.in +++ pkgIndex.tcl.in @@ -1,14 +1,14 @@ #!/usr/local/bin/tclsh -# FILE: "/diska/home/joze/src/tclreadline/pkgIndex.tcl" -# LAST MODIFICATION: "Fri Aug 20 15:33:25 1999 (joze)" -# (C) 1998, 1999 by Johannes Zellner, +# FILE: "/home/joze/src/tclreadline/pkgIndex.tcl.in" +# LAST MODIFICATION: "Thu, 23 Mar 2000 21:13:00 +0100 (joze)" +# (C) 1998 - 2000 by Johannes Zellner, # $Id$ # --- # # tclreadline -- gnu readline for tcl -# Copyright (C) 1999 Johannes Zellner +# Copyright (C) 1998 - 2000 by Johannes Zellner # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. Index: sample.tclshrc ================================================================== --- sample.tclshrc +++ sample.tclshrc @@ -1,9 +1,9 @@ #!/bin/sh -# FILE: "/diska/home/joze/src/tclreadline/sample.tclshrc" -# LAST MODIFICATION: "Mon Sep 13 18:21:52 1999 (joze)" -# (C) 1999 by Johannes Zellner, +# FILE: "/home/joze/src/tclreadline/sample.tclshrc" +# LAST MODIFICATION: "Thu, 23 Mar 2000 21:13:08 +0100 (joze)" +# (C) 1998 - 2000 by Johannes Zellner, # $Id$ # vim:set ft=tcl: \ exec tclsh "$0" "$@" Index: tclreadline.c ================================================================== --- tclreadline.c +++ tclreadline.c @@ -1,16 +1,16 @@ /* ================================================================== FILE: "/home/joze/src/tclreadline/tclreadline.c" - LAST MODIFICATION: "Tue Sep 21 21:19:35 1999 (joze)" - (C) 1998, 1999 by Johannes Zellner, + LAST MODIFICATION: "Thu, 23 Mar 2000 22:42:52 +0100 (joze)" + (C) 1998 - 2000 by Johannes Zellner, $Id$ --- tclreadline -- gnu readline for tcl - Copyright (C) 1999 Johannes Zellner + Copyright (C) 1998 - 2000 by Johannes Zellner This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. @@ -123,22 +123,22 @@ 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; } char* stripright(char* in) { char* ptr; for (ptr = strchr(in, '\0') - 1; ptr >= in && *ptr <= ' '; ptr--) - *ptr = '\0'; + *ptr = '\0'; return in; } char* stripwhite(char* in) @@ -169,17 +169,17 @@ 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; } @@ -187,334 +187,334 @@ TclReadlineCmd( ClientData clientData, Tcl_Interp* interp, /* Current interpreter */ int argc, /* Number of arguments */ char** argv /* Argument strings */ -) + ) { int i, obj_idx, status; Tcl_Obj** objv = (Tcl_Obj**) MALLOC((argc + 1) * sizeof(Tcl_Obj *)); static char *subCmds[] = { - "read", "initialize", "write", "add", "complete", - "customcompleter", "builtincompleter", "eofchar", - "reset-terminal", "bell", - (char *) NULL + "read", "initialize", "write", "add", "complete", + "customcompleter", "builtincompleter", "eofchar", + "reset-terminal", "bell", + (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_READ, TCLRL_INITIALIZE, TCLRL_WRITE, TCLRL_ADD, TCLRL_COMPLETE, + TCLRL_CUSTOMCOMPLETER, TCLRL_BUILTINCOMPLETER, TCLRL_EOFCHAR, + TCLRL_RESET_TERMINAL, TCLRL_BELL }; Tcl_ResetResult(interp); /* clear the result space */ for (i = 0; i < argc; i++) { - Tcl_Obj* objPtr = Tcl_NewStringObj(argv[i], -1); - Tcl_IncrRefCount(objPtr); - objv[i] = objPtr; + Tcl_Obj* objPtr = Tcl_NewStringObj(argv[i], -1); + Tcl_IncrRefCount(objPtr); + objv[i] = objPtr; } objv[argc] = 0; /* terminate */ if (argc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); - return TCL_ERROR; + 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) { - FREE(objv) - return status; + FREE(objv) + return status; } switch (obj_idx) { - case TCLRL_READ: - - rl_callback_handler_install(argc == 3 ? argv[2] : "%", - TclReadlineLineCompleteHandler); - - Tcl_CreateFileHandler(0, TCL_READABLE, - TclReadlineReadHandler, (ClientData) NULL); - - /** - * Main Loop. - * XXX each modification of the global variables - * which terminates the main loop must call - * rl_callback_handler_remove() to leave - * readline in a defined state. XXX - */ - tclrl_state = LINE_PENDING; - - while (!TclReadlineLineComplete()) { + case TCLRL_READ: + + rl_callback_handler_install(argc == 3 ? argv[2] : "%", + TclReadlineLineCompleteHandler); + + Tcl_CreateFileHandler(0, TCL_READABLE, + TclReadlineReadHandler, (ClientData) NULL); + + /** + * Main Loop. + * XXX each modification of the global variables + * which terminates the main loop must call + * rl_callback_handler_remove() to leave + * readline in a defined state. XXX + */ + tclrl_state = LINE_PENDING; + + while (!TclReadlineLineComplete()) { #ifdef EXECUTING_MACRO_HACK - /** - * check first, if more characters are - * available from _rl_executing_macro, - * because Tcl_DoOneEvent() will (naturally) - * not detect this `event'. - */ - if (_rl_executing_macro) - TclReadlineReadHandler((ClientData) NULL, TCL_READABLE); - else + /** + * check first, if more characters are + * available from _rl_executing_macro, + * because Tcl_DoOneEvent() will (naturally) + * not detect this `event'. + */ + if (_rl_executing_macro) + TclReadlineReadHandler((ClientData) NULL, TCL_READABLE); + else #endif - Tcl_DoOneEvent(TCL_ALL_EVENTS); - } - - Tcl_DeleteFileHandler(0); - - switch (tclrl_state) { - - case LINE_COMPLETE: - - return TCL_OK; - /* NOTREACHED */ - break; - - case LINE_EOF: - if (tclrl_eof_string) - return Tcl_Eval(interp, tclrl_eof_string); - else - return TCL_OK; - /* NOTREACHED */ - break; - - default: - return tclrl_state; - /* NOTREACHED */ - break; - } - break; - - case TCLRL_INITIALIZE: - if (3 != argc) { - Tcl_WrongNumArgs(interp, 2, objv, "historyfile"); - return TCL_ERROR; - } else { - return TclReadlineInitialize(interp, argv[2]); - } - break; - - case TCLRL_WRITE: - if (3 != argc) { - Tcl_WrongNumArgs(interp, 2, objv, "historyfile"); - return TCL_ERROR; - } else if (write_history(argv[2])) { - Tcl_AppendResult(interp, "unable to write history to `", - argv[2], "'\n", (char*) NULL); - return TCL_ERROR; - } - if (tclrl_history_length >= 0) { - history_truncate_file(argv[2], tclrl_history_length); - } - return TCL_OK; - break; - - case TCLRL_ADD: - if (3 != argc) { - Tcl_WrongNumArgs(interp, 2, objv, "completerLine"); - return TCL_ERROR; - } else if (TclReadlineKnownCommands(argv[2], (int) 0, _CMD_SET)) { - Tcl_AppendResult(interp, "unable to add command \"", - argv[2], "\"\n", (char*) NULL); - } - break; - - case TCLRL_COMPLETE: - if (3 != argc) { - Tcl_WrongNumArgs(interp, 2, objv, "line"); - return TCL_ERROR; - } else if (Tcl_CommandComplete(argv[2])) { - Tcl_AppendResult(interp, "1", (char*) NULL); - } else { - Tcl_AppendResult(interp, "0", (char*) NULL); - } - break; - - case TCLRL_CUSTOMCOMPLETER: - if (argc > 3) { - Tcl_WrongNumArgs(interp, 2, objv, "?scriptCompleter?"); - return TCL_ERROR; - } else if (3 == argc) { - if (tclrl_custom_completer) - FREE(tclrl_custom_completer); - if (!blank_line(argv[2])) - tclrl_custom_completer = stripwhite(strdup(argv[2])); - } - Tcl_AppendResult(interp, tclrl_custom_completer, (char*) NULL); - break; - - case TCLRL_BUILTINCOMPLETER: - if (argc > 3) { - Tcl_WrongNumArgs(interp, 2, objv, "?boolean?"); - return TCL_ERROR; - } else if (3 == argc) { - int bool = tclrl_use_builtin_completer; - if (TCL_OK != Tcl_GetBoolean(interp, argv[2], &bool)) { - Tcl_AppendResult(interp, - "wrong # args: should be a boolean value.", - (char*) NULL); - return TCL_ERROR; - } else { - tclrl_use_builtin_completer = bool; - } - } - Tcl_AppendResult(interp, tclrl_use_builtin_completer ? "1" : "0", - (char*) NULL); - break; - - case TCLRL_EOFCHAR: - if (argc > 3) { - Tcl_WrongNumArgs(interp, 2, objv, "?script?"); - return TCL_ERROR; - } else if (3 == argc) { - if (tclrl_eof_string) - FREE(tclrl_eof_string); - if (!blank_line(argv[2])) - tclrl_eof_string = stripwhite(strdup(argv[2])); - } - Tcl_AppendResult(interp, tclrl_eof_string, (char*) NULL); - break; - - case TCLRL_RESET_TERMINAL: - /* TODO: add this to the completer */ - if (argc > 3) { - Tcl_WrongNumArgs(interp, 2, objv, "?terminal-name?"); - return TCL_ERROR; - } - if (3 == argc) { - /* - * - tcl8.0 doesn't have Tcl_GetString() - * - rl_reset_terminal() might be defined - * to take no arguments. This might produce - * a compiler warning. - */ - rl_reset_terminal(Tcl_GetStringFromObj(objv[2], (int*) NULL)); + Tcl_DoOneEvent(TCL_ALL_EVENTS); + } + + Tcl_DeleteFileHandler(0); + + switch (tclrl_state) { + + case LINE_COMPLETE: + + return TCL_OK; + /* NOTREACHED */ + break; + + case LINE_EOF: + if (tclrl_eof_string) + return Tcl_Eval(interp, tclrl_eof_string); + else + return TCL_OK; + /* NOTREACHED */ + break; + + default: + return tclrl_state; + /* NOTREACHED */ + break; + } + break; + + case TCLRL_INITIALIZE: + if (3 != argc) { + Tcl_WrongNumArgs(interp, 2, objv, "historyfile"); + return TCL_ERROR; + } else { + return TclReadlineInitialize(interp, argv[2]); + } + break; + + case TCLRL_WRITE: + if (3 != argc) { + Tcl_WrongNumArgs(interp, 2, objv, "historyfile"); + return TCL_ERROR; + } else if (write_history(argv[2])) { + Tcl_AppendResult(interp, "unable to write history to `", + argv[2], "'\n", (char*) NULL); + return TCL_ERROR; + } + if (tclrl_history_length >= 0) { + history_truncate_file(argv[2], tclrl_history_length); + } + return TCL_OK; + break; + + case TCLRL_ADD: + if (3 != argc) { + Tcl_WrongNumArgs(interp, 2, objv, "completerLine"); + return TCL_ERROR; + } else if (TclReadlineKnownCommands(argv[2], (int) 0, _CMD_SET)) { + Tcl_AppendResult(interp, "unable to add command \"", + argv[2], "\"\n", (char*) NULL); + } + break; + + case TCLRL_COMPLETE: + if (3 != argc) { + Tcl_WrongNumArgs(interp, 2, objv, "line"); + return TCL_ERROR; + } else if (Tcl_CommandComplete(argv[2])) { + Tcl_AppendResult(interp, "1", (char*) NULL); + } else { + Tcl_AppendResult(interp, "0", (char*) NULL); + } + break; + + case TCLRL_CUSTOMCOMPLETER: + if (argc > 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?scriptCompleter?"); + return TCL_ERROR; + } else if (3 == argc) { + if (tclrl_custom_completer) + FREE(tclrl_custom_completer); + if (!blank_line(argv[2])) + tclrl_custom_completer = stripwhite(strdup(argv[2])); + } + Tcl_AppendResult(interp, tclrl_custom_completer, (char*) NULL); + break; + + case TCLRL_BUILTINCOMPLETER: + if (argc > 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?boolean?"); + return TCL_ERROR; + } else if (3 == argc) { + int bool = tclrl_use_builtin_completer; + if (TCL_OK != Tcl_GetBoolean(interp, argv[2], &bool)) { + Tcl_AppendResult(interp, + "wrong # args: should be a boolean value.", + (char*) NULL); + return TCL_ERROR; + } else { + tclrl_use_builtin_completer = bool; + } + } + Tcl_AppendResult(interp, tclrl_use_builtin_completer ? "1" : "0", + (char*) NULL); + break; + + case TCLRL_EOFCHAR: + if (argc > 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?script?"); + return TCL_ERROR; + } else if (3 == argc) { + if (tclrl_eof_string) + FREE(tclrl_eof_string); + if (!blank_line(argv[2])) + tclrl_eof_string = stripwhite(strdup(argv[2])); + } + Tcl_AppendResult(interp, tclrl_eof_string, (char*) NULL); + break; + + case TCLRL_RESET_TERMINAL: + /* TODO: add this to the completer */ + if (argc > 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?terminal-name?"); + return TCL_ERROR; + } + if (3 == argc) { + /* + * - tcl8.0 doesn't have Tcl_GetString() + * - rl_reset_terminal() might be defined + * to take no arguments. This might produce + * a compiler warning. + */ + rl_reset_terminal(Tcl_GetStringFromObj(objv[2], (int*) NULL)); #ifdef CLEANUP_AFER_SIGNAL - } else { - rl_cleanup_after_signal(); + } else { + rl_cleanup_after_signal(); #endif - } - break; - - case TCLRL_BELL: - /* - * ring the terminal bell obeying the current - * settings -- audible or visible. - */ - ding(); - break; - - default: - goto BAD_COMMAND; - /* NOTREACHED */ - break; + } + break; + + case TCLRL_BELL: + /* + * ring the terminal bell obeying the current + * settings -- audible or visible. + */ + ding(); + 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; } void TclReadlineReadHandler(ClientData clientData, int mask) { if (mask & TCL_READABLE) { #ifdef EXECUTING_MACRO_HACK - do { + do { #endif - rl_callback_read_char(); + rl_callback_read_char(); #ifdef EXECUTING_MACRO_HACK - /** - * check, if we're inside a macro and - * if so, read all macro characters - * until the next eol. - */ - } while (_rl_executing_macro && !TclReadlineLineComplete()); + /** + * check, if we're inside a macro and + * if so, read all macro characters + * until the next eol. + */ + } while (_rl_executing_macro && !TclReadlineLineComplete()); #endif } } void TclReadlineLineCompleteHandler(char* ptr) { if (!ptr) { /* */ - TclReadlineTerminate(LINE_EOF); + TclReadlineTerminate(LINE_EOF); } else { - /** - * From version 0.9.3 upwards, all lines are - * returned, even empty lines. (Only non-empty - * lines are stuffed in readline's history.) - * The calling script is responsible for handling - * empty strings. - */ - - char* expansion = (char*) NULL; - int status = history_expand(ptr, &expansion); - - if (status >= 1) { + /** + * From version 0.9.3 upwards, all lines are + * returned, even empty lines. (Only non-empty + * lines are stuffed in readline's history.) + * The calling script is responsible for handling + * empty strings. + */ + + char* expansion = (char*) NULL; + int status = history_expand(ptr, &expansion); + + if (status >= 1) { #if 0 - Tcl_Channel channel = Tcl_MakeFileChannel(stdout, TCL_WRITABLE); - /* Tcl_RegisterChannel(interp, channel); */ - (void) Tcl_WriteChars(channel, expansion, -1); - Tcl_Flush(channel); - Tcl_Close(interp, channel); + Tcl_Channel channel = Tcl_MakeFileChannel(stdout, TCL_WRITABLE); + /* Tcl_RegisterChannel(interp, channel); */ + (void) Tcl_WriteChars(channel, expansion, -1); + Tcl_Flush(channel); + Tcl_Close(interp, channel); #else - /* TODO: make this a valid tcl output */ - printf("%s\n", expansion); -#endif - } else if (-1 == status) { - Tcl_AppendResult - (tclrl_interp, "error in history expansion\n", (char*) NULL); - TclReadlineTerminate(TCL_ERROR); - } - /** - * TODO: status == 2 ... - */ - - Tcl_AppendResult(tclrl_interp, expansion, (char*) NULL); - -#ifdef EXECUTING_MACRO_HACK - /** - * don't stuff macro lines - * into readline's history. - */ - if(!_rl_executing_macro) { -#endif - /** - * don't stuff empty lines - * into readline's history. - * don't stuff twice the same - * line into readline's history. - */ - if (expansion && *expansion && (!tclrl_last_line || - strcmp(tclrl_last_line, expansion))) { - add_history(expansion); - } - if (tclrl_last_line) - free(tclrl_last_line); - tclrl_last_line = strdup(expansion); -#ifdef EXECUTING_MACRO_HACK - } -#endif - /** - * tell the calling routines to terminate. - */ - TclReadlineTerminate(LINE_COMPLETE); - FREE(ptr); - FREE(expansion); + /* TODO: make this a valid tcl output */ + printf("%s\n", expansion); +#endif + } else if (-1 == status) { + Tcl_AppendResult + (tclrl_interp, "error in history expansion\n", (char*) NULL); + TclReadlineTerminate(TCL_ERROR); + } + /** + * TODO: status == 2 ... + */ + + Tcl_AppendResult(tclrl_interp, expansion, (char*) NULL); + +#ifdef EXECUTING_MACRO_HACK + /** + * don't stuff macro lines + * into readline's history. + */ + if(!_rl_executing_macro) { +#endif + /** + * don't stuff empty lines + * into readline's history. + * don't stuff twice the same + * line into readline's history. + */ + if (expansion && *expansion && (!tclrl_last_line || + strcmp(tclrl_last_line, expansion))) { + add_history(expansion); + } + if (tclrl_last_line) + free(tclrl_last_line); + tclrl_last_line = strdup(expansion); +#ifdef EXECUTING_MACRO_HACK + } +#endif + /** + * tell the calling routines to terminate. + */ + TclReadlineTerminate(LINE_COMPLETE); + FREE(ptr); + FREE(expansion); } } int Tclreadline_SafeInit(Tcl_Interp *interp) @@ -525,33 +525,33 @@ int Tclreadline_Init(Tcl_Interp *interp) { int status; Tcl_CreateCommand(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, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) - return status; + (char*) &TCLRL_VERSION, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) + return status; if (TCL_OK != (status = Tcl_LinkVar(interp, "::tclreadline::patchLevel", - (char*) &TCLRL_PATCHLEVEL, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) - return status; + (char*) &TCLRL_PATCHLEVEL, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) + return status; if (TCL_OK != (status = Tcl_LinkVar(interp, "tclreadline_library", - (char*) &TCLRL_LIBRARY, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) - return status; + (char*) &TCLRL_LIBRARY, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) + return status; if (TCL_OK != (status = Tcl_LinkVar(interp, "tclreadline_version", - (char*) &TCLRL_VERSION, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) - return status; + (char*) &TCLRL_VERSION, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) + return status; if (TCL_OK != (status = Tcl_LinkVar(interp, "tclreadline_patchLevel", - (char*) &TCLRL_PATCHLEVEL, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) - return status; + (char*) &TCLRL_PATCHLEVEL, TCL_LINK_STRING | TCL_LINK_READ_ONLY))) + return status; return Tcl_PkgProvide(interp, "tclreadline", TCLRL_VERSION); } int TclReadlineInitialize(Tcl_Interp* interp, char* historyfile) @@ -575,46 +575,46 @@ #if 0 rl_basic_quote_characters = "\"{"; /* XXX ??? XXX */ rl_completer_quote_characters = "\""; #endif /* - rl_filename_quote_characters - = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"; + rl_filename_quote_characters + = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"; - rl_filename_quoting_function - = (CPFunction*) TclReadlineFilenameQuotingFunction; - */ + rl_filename_quoting_function + = (CPFunction*) TclReadlineFilenameQuotingFunction; + */ /* - rl_filename_quoting_desired = 1; - */ + 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; } 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; } char** @@ -623,95 +623,95 @@ 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); - FREE(quoted_text); - FREE(quoted_rl_line_buffer); - if (TCL_OK != state) { - Tcl_AppendResult (tclrl_interp, " `", tclrl_custom_completer, - " \"", quoted_text, "\" ", start_s, " ", end_s, - " \"", quoted_rl_line_buffer, "\"' failed.", (char*) NULL); - TclReadlineTerminate(state); - return matches; - } - obj = Tcl_GetObjResult(tclrl_interp); - status = Tcl_ListObjGetElements(tclrl_interp, obj, &objc, &objv); - if (TCL_OK != status) - 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); + FREE(quoted_text); + FREE(quoted_rl_line_buffer); + if (TCL_OK != state) { + Tcl_AppendResult (tclrl_interp, " `", tclrl_custom_completer, + " \"", quoted_text, "\" ", start_s, " ", end_s, + " \"", quoted_rl_line_buffer, "\"' failed.", (char*) NULL); + TclReadlineTerminate(state); + return matches; + } + obj = Tcl_GetObjResult(tclrl_interp); + status = Tcl_ListObjGetElements(tclrl_interp, obj, &objc, &objv); + if (TCL_OK != status) + 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 */ } if (!matches && tclrl_use_builtin_completer) { - matches = completion_matches(text, TclReadline0generator); + matches = completion_matches(text, TclReadline0generator); } - + return matches; } char* TclReadline0generator(char* text, int state) @@ -730,92 +730,92 @@ char** name; char* local_line = (char*) NULL; 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; + + 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 */ } @@ -823,26 +823,26 @@ 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,17 +1,17 @@ /* ================================================================== - FILE: "/diska/home/joze/src/tclreadline/tclreadline.h.in" - LAST MODIFICATION: "Mon Sep 13 17:52:25 1999 (joze)" - (C) 1998, 1999 by Johannes Zellner, + FILE: "/home/joze/src/tclreadline/tclreadline.h.in" + LAST MODIFICATION: "Thu, 23 Mar 2000 21:13:36 +0100 (joze)" + (C) 1998 - 2000 by Johannes Zellner, $Id$ vim:set ft=c: --- tclreadline -- gnu readline for tcl - Copyright (C) 1999 Johannes Zellner + Copyright (C) 1998 - 2000 by Johannes Zellner This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Index: tclreadline.n.in ================================================================== --- tclreadline.n.in +++ tclreadline.n.in @@ -1,16 +1,15 @@ .TH tclreadline n "@TCLREADLINE_VERSION@.@TCLREADLINE_PATCHLEVEL@" "Johannes Zellner" -.\" (C) 1999 by Johannes Zellner .\" FILE: "/home/joze/src/tclreadline/tclreadline.n.in" -.\" LAST MODIFICATION: "Tue Sep 21 21:18:31 1999 (joze)" -.\" (C) 1998, 1999 by Johannes Zellner, +.\" LAST MODIFICATION: "Thu, 23 Mar 2000 21:14:10 +0100 (joze)" +.\" (C) 1998 - 2000 by Johannes Zellner, .\" $Id$ .\" --- .\" .\" tclreadline -- gnu readline for the tcl scripting language -.\" Copyright (C) 1999 Johannes Zellner +.\" Copyright (C) 1998 - 2000 by Johannes Zellner .\" .\" This program is free software; you can redistribute it and/or .\" modify it under the terms of the GNU General Public License .\" as published by the Free Software Foundation; either version 2 .\" of the License, or (at your option) any later version. Index: tclreadlineCompleter.tcl ================================================================== --- tclreadlineCompleter.tcl +++ tclreadlineCompleter.tcl @@ -1,14 +1,15 @@ # -*- tclsh -*- -# FILE: "/disk01/home/joze/src/tclreadline/tclreadlineCompleter.tcl" -# LAST MODIFICATION: "Thu Sep 30 16:43:34 1999 (joze)" -# (C) 1998, 1999 by Johannes Zellner, +# FILE: "/home/joze/src/tclreadline/tclreadlineCompleter.tcl" +# LAST MODIFICATION: "Thu, 23 Mar 2000 22:38:08 +0100 (joze)" +# (C) 1998 - 2000 by Johannes Zellner, # $Id$ +# vim:set ts=4: # --- # # tclreadline -- gnu readline for tcl -# Copyright (C) 1999 Johannes Zellner +# Copyright (C) 1998 - 2000 by Johannes Zellner # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. Index: tclreadlineConfig.sh.in ================================================================== --- tclreadlineConfig.sh.in +++ tclreadlineConfig.sh.in @@ -1,14 +1,14 @@ #!/bin/sh -# FILE: "/diska/home/joze/src/tclreadline/tclreadlineConfig.sh.in" -# LAST MODIFICATION: "Wed Aug 25 16:23:10 1999 (joze)" -# (C) 1998, 1999 by Johannes Zellner, +# FILE: "/home/joze/src/tclreadline/tclreadlineConfig.sh.in" +# LAST MODIFICATION: "Thu, 23 Mar 2000 21:14:52 +0100 (joze)" +# (C) 1998 - 2000 by Johannes Zellner, # $Id$ # --- # # tclreadline -- gnu readline for tcl -# Copyright (C) 1999 Johannes Zellner +# Copyright (C) 1998 - 2000 by Johannes Zellner # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. Index: tclreadlineInit.tcl.in ================================================================== --- tclreadlineInit.tcl.in +++ tclreadlineInit.tcl.in @@ -1,14 +1,14 @@ #!/usr/local/bin/tclsh # FILE: "/home/joze/src/tclreadline/tclreadlineInit.tcl.in" -# LAST MODIFICATION: "Thu Dec 16 21:44:31 1999 (joze)" -# (C) 1998, 1999 by Johannes Zellner, +# LAST MODIFICATION: "Thu, 23 Mar 2000 22:36:01 +0100 (joze)" +# (C) 1998 - 2000 by Johannes Zellner, # $Id$ # --- # # tclreadline -- gnu readline for tcl -# Copyright (C) 1999 Johannes Zellner +# Copyright (C) 1998 - 2000 Johannes Zellner # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. @@ -28,17 +28,17 @@ # ================================================================== package provide tclreadline @TCLREADLINE_VERSION@ namespace eval tclreadline:: { - namespace export Init + namespace export Init } proc ::tclreadline::Init {} { uplevel #0 { if ![info exists tclreadline::library] { - if [catch {load /usr/lib/tclreadline1.0/libtclreadline1.0.so} msg] { + if [catch {load @TCLREADLINE_LIBRARY@/@TCLREADLINE_LIB_FILE@} msg] { puts stderr $msg exit 2 } } } Index: tclreadlineSetup.tcl.in ================================================================== --- tclreadlineSetup.tcl.in +++ tclreadlineSetup.tcl.in @@ -1,14 +1,14 @@ #!/usr/locanl/bin/tclsh # FILE: "/home/joze/src/tclreadline/tclreadlineSetup.tcl.in" -# LAST MODIFICATION: "Mon Sep 20 01:34:31 1999 (joze)" -# (C) 1998, 1999 by Johannes Zellner, +# LAST MODIFICATION: "Thu, 23 Mar 2000 22:45:43 +0100 (joze)" +# (C) 1998 - 2000 by Johannes Zellner, # $Id$ # --- # # tclreadline -- gnu readline for tcl -# Copyright (C) 1999 Johannes Zellner +# Copyright (C) 1998 - 2000 by Johannes Zellner # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. @@ -30,111 +30,110 @@ package provide tclreadline @TCLREADLINE_VERSION@ proc unknown args { - global auto_noexec auto_noload env unknown_pending tcl_interactive - global errorCode errorInfo - - # Save the values of errorCode and errorInfo variables, since they - # may get modified if caught errors occur below. The variables will - # be restored just before re-executing the missing command. - - set savedErrorCode $errorCode - set savedErrorInfo $errorInfo - set name [lindex $args 0] - if ![info exists auto_noload] { - # - # Make sure we're not trying to load the same proc twice. - # - if [info exists unknown_pending($name)] { - return -code error "self-referential recursion in \"unknown\" for command \"$name\"" - } - set unknown_pending($name) pending - set ret [catch {auto_load $name [uplevel 1 {namespace current}]} msg] - unset unknown_pending($name) - if {$ret != 0} { - return -code $ret -errorcode $errorCode \ - "error while autoloading \"$name\": $msg" - } - if ![array size unknown_pending] { - unset unknown_pending - } - if $msg { - set errorCode $savedErrorCode - set errorInfo $savedErrorInfo - set code [catch {uplevel 1 $args} msg] - if {$code == 1} { - # - # Strip the last five lines off the error stack (they're - # from the "uplevel" command). - # - - set new [split $errorInfo \n] - set new [join [lrange $new 0 [expr [llength $new] - 6]] \n] - return -code error -errorcode $errorCode \ - -errorinfo $new $msg - } else { - return -code $code $msg - } - } - } - - # REMOVED THE [info script] TEST (joze, SEP 98) - if {([info level] == 1) \ - && [info exists tcl_interactive] && $tcl_interactive} { - if ![info exists auto_noexec] { - set new [auto_execok $name] - if {$new != ""} { - set errorCode $savedErrorCode - set errorInfo $savedErrorInfo - set redir "" - if {[info commands console] == ""} { - set redir ">&@stdout <@stdin" - } - # LOOK FOR GLOB STUFF IN $ARGS (joze, SEP 98) - return [uplevel eval exec $redir $new \ - [::tclreadline::Glob [lrange $args 1 end]]] - } - } - set errorCode $savedErrorCode - set errorInfo $savedErrorInfo - if {$name == "!!"} { - set newcmd [history event] - } elseif {[regexp {^!(.+)$} $name dummy event]} { - set newcmd [history event $event] - } elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new]} { - set newcmd [history event -1] - catch {regsub -all -- $old $newcmd $new newcmd} - } - if [info exists newcmd] { - tclLog $newcmd - history change $newcmd 0 - return [uplevel $newcmd] - } - - set ret [catch {set cmds [info commands $name*]} msg] - if {[string compare $name "::"] == 0} { - set name "" - } - if {$ret != 0} { - return -code $ret -errorcode $errorCode \ - "error in unknown while checking if \"$name\" is a unique command abbreviation: $msg" - } - if {[llength $cmds] == 1} { - return [uplevel [lreplace $args 0 0 $cmds]] - } - if {[llength $cmds] != 0} { - if {$name == ""} { - return -code error "empty command name \"\"" - } else { - return -code error \ - "ambiguous command name \"$name\": [lsort $cmds]" - } - } - } - return -code error "invalid command name \"$name\"" + global auto_noexec auto_noload env unknown_pending tcl_interactive + global errorCode errorInfo + + # Save the values of errorCode and errorInfo variables, since they + # may get modified if caught errors occur below. The variables will + # be restored just before re-executing the missing command. + + set savedErrorCode $errorCode + set savedErrorInfo $errorInfo + set name [lindex $args 0] + if ![info exists auto_noload] { + # + # Make sure we're not trying to load the same proc twice. + # + if [info exists unknown_pending($name)] { + return -code error "self-referential recursion in \"unknown\" for command \"$name\"" + } + set unknown_pending($name) pending + set ret [catch {auto_load $name [uplevel 1 {namespace current}]} msg] + unset unknown_pending($name) + if {$ret != 0} { + return -code $ret -errorcode $errorCode \ + "error while autoloading \"$name\": $msg" + } + if ![array size unknown_pending] { + unset unknown_pending + } + if $msg { + set errorCode $savedErrorCode + set errorInfo $savedErrorInfo + set code [catch {uplevel 1 $args} msg] + if {$code == 1} { + # + # Strip the last five lines off the error stack (they're + # from the "uplevel" command). + # + + set new [split $errorInfo \n] + set new [join [lrange $new 0 [expr [llength $new] - 6]] \n] + return -code error -errorcode $errorCode \ + -errorinfo $new $msg + } else { + return -code $code $msg + } + } + } + + # REMOVED THE [info script] TEST (joze, SEP 98) + if {([info level] == 1) && [info exists tcl_interactive] && $tcl_interactive} { + if ![info exists auto_noexec] { + set new [auto_execok $name] + if {$new != ""} { + set errorCode $savedErrorCode + set errorInfo $savedErrorInfo + set redir "" + if {[info commands console] == ""} { + set redir ">&@stdout <@stdin" + } + # LOOK FOR GLOB STUFF IN $ARGS (joze, SEP 98) + return [uplevel eval exec $redir $new \ + [::tclreadline::Glob [lrange $args 1 end]]] + } + } + set errorCode $savedErrorCode + set errorInfo $savedErrorInfo + if {$name == "!!"} { + set newcmd [history event] + } elseif {[regexp {^!(.+)$} $name dummy event]} { + set newcmd [history event $event] + } elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new]} { + set newcmd [history event -1] + catch {regsub -all -- $old $newcmd $new newcmd} + } + if [info exists newcmd] { + tclLog $newcmd + history change $newcmd 0 + return [uplevel $newcmd] + } + + set ret [catch {set cmds [info commands $name*]} msg] + if {[string compare $name "::"] == 0} { + set name "" + } + if {$ret != 0} { + return -code $ret -errorcode $errorCode \ + "error in unknown while checking if \"$name\" is a unique command abbreviation: $msg" + } + if {[llength $cmds] == 1} { + return [uplevel [lreplace $args 0 0 $cmds]] + } + if {[llength $cmds] != 0} { + if {$name == ""} { + return -code error "empty command name \"\"" + } else { + return -code error \ + "ambiguous command name \"$name\": [lsort $cmds]" + } + } + } + return -code error "invalid command name \"$name\"" } namespace eval tclreadline { namespace export Setup Loop InitTclCmds InitTkCmds Print ls @@ -147,205 +146,204 @@ } } proc Setup {args} { - uplevel #0 { - - if {"" == [info commands ::tclreadline::readline]} { - ::tclreadline::Init - } - - if {[catch {set a [::tclreadline::prompt1]}] \ - && [info nameofexecutable] != ""} { - - namespace eval ::tclreadline { - variable prompt_string - set base [file tail [info nameofexecutable]] - - if {[string match tclsh* $base] && [info exists tcl_version]} { - set prompt_string \ - "\[0;91mtclsh$tcl_version\[0m" - } elseif {[string match wish* $base] \ - && [info exists tk_version]} { - set prompt_string "\[0;94mwish$tk_version\[0m" - } else { - set prompt_string "\[0;91m$base\[0m" - } - - } - - if {"" == [info procs ::tclreadline::prompt1]} { - proc ::tclreadline::prompt1 {} { - variable prompt_string - global env - if {[catch {set pwd [pwd]} tmp]} { - set pwd "unable to get pwd" - } - - if [info exists env(HOME)] { - regsub $env(HOME) $pwd "~" pwd - } - return "$prompt_string \[$pwd\]" - } - } - # puts body=[info body ::tclreadline::prompt1] - } - - if {"" == [info procs exit]} { - - catch {rename ::tclreadline::Exit ""} - rename exit ::tclreadline::Exit - - proc exit {args} { - - if {[catch { - ::tclreadline::readline write \ - [::tclreadline::HistoryFileGet] - } ::tclreadline::errorMsg]} { - puts stderr $::tclreadline::errorMsg - } - - # this call is ignored, if tclreadline.c - # was compiled with CLEANUP_AFER_SIGNAL - # not defined. This is the case for - # older versions of libreadline. - # - ::tclreadline::readline reset-terminal - - if [catch "eval ::tclreadline::Exit $args" message] { - puts stderr "error:" - puts stderr "$message" - } - # NOTREACHED - } - } - - } - - global env - variable historyfile - - if {[string trim [llength ${args}]]} { - set historyfile "" - catch { - set historyfile [file nativename [lindex ${args} 0]] - } - if {"" == [string trim $historyfile]} { - set historyfile [lindex ${args} 0] - } - } else { - if [info exists env(HOME)] { - set historyfile $env(HOME)/.tclsh-history - } else { - set historyfile .tclsh-history - } - } - set ::tclreadline::errorMsg [readline initialize $historyfile] - if {$::tclreadline::errorMsg != ""} { - puts stderr $::tclreadline::errorMsg - } - - # InitCmds - - rename Setup "" + uplevel #0 { + + if {"" == [info commands ::tclreadline::readline]} { + ::tclreadline::Init + } + + if {[catch {set a [::tclreadline::prompt1]}] && [info nameofexecutable] != ""} { + + namespace eval ::tclreadline { + variable prompt_string + set base [file tail [info nameofexecutable]] + + if {[string match tclsh* $base] && [info exists tcl_version]} { + set prompt_string \ + "\[0;31mtclsh$tcl_version\[0m" + } elseif {[string match wish* $base] \ + && [info exists tk_version]} { + set prompt_string "\[0;34mwish$tk_version\[0m" + } else { + set prompt_string "\[0;31m$base\[0m" + } + + } + + if {"" == [info procs ::tclreadline::prompt1]} { + proc ::tclreadline::prompt1 {} { + variable prompt_string + global env + if {[catch {set pwd [pwd]} tmp]} { + set pwd "unable to get pwd" + } + + if [info exists env(HOME)] { + regsub $env(HOME) $pwd "~" pwd + } + return "$prompt_string \[$pwd\]" + } + } + # puts body=[info body ::tclreadline::prompt1] + } + + if {"" == [info procs exit]} { + + catch {rename ::tclreadline::Exit ""} + rename exit ::tclreadline::Exit + + proc exit {args} { + + if {[catch { + ::tclreadline::readline write \ + [::tclreadline::HistoryFileGet] + } ::tclreadline::errorMsg]} { + puts stderr $::tclreadline::errorMsg + } + + # this call is ignored, if tclreadline.c + # was compiled with CLEANUP_AFER_SIGNAL + # not defined. This is the case for + # older versions of libreadline. + # + ::tclreadline::readline reset-terminal + + if [catch "eval ::tclreadline::Exit $args" message] { + puts stderr "error:" + puts stderr "$message" + } + # NOTREACHED + } + } + + } + + global env + variable historyfile + + if {[string trim [llength ${args}]]} { + set historyfile "" + catch { + set historyfile [file nativename [lindex ${args} 0]] + } + if {"" == [string trim $historyfile]} { + set historyfile [lindex ${args} 0] + } + } else { + if [info exists env(HOME)] { + set historyfile $env(HOME)/.tclsh-history + } else { + set historyfile .tclsh-history + } + } + set ::tclreadline::errorMsg [readline initialize $historyfile] + if {$::tclreadline::errorMsg != ""} { + puts stderr $::tclreadline::errorMsg + } + + # InitCmds + + rename Setup "" } proc HistoryFileGet {} { - variable historyfile - return $historyfile + variable historyfile + return $historyfile } # obsolete # proc Glob {string} { - set commandstring "" - foreach name $string { - set replace [glob -nocomplain -- $name] - if {$replace == ""} { - lappend commandstring $name - } else { - lappend commandstring $replace - } - } - # return $commandstring - # Christian Krone proposed - return [eval concat $commandstring] + set commandstring "" + foreach name $string { + set replace [glob -nocomplain -- $name] + if {$replace == ""} { + lappend commandstring $name + } else { + lappend commandstring $replace + } + } + # return $commandstring + # Christian Krone proposed + return [eval concat $commandstring] } proc Loop {args} { - eval Setup ${args} - - uplevel #0 { - - while {1} { - - if [info exists tcl_prompt2] { - set prompt2 $tcl_prompt2 - } else { - set prompt2 ">" - } - - if {[catch { - if {"" != [namespace eval ::tclreadline {info procs prompt1}]} { - set LINE [::tclreadline::readline read \ - [::tclreadline::prompt1]] - } else { - set LINE [::tclreadline::readline read %] - } - while {![::tclreadline::readline complete $LINE]} { - append LINE "\n" - append LINE [tclreadline::readline read ${prompt2}] - } - } ::tclreadline::errorMsg]} { - puts stderr [list tclreadline::Loop: error. \ - $::tclreadline::errorMsg] - continue - } - - # Magnus Eriksson proposed - # to add the line also to tclsh's history. - # - # I decided to add only lines which are different from - # the previous one to the history. This is different - # from tcsh's behaviour, but I found it quite convenient - # while using mshell on os9. - # - if {[string length $LINE] && [history event 0] != $LINE} { - history add $LINE - } - - if [catch { - set result [eval $LINE] - if {$result != "" && [tclreadline::Print]} { - puts $result - } - set result "" - } ::tclreadline::errorMsg] { - puts stderr $::tclreadline::errorMsg - puts stderr [list while evaluating $LINE] - } - - } - } + eval Setup ${args} + + uplevel #0 { + + while {1} { + + if [info exists tcl_prompt2] { + set prompt2 $tcl_prompt2 + } else { + set prompt2 ">" + } + + if {[catch { + if {"" != [namespace eval ::tclreadline {info procs prompt1}]} { + set LINE [::tclreadline::readline read \ + [::tclreadline::prompt1]] + } else { + set LINE [::tclreadline::readline read %] + } + while {![::tclreadline::readline complete $LINE]} { + append LINE "\n" + append LINE [tclreadline::readline read ${prompt2}] + } + } ::tclreadline::errorMsg]} { + puts stderr [list tclreadline::Loop: error. \ + $::tclreadline::errorMsg] + continue + } + + # Magnus Eriksson proposed + # to add the line also to tclsh's history. + # + # I decided to add only lines which are different from + # the previous one to the history. This is different + # from tcsh's behaviour, but I found it quite convenient + # while using mshell on os9. + # + if {[string length $LINE] && [history event 0] != $LINE} { + history add $LINE + } + + if [catch { + set result [eval $LINE] + if {$result != "" && [tclreadline::Print]} { + puts $result + } + set result "" + } ::tclreadline::errorMsg] { + puts stderr $::tclreadline::errorMsg + puts stderr [list while evaluating $LINE] + } + + } + } } proc Print {args} { - variable PRINT - if ![info exists PRINT] { - set PRINT yes - } - if [regexp -nocase \(true\|yes\|1\) $args] { - set PRINT yes - } elseif [regexp -nocase \(false\|no\|0\) $args] { - set PRINT no - } - return $PRINT + variable PRINT + if ![info exists PRINT] { + set PRINT yes + } + if [regexp -nocase \(true\|yes\|1\) $args] { + set PRINT yes + } elseif [regexp -nocase \(false\|no\|0\) $args] { + set PRINT no + } + return $PRINT } # # # proc InitCmds {} { # # XXX Index: tclshrl.c ================================================================== --- tclshrl.c +++ tclshrl.c @@ -1,16 +1,16 @@ /* ================================================================== FILE: "/home/joze/src/tclreadline/tclshrl.c" - LAST MODIFICATION: "Thu Dec 16 21:51:19 1999 (joze)" - (C) 1998, 1999 by Johannes Zellner, + LAST MODIFICATION: "Thu, 23 Mar 2000 22:42:14 +0100 (joze)" + (C) 1998 - 2000 by Johannes Zellner, $Id$ --- tclreadline -- gnu readline for tcl - Copyright (C) 1999 Johannes Zellner + Copyright (C) 1998 - 2000 by Johannes Zellner This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. Index: wishrl.c ================================================================== --- wishrl.c +++ wishrl.c @@ -1,16 +1,16 @@ /* ================================================================== FILE: "/home/joze/src/tclreadline/wishrl.c" - LAST MODIFICATION: "Thu Dec 16 22:05:05 1999 (joze)" - (C) 1998, 1999 by Johannes Zellner, + LAST MODIFICATION: "Thu, 23 Mar 2000 22:42:23 +0100 (joze)" + (C) 1998 - 2000 by Johannes Zellner, $Id$ --- tclreadline -- gnu readline for tcl - Copyright (C) 1999 Johannes Zellner + Copyright (C) 1998 - 2000 by Johannes Zellner This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version.