home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / tcl / expect / expect-4.7 / exp_main_tk.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-05-26  |  15.7 KB  |  641 lines
  1. /* exp_main_tk.c - main for expectk
  2.  
  3. This is "main.c" from the Tk distribution with some minor modifications to
  4. support Expect.
  5.  
  6. Don Libes, NIST, 12/19/92
  7.  
  8. */
  9.  
  10.  
  11. /* 
  12.  * main.c --
  13.  *
  14.  *    This file contains the main program for "wish", a windowing
  15.  *    shell based on Tk and Tcl.  It also provides a template that
  16.  *    can be used as the basis for main programs for other Tk
  17.  *    applications.
  18.  *
  19.  * Copyright 1990-1992 Regents of the University of California.
  20.  * Permission to use, copy, modify, and distribute this
  21.  * software and its documentation for any purpose and without
  22.  * fee is hereby granted, provided that the above copyright
  23.  * notice appear in all copies.  The University of California
  24.  * makes no representations about the suitability of this
  25.  * software for any purpose.  It is provided "as is" without
  26.  * express or implied warranty.
  27.  */
  28.  
  29. #ifndef lint
  30. static char rcsid[] = "$Header: /user6/ouster/wish/RCS/main.c,v 1.70 92/12/12 16:17:22 ouster Exp $ SPRITE (Berkeley)";
  31. #endif
  32.  
  33. #include "tkConfig.h"
  34. #include "tkInt.h"
  35. #ifdef TCL_DEBUGGER
  36. #include "Dbg.h"
  37. #endif
  38.  
  39. #ifdef TK_EXTENDED
  40. #    include "tclExtend.h"
  41. Tcl_Interp *tk_mainInterp;  /* Need to process signals */
  42. #endif
  43.  
  44. #include "exp_main.h"
  45.  
  46. /*
  47.  * Declarations for library procedures:
  48.  */
  49.  
  50. extern int isatty();
  51.  
  52. /*
  53.  * Command used to initialize wish:
  54.  */
  55.  
  56. #ifdef TK_EXTENDED
  57. static char initCmd[] = "load wishx.tcl";
  58. #else
  59. static char initCmd[] = "source $tk_library/wish.tcl";
  60. #endif
  61.  
  62. /*
  63.  * Global variables used by the main program:
  64.  */
  65.  
  66. static Tk_Window w;        /* The main window for the application.  If
  67.                  * NULL then the application no longer
  68.                  * exists. */
  69. static Tcl_Interp *interp;    /* Interpreter for this application. */
  70. static int x, y;        /* Coordinates of last location moved to;
  71.                  * used by "moveto" and "lineto" commands. */
  72. static Tcl_CmdBuf buffer;    /* Used to assemble lines of terminal input
  73.                  * into Tcl commands. */
  74. static int tty;            /* Non-zero means standard input is a
  75.                  * terminal-like device.  Zero means it's
  76.                  * a file. */
  77.  
  78. /*
  79.  * Command-line options:
  80.  */
  81.  
  82. int synchronize = 0;
  83. char *fileName = NULL;
  84. char *name = NULL;
  85. char *display = NULL;
  86. char *geometry = NULL;
  87.  
  88. /* for Expect */
  89. int my_rc = 1;
  90. int sys_rc = 1;
  91. int optcmd_eval();
  92. #ifdef TCL_DEBUGGER
  93. int optcmd_debug();
  94. #endif
  95.  
  96. Tk_ArgvInfo argTable[] = {
  97.     {"-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName,
  98.     "File from which to read commands"},
  99.     {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
  100.     "Initial geometry for window"},
  101.     {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
  102.     "Display to use"},
  103.     {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
  104.     "Name to use for application"},
  105.     {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
  106.     "Use synchronous mode for display server"},
  107.  
  108. /* for Expect */
  109.     {"-command", TK_ARGV_GENFUNC, (char *) optcmd_eval, (char *)0,
  110.     "Command(s) to execute immediately"},
  111.     {"-debug", TK_ARGV_CONSTANT, (char *) 1, (char *) &exp_is_debugging,
  112.     "Enable diagnostics"},
  113. #if TCL_DEBUGGER
  114.     {"-Debug", TK_ARGV_GENFUNC, (char *) optcmd_debug, (char *)0, 
  115.     "Enable debugger"},
  116. #endif
  117.     {"-interactive", TK_ARGV_CONSTANT, (char *) 1, (char *) &exp_interactive,
  118.     "Interactive mode"},
  119.     {"-norc", TK_ARGV_CONSTANT, (char *) 0, (char *) &my_rc,
  120.     "Don't read ~/.expect.rc"},
  121.     {"-NORC", TK_ARGV_CONSTANT, (char *) 0, (char *) &sys_rc,
  122.     "Don't read system-wide expect.rc"},
  123.  
  124.     {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
  125.     (char *) NULL}
  126. };
  127.  
  128. #ifdef TCL_DEBUGGER
  129. /*ARGSUSED*/
  130. int
  131. optcmd_debug(dst,interp,key,argc,argv)
  132. char *dst;
  133. Tcl_Interp *interp;
  134. char *key;
  135. int argc;
  136. char **argv;
  137. {
  138.     int i;
  139.  
  140.     exp_tcl_debugger_available = 1;
  141.  
  142.     if (Tcl_GetInt(interp,argv[0],&i) != TCL_OK) {
  143.         return TCL_ERROR;
  144.     }
  145.  
  146.     if (i) {
  147.         Dbg_On(interp,0);
  148.     }
  149.     Dbg_Interactor(interp,exp_interpreter);
  150.  
  151.     argc--;
  152.     for (i=0;i<argc;i++) {
  153.         argv[i] = argv[i+1];
  154.     }
  155.  
  156.     return argc;
  157. }
  158. #endif /*TCL_DEBUGGER*/
  159.  
  160. /*ARGSUSED*/
  161. int
  162. optcmd_eval(dst,interp,key,argc,argv)
  163. char *dst;
  164. Tcl_Interp *interp;
  165. char *key;
  166. int argc;
  167. char **argv;
  168. {
  169.     int i;
  170.     int rc;
  171.  
  172.     exp_cmdlinecmds = 1;
  173.  
  174.     rc = Tcl_Eval(interp,argv[0],0,(char **)0);
  175.  
  176.     argc--;
  177.     for (i=0;i<argc;i++) {
  178.         argv[i] = argv[i+1];
  179.     }
  180.  
  181.     return(rc == TCL_ERROR?TCL_ERROR:argc);
  182. }
  183.  
  184. /*
  185.  * Declaration for Tcl command procedure to create demo widget.  This
  186.  * procedure is only invoked if SQUARE_DEMO is defined.
  187.  */
  188.  
  189. extern int Tk_SquareCmd _ANSI_ARGS_((ClientData clientData,
  190.     Tcl_Interp *interp, int argc, char **argv));
  191.  
  192. /*
  193.  * Forward declarations for procedures defined later in this file:
  194.  */
  195.  
  196. static void        DelayedMap _ANSI_ARGS_((ClientData clientData));
  197. static int        LinetoCmd _ANSI_ARGS_((ClientData clientData,
  198.                 Tcl_Interp *interp, int argc, char **argv));
  199. static int        MovetoCmd _ANSI_ARGS_((ClientData clientData,
  200.                 Tcl_Interp *interp, int argc, char **argv));
  201. static void        StdinProc _ANSI_ARGS_((ClientData clientData,
  202.                 int mask));
  203. static void        StructureProc _ANSI_ARGS_((ClientData clientData,
  204.                 XEvent *eventPtr));
  205.  
  206. /*
  207.  *----------------------------------------------------------------------
  208.  *
  209.  * main --
  210.  *
  211.  *    Main program for Wish.
  212.  *
  213.  * Results:
  214.  *    None. This procedure never returns (it exits the process when
  215.  *    it's done
  216.  *
  217.  * Side effects:
  218.  *    This procedure initializes the wish world and then starts
  219.  *    interpreting commands;  almost anything could happen, depending
  220.  *    on the script being interpreted.
  221.  *
  222.  *----------------------------------------------------------------------
  223.  */
  224.  
  225. int
  226. main(argc, argv)
  227.     int argc;                /* Number of arguments. */
  228.     char **argv;            /* Array of argument strings. */
  229. {
  230.     char *args, *p, *msg;
  231.     char buf[20];
  232.     int result;
  233.     Tk_3DBorder border;
  234.     extern char *exp_argv0;
  235.  
  236. #ifdef TK_EXTENDED
  237.     tk_mainInterp = interp = Tcl_CreateExtendedInterp();
  238. #else
  239.     interp = Tcl_CreateInterp();
  240. #endif
  241. #ifdef TCL_MEM_DEBUG
  242.     Tcl_InitMemory(interp);
  243. #endif
  244.  
  245.     exp_init(interp);
  246.     exp_argv0 = argv[0];
  247.  
  248. #ifdef TCL_DEBUGGER
  249.     Dbg_ArgcArgv(argc,argv,1);
  250. #endif
  251.  
  252.     /*
  253.      * Parse command-line arguments.
  254.      */
  255.  
  256.     if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0)
  257.         != TCL_OK) {
  258.     fprintf(stderr, "%s\n", interp->result);
  259.     exit(1);
  260.     }
  261.  
  262.     if (!fileName) fileName = argv[1];
  263.  
  264.     if (name == NULL) {
  265.     if (fileName != NULL) {
  266.         p = fileName;
  267.     } else {
  268.         p = argv[0];
  269.     }
  270.     name = strrchr(p, '/');
  271.     if (name != NULL) {
  272.         name++;
  273.     } else {
  274.         name = p;
  275.     }
  276.     }
  277.  
  278.   /* if user hasn't explicitly requested we be interactive */
  279.   /* look for a file or some other source of commands */
  280.     if (fileName && !exp_interactive) {
  281.     if (0 == strcmp(fileName,"-")) {
  282.         exp_cmdfile = stdin;
  283.     } else if (NULL == (exp_cmdfile = fopen(fileName,"r"))) {
  284.         perror(fileName);
  285.         exp_exit(interp,-1);
  286.     }
  287.     } else if (!exp_cmdlinecmds) {
  288.     /* no other source of commands, force interactive */
  289.     exp_interactive = 1;
  290.     }
  291.  
  292.     exp_interpret_rcfiles(interp,my_rc,sys_rc);
  293.  
  294.     /*
  295.      * Initialize the Tk application and arrange to map the main window
  296.      * after the startup script has been executed, if any.  This way
  297.      * the script can withdraw the window so it isn't ever mapped
  298.      * at all.
  299.      */
  300.  
  301.     w = Tk_CreateMainWindow(interp, display, name);
  302.     if (w == NULL) {
  303.     fprintf(stderr, "%s\n", interp->result);
  304.     exit(1);
  305.     }
  306.     Tk_SetClass(w, "Tk");
  307.     Tk_CreateEventHandler(w, StructureNotifyMask, StructureProc,
  308.         (ClientData) NULL);
  309.     Tk_DoWhenIdle(DelayedMap, (ClientData) NULL);
  310.     if (synchronize) {
  311.     XSynchronize(Tk_Display(w), True);
  312.     }
  313.     Tk_GeometryRequest(w, 200, 200);
  314.     border = Tk_Get3DBorder(interp, w, None, "#ffe4c4");
  315.     if (border == NULL) {
  316.     Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
  317.     Tk_SetWindowBackground(w, WhitePixelOfScreen(Tk_Screen(w)));
  318.     } else {
  319.     Tk_SetBackgroundFromBorder(w, border);
  320.     }
  321.     XSetForeground(Tk_Display(w), DefaultGCOfScreen(Tk_Screen(w)),
  322.         BlackPixelOfScreen(Tk_Screen(w)));
  323.  
  324.     /*
  325.      * Make command-line arguments available in the Tcl variables "argc"
  326.      * and "argv".  Also set the "geometry" variable from the geometry
  327.      * specified on the command line.
  328.      */
  329.  
  330.     args = Tcl_Merge(argc-1, argv+1);
  331.     Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
  332.     ckfree(args);
  333.     sprintf(buf, "%d", argc-1);
  334.     Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
  335.     if (geometry != NULL) {
  336.     Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
  337.     }
  338.  
  339.     /*
  340.      * Add a few application-specific commands to the application's
  341.      * interpreter.
  342.      */
  343.  
  344.     Tcl_CreateCommand(interp, "lineto", LinetoCmd, (ClientData) w,
  345.         (void (*)()) NULL);
  346.     Tcl_CreateCommand(interp, "moveto", MovetoCmd, (ClientData) w,
  347.         (void (*)()) NULL);
  348. #ifdef SQUARE_DEMO
  349.     Tcl_CreateCommand(interp, "square", Tk_SquareCmd, (ClientData) w,
  350.         (void (*)()) NULL);
  351. #endif
  352.  
  353.     /*
  354.      * Execute Wish's initialization script, followed by the script specified
  355.      * on the command line, if any.
  356.      */
  357.  
  358. #ifdef TK_EXTENDED
  359.      tclAppName    = "Wish";
  360.      tclAppLongname = "Wish - Tk Shell";
  361.      tclAppVersion  = TK_VERSION;
  362.      Tcl_ShellEnvInit (interp, TCLSH_ABORT_STARTUP_ERR,
  363.         name,
  364.         0, NULL,       /* argv var already set  */
  365.         fileName == NULL,  /* interactive?        */
  366.         NULL);           /* Standard default file */
  367. #endif
  368.  
  369.     result = Tcl_Eval(interp, initCmd, 0, (char **) NULL);
  370.     if (result != TCL_OK) {
  371.     goto error;
  372.     }
  373.  
  374.     /* become interactive if requested or "nothing to do" */
  375.     if (exp_interactive) {
  376.         (void) Tcl_Eval(interp, "update", 0, (char **) NULL);
  377.         (void) exp_interpreter(interp);
  378.     } else if (exp_cmdfile) {
  379.         exp_interpret_cmdfile(interp,exp_cmdfile);
  380.         (void) Tcl_Eval(interp, "update", 0, (char **) NULL);
  381.         Tk_MainLoop();
  382.     }
  383.  
  384. #if 0
  385.     if (exp_interactive || (!fileName && !exp_cmdlinecmds)) {
  386.         (void) Tcl_Eval(interp, "update", 0, (char **) NULL);
  387.         (void) exp_interpreter(interp);
  388.     }
  389.  
  390.     if (exp_cmdfile) {
  391.         exp_interpret_cmdfile(interp,exp_cmdfile);
  392.         (void) Tcl_Eval(interp, "update", 0, (char **) NULL);
  393.         Tk_MainLoop();
  394.     }
  395. #endif
  396.  
  397.     exp_exit(interp,0);
  398.  
  399. #if 0
  400.     tty = isatty(0);
  401.     if (fileName != NULL) {
  402.     result = Tcl_VarEval(interp, "source ", fileName, (char *) NULL);
  403.     if (result != TCL_OK) {
  404.         goto error;
  405.     }
  406.     tty = 0;
  407.     } else {
  408.     /*
  409.      * Commands will come from standard input.  Set up a handler
  410.      * to receive those characters and print a prompt if the input
  411.      * device is a terminal.
  412.      */
  413.  
  414.     Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
  415.     if (tty) {
  416.         printf("wish: ");
  417.     }
  418.     }
  419.     fflush(stdout);
  420.     buffer = Tcl_CreateCmdBuf();
  421.     (void) Tcl_Eval(interp, "update", 0, (char **) NULL);
  422.  
  423.     /*
  424.      * Loop infinitely, waiting for commands to execute.  When there
  425.      * are no windows left, Tk_MainLoop returns and we clean up and
  426.      * exit.
  427.      */
  428.  
  429.     Tk_MainLoop();
  430.     Tcl_DeleteInterp(interp);
  431.     Tcl_DeleteCmdBuf(buffer);
  432.     exit(0);
  433. #endif
  434.  
  435. error:
  436.     msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
  437.     if (msg == NULL) {
  438.     msg = interp->result;
  439.     }
  440.     fprintf(stderr, "%s\n", msg);
  441.     Tcl_Eval(interp, "destroy .", 0, (char **) NULL);
  442.     exit(1);
  443.     return 0;            /* Needed only to prevent compiler warnings. */
  444. }
  445.  
  446. #if 0
  447. /*
  448.  *----------------------------------------------------------------------
  449.  *
  450.  * StdinProc --
  451.  *
  452.  *    This procedure is invoked by the event dispatcher whenever
  453.  *    standard input becomes readable.  It grabs the next line of
  454.  *    input characters, adds them to a command being assembled, and
  455.  *    executes the command if it's complete.
  456.  *
  457.  * Results:
  458.  *    None.
  459.  *
  460.  * Side effects:
  461.  *    Could be almost arbitrary, depending on the command that's
  462.  *    typed.
  463.  *
  464.  *----------------------------------------------------------------------
  465.  */
  466.  
  467.     /* ARGSUSED */
  468. static void
  469. StdinProc(clientData, mask)
  470.     ClientData clientData;        /* Not used. */
  471.     int mask;                /* Not used. */
  472. {
  473. #define BUFFER_SIZE 4000
  474.     char input[BUFFER_SIZE+1];
  475.     static int gotPartial = 0;
  476.     char *cmd;
  477.     int result, count;
  478.  
  479.     count = read(fileno(stdin), input, BUFFER_SIZE);
  480.     if (count <= 0) {
  481.     if (!gotPartial) {
  482.         if (tty) {
  483.         Tcl_Eval(interp, "destroy .", 0, (char **) NULL);
  484.         exit(0);
  485.         } else {
  486.         Tk_DeleteFileHandler(0);
  487.         }
  488.         return;
  489.     } else {
  490.         input[0] = 0;
  491.     }
  492.     } else {
  493.     input[count] = 0;
  494.     cmd = Tcl_AssembleCmd(buffer, input);
  495.     if (cmd == NULL) {
  496.     gotPartial = 1;
  497.     return;
  498.     }
  499.     gotPartial = 0;
  500.     result = Tcl_RecordAndEval(interp, cmd, 0);
  501.     if (*interp->result != 0) {
  502.     if ((result != TCL_OK) || (tty)) {
  503.         printf("%s\n", interp->result);
  504.     }
  505.     }
  506.     if (tty) {
  507.     printf("wish: ");
  508.     fflush(stdout);
  509.     }
  510. }
  511. #endif
  512.  
  513. /*
  514.  *----------------------------------------------------------------------
  515.  *
  516.  * StructureProc --
  517.  *
  518.  *    This procedure is invoked whenever a structure-related event
  519.  *    occurs on the main window.  If the window is deleted, the
  520.  *    procedure modifies "w" to record that fact.
  521.  *
  522.  * Results:
  523.  *    None.
  524.  *
  525.  * Side effects:
  526.  *    Variable "w" may get set to NULL.
  527.  *
  528.  *----------------------------------------------------------------------
  529.  */
  530.  
  531.     /* ARGSUSED */
  532. static void
  533. StructureProc(clientData, eventPtr)
  534.     ClientData clientData;    /* Information about window. */
  535.     XEvent *eventPtr;        /* Information about event. */
  536. {
  537.     if (eventPtr->type == DestroyNotify) {
  538.     w = NULL;
  539.     }
  540. }
  541.  
  542. /*
  543.  *----------------------------------------------------------------------
  544.  *
  545.  * DelayedMap --
  546.  *
  547.  *    This procedure is invoked by the event dispatcher once the
  548.  *    startup script has been processed.  It waits for all other
  549.  *    pending idle handlers to be processed (so that all the
  550.  *    geometry information will be correct), then maps the
  551.  *    application's main window.
  552.  *
  553.  * Results:
  554.  *    None.
  555.  *
  556.  * Side effects:
  557.  *    The main window gets mapped.
  558.  *
  559.  *----------------------------------------------------------------------
  560.  */
  561.  
  562.     /* ARGSUSED */
  563. static void
  564. DelayedMap(clientData)
  565.     ClientData clientData;    /* Not used. */
  566. {
  567.  
  568.     while (Tk_DoOneEvent(TK_IDLE_EVENTS) != 0) {
  569.     /* Empty loop body. */
  570.     }
  571.     if (w == NULL) {
  572.     return;
  573.     }
  574.     Tk_MapWindow(w);
  575. }
  576.  
  577. /*
  578.  *----------------------------------------------------------------------
  579.  *
  580.  * MoveToCmd and LineToCmd --
  581.  *
  582.  *    This procedures are registered as the command procedures for
  583.  *    "moveto" and "lineto" Tcl commands.  They provide a trivial
  584.  *    drawing facility.  They don't really work right, in that the
  585.  *    drawn information isn't persistent on the screen (it will go
  586.  *    away if the window is iconified and de-iconified again).  The
  587.  *    commands are here partly for testing and partly to illustrate
  588.  *    how to add application-specific commands to Tk.  You probably
  589.  *    shouldn't use these commands in any real scripts.
  590.  *
  591.  * Results:
  592.  *    The procedures return standard Tcl results.
  593.  *
  594.  * Side effects:
  595.  *    The screen gets modified.
  596.  *
  597.  *----------------------------------------------------------------------
  598.  */
  599.  
  600.     /* ARGSUSED */
  601. static int
  602. MovetoCmd(dummy, interp, argc, argv)
  603.     ClientData dummy;            /* Not used. */
  604.     Tcl_Interp *interp;            /* Current interpreter. */
  605.     int argc;                /* Number of arguments. */
  606.     char **argv;            /* Argument strings. */
  607. {
  608.     if (argc != 3) {
  609.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  610.         " x y\"", (char *) NULL);
  611.     return TCL_ERROR;
  612.     }
  613.     x = strtol(argv[1], (char **) NULL, 0);
  614.     y = strtol(argv[2], (char **) NULL, 0);
  615.     return TCL_OK;
  616. }
  617.     /* ARGSUSED */
  618. static int
  619. LinetoCmd(dummy, interp, argc, argv)
  620.     ClientData dummy;            /* Not used. */
  621.     Tcl_Interp *interp;            /* Current interpreter. */
  622.     int argc;                /* Number of arguments. */
  623.     char **argv;            /* Argument strings. */
  624. {
  625.     int newX, newY;
  626.  
  627.     if (argc != 3) {
  628.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  629.         " x y\"", (char *) NULL);
  630.     return TCL_ERROR;
  631.     }
  632.     newX = strtol(argv[1], (char **) NULL, 0);
  633.     newY = strtol(argv[2], (char **) NULL, 0);
  634.     Tk_MakeWindowExist(w);
  635.     XDrawLine(Tk_Display(w), Tk_WindowId(w),
  636.         DefaultGCOfScreen(Tk_Screen(w)), x, y, newX, newY);
  637.     x = newX;
  638.     y = newY;
  639.     return TCL_OK;
  640. }
  641.