Wouldn't it be nice to have readline editing capabilities in Tcl and
its siblings? I'm sure this must be one of the features close to the
top of a programmer's wish [sic] list. Anyhow, a friend of mine who
runs Debian pointed out that their distribution had it! I've
extracted the relevant bits from their patch file and enclosed it
below.
This is only for the tcl package, but the principle is the same for
the others. Note that tclMain.c is not actually altered, but rather
a modified duplicate is generated: rl-tclMain.c. This is good
because programs not aware of the readline feature won't break
during compile when they do not include -lreadline.
I really hope Mandrake will include it in their future releases.
Howard Lee
Computing Lab
University of Kent
England
************************* CUT HERE ***************************
diff -P -r -u tcl8.0.4-orig/unix/Makefile.in tcl8.0.4/unix/Makefile.in
--- tcl8.0.4-orig/unix/Makefile.in Wed Nov 18 22:54:26 1998
+++ tcl8.0.4/unix/Makefile.in Thu Sep 16 03:12:13 1999
@@ -222,7 +222,7 @@
${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \
-DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\"
-TCLSH_OBJS = tclAppInit.o
+TCLSH_OBJS = tclAppInit.o rl-tclMain.o
TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
tclUnixTest.o
@@ -353,7 +353,7 @@
tclsh: ${TCLSH_OBJS} ${TCL_LIB_FILE}
- ${CC} @LD_FLAGS@ ${TCLSH_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} \
+ ${CC} @LD_FLAGS@ ${TCLSH_OBJS} @TCL_BUILD_LIB_SPEC@ -lreadline -lncurses
+${LIBS} \
@TCL_LD_SEARCH_FLAGS@ -o tclsh
tcltest: ${TCLTEST_OBJS} ${TCL_LIB_FILE} ${BUILD_DLTEST}
diff -P -r -u tcl8.0.4-orig/unix/configure.in tcl8.0.4/unix/configure.in
--- tcl8.0.4-orig/unix/configure.in Wed Nov 18 22:54:26 1998
+++ tcl8.0.4/unix/configure.in Thu Sep 16 03:12:13 1999
@@ -771,8 +771,9 @@
;;
Linux*)
SHLIB_CFLAGS="-fPIC"
- SHLIB_LD_LIBS=""
+ SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".so"
+ TCL_SHARED_LIB_SUFFIX='${VERSION}.so.1'
if test "$have_dl" = yes; then
SHLIB_LD="${CC} -shared"
DL_OBJS="tclLoadDl.o"
@@ -1193,7 +1194,7 @@
if test "x$DL_OBJS" = "xtclLoadAout.o"; then
MAKE_LIB="ar cr \${TCL_LIB_FILE} \${OBJS}"
else
- MAKE_LIB="\${SHLIB_LD} -o \${TCL_LIB_FILE} \${OBJS} ${SHLIB_LD_LIBS}"
+ MAKE_LIB="\${SHLIB_LD} -o \${TCL_LIB_FILE} \${OBJS} ${SHLIB_LD_LIBS}
+-Wl,-soname,${TCL_LIB_FILE}"
RANLIB=":"
fi
else
@@ -1225,7 +1226,7 @@
else
TCL_LIB_FLAG="-ltcl`echo ${TCL_VERSION} | tr -d .`\${TCL_DBGX}"
fi
-TCL_BUILD_LIB_SPEC="-L`pwd` ${TCL_LIB_FLAG}"
+TCL_BUILD_LIB_SPEC="`pwd`/${TCL_LIB_FILE}"
TCL_LIB_SPEC="-L${exec_prefix}/lib ${TCL_LIB_FLAG}"
# tclConfig.sh needs a version of the _LIB_SUFFIX that has been eval'ed
diff -P -r -u tcl8.0.4-orig/unix/rl-tclMain.c tcl8.0.4/unix/rl-tclMain.c
--- tcl8.0.4-orig/unix/rl-tclMain.c Thu Jan 1 01:00:00 1970
+++ tcl8.0.4/unix/rl-tclMain.c Thu Sep 16 03:12:13 1999
@@ -0,0 +1,395 @@
+/*
+ * tclMain.c --
+ *
+ * Main program for Tcl shells and other Tcl-based applications.
+ *
+ * Copyright (c) 1988-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclMain.c 1.54 97/08/07 19:04:43
+ */
+
+#include "tcl.h"
+#include "tclInt.h"
+
+#ifndef USESTDIN
+#ifndef __cplusplus
+#include <readline/readline.h>
+#else /* __cplusplus */
+EXTERN char *readline (char *prompt);
+EXTERN void add_history (char *line);
+#endif /* __cplusplus */
+#endif /* USESTDIN */
+
+/*
+ * The following code ensures that tclLink.c is linked whenever
+ * Tcl is linked. Without this code there's no reference to the
+ * code in that file from anywhere in Tcl, so it may not be
+ * linked into the application.
+ */
+
+EXTERN int tcl_LinkVar _ANSI_ARGS_((Tcl_Interp *interp,
+ char *varName, char *addr, int type));
+#ifdef __cplusplus
+EXTERN
+#endif /* __cplusplus */
+typedef int (*dummyfnptrtype)(Tcl_Interp *interp, char *varName, char *addr, int
+type);
+
+dummyfnptrtype tclDummyLinkVarPtr = Tcl_LinkVar;
+
+/*
+ * Declarations for various library procedures and variables (don't want
+ * to include tclPort.h here, because people might copy this file out of
+ * the Tcl source directory to make their own modified versions).
+ * Note: "exit" should really be declared here, but there's no way to
+ * declare it without causing conflicts with other definitions elsewher
+ * on some systems, so it's better just to leave it out.
+ */
+
+EXTERN int isatty _ANSI_ARGS_((int fd));
+EXTERN char * strcpy _ANSI_ARGS_((char *dst, CONST char *src));
+
+static Tcl_Interp *interp; /* Interpreter for application. */
+
+#ifdef TCL_MEM_DEBUG
+static char dumpFile[100]; /* Records where to dump memory allocation
+ * information. */
+static int quitFlag = 0; /* 1 means "checkmem" command was called,
+ * so the application should quit and dump
+ * memory allocation information. */
+#endif
+
+/*
+ * Forward references for procedures defined later in this file:
+ */
+
+#ifdef TCL_MEM_DEBUG
+static int CheckmemCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char *argv[]));
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_Main --
+ *
+ * Main program for tclsh and most other Tcl-based applications.
+ *
+ * Results:
+ * None. This procedure never returns (it exits the process when
+ * it's done.
+ *
+ * Side effects:
+ * This procedure initializes the Tk world and then starts
+ * interpreting commands; almost anything could happen, depending
+ * on the script being interpreted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_Main(
+ int argc, /* Number of arguments. */
+ char **argv, /* Array of argument strings. */
+ Tcl_AppInitProc *appInitProc)
+ /* Application-specific initialization
+ * procedure to call after most
+ * initialization but before starting to
+ * execute commands. */
+{
+ Tcl_Obj *prompt1NamePtr = NULL;
+ Tcl_Obj *prompt2NamePtr = NULL;
+ Tcl_Obj *resultPtr;
+ Tcl_Obj *commandPtr = NULL;
+ char buffer[1000], *args, *fileName, *bytes;
+ int code, gotPartial, tty, length;
+ int exitCode = 0;
+ Tcl_Channel inChannel, outChannel, errChannel;
+
+ Tcl_FindExecutable(argv[0]);
+ interp = Tcl_CreateInterp();
+#ifdef TCL_MEM_DEBUG
+ Tcl_InitMemory(interp);
+ Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL);
+#endif
+
+ /*
+ * Make command-line arguments available in the Tcl variables "argc"
+ * and "argv". If the first argument doesn't start with a "-" then
+ * strip it off and use it as the name of a script file to process.
+ */
+
+ fileName = NULL;
+ if ((argc > 1) && (argv[1][0] != '-')) {
+ fileName = argv[1];
+ argc--;
+ argv++;
+ }
+ args = Tcl_Merge(argc-1, argv+1);
+ Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
+ ckfree(args);
+ TclFormatInt(buffer, argc-1);
+ Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
+ TCL_GLOBAL_ONLY);
+
+ /*
+ * Set the "tcl_interactive" variable.
+ */
+
+ tty = isatty(0);
+ Tcl_SetVar(interp, "tcl_interactive",
+ ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
+
+ /*
+ * Invoke application-specific initialization.
+ */
+
+ if ((*appInitProc)(interp) != TCL_OK) {
+ errChannel = Tcl_GetStdChannel(TCL_STDERR);
+ if (errChannel) {
+ Tcl_Write(errChannel,
+ "application-specific initialization failed: ", -1);
+ Tcl_Write(errChannel, interp->result, -1);
+ Tcl_Write(errChannel, "\n", 1);
+ }
+ }
+
+ /*
+ * If a script file was specified then just source that file
+ * and quit.
+ */
+
+ if (fileName != NULL) {
+ code = Tcl_EvalFile(interp, fileName);
+ if (code != TCL_OK) {
+ errChannel = Tcl_GetStdChannel(TCL_STDERR);
+ if (errChannel) {
+ /*
+ * The following statement guarantees that the errorInfo
+ * variable is set properly.
+ */
+
+ Tcl_AddErrorInfo(interp, "");
+ Tcl_Write(errChannel,
+ Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), -1);
+ Tcl_Write(errChannel, "\n", 1);
+ }
+ exitCode = 1;
+ }
+ goto done;
+ }
+
+ /*
+ * We're running interactively. Source a user-specific startup
+ * file if the application specified one and if the file exists.
+ */
+
+ Tcl_SourceRCFile(interp);
+
+ /*
+ * Process commands from stdin until there's an end-of-file. Note
+ * that we need to fetch the standard channels again after every
+ * eval, since they may have been changed.
+ */
+
+ commandPtr = Tcl_NewObj();
+ Tcl_IncrRefCount(commandPtr);
+ prompt1NamePtr = Tcl_NewStringObj("tcl_prompt1", -1);
+ Tcl_IncrRefCount(prompt1NamePtr);
+ prompt2NamePtr = Tcl_NewStringObj("tcl_prompt2", -1);
+ Tcl_IncrRefCount(prompt2NamePtr);
+
+ inChannel = Tcl_GetStdChannel(TCL_STDIN);
+ outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+ gotPartial = 0;
+ while (1) {
+ if (tty) {
+ Tcl_Obj *promptCmdPtr;
+ char *prompt;
+ char *line;
+
+ promptCmdPtr = Tcl_ObjGetVar2(interp,
+ (gotPartial? prompt2NamePtr : prompt1NamePtr),
+ (Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
+ if (promptCmdPtr == NULL) {
+ defaultPrompt:
+ if (!gotPartial) {
+ prompt = "% ";
+ } else {
+ prompt = "+ ";
+ }
+ length = strlen(prompt);
+ } else {
+ code = Tcl_EvalObj(interp, promptCmdPtr);
+ inChannel = Tcl_GetStdChannel(TCL_STDIN);
+ outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+ errChannel = Tcl_GetStdChannel(TCL_STDERR);
+ if (code != TCL_OK) {
+ if (errChannel) {
+ resultPtr = Tcl_GetObjResult(interp);
+ bytes = Tcl_GetStringFromObj(resultPtr, &length);
+ Tcl_Write(errChannel, bytes, length);
+ Tcl_Write(errChannel, "\n", 1);
+ }
+ Tcl_AddErrorInfo(interp,
+ "\n (script that generates prompt)");
+ goto defaultPrompt;
+ }
+ resultPtr = Tcl_GetObjResult(interp);
+ prompt = Tcl_GetStringFromObj(resultPtr, &length);
+ }
+#ifdef USESTDIN
+ if (outChannel) {
+ Tcl_Write(outChannel, prompt, length);
+ Tcl_Flush(outChannel);
+ }
+ }
+ if (!inChannel) {
+ goto done;
+ }
+ length = Tcl_GetsObj(inChannel, commandPtr);
+ if (length < 0) {
+ goto done;
+ }
+ if ((length == 0) && Tcl_Eof(inChannel) && (!gotPartial)) {
+ goto done;
+ }
+
+#else /* !USESTDIN */
+ line = readline(prompt);
+ if(line != NULL) {
+ length = strlen(line);
+ Tcl_AppendToObj(commandPtr, line, length);
+ } else {
+ goto done;
+ }
+ /* Clean up the string allocated by readline & add it to history */
+ if(line) {
+ if(*line) {
+ add_history(line);
+ }
+ free(line);
+ }
+ } else {
+ /* using readline but not a tty - must use gets */
+ if (!inChannel) {
+ goto done;
+ }
+ length = Tcl_GetsObj(inChannel, commandPtr);
+ if (length < 0) {
+ goto done;
+ }
+ if ((length == 0) && Tcl_Eof(inChannel) && (!gotPartial)) {
+ goto done;
+ }
+ }
+
+#endif /* USESTDIN */
+
+ /*
+ * Add the newline removed by Tcl_GetsObj back to the string.
+ */
+
+ Tcl_AppendToObj(commandPtr, "\n", 1);
+ if (!TclObjCommandComplete(commandPtr)) {
+ gotPartial = 1;
+ continue;
+ }
+
+ gotPartial = 0;
+ code = Tcl_RecordAndEvalObj(interp, commandPtr, 0);
+ inChannel = Tcl_GetStdChannel(TCL_STDIN);
+ outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+ errChannel = Tcl_GetStdChannel(TCL_STDERR);
+ Tcl_SetObjLength(commandPtr, 0);
+ if (code != TCL_OK) {
+ if (errChannel) {
+ resultPtr = Tcl_GetObjResult(interp);
+ bytes = Tcl_GetStringFromObj(resultPtr, &length);
+ Tcl_Write(errChannel, bytes, length);
+ Tcl_Write(errChannel, "\n", 1);
+ }
+ } else if (tty) {
+ resultPtr = Tcl_GetObjResult(interp);
+ bytes = Tcl_GetStringFromObj(resultPtr, &length);
+ if ((length > 0) && outChannel) {
+ Tcl_Write(outChannel, bytes, length);
+ Tcl_Write(outChannel, "\n", 1);
+ }
+ }
+#ifdef TCL_MEM_DEBUG
+ if (quitFlag) {
+ Tcl_DecrRefCount(commandPtr);
+ Tcl_DecrRefCount(prompt1NamePtr);
+ Tcl_DecrRefCount(prompt2NamePtr);
+ Tcl_DeleteInterp(interp);
+ Tcl_Exit(0);
+ }
+#endif
+ }
+
+ /*
+ * Rather than calling exit, invoke the "exit" command so that
+ * users can replace "exit" with some other command to do additional
+ * cleanup on exit. The Tcl_Eval call should never return.
+ */
+
+ done:
+ if (commandPtr != NULL) {
+ Tcl_DecrRefCount(commandPtr);
+ }
+ if (prompt1NamePtr != NULL) {
+ Tcl_DecrRefCount(prompt1NamePtr);
+ }
+ if (prompt2NamePtr != NULL) {
+ Tcl_DecrRefCount(prompt2NamePtr);
+ }
+ sprintf(buffer, "exit %d", exitCode);
+ Tcl_Eval(interp, buffer);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CheckmemCmd --
+ *
+ * This is the command procedure for the "checkmem" command, which
+ * causes the application to exit after printing information about
+ * memory usage to the file passed to this command as its first
+ * argument.
+ *
+ * Results:
+ * Returns a standard Tcl completion code.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+#ifdef TCL_MEM_DEBUG
+
+ /* ARGSUSED */
+static int
+CheckmemCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Interpreter for evaluation. */
+ int argc, /* Number of arguments. */
+ char *argv[]) /* String values of arguments. */
+{
+ extern char *tclMemDumpFileName;
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " fileName\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ strcpy(dumpFile, argv[1]);
+ tclMemDumpFileName = dumpFile;
+ quitFlag = 1;
+ return TCL_OK;
+}
+#endif
