FILE(1/2): tkMain.c for tcl-dp3.2 and tcl/tk4.0b3 
Author Message
 FILE(1/2): tkMain.c for tcl-dp3.2 and tcl/tk4.0b3

/*
 * main.c --
 *
 *      This file contains the main program for "wish", a windowing
 *      shell based on Tk and Tcl.  It also provides a template that
 *      can be used as the basis for main programs for other Tk
 *      applications.
 *
 * Copyright (c) 1990-1993 The Regents of the University of California.
 * All rights reserved.
 *
 * Permission is hereby granted, without written agreement and without
 * license or royalty fees, to use, copy, modify, and distribute this
 * software and its documentation for any purpose, provided that the
 * above copyright notice and the following two paragraphs appear in
 * all copies of this software.
 *
 * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
 * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
 * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
 * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
 * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
 * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
 * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
 * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
 */

#include <stdio.h>
#include <tcl.h>
#include <tk.h>

/*
 * Declarations for various library procedures and variables (don't want
 * to include tkInt.h or tkConfig.h here, because people might copy this
 * file out of the Tk source directory to make their own modified versions).
 */

extern void             exit _ANSI_ARGS_((int status));
extern int              isatty _ANSI_ARGS_((int fd));
extern int              read _ANSI_ARGS_((int fd, char *buf, size_t size));
extern char *           strrchr _ANSI_ARGS_((CONST char *string, int c));

/*
 * Global variables used by the main program:
 */

#ifndef NO_X11
static Tk_Window mainWindow;    /* The main window for the application.  If
                                 * NULL then the application no longer
                                 * exists. */
#endif
static Tcl_Interp *interp;      /* Interpreter for this application. */
char *dp_RcFileName = NULL;     /* Name of a user-specific startup script
                                 * to source if the application is being run
                                 * interactively (e.g. "~/.wishrc").  Set
                                 * by Tcl_AppInit.  NULL means don't source
                                 * anything ever. */
static Tcl_DString command;     /* Used to assemble lines of terminal input
                                 * into Tcl commands. */
static int tty;                 /* Non-zero means standard input is a
                                 * terminal-like device.  Zero means it's
                                 * a file. */
static char updateCmd[] = "dp_update";
static char exitCmd[] = "exit";
static char errorExitCmd[] = "exit 1";

/*
 * Command-line options:
 */

#ifndef NO_X11
static int synchronize = 0;
static char *display = NULL;
static char *geometry = NULL;
#endif
static char *fileName = NULL;
static char *name = NULL;
static int hasWindows = 1;
static int isDaemon = 0;

static Tk_ArgvInfo argTable[] = {
#ifndef NO_X11
    {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
        "Initial geometry for window"},
    {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
        "Display to use"},
    {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
        "Name to use for application"},
    {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
        "Use synchronous mode for display server"},
#endif
    {"-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName,
        "File from which to read commands"},
    {"-notk", TK_ARGV_CONSTANT, (char *) 0, (char *) &hasWindows,
        "Run without tk support"},
    {"-bg", TK_ARGV_CONSTANT, (char *) 1, (char *) &isDaemon,
        "Process background events"},
    {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
        (char *) NULL}

Quote:
};

static void             Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial));
static void             StdinProc _ANSI_ARGS_((ClientData clientData,
                            int mask));

/*
 *----------------------------------------------------------------------
 *
 * main --
 *
 *      Main program for Dpwish.
 *
 * Results:
 *      None. This procedure never returns (it exits the process when
 *      it's done
 *
 * Side effects:
 *      This procedure initializes the wish world and then starts
 *      interpreting commands;  almost anything could happen, depending
 *      on the script being interpreted.
 *
 *----------------------------------------------------------------------
 */

int
main(argc, argv)
    int argc;                           /* Number of arguments. */
    char **argv;                        /* Array of argument strings. */
{
    char *args, *p, *msg;
    char buf[20];
    char *execName;
    int code;

    interp = Tcl_CreateInterp();
#ifdef TCL_MEM_DEBUG
    Tcl_InitMemory(interp);
#endif

    /*
     * Parse command-line arguments.
     */

    if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0)
            != TCL_OK) {
        fprintf(stderr, "%s\n", interp->result);
        exit(1);
    }

#ifdef NO_X11
    hasWindows = 0;
#endif

    /*
     * If executable is called "dptcl", assume -notk
     */
    execName = strrchr(argv[0], '/');
    if (execName != NULL) {
        execName++;
    } else {
        execName = argv[0];
    }
    if (strcmp(execName,"dptcl") == 0) {
        hasWindows = 0;
    }

    if (name == NULL) {
        if (fileName != NULL) {
            p = fileName;
        } else {
            p = execName;
        }
        name = strrchr(p, '/');
        if (name != NULL) {
            name++;
        } else {
            name = p;
        }
    }

#ifndef NO_X11
    /*
     * If a display was specified, put it into the DISPLAY
     * environment variable so that it will be available for
     * any sub-processes created by us.
     */

    if (display != NULL) {
        Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY);
    }

    /*
     * Initialize the Tk application.
     */
    if (hasWindows) {
        mainWindow = Tk_CreateMainWindow(interp, display, name, "Tk");
        if (mainWindow == NULL) {
            fprintf(stderr, "%s\n", interp->result);
            exit(1);
        }
        if (synchronize) {
            XSynchronize(Tk_Display(mainWindow), True);
        }
        Tk_GeometryRequest(mainWindow, 200, 200);
    }
#else
    hasWindows = 0;
#endif

    /*
     * Make command-line arguments available in the Tcl variables "argc"
     * and "argv".  Also set the "geometry" variable from the geometry
     * specified on the command line.
     */

    args = Tcl_Merge(argc-1, argv+1);
    Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
    ckfree(args);
    sprintf(buf, "%d", argc-1);
    Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
    Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
            TCL_GLOBAL_ONLY);
#ifndef NO_X11
    if (geometry != NULL) {
        Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
    }
#endif

    /*
     * 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 (Tcl_AppInit(interp) != TCL_OK) {
        fprintf(stderr, "Tcl_AppInit failed: %s\n", interp->result);
    }

#ifndef NO_X11
    /*
     * Set the geometry of the main window, if requested.
     */

    if (hasWindows && geometry != NULL) {
        code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL);
        if (code != TCL_OK) {
            fprintf(stderr, "%s\n", interp->result);
        }
    }
#endif

    /*
     * Invoke the script specified on the command line, if any.
     */

    if (fileName != NULL) {
        code = Tcl_VarEval(interp, "source ", fileName, (char *) NULL);
        if (code != TCL_OK) {
            goto error;
        }
        tty = 0;
    } else {
        /*
         * Commands will come from standard input, so set up an event
         * handler for standard input.  If the input device is aEvaluate the
         * .rc file, if one has been specified, set up an event handler
         * for standard input, and print a prompt if the input
         * device is a terminal.
         */

        if (dp_RcFileName != NULL) {
            Tcl_DString buffer;
            char *fullName;
            FILE *f;

            fullName = Tcl_TildeSubst(interp, dp_RcFileName, &buffer);
            if (fullName == NULL) {
                fprintf(stderr, "%s\n", interp->result);
            } else {
                f = fopen(fullName, "r");
                if (f != NULL) {
                    code = Tcl_EvalFile(interp, fullName);
                    if (code != TCL_OK) {
                        fprintf(stderr, "%s\n", interp->result);
                    }
                    fclose(f);
                }
            }
            Tcl_DStringFree(&buffer);
        }
        Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
        if (tty) {
            Prompt(interp, 0);
        }
    }
    fflush(stdout);
    Tcl_DStringInit(&command);

    /*
     * Loop infinitely, waiting for commands to execute.  When there
     * are no windows left, Tk_MainLoop returns and we exit.
     */

    if (hasWindows) {
        (void) Tcl_Eval(interp, updateCmd);
        Tk_MainLoop();
    } else {
        while (1) {
            (void)Tk_DoOneEvent(0);
        }
    }

    /*
     * Don't exit directly, but rather invoke the Tcl "exit" command.
     * This gives the application the opportunity to redefine "exit"
     * to do additional cleanup.
     */

    Tcl_Eval(interp, exitCmd);
    exit(1);

error:
    msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
    if (msg == NULL) {
        msg = interp->result;
    }
    fprintf(stderr, "%s\n", msg);
    Tcl_Eval(interp, errorExitCmd);
    return 1;                   /* Needed only to prevent compiler warnings. */

Quote:
}

/*
 *----------------------------------------------------------------------
 *
 * StdinProc --
 *
 *      This procedure is invoked by the event dispatcher whenever
 *      standard input becomes readable.  It grabs the next line of
 *      input characters, adds them to a command being assembled, and
 *      executes the command if it's complete.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Could be almost arbitrary, depending on the command that's
 *      typed.
 *
 *----------------------------------------------------------------------
 */

    /* ARGSUSED */
static void
StdinProc(clientData, mask)
    ClientData clientData;              /* Not used. */
    int mask;                           /* Not used. */
{
#define BUFFER_SIZE 4000
    char input[BUFFER_SIZE+1];
    static int gotPartial = 0;
    char *cmd;
    int code, count;

    count = read(fileno(stdin), input, BUFFER_SIZE);
    if (count <= 0) {
        if (!gotPartial) {
            if (tty) {
                Tcl_Eval(interp, exitCmd);
                exit(1);
            } else {
                Tk_DeleteFileHandler(0);
            }
            return;
        } else {
            count = 0;
        }
    }
    cmd = Tcl_DStringAppend(&command, input, count);
    if (count != 0) {
        if ((input[count-1] != '\n') && (input[count-1] != ';')) {
            gotPartial = 1;
            goto prompt;
        }
        if (!Tcl_CommandComplete(cmd)) {
            gotPartial = 1;
            goto prompt;
        }
    }
    gotPartial = 0;

    /*
     * Disable the stdin file handler while evaluating the command;
     * otherwise if the command re-enters the event loop we might
     * process commands from stdin before the current command is
     * finished.  Among other things, this will trash the text of the
     * command being evaluated.
     */

    Tk_CreateFileHandler(0, 0, StdinProc, (ClientData) 0);
    code = Tcl_RecordAndEval(interp, cmd, 0);
    Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
    Tcl_DStringFree(&command);
    if (*interp->result != 0) {
        if ((code != TCL_OK) || (tty)) {
            printf("%s\n", interp->result);
        }
    }

    /*
     * Output a prompt.
     */

    prompt:
    if (tty) {
        Prompt(interp, gotPartial);
    }

Quote:
}

/*
 *----------------------------------------------------------------------
 *
 * Prompt --
 *
 *      Issue a prompt on standard output, or invoke a script
 *      to issue the prompt.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      A prompt gets output, and a Tcl script may be evaluated
 *      in interp.
 *
 *----------------------------------------------------------------------
 */

static void
Prompt(interp, partial)
    Tcl_Interp *interp;                 /* Interpreter to use for prompting. */
    int partial;                        /* Non-zero means there already
                                         * exists a partial command, so use
                                         * the secondary prompt. */
{
    char *promptCmd;
    int code;

    promptCmd = Tcl_GetVar(interp,
        partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY);
    if (promptCmd == NULL) {
        defaultPrompt:
        if (!partial) {
            fputs("% ", stdout);
        }
    } else {
        code = Tcl_Eval(interp, promptCmd);
        if (code != TCL_OK) {
            Tcl_AddErrorInfo(interp,
                    "\n    (script that generates prompt)");
            fprintf(stderr, "%s\n", interp->result);
            goto defaultPrompt;
        }
    }
    fflush(stdout);

Quote:
}



Mon, 10 Nov 1997 03:00:00 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. FILE(2/2): tkAppInit.c & tcl-dp3.2 with tcl/tk4.0b3

2. tcl-dp3.3b1, tcl7.4 and tk4.0

3. Tcl/Tk4.0b3 locale problem.

4. installing tk4.0b3 and tcl 7.4b3

5. tcl-dp3.1 and Tcl

6. dde package - buggy pkgIndex.tcl file in /Tcl/lib/tcl.8.4/dde1.1

7. Tcl-DP3.3b1 on Linux

8. Need Tcl-dp3.4x

9. Tcl-dp3.3b1

10. compile tcl-dp3.4b2

11. Where is tcl-dp3.4 source ??

12. Tcl-DP3.3b1 installation on AIX 3.2.5

 

 
Powered by phpBB® Forum Software