home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / maths / plplot / plplot_2 / drivers / tk / tkMain.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-06-30  |  12.5 KB  |  479 lines
  1. /* $Id: tkMain.c,v 1.2 1994/06/30 18:45:05 mjl Exp $
  2.  * $Log: tkMain.c,v $
  3.  * Revision 1.2  1994/06/30  18:45:05  mjl
  4.  * Minor changes to pass gcc -Wall without warnings and other cleaning up.
  5.  *
  6.  * Revision 1.1  1994/06/23  22:39:10  mjl
  7.  * Handles nearly all the important setup for extended wish's.  Taken from
  8.  * tkMain.c of Tk 3.6, and modified minimally to support my needs.
  9.  *
  10. */
  11.  
  12. /*
  13.  * Modified version of tkMain.c, from Tk 3.6.
  14.  * Maurice LeBrun
  15.  * 23-Jun-1994
  16.  *
  17.  * Modifications include:
  18.  * 1. main() changed to pltkMain().
  19.  * 2. tcl_RcFileName changed to pltk_RcFileName.
  20.  * 3. Support for -e <script> startup option
  21.  *
  22.  * The original notes follow.
  23.  */
  24.  
  25. /* 
  26.  * main.c --
  27.  *
  28.  *    This file contains the main program for "wish", a windowing
  29.  *    shell based on Tk and Tcl.  It also provides a template that
  30.  *    can be used as the basis for main programs for other Tk
  31.  *    applications.
  32.  *
  33.  * Copyright (c) 1990-1993 The Regents of the University of California.
  34.  * All rights reserved.
  35.  *
  36.  * Permission is hereby granted, without written agreement and without
  37.  * license or royalty fees, to use, copy, modify, and distribute this
  38.  * software and its documentation for any purpose, provided that the
  39.  * above copyright notice and the following two paragraphs appear in
  40.  * all copies of this software.
  41.  * 
  42.  * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  43.  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  44.  * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  45.  * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  46.  *
  47.  * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  48.  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  49.  * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  50.  * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  51.  * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  52.  */
  53.  
  54. #include <stdio.h>
  55. #include <stdlib.h>
  56. #include <tcl.h>
  57. #include <tk.h>
  58.  
  59. /*
  60.  * Declarations for various library procedures and variables (don't want
  61.  * to include tkInt.h or tkConfig.h here, because people might copy this
  62.  * file out of the Tk source directory to make their own modified versions).
  63.  */
  64.  
  65. extern void        exit _ANSI_ARGS_((int status));
  66. extern int        isatty _ANSI_ARGS_((int fd));
  67. extern int        read _ANSI_ARGS_((int fd, char *buf, size_t size));
  68. extern char *        strrchr _ANSI_ARGS_((CONST char *string, int c));
  69.  
  70. /*
  71.  * Global variables used by the main program:
  72.  */
  73.  
  74. static Tk_Window mainWindow;    /* The main window for the application.  If
  75.                  * NULL then the application no longer
  76.                  * exists. */
  77. static Tcl_Interp *interp;    /* Interpreter for this application. */
  78. char *pltk_RcFileName = NULL;    /* Name of a user-specific startup script
  79.                  * to source if the application is being run
  80.                  * interactively (e.g. "~/.wishrc").  Set
  81.                  * by Tcl_AppInit.  NULL means don't source
  82.                  * anything ever. */
  83. static Tcl_DString command;    /* Used to assemble lines of terminal input
  84.                  * into Tcl commands. */
  85. static int tty;            /* Non-zero means standard input is a
  86.                  * terminal-like device.  Zero means it's
  87.                  * a file. */
  88. static char errorExitCmd[] = "exit 1";
  89.  
  90. /*
  91.  * Command-line options:
  92.  */
  93.  
  94. static int synchronize = 0;
  95. static char *script = NULL;
  96. static char *fileName = NULL;
  97. static char *name = NULL;
  98. static char *display = NULL;
  99. static char *geometry = NULL;
  100.  
  101. static Tk_ArgvInfo argTable[] = {
  102.     {"-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName,
  103.     "File from which to read commands"},
  104.     {"-e", TK_ARGV_STRING, (char *) NULL, (char *) &script,
  105.     "Script to execute on startup"},
  106.     {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
  107.     "Initial geometry for window"},
  108.     {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
  109.     "Display to use"},
  110.     {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
  111.     "Name to use for application"},
  112.     {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
  113.     "Use synchronous mode for display server"},
  114.     {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
  115.     (char *) NULL}
  116. };
  117.  
  118. /*
  119.  * Declaration for Tcl command procedure to create demo widget.  This
  120.  * procedure is only invoked if SQUARE_DEMO is defined.
  121.  */
  122.  
  123. extern int SquareCmd _ANSI_ARGS_((ClientData clientData,
  124.     Tcl_Interp *interp, int argc, char *argv[]));
  125.  
  126. /*
  127.  * Forward declarations for procedures defined later in this file:
  128.  */
  129.  
  130. static void        Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial));
  131. static void        StdinProc _ANSI_ARGS_((ClientData clientData,
  132.                 int mask));
  133.  
  134. /*
  135.  *----------------------------------------------------------------------
  136.  *
  137.  * main --
  138.  *
  139.  *    Main program for Wish.
  140.  *
  141.  * Results:
  142.  *    None. This procedure never returns (it exits the process when
  143.  *    it's done
  144.  *
  145.  * Side effects:
  146.  *    This procedure initializes the wish world and then starts
  147.  *    interpreting commands;  almost anything could happen, depending
  148.  *    on the script being interpreted.
  149.  *
  150.  *----------------------------------------------------------------------
  151.  */
  152.  
  153. int
  154. pltkMain(int argc, char **argv)
  155. {
  156.     char *args, *p, *msg;
  157.     char buf[20];
  158.     int code;
  159.  
  160.     interp = Tcl_CreateInterp();
  161. #ifdef TCL_MEM_DEBUG
  162.     Tcl_InitMemory(interp);
  163. #endif
  164.  
  165.     /*
  166.      * Parse command-line arguments.
  167.      */
  168.  
  169.     if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0)
  170.         != TCL_OK) {
  171.     fprintf(stderr, "%s\n", interp->result);
  172.     exit(1);
  173.     }
  174.     if (name == NULL) {
  175.     if (fileName != NULL) {
  176.         p = fileName;
  177.     } else {
  178.         p = argv[0];
  179.     }
  180.     name = strrchr(p, '/');
  181.     if (name != NULL) {
  182.         name++;
  183.     } else {
  184.         name = p;
  185.     }
  186.     }
  187.  
  188.     /*
  189.      * If a display was specified, put it into the DISPLAY
  190.      * environment variable so that it will be available for
  191.      * any sub-processes created by us.
  192.      */
  193.  
  194.     if (display != NULL) {
  195.     Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY);
  196.     }
  197.  
  198.     /*
  199.      * Initialize the Tk application.
  200.      */
  201.  
  202.     mainWindow = Tk_CreateMainWindow(interp, display, name, "Tk");
  203.     if (mainWindow == NULL) {
  204.     fprintf(stderr, "%s\n", interp->result);
  205.     exit(1);
  206.     }
  207.     if (synchronize) {
  208.     XSynchronize(Tk_Display(mainWindow), True);
  209.     }
  210.     Tk_GeometryRequest(mainWindow, 200, 200);
  211.  
  212.     /*
  213.      * Make command-line arguments available in the Tcl variables "argc"
  214.      * and "argv".  Also set the "geometry" variable from the geometry
  215.      * specified on the command line.
  216.      */
  217.  
  218.     args = Tcl_Merge(argc-1, argv+1);
  219.     Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
  220.     ckfree(args);
  221.     sprintf(buf, "%d", argc-1);
  222.     Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
  223.     Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
  224.         TCL_GLOBAL_ONLY);
  225.     if (geometry != NULL) {
  226.     Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
  227.     }
  228.  
  229.     /*
  230.      * Set the "tcl_interactive" variable.
  231.      */
  232.  
  233.     tty = isatty(0);
  234.     Tcl_SetVar(interp, "tcl_interactive",
  235.         ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
  236.  
  237.     /*
  238.      * Add a few application-specific commands to the application's
  239.      * interpreter.
  240.      */
  241.  
  242. #ifdef SQUARE_DEMO
  243.     Tcl_CreateCommand(interp, "square", SquareCmd, (ClientData) mainWindow,
  244.         (void (*)()) NULL);
  245. #endif
  246.  
  247.     /*
  248.      * Invoke application-specific initialization.
  249.      */
  250.  
  251.     if (Tcl_AppInit(interp) != TCL_OK) {
  252.     fprintf(stderr, "Tcl_AppInit failed: %s\n", interp->result);
  253.     }
  254.  
  255.     /*
  256.      * Set the geometry of the main window, if requested.
  257.      */
  258.  
  259.     if (geometry != NULL) {
  260.     code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL);
  261.     if (code != TCL_OK) {
  262.         fprintf(stderr, "%s\n", interp->result);
  263.     }
  264.     }
  265.  
  266.     /*
  267.      * Invoke the script specified on the command line, if any.
  268.      */
  269.  
  270.     if (script != NULL) {
  271.     code = Tcl_VarEval(interp, script, (char *) NULL);
  272.     if (code != TCL_OK) {
  273.         goto error;
  274.     }
  275.     tty = 0;
  276.     }
  277.     else if (fileName != NULL) {
  278.     code = Tcl_VarEval(interp, "source ", fileName, (char *) NULL);
  279.     if (code != TCL_OK) {
  280.         goto error;
  281.     }
  282.     tty = 0;
  283.     } else {
  284.     /*
  285.      * Commands will come from standard input, so set up an event
  286.      * handler for standard input.  If the input device is aEvaluate the
  287.      * .rc file, if one has been specified, set up an event handler
  288.      * for standard input, and print a prompt if the input
  289.      * device is a terminal.
  290.      */
  291.  
  292.     if (pltk_RcFileName != NULL) {
  293.         Tcl_DString buffer;
  294.         char *fullName;
  295.         FILE *f;
  296.     
  297.         fullName = Tcl_TildeSubst(interp, pltk_RcFileName, &buffer);
  298.         if (fullName == NULL) {
  299.         fprintf(stderr, "%s\n", interp->result);
  300.         } else {
  301.         f = fopen(fullName, "r");
  302.         if (f != NULL) {
  303.             code = Tcl_EvalFile(interp, fullName);
  304.             if (code != TCL_OK) {
  305.             fprintf(stderr, "%s\n", interp->result);
  306.             }
  307.             fclose(f);
  308.         }
  309.         }
  310.         Tcl_DStringFree(&buffer);
  311.     }
  312.     Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
  313.     if (tty) {
  314.         Prompt(interp, 0);
  315.     }
  316.     }
  317.     fflush(stdout);
  318.     Tcl_DStringInit(&command);
  319.  
  320.     /*
  321.      * Loop infinitely, waiting for commands to execute.  When there
  322.      * are no windows left, Tk_MainLoop returns and we exit.
  323.      */
  324.  
  325.     Tk_MainLoop();
  326.  
  327.     /*
  328.      * Don't exit directly, but rather invoke the Tcl "exit" command.
  329.      * This gives the application the opportunity to redefine "exit"
  330.      * to do additional cleanup.
  331.      */
  332.  
  333.     Tcl_Eval(interp, "exit");
  334.     exit(1);
  335.  
  336. error:
  337.     msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
  338.     if (msg == NULL) {
  339.     msg = interp->result;
  340.     }
  341.     fprintf(stderr, "%s\n", msg);
  342.     Tcl_Eval(interp, errorExitCmd);
  343.     return 1;            /* Needed only to prevent compiler warnings. */
  344. }
  345.  
  346. /*
  347.  *----------------------------------------------------------------------
  348.  *
  349.  * StdinProc --
  350.  *
  351.  *    This procedure is invoked by the event dispatcher whenever
  352.  *    standard input becomes readable.  It grabs the next line of
  353.  *    input characters, adds them to a command being assembled, and
  354.  *    executes the command if it's complete.
  355.  *
  356.  * Results:
  357.  *    None.
  358.  *
  359.  * Side effects:
  360.  *    Could be almost arbitrary, depending on the command that's
  361.  *    typed.
  362.  *
  363.  *----------------------------------------------------------------------
  364.  */
  365.  
  366.     /* ARGSUSED */
  367. static void
  368. StdinProc(clientData, mask)
  369.     ClientData clientData;        /* Not used. */
  370.     int mask;                /* Not used. */
  371. {
  372. #define BUFFER_SIZE 4000
  373.     char input[BUFFER_SIZE+1];
  374.     static int gotPartial = 0;
  375.     char *cmd;
  376.     int code, count;
  377.  
  378.     count = read(fileno(stdin), input, BUFFER_SIZE);
  379.     if (count <= 0) {
  380.     if (!gotPartial) {
  381.         if (tty) {
  382.         Tcl_Eval(interp, "exit");
  383.         exit(1);
  384.         } else {
  385.         Tk_DeleteFileHandler(0);
  386.         }
  387.         return;
  388.     } else {
  389.         count = 0;
  390.     }
  391.     }
  392.     cmd = Tcl_DStringAppend(&command, input, count);
  393.     if (count != 0) {
  394.     if ((input[count-1] != '\n') && (input[count-1] != ';')) {
  395.         gotPartial = 1;
  396.         goto prompt;
  397.     }
  398.     if (!Tcl_CommandComplete(cmd)) {
  399.         gotPartial = 1;
  400.         goto prompt;
  401.     }
  402.     }
  403.     gotPartial = 0;
  404.  
  405.     /*
  406.      * Disable the stdin file handler while evaluating the command;
  407.      * otherwise if the command re-enters the event loop we might
  408.      * process commands from stdin before the current command is
  409.      * finished.  Among other things, this will trash the text of the
  410.      * command being evaluated.
  411.      */
  412.  
  413.     Tk_CreateFileHandler(0, 0, StdinProc, (ClientData) 0);
  414.     code = Tcl_RecordAndEval(interp, cmd, 0);
  415.     Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
  416.     Tcl_DStringFree(&command);
  417.     if (*interp->result != 0) {
  418.     if ((code != TCL_OK) || (tty)) {
  419.         printf("%s\n", interp->result);
  420.     }
  421.     }
  422.  
  423.     /*
  424.      * Output a prompt.
  425.      */
  426.  
  427.     prompt:
  428.     if (tty) {
  429.     Prompt(interp, gotPartial);
  430.     }
  431. }
  432.  
  433. /*
  434.  *----------------------------------------------------------------------
  435.  *
  436.  * Prompt --
  437.  *
  438.  *    Issue a prompt on standard output, or invoke a script
  439.  *    to issue the prompt.
  440.  *
  441.  * Results:
  442.  *    None.
  443.  *
  444.  * Side effects:
  445.  *    A prompt gets output, and a Tcl script may be evaluated
  446.  *    in interp.
  447.  *
  448.  *----------------------------------------------------------------------
  449.  */
  450.  
  451. static void
  452. Prompt(interp, partial)
  453.     Tcl_Interp *interp;            /* Interpreter to use for prompting. */
  454.     int partial;            /* Non-zero means there already
  455.                      * exists a partial command, so use
  456.                      * the secondary prompt. */
  457. {
  458.     char *promptCmd;
  459.     int code;
  460.  
  461.     promptCmd = Tcl_GetVar(interp,
  462.     partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY);
  463.     if (promptCmd == NULL) {
  464.     defaultPrompt:
  465.     if (!partial) {
  466.         fputs("% ", stdout);
  467.     }
  468.     } else {
  469.     code = Tcl_Eval(interp, promptCmd);
  470.     if (code != TCL_OK) {
  471.         Tcl_AddErrorInfo(interp,
  472.             "\n    (script that generates prompt)");
  473.         fprintf(stderr, "%s\n", interp->result);
  474.         goto defaultPrompt;
  475.     }
  476.     }
  477.     fflush(stdout);
  478. }
  479.