/[dtapublic]/projs/ets/trunk/src/c_tk_base_7_5_w_mods/tkmain.c

Diff of /projs/ets/trunk/src/c_tk_base_7_5_w_mods/tkmain.c

Parent Directory | Revision Log | View Patch Patch

-revision 70 by dashley,
Sat Nov  5 10:54:17 2016 UTC
+revision 71 by dashley,
Sat Nov  5 11:07:06 2016 UTC
 Line 1
  /* $Header$ */
  /*
   * tkMain.c --
   *
   *      This file contains a generic main program for Tk-based applications.
   *      It can be used as-is for many applications, just by supplying a
   *      different appInitProc procedure for each specific application.
   *      Or, it can be used as a template for creating new main programs
   *      for Tk applications.
   *
   * Copyright (c) 1990-1994 The Regents of the University of California.
   * Copyright (c) 1994-1997 Sun Microsystems, Inc.
   *
   * See the file "license.terms" for information on usage and redistribution
   * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
   *
   * RCS: @(#) $Id: tkmain.c,v 1.1.1.1 2001/06/13 05:05:07 dtashley Exp $
   */
  #define MODULE_TK_MAIN
  #include <ctype.h>
  #include <stdio.h>
  #include <string.h>
  #include <tcl.h>
  #include <tclInt.h>
  #include "appinit.h"
  #include "build_config.h"
  #include "extninit.h"
  #include "msgstrs.h"
  #include "tk.h"
  #include "tkInt.h"
  #ifdef NO_STDLIB_H
  #   include "../compat/stdlib.h"
  #else
  #   include <stdlib.h>
  #endif
  #ifdef __WIN32__
  #include "tkWinInt.h"
  #endif
  typedef struct ThreadSpecificData {
      Tcl_Interp *interp;         /* Interpreter for this thread. */
      Tcl_DString command;        /* Used to assemble lines of terminal input
                                   * into Tcl commands. */
      Tcl_DString line;           /* Used to read the next line from the
                                   * terminal input. */
      int tty;                    /* Non-zero means standard input is a
                                   * terminal-like device.  Zero means it's
                                   * a file. */
  } ThreadSpecificData;
  Tcl_ThreadDataKey dataKey;
  /*
   * Declarations for various library procedures and variables (don't want
   * to include tkInt.h or tkPort.h here, because people might copy this
   * file out of the Tk source directory to make their own modified versions).
   * Note: don't declare "exit" here even though a declaration is really
   * needed, because it will conflict with a declaration elsewhere on
   * some systems.
   */
  #if !defined(__WIN32__) && !defined(_WIN32)
  extern int              isatty _ANSI_ARGS_((int fd));
  extern char *           strrchr _ANSI_ARGS_((CONST char *string, int c));
  #endif
  extern void             TkpDisplayWarning _ANSI_ARGS_((char *msg,
                              char *title));
  /*
   * Forward declarations for procedures defined later in this file.
   */
  static void             Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial));
  static void             StdinProc _ANSI_ARGS_((ClientData clientData,
                              int mask));
  /*
   *----------------------------------------------------------------------
   *
   * Tk_MainEx --
   *
   *      Main program for Wish and most other Tk-based applications.
   *
   * Results:
   *      None. This procedure never returns (it exits the process when
   *      it's done.
   *
   * Side effects:
   *      This procedure initializes the Tk world and then starts
   *      interpreting commands;  almost anything could happen, depending
   *      on the script being interpreted.
   *
   *----------------------------------------------------------------------
   */
  void
  Tk_MainEx(argc, argv, appInitProc, interp)
      int argc;                           /* Number of arguments. */
      char **argv;                        /* Array of argument strings. */
      Tcl_AppInitProc *appInitProc;       /* Application-specific initialization
                                                           * procedure to call after most
                                                           * initialization but before starting
                                                           * to execute commands.  This input
                                           * parameter is ignored because of the
                                           * integration of the code automatically
                                           * generated by "mktclapp".
                                           */
      Tcl_Interp *interp;
  {
      char *args, *fileName;
      char buf[TCL_INTEGER_SPACE];
      int code;
      size_t length;
      Tcl_Channel inChannel, outChannel;
      Tcl_DString argString;
      ThreadSpecificData *tsdPtr;
  #ifdef __WIN32__
      HANDLE handle;
  #endif
  #if 1
      /* Dope the environment variables so that the first place the
      ** run-time code searches for the library files is in the "baked in"
      ** libraries.  Over time, this should be changed to permanently
      ** bake things in so that this trick isn't necessary.
      */
      putenv("TCL_LIBRARY=" ET_TCL_LIBRARY);
      putenv("TK_LIBRARY=" ET_TK_LIBRARY);
      /* Run the local initialization procedure for the ET module.
      ** This will dope the interpreter so that attempts to load the
      ** library files will get redirected internally.
      */
      Et_DoInit(interp);
  #endif
  /*     appInitProc = Et_DoInit; */
      /*
       * Ensure that we are getting the matching version of Tcl.  This is
       * really only an issue when Tk is loaded dynamically.
       */
      if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
          abort();
      }
      tsdPtr = (ThreadSpecificData *)
          Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
      Tcl_FindExecutable(argv[0]);
      tsdPtr->interp = interp;
  #if (defined(__WIN32__) || defined(MAC_TCL))
      Tk_InitConsoleChannels(interp);
  #endif
  #ifdef TCL_MEM_DEBUG
      Tcl_InitMemory(interp);
  #endif
      /*
       * Parse command-line arguments.  A leading "-file" argument is
       * ignored (a historical relic from the distant past).  If the
       * next argument doesn't start with a "-" then strip it off and
       * use it as the name of a script file to process.
       */
      fileName = TclGetStartupScriptFileName();
      if (argc > 1) {
          length = strlen(argv[1]);
          if ((length >= 2) && (strncmp(argv[1], "-file", length) == 0)) {
              argc--;
              argv++;
          }
      }
      if (fileName == NULL) {
          if ((argc > 1) && (argv[1][0] != '-')) {
              fileName = argv[1];
              argc--;
              argv++;
          }
      }
      /*
       * Make command-line arguments available in the Tcl variables "argc"
       * and "argv".
       */
      args = Tcl_Merge(argc-1, argv+1);
      Tcl_ExternalToUtfDString(NULL, args, -1, &argString);
      Tcl_SetVar(interp, "argv", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);
      Tcl_DStringFree(&argString);
      ckfree(args);
      sprintf(buf, "%d", argc-1);
      if (fileName == NULL) {
          Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString);
      } else {
          fileName = Tcl_ExternalToUtfDString(NULL, fileName, -1, &argString);
      }
      Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
      Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);
      /*
       * Set the "tcl_interactive" variable.
       */
      /*
       * For now, under Windows, we assume we are not running as a console mode
       * app, so we need to use the GUI console.  In order to enable this, we
       * always claim to be running on a tty.  This probably isn't the right
       * way to do it.
       */
  #ifdef __WIN32__
      handle = GetStdHandle(STD_INPUT_HANDLE);
      if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)
               || (GetFileType(handle) == FILE_TYPE_UNKNOWN)) {
          /*
           * If it's a bad or closed handle, then it's been connected
           * to a wish console window.
           */
          tsdPtr->tty = 1;
      } else if (GetFileType(handle) == FILE_TYPE_CHAR) {
          /*
           * A character file handle is a tty by definition.
           */
          tsdPtr->tty = 1;
      } else {
          tsdPtr->tty = 0;
      }
  #else
      tsdPtr->tty = isatty(0);
  #endif
      Tcl_SetVar(interp, "tcl_interactive",
              ((fileName == NULL) && tsdPtr->tty) ? "1" : "0", TCL_GLOBAL_ONLY);
      /*
       * Invoke application-specific initialization.
       */
      if ((*appInitProc)(interp) != TCL_OK) {
          TkpDisplayWarning(Tcl_GetStringResult(interp),
                  "Application initialization failed");
      }
     /* Register any extensions that should be registered for the
     ** executable currently being built.
     */
     ExtninitInit(interp);
     /* Set a Tcl variable to indicate the particular product
     ** we are building.  This is used in the startup message script
     ** to announce product version, and may be used other
     ** places, as well.
     */
     Tcl_SetVar(interp,
                BUILD_CONFIG_PRODUCT_NAME_VARIABLE,
                BUILD_CONFIG_STATIC_WISH_ALIAS,
                TCL_GLOBAL_ONLY);
     /* Set  Tcl variable to indicate the relese version of the
     ** product we are building.  This is used in the startup message script
     ** to announce product version, and may be used other
     ** places, as well.
     */
     Tcl_SetVar(interp,
                BUILD_CONFIG_PRODUCT_VERSION_VARIABLE,
                BUILD_CONFIG_RELEASE_VERSION,
                TCL_GLOBAL_ONLY);
     /* Change the title of the console window to reflect
     ** the product name and version.
     */
     Tcl_GlobalEval(interp,
                    "wm title . \""
                    BUILD_CONFIG_STATIC_WISH_ALIAS
                    " v"
                    BUILD_CONFIG_RELEASE_VERSION
                    "\"");
     /* Output the introductory message to the console.
     ** The script called is generic and applies to both
     ** IjuScripter and IjuConsole.
     */
     Tcl_GlobalEval(interp, BUILD_CONFIG_StartupMessageScript);
     /*
      * Invoke the script specified on the command line, if any.
      */
      if (fileName != NULL) {
          Tcl_ResetResult(interp);
          code = Tcl_EvalFile(interp, fileName);
          if (code != TCL_OK) {
              /*
               * The following statement guarantees that the errorInfo
               * variable is set properly.
               */
              Tcl_AddErrorInfo(interp, "");
              TkpDisplayWarning(Tcl_GetVar(interp, "errorInfo",
                      TCL_GLOBAL_ONLY), "Error in startup script");
              Tcl_DeleteInterp(interp);
              Tcl_Exit(1);
          }
          tsdPtr->tty = 0;
      } else {
          /*
           * Evaluate the .rc file, if one has been specified.
           */
          Tcl_SourceRCFile(interp);
          /*
           * Establish a channel handler for stdin.
           */
          inChannel = Tcl_GetStdChannel(TCL_STDIN);
          if (inChannel) {
              Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
                      (ClientData) inChannel);
          }
          if (tsdPtr->tty) {
              Prompt(interp, 0);
          }
      }
      Tcl_DStringFree(&argString);
      outChannel = Tcl_GetStdChannel(TCL_STDOUT);
      if (outChannel) {
          Tcl_Flush(outChannel);
      }
      Tcl_DStringInit(&tsdPtr->command);
      Tcl_DStringInit(&tsdPtr->line);
      Tcl_ResetResult(interp);
      /*
       * Loop infinitely, waiting for commands to execute.  When there
       * are no windows left, Tk_MainLoop returns and we exit.
       */
      Tk_MainLoop();
      Tcl_DeleteInterp(interp);
      Tcl_Exit(0);
  }
  /*
   *----------------------------------------------------------------------
   *
   * 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. */
  {
      static int gotPartial = 0;
      char *cmd;
      int code, count;
      Tcl_Channel chan = (Tcl_Channel) clientData;
      ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
              Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
      Tcl_Interp *interp = tsdPtr->interp;
      count = Tcl_Gets(chan, &tsdPtr->line);
      if (count < 0) {
          if (!gotPartial) {
              if (tsdPtr->tty) {
                  Tcl_Exit(0);
              } else {
                  Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
              }
              return;
          }
      }
      (void) Tcl_DStringAppend(&tsdPtr->command, Tcl_DStringValue(
              &tsdPtr->line), -1);
      cmd = Tcl_DStringAppend(&tsdPtr->command, "\n", -1);
      Tcl_DStringFree(&tsdPtr->line);
      if (!Tcl_CommandComplete(cmd)) {
          gotPartial = 1;
          goto prompt;
      }
      gotPartial = 0;
      /*
       * Disable the stdin channel 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.
       */
      Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan);
      code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
      chan = Tcl_GetStdChannel(TCL_STDIN);
      if (chan) {
          Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
                  (ClientData) chan);
      }
      Tcl_DStringFree(&tsdPtr->command);
      if (Tcl_GetStringResult(interp)[0] != '\0') {
          if ((code != TCL_OK) || (tsdPtr->tty)) {
              chan = Tcl_GetStdChannel(TCL_STDOUT);
              if (chan) {
                  Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
                  Tcl_WriteChars(chan, "\n", 1);
              }
          }
      }
      /*
       * Output a prompt.
       */
      prompt:
      if (tsdPtr->tty) {
          Prompt(interp, gotPartial);
      }
      Tcl_ResetResult(interp);
  }
  /*
   *----------------------------------------------------------------------
   *
   * 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;
      Tcl_Channel outChannel, errChannel;
      promptCmd = Tcl_GetVar(interp,
          partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY);
      if (promptCmd == NULL) {
  defaultPrompt:
          if (!partial) {
              /*
               * We must check that outChannel is a real channel - it
               * is possible that someone has transferred stdout out of
               * this interpreter with "interp transfer".
               */
              outChannel = Tcl_GetChannel(interp, "stdout", NULL);
              if (outChannel != (Tcl_Channel) NULL) {
                  Tcl_WriteChars(outChannel, "% ", 2);
              }
          }
      } else {
          code = Tcl_Eval(interp, promptCmd);
          if (code != TCL_OK) {
              Tcl_AddErrorInfo(interp,
                      "\n    (script that generates prompt)");
              /*
               * We must check that errChannel is a real channel - it
               * is possible that someone has transferred stderr out of
               * this interpreter with "interp transfer".
               */
              errChannel = Tcl_GetChannel(interp, "stderr", NULL);
              if (errChannel != (Tcl_Channel) NULL) {
                  Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
                  Tcl_WriteChars(errChannel, "\n", 1);
              }
              goto defaultPrompt;
          }
      }
      outChannel = Tcl_GetChannel(interp, "stdout", NULL);
      if (outChannel != (Tcl_Channel) NULL) {
          Tcl_Flush(outChannel);
      }
  }
  /* End of tkmain.c */

 Legend:



Removed from v.70
 


changed lines


 
Added in v.71
 Legend:



Removed from v.70
 


changed lines


 
Added in v.71
-Removed from v.70
+Added in v.71

dashley@gmail.com	ViewVC Help
Powered by ViewVC 1.1.25