- "Tcl" and "Tk" unifications (and few others)

[packages/tcl.git] / tcl-readline.patch

--- tcl8.4.3/unix/Makefile.in.wiget	2003-05-23 02:47:23.000000000 +0200
+++ tcl8.4.3/unix/Makefile.in	2003-06-09 22:15:13.000000000 +0200
@@ -295,7 +295,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 \
 	tclThreadTest.o	tclUnixTest.o
@@ -475,7 +475,7 @@
 
 tclsh: ${TCLSH_OBJS} ${TCL_LIB_FILE}
 	${CC} ${LDFLAGS} ${TCLSH_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} \
-		${CC_SEARCH_FLAGS} -o tclsh
+		-lreadline -lncurses ${CC_SEARCH_FLAGS} -o tclsh
 
 # Resetting the LIB_RUNTIME_DIR below is required so that
 # the generated tcltest executable gets the build directory
--- /dev/null	1970-01-01 01:00:00.000000000 +0100
+++ tcl8.4.3/unix/rl-tclMain.c	2003-06-09 22:13:58.000000000 +0200
@@ -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
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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