tcl-readline.patch

   1 --- tcl8.4.3/unix/Makefile.in.wiget     2003-05-23 02:47:23.000000000 +0200
   2 +++ tcl8.4.3/unix/Makefile.in   2003-06-09 22:15:13.000000000 +0200
   3 @@ -295,7 +295,7 @@
   4  ${GENERIC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \
   5  -DTCL_SHLIB_EXT=\"${SHLIB_SUFFIX}\"
   6
   7 -TCLSH_OBJS = tclAppInit.o
   8 +TCLSH_OBJS = tclAppInit.o rl-tclMain.o
   9
  10  TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
  11         tclThreadTest.o tclUnixTest.o
  12 @@ -475,7 +475,7 @@
  13
  14  tclsh: ${TCLSH_OBJS} ${TCL_LIB_FILE}
  15         ${CC} ${LDFLAGS} ${TCLSH_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} \
  16 -               ${CC_SEARCH_FLAGS} -o tclsh
  17 +               -lreadline -lncurses ${CC_SEARCH_FLAGS} -o tclsh
  18
  19  # Resetting the LIB_RUNTIME_DIR below is required so that
  20  # the generated tcltest executable gets the build directory
  21 --- /dev/null   1970-01-01 01:00:00.000000000 +0100
  22 +++ tcl8.4.3/unix/rl-tclMain.c  2003-06-09 22:13:58.000000000 +0200
  23 @@ -0,0 +1,395 @@
  24 +/*
  25 + * tclMain.c --
  26 + *
  27 + *     Main program for Tcl shells and other Tcl-based applications.
  28 + *
  29 + * Copyright (c) 1988-1994 The Regents of the University of California.
  30 + * Copyright (c) 1994-1996 Sun Microsystems, Inc.
  31 + *
  32 + * See the file "license.terms" for information on usage and redistribution
  33 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  34 + *
  35 + * SCCS: @(#) tclMain.c 1.54 97/08/07 19:04:43
  36 + */
  37 +
  38 +#include "tcl.h"
  39 +#include "tclInt.h"
  40 +
  41 +#ifndef USESTDIN
  42 +#ifndef __cplusplus
  43 +#include <readline/readline.h>
  44 +#else /* __cplusplus */
  45 +EXTERN char *readline (char *prompt);
  46 +EXTERN void add_history (char *line);
  47 +#endif /* __cplusplus */
  48 +#endif /* USESTDIN */
  49 +
  50 +/*
  51 + * The following code ensures that tclLink.c is linked whenever
  52 + * Tcl is linked.  Without this code there's no reference to the
  53 + * code in that file from anywhere in Tcl, so it may not be
  54 + * linked into the application.
  55 + */
  56 +
  57 +EXTERN int tcl_LinkVar _ANSI_ARGS_((Tcl_Interp *interp,
  58 +                                   char *varName, char *addr, int type));
  59 +#ifdef __cplusplus
  60 +EXTERN
  61 +#endif /* __cplusplus */
  62 +typedef int (*dummyfnptrtype)(Tcl_Interp *interp, char *varName, char *addr, int type);
  63 +
  64 +dummyfnptrtype tclDummyLinkVarPtr = Tcl_LinkVar;
  65 +
  66 +/*
  67 + * Declarations for various library procedures and variables (don't want
  68 + * to include tclPort.h here, because people might copy this file out of
  69 + * the Tcl source directory to make their own modified versions).
  70 + * Note:  "exit" should really be declared here, but there's no way to
  71 + * declare it without causing conflicts with other definitions elsewher
  72 + * on some systems, so it's better just to leave it out.
  73 + */
  74 +
  75 +EXTERN int             isatty _ANSI_ARGS_((int fd));
  76 +EXTERN char *          strcpy _ANSI_ARGS_((char *dst, CONST char *src));
  77 +
  78 +static Tcl_Interp *interp;     /* Interpreter for application. */
  79 +
  80 +#ifdef TCL_MEM_DEBUG
  81 +static char dumpFile[100];     /* Records where to dump memory allocation
  82 +                                * information. */
  83 +static int quitFlag = 0;       /* 1 means "checkmem" command was called,
  84 +                                * so the application should quit and dump
  85 +                                * memory allocation information. */
  86 +#endif
  87 +
  88 +/*
  89 + * Forward references for procedures defined later in this file:
  90 + */
  91 +
  92 +#ifdef TCL_MEM_DEBUG
  93 +static int             CheckmemCmd _ANSI_ARGS_((ClientData clientData,
  94 +                           Tcl_Interp *interp, int argc, char *argv[]));
  95 +#endif
  96 +\f
  97 +/*
  98 + *----------------------------------------------------------------------
  99 + *
 100 + * Tcl_Main --
 101 + *
 102 + *     Main program for tclsh and most other Tcl-based applications.
 103 + *
 104 + * Results:
 105 + *     None. This procedure never returns (it exits the process when
 106 + *     it's done.
 107 + *
 108 + * Side effects:
 109 + *     This procedure initializes the Tk world and then starts
 110 + *     interpreting commands;  almost anything could happen, depending
 111 + *     on the script being interpreted.
 112 + *
 113 + *----------------------------------------------------------------------
 114 + */
 115 +
 116 +void
 117 +Tcl_Main(
 118 +    int argc,                  /* Number of arguments. */
 119 +    char **argv,               /* Array of argument strings. */
 120 +    Tcl_AppInitProc *appInitProc)
 121 +                               /* Application-specific initialization
 122 +                                * procedure to call after most
 123 +                                * initialization but before starting to
 124 +                                * execute commands. */
 125 +{
 126 +    Tcl_Obj *prompt1NamePtr = NULL;
 127 +    Tcl_Obj *prompt2NamePtr = NULL;
 128 +    Tcl_Obj *resultPtr;
 129 +    Tcl_Obj *commandPtr = NULL;
 130 +    char buffer[1000], *args, *fileName, *bytes;
 131 +    int code, gotPartial, tty, length;
 132 +    int exitCode = 0;
 133 +    Tcl_Channel inChannel, outChannel, errChannel;
 134 +
 135 +    Tcl_FindExecutable(argv[0]);
 136 +    interp = Tcl_CreateInterp();
 137 +#ifdef TCL_MEM_DEBUG
 138 +    Tcl_InitMemory(interp);
 139 +    Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0,
 140 +           (Tcl_CmdDeleteProc *) NULL);
 141 +#endif
 142 +
 143 +    /*
 144 +     * Make command-line arguments available in the Tcl variables "argc"
 145 +     * and "argv".  If the first argument doesn't start with a "-" then
 146 +     * strip it off and use it as the name of a script file to process.
 147 +     */
 148 +
 149 +    fileName = NULL;
 150 +    if ((argc > 1) && (argv[1][0] != '-')) {
 151 +       fileName = argv[1];
 152 +       argc--;
 153 +       argv++;
 154 +    }
 155 +    args = Tcl_Merge(argc-1, argv+1);
 156 +    Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
 157 +    ckfree(args);
 158 +    TclFormatInt(buffer, argc-1);
 159 +    Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY);
 160 +    Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
 161 +           TCL_GLOBAL_ONLY);
 162 +
 163 +    /*
 164 +     * Set the "tcl_interactive" variable.
 165 +     */
 166 +
 167 +    tty = isatty(0);
 168 +    Tcl_SetVar(interp, "tcl_interactive",
 169 +           ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
 170 +
 171 +    /*
 172 +     * Invoke application-specific initialization.
 173 +     */
 174 +
 175 +    if ((*appInitProc)(interp) != TCL_OK) {
 176 +       errChannel = Tcl_GetStdChannel(TCL_STDERR);
 177 +       if (errChannel) {
 178 +           Tcl_Write(errChannel,
 179 +                   "application-specific initialization failed: ", -1);
 180 +           Tcl_Write(errChannel, interp->result, -1);
 181 +           Tcl_Write(errChannel, "\n", 1);
 182 +       }
 183 +    }
 184 +
 185 +    /*
 186 +     * If a script file was specified then just source that file
 187 +     * and quit.
 188 +     */
 189 +
 190 +    if (fileName != NULL) {
 191 +       code = Tcl_EvalFile(interp, fileName);
 192 +       if (code != TCL_OK) {
 193 +           errChannel = Tcl_GetStdChannel(TCL_STDERR);
 194 +           if (errChannel) {
 195 +               /*
 196 +                * The following statement guarantees that the errorInfo
 197 +                * variable is set properly.
 198 +                */
 199 +
 200 +               Tcl_AddErrorInfo(interp, "");
 201 +               Tcl_Write(errChannel,
 202 +                       Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), -1);
 203 +               Tcl_Write(errChannel, "\n", 1);
 204 +           }
 205 +           exitCode = 1;
 206 +       }
 207 +       goto done;
 208 +    }
 209 +
 210 +    /*
 211 +     * We're running interactively.  Source a user-specific startup
 212 +     * file if the application specified one and if the file exists.
 213 +     */
 214 +
 215 +    Tcl_SourceRCFile(interp);
 216 +
 217 +    /*
 218 +     * Process commands from stdin until there's an end-of-file.  Note
 219 +     * that we need to fetch the standard channels again after every
 220 +     * eval, since they may have been changed.
 221 +     */
 222 +
 223 +    commandPtr = Tcl_NewObj();
 224 +    Tcl_IncrRefCount(commandPtr);
 225 +    prompt1NamePtr = Tcl_NewStringObj("tcl_prompt1", -1);
 226 +    Tcl_IncrRefCount(prompt1NamePtr);
 227 +    prompt2NamePtr = Tcl_NewStringObj("tcl_prompt2", -1);
 228 +    Tcl_IncrRefCount(prompt2NamePtr);
 229 +
 230 +    inChannel = Tcl_GetStdChannel(TCL_STDIN);
 231 +    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
 232 +    gotPartial = 0;
 233 +    while (1) {
 234 +       if (tty) {
 235 +           Tcl_Obj *promptCmdPtr;
 236 +           char *prompt;
 237 +           char *line;
 238 +
 239 +           promptCmdPtr = Tcl_ObjGetVar2(interp,
 240 +                   (gotPartial? prompt2NamePtr : prompt1NamePtr),
 241 +                   (Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
 242 +           if (promptCmdPtr == NULL) {
 243 +                defaultPrompt:
 244 +               if (!gotPartial) {
 245 +                   prompt = "% ";
 246 +               } else {
 247 +                   prompt = "+ ";
 248 +               }
 249 +               length = strlen(prompt);
 250 +           } else {
 251 +               code = Tcl_EvalObj(interp, promptCmdPtr);
 252 +               inChannel = Tcl_GetStdChannel(TCL_STDIN);
 253 +               outChannel = Tcl_GetStdChannel(TCL_STDOUT);
 254 +               errChannel = Tcl_GetStdChannel(TCL_STDERR);
 255 +               if (code != TCL_OK) {
 256 +                   if (errChannel) {
 257 +                       resultPtr = Tcl_GetObjResult(interp);
 258 +                       bytes = Tcl_GetStringFromObj(resultPtr, &length);
 259 +                       Tcl_Write(errChannel, bytes, length);
 260 +                       Tcl_Write(errChannel, "\n", 1);
 261 +                   }
 262 +                   Tcl_AddErrorInfo(interp,
 263 +                           "\n    (script that generates prompt)");
 264 +                   goto defaultPrompt;
 265 +               }
 266 +               resultPtr = Tcl_GetObjResult(interp);
 267 +               prompt = Tcl_GetStringFromObj(resultPtr, &length);
 268 +           }
 269 +#ifdef USESTDIN
 270 +           if (outChannel) {
 271 +               Tcl_Write(outChannel, prompt, length);
 272 +               Tcl_Flush(outChannel);
 273 +           }
 274 +       }
 275 +       if (!inChannel) {
 276 +           goto done;
 277 +       }
 278 +        length = Tcl_GetsObj(inChannel, commandPtr);
 279 +       if (length < 0) {
 280 +           goto done;
 281 +       }
 282 +       if ((length == 0) && Tcl_Eof(inChannel) && (!gotPartial)) {
 283 +           goto done;
 284 +       }
 285 +
 286 +#else /* !USESTDIN */
 287 +           line = readline(prompt);
 288 +           if(line != NULL) {
 289 +               length = strlen(line);
 290 +               Tcl_AppendToObj(commandPtr, line, length);
 291 +           } else {
 292 +               goto done;
 293 +           }
 294 +            /* Clean up the string allocated by readline & add it to history */
 295 +           if(line) {
 296 +               if(*line) {
 297 +                   add_history(line);
 298 +               }
 299 +               free(line);
 300 +           }
 301 +       } else {
 302 +           /* using readline but not a tty - must use gets */
 303 +           if (!inChannel) {
 304 +               goto done;
 305 +           }
 306 +           length = Tcl_GetsObj(inChannel, commandPtr);
 307 +           if (length < 0) {
 308 +               goto done;
 309 +           }
 310 +           if ((length == 0) && Tcl_Eof(inChannel) && (!gotPartial)) {
 311 +               goto done;
 312 +           }
 313 +       }
 314 +
 315 +#endif /* USESTDIN */
 316 +
 317 +        /*
 318 +         * Add the newline removed by Tcl_GetsObj back to the string.
 319 +         */
 320 +
 321 +       Tcl_AppendToObj(commandPtr, "\n", 1);
 322 +       if (!TclObjCommandComplete(commandPtr)) {
 323 +           gotPartial = 1;
 324 +           continue;
 325 +       }
 326 +
 327 +       gotPartial = 0;
 328 +       code = Tcl_RecordAndEvalObj(interp, commandPtr, 0);
 329 +       inChannel = Tcl_GetStdChannel(TCL_STDIN);
 330 +       outChannel = Tcl_GetStdChannel(TCL_STDOUT);
 331 +       errChannel = Tcl_GetStdChannel(TCL_STDERR);
 332 +       Tcl_SetObjLength(commandPtr, 0);
 333 +       if (code != TCL_OK) {
 334 +           if (errChannel) {
 335 +               resultPtr = Tcl_GetObjResult(interp);
 336 +               bytes = Tcl_GetStringFromObj(resultPtr, &length);
 337 +               Tcl_Write(errChannel, bytes, length);
 338 +               Tcl_Write(errChannel, "\n", 1);
 339 +           }
 340 +       } else if (tty) {
 341 +           resultPtr = Tcl_GetObjResult(interp);
 342 +           bytes = Tcl_GetStringFromObj(resultPtr, &length);
 343 +           if ((length > 0) && outChannel) {
 344 +               Tcl_Write(outChannel, bytes, length);
 345 +               Tcl_Write(outChannel, "\n", 1);
 346 +           }
 347 +       }
 348 +#ifdef TCL_MEM_DEBUG
 349 +       if (quitFlag) {
 350 +           Tcl_DecrRefCount(commandPtr);
 351 +           Tcl_DecrRefCount(prompt1NamePtr);
 352 +           Tcl_DecrRefCount(prompt2NamePtr);
 353 +           Tcl_DeleteInterp(interp);
 354 +           Tcl_Exit(0);
 355 +       }
 356 +#endif
 357 +    }
 358 +
 359 +    /*
 360 +     * Rather than calling exit, invoke the "exit" command so that
 361 +     * users can replace "exit" with some other command to do additional
 362 +     * cleanup on exit.  The Tcl_Eval call should never return.
 363 +     */
 364 +
 365 +    done:
 366 +    if (commandPtr != NULL) {
 367 +       Tcl_DecrRefCount(commandPtr);
 368 +    }
 369 +    if (prompt1NamePtr != NULL) {
 370 +       Tcl_DecrRefCount(prompt1NamePtr);
 371 +    }
 372 +    if (prompt2NamePtr != NULL) {
 373 +       Tcl_DecrRefCount(prompt2NamePtr);
 374 +    }
 375 +    sprintf(buffer, "exit %d", exitCode);
 376 +    Tcl_Eval(interp, buffer);
 377 +}
 378 +\f
 379 +/*
 380 + *----------------------------------------------------------------------
 381 + *
 382 + * CheckmemCmd --
 383 + *
 384 + *     This is the command procedure for the "checkmem" command, which
 385 + *     causes the application to exit after printing information about
 386 + *     memory usage to the file passed to this command as its first
 387 + *     argument.
 388 + *
 389 + * Results:
 390 + *     Returns a standard Tcl completion code.
 391 + *
 392 + * Side effects:
 393 + *     None.
 394 + *
 395 + *----------------------------------------------------------------------
 396 + */
 397 +#ifdef TCL_MEM_DEBUG
 398 +
 399 +       /* ARGSUSED */
 400 +static int
 401 +CheckmemCmd(
 402 +    ClientData clientData,             /* Not used. */
 403 +    Tcl_Interp *interp,                /* Interpreter for evaluation. */
 404 +    int argc,                          /* Number of arguments. */
 405 +    char *argv[])                      /* String values of arguments. */
 406 +{
 407 +    extern char *tclMemDumpFileName;
 408 +    if (argc != 2) {
 409 +       Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
 410 +               " fileName\"", (char *) NULL);
 411 +       return TCL_ERROR;
 412 +    }
 413 +    strcpy(dumpFile, argv[1]);
 414 +    tclMemDumpFileName = dumpFile;
 415 +    quitFlag = 1;
 416 +    return TCL_OK;
 417 +}
 418 +#endif