wxPython/wxSWIG/swig_lib/tcl/expectk.i

   1 //
   2 // $Header$
   3 //
   4 // SWIG file for building expectk
   5 // Dave Beazley
   6 // March 18, 1996
   7 //
   8 /* Revision History
   9  * $Log$
  10  * Revision 1.1  2002/04/29 19:56:56  RD
  11  * Since I have made several changes to SWIG over the years to accomodate
  12  * special cases and other things in wxPython, and since I plan on making
  13  * several more, I've decided to put the SWIG sources in wxPython's CVS
  14  * instead of relying on maintaining patches.  This effectivly becomes a
  15  * fork of an obsolete version of SWIG, :-( but since SWIG 1.3 still
  16  * doesn't have some things I rely on in 1.1, not to mention that my
  17  * custom patches would all have to be redone, I felt that this is the
  18  * easier road to take.
  19  *
  20  * Revision 1.2  1999/11/05 21:45:14  beazley
  21  * Minor Changes
  22  *
  23  * Revision 1.1.1.1  1999/02/28 02:00:55  beazley
  24  * Swig1.1
  25  *
  26  * Revision 1.1  1996/05/22 19:47:45  beazley
  27  * Initial revision
  28  *
  29  */
  30
  31
  32 #ifdef AUTODOC
  33 %subsection "expectk.i"
  34 %text %{
  35 This module provides a main() function for building an extended version of
  36 expectk.  It has been tested with Expect 5.19, but may need modification
  37 for newer versions.
  38 %}
  39 #endif
  40
  41 %{
  42
  43 /* exp_main_tk.c - main for expectk
  44
  45 This is "main.c" from the Tk distribution with some minor modifications to
  46 support Expect.
  47
  48 Don Libes, NIST, 12/19/92
  49
  50 */
  51
  52
  53 /*
  54  * main.c --
  55  *
  56  *      This file contains the main program for "wish", a windowing
  57  *      shell based on Tk and Tcl.  It also provides a template that
  58  *      can be used as the basis for main programs for other Tk
  59  *      applications.
  60  *
  61  * Copyright (c) 1990-1993 The Regents of the University of California.
  62  * All rights reserved.
  63  *
  64  * Permission is hereby granted, without written agreement and without
  65  * license or royalty fees, to use, copy, modify, and distribute this
  66  * software and its documentation for any purpose, provided that the
  67  * above copyright notice and the following two paragraphs appear in
  68  * all copies of this software.
  69  *
  70  * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  71  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  72  * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  73  * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  74  *
  75  * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  76  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  77  * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  78  * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  79  * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  80  */
  81
  82 /*#include "tkConfig.h"*/
  83 /*#include "tkInt.h"*/
  84 #include <tk.h>
  85 #include "expect_tcl.h"
  86 #include "Dbg.h"
  87 #include "string.h"
  88
  89 #ifdef TK_EXTENDED
  90 #    include "tclExtend.h"
  91 #endif
  92
  93 /*
  94  * Global variables used by the main program:
  95  */
  96
  97 static Tk_Window mainWindow;    /* The main window for the application.  If
  98                                  * NULL then the application no longer
  99                                  * exists. */
 100 static Tcl_Interp *interp;      /* Interpreter for this application. */
 101 #if 0
 102 char *tcl_RcFileName = NULL;    /* Name of a user-specific startup script
 103                                  * to source if the application is being run
 104                                  * interactively (e.g. "~/.wishrc").  Set
 105                                  * by Tcl_AppInit.  NULL means don't source
 106                                  * anything ever. */
 107 #endif
 108 static Tcl_DString command;     /* Used to assemble lines of terminal input
 109                                  * into Tcl commands. */
 110 static int tty;                 /* Non-zero means standard input is a
 111                                  * terminal-like device.  Zero means it's
 112                                  * a file. */
 113 static char normalExitCmd[] = "exit";
 114 static char errorExitCmd[] = "exit 1";
 115
 116 /*
 117  * Command-line options:
 118  */
 119
 120 int synchronize = 0;
 121 char *fileName = NULL;
 122 char *name = NULL;
 123 char *display = NULL;
 124 char *geometry = NULL;
 125
 126 /* for Expect */
 127 int my_rc = 1;
 128 int sys_rc = 1;
 129 int optcmd_eval();
 130 int dashdash;   /* not used, but Tk's arg parser requires a placeholder */
 131 #ifdef TCL_DEBUGGER
 132 int optcmd_debug();
 133 #endif
 134
 135 Tk_ArgvInfo argTable[] = {
 136     {"-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName,
 137         "File from which to read commands"},
 138     {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
 139         "Initial geometry for window"},
 140     {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
 141         "Display to use"},
 142     {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
 143         "Name to use for application"},
 144     {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
 145         "Use synchronous mode for display server"},
 146
 147 /* for Expect */
 148     {"-buffer", TK_ARGV_STRING, (char *) 1, (char *) &exp_buffer_command_input,
 149         "Buffer command input"},
 150     {"-command", TK_ARGV_GENFUNC, (char *) optcmd_eval, (char *)0,
 151         "Command(s) to execute immediately"},
 152     {"-diag", TK_ARGV_CONSTANT, (char *) 1, (char *) &exp_is_debugging,
 153         "Enable diagnostics"},
 154     {"--", TK_ARGV_REST, (char *)NULL, (char *)&dashdash,
 155         "End of options"},
 156 #if TCL_DEBUGGER
 157     {"-Debug", TK_ARGV_GENFUNC, (char *) optcmd_debug, (char *)0,
 158         "Enable debugger"},
 159 #endif
 160     {"-interactive", TK_ARGV_CONSTANT, (char *) 1, (char *) &exp_interactive,
 161         "Interactive mode"},
 162     {"-norc", TK_ARGV_CONSTANT, (char *) 0, (char *) &my_rc,
 163         "Don't read ~/.expect.rc"},
 164     {"-NORC", TK_ARGV_CONSTANT, (char *) 0, (char *) &sys_rc,
 165         "Don't read system-wide expect.rc"},
 166     {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
 167         (char *) NULL}
 168 };
 169
 170 #ifdef TCL_DEBUGGER
 171 /*ARGSUSED*/
 172 int
 173 optcmd_debug(dst,interp,key,argc,argv)
 174 char *dst;
 175 Tcl_Interp *interp;
 176 char *key;
 177 int argc;
 178 char **argv;
 179 {
 180         int i;
 181
 182         if (argc == 0) {
 183                 strcpy(interp->result,"-Debug flag needs 1 or 0 argument");
 184                 return -1;
 185         }
 186
 187         if (Tcl_GetInt(interp,argv[0],&i) != TCL_OK) {
 188                 return -1;
 189         }
 190
 191         if (i) {
 192                 Dbg_On(interp,0);
 193         }
 194
 195         argc--;
 196         for (i=0;i<argc;i++) {
 197                 argv[i] = argv[i+1];
 198         }
 199
 200         return argc;
 201 }
 202 #endif /*TCL_DEBUGGER*/
 203
 204 /*ARGSUSED*/
 205 int
 206 optcmd_eval(dst,interp,key,argc,argv)
 207 char *dst;
 208 Tcl_Interp *interp;
 209 char *key;
 210 int argc;
 211 char **argv;
 212 {
 213         int i;
 214         int rc;
 215
 216         exp_cmdlinecmds = 1;
 217
 218         rc = Tcl_Eval(interp,argv[0]);
 219         if (rc == TCL_ERROR) return -1;
 220
 221         argc--;
 222         for (i=0;i<argc;i++) {
 223                 argv[i] = argv[i+1];
 224         }
 225
 226         return argc;
 227 }
 228
 229 /*
 230  * Declaration for Tcl command procedure to create demo widget.  This
 231  * procedure is only invoked if SQUARE_DEMO is defined.
 232  */
 233
 234 extern int SquareCmd _ANSI_ARGS_((ClientData clientData,
 235         Tcl_Interp *interp, int argc, char *argv[]));
 236
 237 /*
 238  * Forward declarations for procedures defined later in this file:
 239  */
 240
 241 static void             Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial));
 242 static void             StdinProc _ANSI_ARGS_((ClientData clientData,
 243                             int mask));
 244 \f
 245 /*
 246  *----------------------------------------------------------------------
 247  *
 248  * main --
 249  *
 250  *      Main program for Wish.
 251  *
 252  * Results:
 253  *      None. This procedure never returns (it exits the process when
 254  *      it's done
 255  *
 256  * Side effects:
 257  *      This procedure initializes the wish world and then starts
 258  *      interpreting commands;  almost anything could happen, depending
 259  *      on the script being interpreted.
 260  *
 261  *----------------------------------------------------------------------
 262  */
 263
 264 int
 265 main(argc, argv)
 266     int argc;                           /* Number of arguments. */
 267     char **argv;                        /* Array of argument strings. */
 268 {
 269     char *args, *p, *msg, *class;
 270     char buf[20];
 271     int code;
 272     int SWIG_init(Tcl_Interp *);
 273         extern char *exp_argv0;
 274         int used_argv1_for_filename = 0;        /* added for Expect - DEL */
 275
 276 #ifdef TK_EXTENDED
 277     tk_mainInterp = interp = Tcl_CreateExtendedInterp();
 278 #else
 279     interp = Tcl_CreateInterp();
 280 #endif
 281 #ifdef TCL_MEM_DEBUG
 282     Tcl_InitMemory(interp);
 283 #endif
 284
 285         if (Exp_Init(interp) == TCL_ERROR) {
 286                 fprintf(stderr,"Exp_Init failed: %s\n",interp->result);
 287                 return 1;
 288         }
 289
 290         /* Add SWIG Extension */
 291
 292         if (SWIG_init(interp) == TCL_ERROR) {
 293                 fprintf(stderr,"Unable to initialize user-extensions : %s\n", interp->result);
 294                 return 1;
 295         }
 296         exp_argv0 = argv[0];
 297
 298 #ifdef TCL_DEBUGGER
 299         Dbg_ArgcArgv(argc,argv,1);
 300 #endif
 301
 302     /*
 303      * Parse command-line arguments.
 304      */
 305
 306     if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0)
 307             != TCL_OK) {
 308         fprintf(stderr, "%s\n", interp->result);
 309         exit(1);
 310     }
 311
 312     if (!fileName) {                    /* added for Expect - DEL */
 313         fileName = argv[1];
 314         used_argv1_for_filename = 1;
 315     }
 316
 317     if (name == NULL) {
 318         if (fileName != NULL) {
 319             p = fileName;
 320         } else {
 321             p = argv[0];
 322         }
 323         name = strrchr(p, '/');
 324         if (name != NULL) {
 325             name++;
 326         } else {
 327             name = p;
 328         }
 329     }
 330
 331   /* if user hasn't explicitly requested we be interactive */
 332   /* look for a file or some other source of commands */
 333     if (fileName && !exp_interactive) {
 334         if (0 == strcmp(fileName,"-")) {
 335                 exp_cmdfile = stdin;
 336         } else if (exp_buffer_command_input) {
 337                 if (NULL == (exp_cmdfile = fopen(fileName,"r"))) {
 338                         perror(fileName);
 339                         exp_exit(interp,1);
 340                 } else {
 341                         exp_close_on_exec(fileno(exp_cmdfile));
 342                 }
 343         } else {
 344                 exp_cmdfilename = fileName;
 345         }
 346     } else if (!exp_cmdlinecmds) {
 347         /* no other source of commands, force interactive */
 348         exp_interactive = 1;
 349     }
 350
 351     /*
 352      * If a display was specified, put it into the DISPLAY
 353      * environment variable so that it will be available for
 354      * any sub-processes created by us.
 355      */
 356
 357     if (display != NULL) {
 358         Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY);
 359     }
 360
 361     /*
 362      * Initialize the Tk application.  If a -name option was provided,
 363      * use it;  otherwise, if a file name was provided, use the last
 364      * element of its path as the name of the application; otherwise
 365      * use the last element of the program name.  For the application's
 366      * class, capitalize the first letter of the name.
 367      */
 368
 369 #if TK_MAJOR_VERSION >= 4
 370     class = (char *) ckalloc((unsigned) (strlen(name) + 1));
 371     strcpy(class, name);
 372     class[0] = toupper((unsigned char) class[0]);
 373     mainWindow = Tk_CreateMainWindow(interp, display, name, class);
 374 #else
 375 # if TK_MAJOR_VERSION == 3 && TK_MINOR_VERSION < 4
 376     mainWindow = Tk_CreateMainWindow(interp, display, name);
 377 # else
 378     mainWindow = Tk_CreateMainWindow(interp, display, name, "Tk");
 379 # endif
 380 #endif
 381
 382     if (mainWindow == NULL) {
 383         fprintf(stderr, "%s\n", interp->result);
 384         exit(1);
 385     }
 386 #if TK_MAJOR_VERSION == 3 && TK_MINOR_VERSION < 4
 387     Tk_SetClass(mainWindow, "Tk");
 388 #endif
 389     if (synchronize) {
 390         XSynchronize(Tk_Display(mainWindow), True);
 391     }
 392
 393 #if TK_MAJOR_VERSION < 4
 394     Tk_GeometryRequest(mainWindow, 200, 200);
 395 #endif
 396
 397     /*
 398      * Make command-line arguments available in the Tcl variables "argc"
 399      * and "argv".  Also set the "geometry" variable from the geometry
 400      * specified on the command line.
 401      */
 402
 403     if (used_argv1_for_filename) {      /* added for Expect - DEL */
 404         argv++;
 405         argc--;
 406         /* if no script name, use interpreter name */
 407         if (!argv[0] && !fileName) argv[0] = name;
 408     }
 409
 410     args = Tcl_Merge(argc-1, argv+1);
 411     Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
 412     ckfree(args);
 413     sprintf(buf, "%d", argc-1);
 414     Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
 415     Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
 416             TCL_GLOBAL_ONLY);
 417     if (geometry != NULL) {
 418 #if TK_MAJOR_VERSION < 4
 419         Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
 420 #else
 421         Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
 422         code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL);
 423         if (code != TCL_OK) {
 424             fprintf(stderr, "%s\n", interp->result);
 425         }
 426 #endif
 427     }
 428
 429     /*
 430      * Set the "tcl_interactive" variable.
 431      */
 432
 433     tty = isatty(0);
 434     Tcl_SetVar(interp, "tcl_interactive",
 435             ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
 436
 437     /*
 438      * Add a few application-specific commands to the application's
 439      * interpreter.
 440      */
 441
 442 #ifdef SQUARE_DEMO
 443     Tcl_CreateCommand(interp, "square", SquareCmd, (ClientData) mainWindow,
 444             (void (*)()) NULL);
 445 #endif
 446
 447     if (Tcl_Init(interp) == TCL_ERROR) {
 448         fprintf(stderr,"Tcl_Init failed: %s\n",interp->result);
 449         return 1;
 450     }
 451     if (Tk_Init(interp) == TCL_ERROR) {
 452         fprintf(stderr,"Tk_Init failed: %s\n",interp->result);
 453         return 1;
 454     }
 455
 456     /* Call Exp_Init again because Tcl_Init resets auto_path, sigh. */
 457     /* A better solution would be to execute Tcl/Tk_Init much earlier */
 458     /* (before argc/argv is processed). */
 459
 460     if (Exp_Init(interp) == TCL_ERROR) {
 461         fprintf(stderr,"Exp_Init failed: %s\n",interp->result);
 462         return 1;
 463     }
 464
 465 #if 0
 466     tcl_RcFileName = "~/.wishrc";
 467
 468     /*
 469      * Invoke application-specific initialization.
 470      */
 471
 472     if (Tcl_AppInit(interp) != TCL_OK) {
 473         fprintf(stderr, "Tcl_AppInit failed: %s\n", interp->result);
 474     }
 475 #endif
 476
 477     exp_interpret_rcfiles(interp,my_rc,sys_rc);
 478
 479 #ifdef TK_EXTENDED
 480      tclAppName = "Wish";
 481      tclAppLongname = "Wish - Tk Shell";
 482      tclAppVersion  = TK_VERSION;
 483      Tcl_ShellEnvInit (interp, TCLSH_ABORT_STARTUP_ERR,
 484                 name,
 485                 0, NULL,           /* argv var already set  */
 486                 fileName == NULL,  /* interactive?          */
 487                 NULL);             /* Standard default file */
 488 #endif
 489
 490     /*
 491      * Set the geometry of the main window, if requested.
 492      */
 493
 494     if (geometry != NULL) {
 495         code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL);
 496         if (code != TCL_OK) {
 497             fprintf(stderr, "%s\n", interp->result);
 498         }
 499     }
 500
 501     /*
 502      * Invoke the script specified on the command line, if any.
 503      */
 504
 505         /* become interactive if requested or "nothing to do" */
 506         if (exp_interactive) {
 507                 (void) exp_interpreter(interp);
 508         } else if (exp_cmdfile) {
 509                 int rc = exp_interpret_cmdfile(interp,exp_cmdfile);
 510                 if (rc != TCL_OK) exp_exit(interp,rc);
 511                 Tk_MainLoop();
 512         } else if (exp_cmdfilename) {
 513                 int rc = exp_interpret_cmdfilename(interp,exp_cmdfilename);
 514                 if (rc != TCL_OK) exp_exit(interp,rc);
 515                 Tk_MainLoop();
 516         }
 517
 518     /*
 519      * Don't exit directly, but rather invoke the Tcl "exit" command.
 520      * This gives the application the opportunity to redefine "exit"
 521      * to do additional cleanup.
 522      */
 523
 524     Tcl_Eval(interp,normalExitCmd);
 525     exit(1);
 526
 527 #if 0
 528     if (fileName != NULL) {
 529       Dbg_On(interp,0);
 530         code = Tcl_VarEval(interp, "source ", fileName, (char *) NULL);
 531         if (code != TCL_OK) {
 532             goto error;
 533         }
 534         tty = 0;
 535     } else {
 536         /*
 537          * Commands will come from standard input, so set up an event
 538          * handler for standard input.  If the input device is aEvaluate the
 539          * .rc file, if one has been specified, set up an event handler
 540          * for standard input, and print a prompt if the input
 541          * device is a terminal.
 542          */
 543
 544         if (tcl_RcFileName != NULL) {
 545             Tcl_DString buffer;
 546             char *fullName;
 547
 548             fullName = Tcl_TildeSubst(interp, tcl_RcFileName, &buffer);
 549             if (fullName == NULL) {
 550                 fprintf(stderr, "%s\n", interp->result);
 551             } else {
 552                 if (access(fullName, R_OK) == 0) {
 553                     code = Tcl_EvalFile(interp, fullName);
 554                     if (code != TCL_OK) {
 555                         fprintf(stderr, "%s\n", interp->result);
 556                     }
 557                 }
 558             }
 559             Tcl_DStringFree(&buffer);
 560         }
 561         Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
 562         if (tty) {
 563             Prompt(interp, 0);
 564         }
 565     }
 566     fflush(stdout);
 567     Tcl_DStringInit(&command);
 568
 569     /*
 570      * Loop infinitely, waiting for commands to execute.  When there
 571      * are no windows left, Tk_MainLoop returns and we exit.
 572      */
 573
 574     Tk_MainLoop();
 575
 576     /*
 577      * Don't exit directly, but rather invoke the Tcl "exit" command.
 578      * This gives the application the opportunity to redefine "exit"
 579      * to do additional cleanup.
 580      */
 581
 582     Tcl_Eval(interp, "exit");
 583     exit(1);
 584
 585 error:
 586     msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
 587     if (msg == NULL) {
 588         msg = interp->result;
 589     }
 590     fprintf(stderr, "%s\n", msg);
 591     Tcl_Eval(interp, errorExitCmd);
 592     return 1;                   /* Needed only to prevent compiler warnings. */
 593
 594 #endif /*0*/
 595 }
 596 \f
 597 #if 0
 598 /*
 599  *----------------------------------------------------------------------
 600  *
 601  * StdinProc --
 602  *
 603  *      This procedure is invoked by the event dispatcher whenever
 604  *      standard input becomes readable.  It grabs the next line of
 605  *      input characters, adds them to a command being assembled, and
 606  *      executes the command if it's complete.
 607  *
 608  * Results:
 609  *      None.
 610  *
 611  * Side effects:
 612  *      Could be almost arbitrary, depending on the command that's
 613  *      typed.
 614  *
 615  *----------------------------------------------------------------------
 616  */
 617
 618     /* ARGSUSED */
 619 static void
 620 StdinProc(clientData, mask)
 621     ClientData clientData;              /* Not used. */
 622     int mask;                           /* Not used. */
 623 {
 624 #define BUFFER_SIZE 4000
 625     char input[BUFFER_SIZE+1];
 626     static int gotPartial = 0;
 627     char *cmd;
 628     int code, count;
 629
 630     count = read(fileno(stdin), input, BUFFER_SIZE);
 631     if (count <= 0) {
 632         if (!gotPartial) {
 633             if (tty) {
 634                 Tcl_Eval(interp, "exit");
 635                 exit(1);
 636             } else {
 637                 Tk_DeleteFileHandler(0);
 638             }
 639             return;
 640         } else {
 641             count = 0;
 642         }
 643     }
 644     cmd = Tcl_DStringAppend(&command, input, count);
 645     if (count != 0) {
 646         if ((input[count-1] != '\n') && (input[count-1] != ';')) {
 647             gotPartial = 1;
 648             goto prompt;
 649         }
 650         if (!Tcl_CommandComplete(cmd)) {
 651             gotPartial = 1;
 652             goto prompt;
 653         }
 654     }
 655     gotPartial = 0;
 656
 657     /*
 658      * Disable the stdin file handler while evaluating the command;
 659      * otherwise if the command re-enters the event loop we might
 660      * process commands from stdin before the current command is
 661      * finished.  Among other things, this will trash the text of the
 662      * command being evaluated.
 663      */
 664
 665     Tk_CreateFileHandler(0, 0, StdinProc, (ClientData) 0);
 666     code = Tcl_RecordAndEval(interp, cmd, 0);
 667     Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
 668     Tcl_DStringFree(&command);
 669     if (*interp->result != 0) {
 670         if ((code != TCL_OK) || (tty)) {
 671             printf("%s\n", interp->result);
 672         }
 673     }
 674
 675     /*
 676      * Output a prompt.
 677      */
 678
 679     prompt:
 680     if (tty) {
 681         Prompt(interp, gotPartial);
 682     }
 683 }
 684 \f
 685 /*
 686  *----------------------------------------------------------------------
 687  *
 688  * Prompt --
 689  *
 690  *      Issue a prompt on standard output, or invoke a script
 691  *      to issue the prompt.
 692  *
 693  * Results:
 694  *      None.
 695  *
 696  * Side effects:
 697  *      A prompt gets output, and a Tcl script may be evaluated
 698  *      in interp.
 699  *
 700  *----------------------------------------------------------------------
 701  */
 702
 703 static void
 704 Prompt(interp, partial)
 705     Tcl_Interp *interp;                 /* Interpreter to use for prompting. */
 706     int partial;                        /* Non-zero means there already
 707                                          * exists a partial command, so use
 708                                          * the secondary prompt. */
 709 {
 710     char *promptCmd;
 711     int code;
 712
 713     promptCmd = Tcl_GetVar(interp,
 714         partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY);
 715     if (promptCmd == NULL) {
 716         defaultPrompt:
 717         if (!partial) {
 718             fputs("% ", stdout);
 719         }
 720     } else {
 721         code = Tcl_Eval(interp, promptCmd);
 722         if (code != TCL_OK) {
 723             Tcl_AddErrorInfo(interp,
 724                     "\n    (script that generates prompt)");
 725             fprintf(stderr, "%s\n", interp->result);
 726             goto defaultPrompt;
 727         }
 728     }
 729     fflush(stdout);
 730 }
 731 #endif /*0*/
 732
 733 %}