C++ Tcl_SetVar函数代码示例

/* Check for and process Tcl binds */
int check_tcl_bind(tcl_bind_list_t *tl, const char *match,
                   struct flag_record *atr, const char *param, int match_type)
{
  int x, result = 0, cnt = 0, finish = 0;
  char *proc = NULL, *mask = NULL;
  tcl_bind_mask_t *tm, *tm_last = NULL, *tm_p = NULL;
  tcl_cmd_t *tc, *htc = NULL;

  for (tm = tl->first; tm && !finish; tm_last = tm, tm = tm->next) {

    if (tm->flags & TBM_DELETED)
      continue;                 /* This bind mask was deleted */

    if (!check_bind_match(match, tm->mask, match_type))
      continue;                 /* This bind does not match. */

    for (tc = tm->first; tc; tc = tc->next) {

      /* Search for valid entry. */
      if (!(tc->attributes & TC_DELETED)) {

        /* Check if the provided flags suffice for this command. */
        if (check_bind_flags(&tc->flags, atr, match_type)) {
          cnt++;
          tm_p = tm_last;

          /* Not stackable */
          if (!(match_type & BIND_STACKABLE)) {

            /* Remember information about this bind. */
            proc = tc->func_name;
            mask = tm->mask;
            htc = tc;

            /* Either this is a non-partial match, which means we
             * only want to execute _one_ bind ...
             */
            if ((match_type & 0x03) != MATCH_PARTIAL ||
              /* ... or this happens to be an exact match. */
              !egg_strcasecmp(match, tm->mask)) {
              cnt = 1;
              finish = 1;
            }

            /* We found a match so break out of the inner loop. */
            break;
          }

          /*
           * Stackable; could be multiple commands/triggers.
           * Note: This code assumes BIND_ALTER_ARGS, BIND_WANTRET, and
           *       BIND_STACKRET will only be used for stackable binds.
           */

          tc->hits++;
          Tcl_SetVar(interp, "lastbind", (char *) tm->mask, TCL_GLOBAL_ONLY);
          x = trigger_bind(tc->func_name, param, tm->mask);

          if (match_type & BIND_ALTER_ARGS) {

            if (interp->result == NULL || !interp->result[0])
              return x;

          } else if ((match_type & BIND_STACKRET) && x == BIND_EXEC_LOG) {

            /* If we have multiple commands/triggers, and if any of the
             * commands return 1, we store the result so we can return it
             * after processing all stacked binds.
             */
            if (!result)
              result = x;
            continue;

          } else if ((match_type & BIND_WANTRET) && x == BIND_EXEC_LOG)

            /* Return immediately if any commands return 1 */
            return x;
        }
      }
    }
  }

  if (!cnt)
    return BIND_NOMATCH;

  /* Do this before updating the preferred entries information,
   * since we don't want to change the order of stacked binds
   */
  if (result)           /* BIND_STACKRET */
    return result;

  if ((match_type & 0x03) == MATCH_MASK || (match_type & 0x03) == MATCH_CASE)
    return BIND_EXECUTED;

  /* Hit counter */
  if (htc)
    htc->hits++;

  /* Now that we have found at least one bind, we can update the
//.........这里部分代码省略.........

int 
TclKit_AppInit(Tcl_Interp *interp)
{
    char *oldCmd;
    KITDEBUG("Initializing static packages")
%DQKIT_INIT_CODE%
    Tcl_StaticPackage(0, "Mk4tcl", Mk4tcl_Init, NULL);
    Tcl_StaticPackage(0, "dqkitpwb", Pwb_Init, NULL);
    Tcl_StaticPackage(0, "rechan", Rechan_Init, NULL);
    Tcl_StaticPackage(0, "vfs", Vfs_Init, NULL);
    Tcl_StaticPackage(0, "zlib", Zlib_Init, NULL);
#ifdef _WIN32
    Tcl_StaticPackage(0, "dde", Dde_Init, NULL);
    Tcl_StaticPackage(0, "registry", Registry_Init, NULL);
#endif
#ifdef KIT_INCLUDES_TK
    Tcl_StaticPackage(0, "Tk", Tk_Init, Tk_SafeInit);
#endif

    /* the tcl_rcFileName variable only exists in the initial interpreter */
#ifdef _WIN32
    Tcl_SetVar(interp, "tcl_rcFileName", "~/tclkitrc.tcl", TCL_GLOBAL_ONLY);
#else
    Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclkitrc", TCL_GLOBAL_ONLY);
#ifdef MAC_TCL
    Tcl_SetVar(interp, "tcl_rcRsrcName", "tclkitrc", TCL_GLOBAL_ONLY);
#endif
#endif

    KITDEBUG("TclSetPreInitScript()")
    oldCmd = TclSetPreInitScript(preInitCmd);
    KITDEBUG("Tcl_Init()")
    if (Tcl_Init(interp) == TCL_ERROR)
        goto error;
    KITDEBUG("Tcl_Init2()")
    TclSetPreInitScript(preInitCmd2);

#ifdef KIT_INCLUDES_TK
    KITDEBUG("Initializing Tk")
#if defined(_WIN32) || defined(MAC_TCL)
    if (Tk_Init(interp) == TCL_ERROR)
        goto error;
#ifdef _WIN32
    KITDEBUG("Initializing Tk console window")
    if (Tk_CreateConsoleWindow(interp) == TCL_ERROR)
        goto error;
#else
    KITDEBUG("Setting up main Tcl interp")
    SetupMainInterp(interp);
#endif
#endif
#endif

    KITDEBUG("Tcl_Eval(initScript)")
      /* messy because TclSetStartupScriptPath is called slightly too late */
    if (Tcl_Eval(interp, initScript) == TCL_OK) {
        Tcl_Obj* path = TclGetStartupScriptPath();
	TclSetStartupScriptPath(Tcl_GetObjResult(interp));
	if (path == NULL)
	  Tcl_Eval(interp, "incr argc -1; set argv [lrange $argv 1 end]");
    }

    KITDEBUG("returning")
    Tcl_SetVar(interp, "errorInfo", "", TCL_GLOBAL_ONLY);
    Tcl_ResetResult(interp);
    return TCL_OK;

error:
#ifdef KIT_INCLUDES_TK
#ifdef _WIN32
    MessageBeep(MB_ICONEXCLAMATION);
    MessageBox(NULL, Tcl_GetStringResult(interp), "Error in TclKit",
        MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
    ExitProcess(1);
    /* we won't reach this, but we need the return */
#endif
#endif
    return TCL_ERROR;
}

/* Initialisation, based on tkMain.c */
CAMLprim value camltk_opentk(value argv)
{
    CAMLparam1(argv);
    CAMLlocal1(tmp);
    char *argv0;

    /* argv must contain argv[0], the application command name */
    tmp = Val_unit;

    if ( argv == Val_int(0) ) {
        failwith("camltk_opentk: argv is empty");
    }
    argv0 = String_val( Field( argv, 0 ) );

    if (!cltk_slave_mode) {
        /* Create an interpreter, dies if error */
#if TCL_MAJOR_VERSION >= 8
        Tcl_FindExecutable(String_val(argv0));
#endif
        cltclinterp = Tcl_CreateInterp();
        {
            /* Register cltclinterp for use in other related extensions */
            value *interp = caml_named_value("cltclinterp");
            if (interp != NULL)
                Store_field(*interp,0,copy_nativeint((intnat)cltclinterp));
        }

        if (Tcl_Init(cltclinterp) != TCL_OK)
            tk_error(Tcl_GetStringResult(cltclinterp));
        Tcl_SetVar(cltclinterp, "argv0", String_val (argv0), TCL_GLOBAL_ONLY);

        {   /* Sets argv */
            int argc = 0;

            tmp = Field(argv, 1); /* starts from argv[1] */
            while ( tmp != Val_int(0) ) {
                argc++;
                tmp = Field(tmp, 1);
            }

            if( argc != 0 ) {
                int i;
                char *args;
                char **tkargv;
                char argcstr[256]; /* string of argc */

                tkargv = (char**)stat_alloc(sizeof( char* ) * argc );
                tmp = Field(argv, 1); /* starts from argv[1] */
                i = 0;

                while ( tmp != Val_int(0) ) {
                    tkargv[i] = String_val(Field(tmp, 0));
                    tmp = Field(tmp, 1);
                    i++;
                }

                sprintf( argcstr, "%d", argc );
                Tcl_SetVar(cltclinterp, "argc", argcstr, TCL_GLOBAL_ONLY);
                args = Tcl_Merge(argc, (const char *const*)tkargv); /* args must be freed by Tcl_Free */
                Tcl_SetVar(cltclinterp, "argv", args, TCL_GLOBAL_ONLY);
                Tcl_Free(args);
                stat_free( tkargv );
            }
        }
        if (Tk_Init(cltclinterp) != TCL_OK)
            tk_error(Tcl_GetStringResult(cltclinterp));

        /* Retrieve the main window */
        cltk_mainWindow = Tk_MainWindow(cltclinterp);

        if (NULL == cltk_mainWindow)
            tk_error(Tcl_GetStringResult(cltclinterp));

        Tk_GeometryRequest(cltk_mainWindow,200,200);
    }

    /* Create the camlcallback command */
    Tcl_CreateCommand(cltclinterp,
                      CAMLCB, CamlCBCmd,
                      (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);

    /* This is required by "unknown" and thus autoload */
    Tcl_SetVar(cltclinterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
    /* Our hack for implementing break in callbacks */
    Tcl_SetVar(cltclinterp, "BreakBindingsSequence", "0", TCL_GLOBAL_ONLY);

    /* Load the traditional rc file */
    {
        char *home = getenv("HOME");
        if (home != NULL) {
            char *f = stat_alloc(strlen(home)+strlen(RCNAME)+2);
            f[0]='\0';
            strcat(f, home);
            strcat(f, "/");
            strcat(f, RCNAME);
            if (0 == access(f,R_OK))
                if (TCL_OK != Tcl_EvalFile(cltclinterp,f)) {
                    stat_free(f);
                    tk_error(Tcl_GetStringResult(cltclinterp));
//.........这里部分代码省略.........

int
Tcl_AppInit(Tcl_Interp *interp)
{
	Tk_Window main_window;
	const char * _tkinter_skip_tk_init;

#ifdef TK_AQUA
#ifndef MAX_PATH_LEN
#define MAX_PATH_LEN 1024
#endif
	char tclLibPath[MAX_PATH_LEN], tkLibPath[MAX_PATH_LEN];
	Tcl_Obj*	pathPtr;

        /* pre- Tcl_Init code copied from tkMacOSXAppInit.c */
	Tk_MacOSXOpenBundleResources (interp, "com.tcltk.tcllibrary",
       	tclLibPath, MAX_PATH_LEN, 0);

	if (tclLibPath[0] != '\0') {
       	Tcl_SetVar(interp, "tcl_library", tclLibPath, TCL_GLOBAL_ONLY);
		Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, TCL_GLOBAL_ONLY);
		Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, TCL_GLOBAL_ONLY);
	}
	
   	if (tclLibPath[0] != '\0') {
		Tcl_SetVar(interp, "tcl_library", tclLibPath, TCL_GLOBAL_ONLY);
		Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, TCL_GLOBAL_ONLY);
		Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, TCL_GLOBAL_ONLY);
	}
#endif
	if (Tcl_Init (interp) == TCL_ERROR)
		return TCL_ERROR;

#ifdef TK_AQUA
        /* pre- Tk_Init code copied from tkMacOSXAppInit.c */
	Tk_MacOSXOpenBundleResources (interp, "com.tcltk.tklibrary",
            tkLibPath, MAX_PATH_LEN, 1);

	if (tclLibPath[0] != '\0') {
		pathPtr = Tcl_NewStringObj(tclLibPath, -1);
	} else {
		Tcl_Obj *pathPtr = TclGetLibraryPath();
	}

	if (tkLibPath[0] != '\0') {
		Tcl_Obj *objPtr;

		Tcl_SetVar(interp, "tk_library", tkLibPath, TCL_GLOBAL_ONLY);
		objPtr = Tcl_NewStringObj(tkLibPath, -1);
		Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	}

	TclSetLibraryPath(pathPtr);
#endif

#ifdef WITH_XXX
		// Initialize modules that don't require Tk
#endif

	_tkinter_skip_tk_init =	Tcl_GetVar(interp, "_tkinter_skip_tk_init", TCL_GLOBAL_ONLY);
	if (_tkinter_skip_tk_init != NULL && strcmp(_tkinter_skip_tk_init, "1")	== 0) {
		return TCL_OK;
	}
	if (Tk_Init(interp) == TCL_ERROR)
		return TCL_ERROR;

	main_window = Tk_MainWindow(interp);

#ifdef TK_AQUA
	TkMacOSXInitAppleEvents(interp);
	TkMacOSXInitMenus(interp);
#endif
    
#ifdef WITH_MOREBUTTONS
	{
		extern Tcl_CmdProc studButtonCmd;
		extern Tcl_CmdProc triButtonCmd;

		Tcl_CreateCommand(interp, "studbutton", studButtonCmd,
				  (ClientData) main_window, NULL);
		Tcl_CreateCommand(interp, "tributton", triButtonCmd,
				  (ClientData) main_window, NULL);
	}
#endif

#ifdef WITH_PIL /* 0.2b5 and later -- not yet released as of May 14 */
	{
		extern void TkImaging_Init(Tcl_Interp *);
		TkImaging_Init(interp);
		/* XXX TkImaging_Init() doesn't have the right return type */
		/*Tcl_StaticPackage(interp, "Imaging", TkImaging_Init, NULL);*/
	}
#endif

#ifdef WITH_PIL_OLD /* 0.2b4 and earlier */
	{
		extern void TkImaging_Init(void);
		/* XXX TkImaging_Init() doesn't have the right prototype */
		/*Tcl_StaticPackage(interp, "Imaging", TkImaging_Init, NULL);*/
	}
#endif
//.........这里部分代码省略.........

int
Tcl_AppInit(
    Tcl_Interp *interp)		/* Interpreter for application. */
{
    if (Tcl_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }

#ifdef TCL_TEST
    if (Tcltest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
            (Tcl_PackageInitProc *) NULL);
    if (TclObjTest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
#endif /* TCL_TEST */

    /*
     * Call the init procedures for included packages.  Each call should
     * look like this:
     *
     * if (Mod_Init(interp) == TCL_ERROR) {
     *     return TCL_ERROR;
     * }
     *
     * where "Mod" is the name of the module.
     */
    if (Itcl_Init(interp) == TCL_ERROR) {
        return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Itcl", Itcl_Init, Itcl_SafeInit);

    /*
     *  This is itclsh, so import all [incr Tcl] commands by
     *  default into the global namespace.  Fix up the autoloader
     *  to do the same.
     */
    if (Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
            "::itcl::*", /* allowOverwrite */ 1) != TCL_OK) {
        return TCL_ERROR;
    }

    if (Tcl_Eval(interp, "auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* }") != TCL_OK) {
        return TCL_ERROR;
    }

    /*
     * Call Tcl_CreateCommand for application-specific commands, if
     * they weren't already created by the init procedures called above.
     * Each call would loo like this:
     *
     * Tcl_CreateCommand(interp, "tclName", CFuncCmd, NULL, NULL);
     */

    /*
     * Specify a user-specific startup script to invoke if the application
     * is run interactively.  On the Mac we can specifiy either a TEXT resource
     * which contains the script or the more UNIX like file location
     * may also used.  (I highly recommend using the resource method.)
     */

    Tcl_SetVar(interp, "tcl_rcRsrcName", "itclshrc", TCL_GLOBAL_ONLY);
    /* Tcl_SetVar(interp, "tcl_rcFileName", "~/.itclshrc", TCL_GLOBAL_ONLY); */

    return TCL_OK;
}

int
Tcl_AppInit(
    Tcl_Interp *interp)		/* Interpreter for application. */
{
    Tcl_Channel tempChan;
    
    if (Tcl_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }

#ifdef TCL_TEST
    if (Tcltest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
            (Tcl_PackageInitProc *) NULL);
    if (TclObjTest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
#endif /* TCL_TEST */

    /*
     * Call the init procedures for included packages.  Each call should
     * look like this:
     *
     * if (Mod_Init(interp) == TCL_ERROR) {
     *     return TCL_ERROR;
     * }
     *
     * where "Mod" is the name of the module.
     */

    /*
     * Call Tcl_CreateCommand for application-specific commands, if
     * they weren't already created by the init procedures called above.
     * Each call would loo like this:
     *
     * Tcl_CreateCommand(interp, "tclName", CFuncCmd, NULL, NULL);
     */

    /*
     * Specify a user-specific startup script to invoke if the application
     * is run interactively.  On the Mac we can specifiy either a TEXT resource
     * which contains the script or the more UNIX like file location
     * may also used.  (I highly recommend using the resource method.)
     */

    Tcl_SetVar(interp, "tcl_rcRsrcName", "tclshrc", TCL_GLOBAL_ONLY);

    /* Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); */

    /*
     * We have to support at least the quit Apple Event. 
     */
    
    TkMacInitAppleEvents(interp);
    
    /* 
     * Open a file channel to put stderr, stdin, stdout... 
     */
    
    tempChan = Tcl_OpenFileChannel(interp, ":temp.in", "a+", 0);
    Tcl_SetStdChannel(tempChan,TCL_STDIN);
    Tcl_RegisterChannel(interp, tempChan);
    Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
    Tcl_SetChannelOption(NULL, tempChan, "-buffering", "line");

    tempChan = Tcl_OpenFileChannel(interp, ":temp.out", "a+", 0);
    Tcl_SetStdChannel(tempChan,TCL_STDOUT);
    Tcl_RegisterChannel(interp, tempChan);
    Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
    Tcl_SetChannelOption(NULL, tempChan, "-buffering", "line");

    tempChan = Tcl_OpenFileChannel(interp, ":temp.err", "a+", 0);
    Tcl_SetStdChannel(tempChan,TCL_STDERR);
    Tcl_RegisterChannel(interp, tempChan);
    Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
    Tcl_SetChannelOption(NULL, tempChan, "-buffering", "none");
   
    
    return TCL_OK;
}

  int Ng_SetOCCVisParameters  (ClientData clientData,
			       Tcl_Interp * interp,
			       int argc, tcl_const char *argv[])
  {
#ifdef OCCGEOMETRY
    int showvolume;
	OCCGeometry * occgeometry = dynamic_cast<OCCGeometry*> (ng_geometry.Ptr());

    showvolume = atoi (Tcl_GetVar (interp, "::occoptions.showvolumenr", 0));

    if (occgeometry)
      if (showvolume != vispar.occshowvolumenr)
	{
	  if (showvolume < 0 || showvolume > occgeometry->NrSolids())
	    {
	      char buf[20];
	      sprintf (buf, "%5i", vispar.occshowvolumenr);
	      Tcl_SetVar (interp, "::occoptions.showvolumenr", buf, 0);
	    }
	  else
	    {
	      vispar.occshowvolumenr = showvolume;
	      if (occgeometry)
		occgeometry -> changed = OCCGEOMETRYVISUALIZATIONHALFCHANGE;
	    }
	}
    
    int temp;

    temp = atoi (Tcl_GetVar (interp, "::occoptions.visproblemfaces", 0));

    if ((bool) temp != vispar.occvisproblemfaces)
      {
	vispar.occvisproblemfaces = temp;
	if (occgeometry)
	  occgeometry -> changed = OCCGEOMETRYVISUALIZATIONHALFCHANGE;
      }

    vispar.occshowsurfaces = atoi (Tcl_GetVar (interp, "::occoptions.showsurfaces", 0));
    vispar.occshowedges = atoi (Tcl_GetVar (interp, "::occoptions.showedges", 0));
    vispar.occzoomtohighlightedentity = atoi (Tcl_GetVar (interp, "::occoptions.zoomtohighlightedentity", 0));
    vispar.occdeflection = pow(10.0,-1-atof (Tcl_GetVar (interp, "::occoptions.deflection", 0)));

#endif





#ifdef ACIS
    vispar.ACISshowfaces = atoi (Tcl_GetVar (interp, "::occoptions.showsurfaces", 0));
    vispar.ACISshowedges = atoi (Tcl_GetVar (interp, "::occoptions.showedges", 0));
    vispar.ACISshowsolidnr = atoi (Tcl_GetVar (interp, "::occoptions.showsolidnr", 0));
    vispar.ACISshowsolidnr2 = atoi (Tcl_GetVar (interp, "::occoptions.showsolidnr2", 0));

#endif



    return TCL_OK;
  }  

int TclTextInterp::evalString(const char *s) {
#if defined(VMD_NANOHUB)
  if (Tcl_Eval(interp, s) != TCL_OK) {
#else
  if (Tcl_RecordAndEval(interp, s, 0) != TCL_OK) {
#endif
    // Don't print error message if there's nothing to show.
    if (strlen(Tcl_GetStringResult(interp))) 
      msgErr << Tcl_GetStringResult(interp) << sendmsg;
    return FALSE;
  }
  return TRUE;
}

void TclTextInterp::setString(const char *name, const char *val) {
  if (interp)
    Tcl_SetVar(interp, name, val, 
      TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
}

void TclTextInterp::setMap(const char *name, const char *key, 
                           const char *val) { 
  if (interp)
    Tcl_SetVar2(interp, name, key, val, 
      TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
    
}

// There's a fair amount of code duplication between doEvent and evalFile,
// maybe these could be combined somehow, say by having TclTextInterp keep 
// track of its Tcl_Channel objects.
// 
// Side note: Reading line-by-line gives different Tcl semantics than 
// just calling Tcl_EvalFile. Shell commands (e.g., stty) are properly
// parsed when read line-by-line and passed to Tcl_RecordAndEval, but are
// unrecognized when contained in a file read by Tcl_EvalFile.  I would 
// consider this a bug.  

int TclTextInterp::evalFile(const char *fname) {
  Tcl_Channel inchannel = Tcl_OpenFileChannel(interp, fname, "r", 0644);
  Tcl_Channel outchannel = Tcl_GetStdChannel(TCL_STDOUT);
  if (inchannel == NULL) {
    msgErr << "Error opening file " << fname << sendmsg;
    msgErr << Tcl_GetStringResult(interp) << sendmsg;
    return 1;
  }

  Tcl_Obj *cmdPtr = Tcl_NewObj();
  Tcl_IncrRefCount(cmdPtr);
  int length = 0;
  while ((length = Tcl_GetsObj(inchannel, cmdPtr)) >= 0) {
    Tcl_AppendToObj(cmdPtr, "\n", 1);
    char *stringrep = Tcl_GetStringFromObj(cmdPtr, NULL);
    if (!Tcl_CommandComplete(stringrep)) {
      continue;
    }

    // check if "exit" was called
    if (app->exitFlag) break;

#if defined(VMD_NANOHUB)
    Tcl_EvalObjEx(interp, cmdPtr, 0);
#else
    Tcl_RecordAndEvalObj(interp, cmdPtr, 0);
#endif

#if TCL_MINOR_VERSION >= 4
    Tcl_DecrRefCount(cmdPtr);
    cmdPtr = Tcl_NewObj();
    Tcl_IncrRefCount(cmdPtr);
#else
    // XXX this crashes Tcl 8.5.[46] with an internal panic
    Tcl_SetObjLength(cmdPtr, 0);
#endif

    // XXX this makes sure the display is updated 
    // after each line read from the file or pipe
    // So, this is also where we'd optimise reading multiple
    // lines at once
    //
    // In VR modes (CAVE, FreeVR, VR Juggler) the draw method will 
    // not be called from app->display_update(), so multiple lines
    // of input could be combined in one frame, if possible
    app->display_update();

    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
    char *bytes = Tcl_GetStringFromObj(resultPtr, &length);
#if defined(VMDTKCON)
    if (length > 0) {
      vmdcon_append(VMDCON_ALWAYS, bytes,length);
      vmdcon_append(VMDCON_ALWAYS, "\n", 1);
    }
    vmdcon_purge();
#else
    if (length > 0) {
#if TCL_MINOR_VERSION >= 4
      Tcl_WriteChars(outchannel, bytes, length);
      Tcl_WriteChars(outchannel, "\n", 1);
#else
      Tcl_Write(outchannel, bytes, length);
//.........这里部分代码省略.........

TclTextInterp::TclTextInterp(VMDApp *vmdapp, int guienabled, int mpienabled)
: app(vmdapp) {
  
  interp = Tcl_CreateInterp();
#if 0
  Tcl_InitMemory(interp); // enable Tcl memory debugging features
                          // when compiled with TCL_MEM_DEBUG
#endif

  commandPtr = Tcl_NewObj();
  Tcl_IncrRefCount(commandPtr);
  consoleisatty = vmd_isatty(0); // whether we're interactive or not
  ignorestdin = 0;
  gotPartial = 0;
  needPrompt = 1;
  callLevel = 0;
  starttime = delay = 0;

#if defined(VMDMPI)
  //
  // MPI builds of VMD cannot try to read any command input from the 
  // console because it creates shutdown problems, at least with MPICH.
  // File-based command input is fine however.
  //
  // don't check for interactive console input if running in parallel
  if (mpienabled)
    ignorestdin = 1;
#endif

#if defined(ANDROIDARMV7A)
  //
  // For the time being, the Android builds won't attempt to get any
  // console input.  Any input we're going to get is going to come via
  // some means other than stdin, such as a network socket, text box, etc.
  //
  // Don't check for interactive console input if compiled for Android
  ignorestdin = 1;
#endif

  // set tcl_interactive, lets us run unix commands as from a shell
#if !defined(VMD_NANOHUB)
  Tcl_SetVar(interp, "tcl_interactive", "1", 0);
#else
  Tcl_SetVar(interp, "tcl_interactive", "0", 0);

  Tcl_Channel channel;
#define CLIENT_READ	(3)
#define CLIENT_WRITE	(4)
  channel = Tcl_MakeFileChannel((ClientData)CLIENT_READ, TCL_READABLE);
  if (channel != NULL) {
      const char *result;

      Tcl_RegisterChannel(interp, channel);
      result = Tcl_SetVar2(interp, "vmd_client", "read", 
		Tcl_GetChannelName(channel), 
		TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
      if (result == NULL) {
	  fprintf(stderr, "can't create variable for client read channel\n");
      }
  }
  channel = Tcl_MakeFileChannel((ClientData)CLIENT_WRITE, TCL_WRITABLE);
  if (channel != NULL) {
      const char *result;

      Tcl_RegisterChannel(interp, channel);
      result = Tcl_SetVar2(interp, "vmd_client", "write", 
		Tcl_GetChannelName(channel), 
		TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
      if (result == NULL) {
	  fprintf(stderr, "can't create variable for client write channel\n");
      }
  }
  write(CLIENT_WRITE, "vmd 1.0\n", 8);
#endif


  // pass our instance of VMDApp to a hash table assoc. with the interpreter 
  Tcl_SetAssocData(interp, "VMDApp", NULL, app);
 
  // Set up argc, argv0, and argv variables
  {
    char argcbuf[20];
    sprintf(argcbuf, "%d", app->argc_m);
    Tcl_SetVar(interp, "argc", argcbuf, TCL_GLOBAL_ONLY);
    // it might be better to use the same thing that was passed to
    // Tcl_FindExecutable, but this is now
    Tcl_SetVar(interp, "argv0", app->argv_m[0], TCL_GLOBAL_ONLY);
    char *args = Tcl_Merge(app->argc_m-1, app->argv_m+1);
    Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
    Tcl_Free(args);
  }

#if defined(_MSC_VER) && TCL_MINOR_VERSION >= 4
  // The Windows versions of Tcl 8.5.x have trouble finding
  // the Tcl library subdirectory for unknown reasons.
  // We force the appropriate env variables to be set in Tcl, 
  // despite Windows.
  {
    char vmdinitscript[4096];
    char * tcl_library = getenv("TCL_LIBRARY");
//.........这里部分代码省略.........

int flow_demo_c (ClientData clientData, Tcl_Interp* interp, int argc, const char** argv)
{
  int i, i_seq, nr, j,pft_version=3,num_points,dumy;
  char	        name[128];
  unsigned char	*imgf;
  Tk_PhotoHandle img_handle;
  Tk_PhotoImageBlock img_block;

  nr = atoi(argv[1]);

  fpp = fopen_r ("parameters/sequence.par");
  for (i=0; i<4; i++)
    fscanf (fpp, "%s\n", seq_name[i]);     /* name of sequence */
  fscanf (fpp,"%d\n", &seq_first);
  fscanf (fpp,"%d\n", &seq_last);
  fclose (fpp);


  /* allocate memory */
  imgf = (unsigned char *) calloc (imgsize, 1);

  fpp = fopen ("parameters/pft_version.par", "r");
  if (fpp){
      fscanf (fpp, "%d\n", &pft_version);
	  pft_version=pft_version+3;
      fclose (fpp);
  }
  else{
	  fpp = fopen ("parameters/pft_version.par", "w");
      fprintf(fpp,"%d\n", 0);
	  fclose(fpp);
  }

  /* load and display images */
  for (i_seq=seq_first; i_seq<=seq_last; i_seq++){
      compose_name_plus_nr (seq_name[nr], "", i_seq, name);
      fp1 = fopen_r (name);	if (! fp1)	return TCL_OK;
      sprintf (buf, "display camera %d, image %d", nr+1, i_seq);
      Tcl_SetVar(interp, "tbuf", buf, TCL_GLOBAL_ONLY);
      Tcl_Eval(interp, ".text delete 2");
      Tcl_Eval(interp, ".text insert 2 $tbuf");

      read_image (interp, name, imgf);
      fclose (fp1);

      img_handle = Tk_FindPhoto( interp, "temp");
      Tk_PhotoGetImage (img_handle, &img_block);

      sprintf(buf, "newimage %d", nr+1);
      Tcl_Eval(interp, buf);

      
	  if(pft_version==4){
         sprintf (filename, "%s%s", name,"_targets");
	      /* read targets of camera nr*/
	     nt4[3][nr]=0;

	     fp1= fopen (filename, "r");
	     if (! fp1) printf("Can't open ascii file: %s\n", filename);

         fscanf (fp1, "%d\n", &nt4[3][nr]);
         for (j=0; j<nt4[3][nr]; j++){
	          fscanf (fp1, "%4d %lf %lf %d %d %d %d %d\n",
		      &pix[nr][j].pnr, &pix[nr][j].x,
		      &pix[nr][j].y, &pix[nr][j].n ,
		      &pix[nr][j].nx ,&pix[nr][j].ny,
		      &pix[nr][j].sumg, &pix[nr][j].tnr);
	     }
         fclose (fp1);
         num[nr] = nt4[3][nr];
		 if (display){
	         for (j=0; j<num[nr]; j++){
	             drawcross (interp, (int) pix[nr][j].x, (int) pix[nr][j].y,cr_sz, nr, "blue");
	         }
			 printf ("drawing %d 2d ", num[nr]);
		 }

         sprintf (filename, "res/rt_is.%d", i_seq);
		 fp1= fopen (filename, "r");
  if (fp1){
         fscanf (fp1, "%d\n", &num_points);
         for (j=0; j<num_points; j++){
	         if (n_img==4){
		        fscanf(fp1, "%d %lf %lf %lf %d %d %d %d\n",
	            &dumy, &fix[j].x, &fix[j].y, &fix[j].z,
	            &geo[0][j].pnr, &geo[1][j].pnr, &geo[2][j].pnr, &geo[3][j].pnr);
		     }
		     if (n_img==3){
		        fscanf(fp1, "%d %lf %lf %lf %d %d %d %d\n",
	            &dumy, &fix[j].x, &fix[j].y, &fix[j].z,
	            &geo[0][j].pnr, &geo[1][j].pnr, &geo[2][j].pnr);
		     }
		     if (n_img==2){ // Alex's patch. 24.09.09. Working on Wesleyan data of 2 cameras only
		        fscanf(fp1, "%d %lf %lf %lf %d %d %d %d\n",
	            &dumy, &fix[j].x, &fix[j].y, &fix[j].z,
	            &geo[0][j].pnr, &geo[1][j].pnr);
	         }
		 }
         fclose (fp1);
		 if (display){
//.........这里部分代码省略.........

void check_tcl_loadunld(const char *mod, tcl_bind_list_t *tl)
{
  Tcl_SetVar(interp, "_lu1", (char *) mod, 0);
  check_tcl_bind(tl, mod, 0, " $_lu1", MATCH_MASK | BIND_STACKABLE);
}

void check_tcl_disc(const char *bot)
{
  Tcl_SetVar(interp, "_disc1", (char *) bot, 0);
  check_tcl_bind(H_disc, bot, 0, " $_disc1", MATCH_MASK | BIND_STACKABLE);
}

int
Tcl_AppInit(
    Tcl_Interp *interp)		/* Interpreter for application. */
{
    if (Tcl_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }

#ifdef TCL_TEST
    if (Tcltest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, NULL);
    if (TclObjTest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    if (Procbodytest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
	    Procbodytest_SafeInit);
#endif /* TCL_TEST */

#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
    {
	extern Tcl_PackageInitProc Registry_Init;
	extern Tcl_PackageInitProc Dde_Init;
	extern Tcl_PackageInitProc Dde_SafeInit;

	if (Registry_Init(interp) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);

	if (Dde_Init(interp) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit);
   }
#endif

    /*
     * Call the init functions for included packages. Each call should look
     * like this:
     *
     * if (Mod_Init(interp) == TCL_ERROR) {
     *     return TCL_ERROR;
     * }
     *
     * where "Mod" is the name of the module.
     */

    /*
     * Call Tcl_CreateCommand for application-specific commands, if they
     * weren't already created by the init functions called above.
     */

    /*
     * Specify a user-specific startup file to invoke if the application is
     * run interactively. Typically the startup file is "~/.apprc" where "app"
     * is the name of the application. If this line is deleted then no
     * user-specific startup file will be run under any conditions.
     */

    Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY);
    return TCL_OK;
}

char *tcl::setGlobalVar(char *name, char *value)
{
	return (char *) Tcl_SetVar(tcl_int, name, value, TCL_GLOBAL_ONLY);
}

void
Tcl_Main(
    int argc,			/* Number of arguments. */
    char **argv,		/* Array of argument strings. */
    Tcl_AppInitProc *appInitProc)
				/* Application-specific initialization
				 * function to call after most initialization
				 * but before starting to execute commands. */
{
    Tcl_Obj *path, *resultPtr, *argvPtr, *commandPtr = NULL;
    const char *encodingName = NULL;
    PromptType prompt = PROMPT_START;
    int code, length, tty, exitCode = 0;
    Tcl_Channel inChannel, outChannel, errChannel;
    Tcl_Interp *interp;
    Tcl_DString appName;

    Tcl_FindExecutable(argv[0]);

    interp = Tcl_CreateInterp();
    Tcl_InitMemory(interp);

    /*
     * If the application has not already set a startup script, parse the
     * first few command line arguments to determine the script path and
     * encoding.
     */

    if (NULL == Tcl_GetStartupScript(NULL)) {
	/*
	 * Check whether first 3 args (argv[1] - argv[3]) look like
	 * 	-encoding ENCODING FILENAME
	 * or like
	 * 	FILENAME
	 */

	if ((argc > 3) && (0 == strcmp("-encoding", argv[1]))
		&& ('-' != argv[3][0])) {
	    Tcl_SetStartupScript(Tcl_NewStringObj(argv[3], -1), argv[2]);
	    argc -= 3;
	    argv += 3;
	} else if ((argc > 1) && ('-' != argv[1][0])) {
	    Tcl_SetStartupScript(Tcl_NewStringObj(argv[1], -1), NULL);
	    argc--;
	    argv++;
	}
    }

    path = Tcl_GetStartupScript(&encodingName);
    if (path == NULL) {
	Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName);
    } else {
	const char *pathName = Tcl_GetStringFromObj(path, &length);

	Tcl_ExternalToUtfDString(NULL, pathName, length, &appName);
	path = Tcl_NewStringObj(Tcl_DStringValue(&appName), -1);
	Tcl_SetStartupScript(path, encodingName);
    }
    Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY);
    Tcl_DStringFree(&appName);
    argc--;
    argv++;

    Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY);

    argvPtr = Tcl_NewListObj(0, NULL);
    while (argc--) {
	Tcl_DString ds;

	Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds);
	Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj(
		Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
	Tcl_DStringFree(&ds);
    }
    Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);

    /*
     * Set the "tcl_interactive" variable.
     */

    tty = isatty(0);
    Tcl_SetVar(interp, "tcl_interactive", ((path == NULL) && tty) ? "1" : "0",
	    TCL_GLOBAL_ONLY);

    /*
     * Invoke application-specific initialization.
     */

    Tcl_Preserve(interp);
    if (appInitProc(interp) != TCL_OK) {
	errChannel = Tcl_GetStdChannel(TCL_STDERR);
	if (errChannel) {
	    Tcl_WriteChars(errChannel,
		    "application-specific initialization failed: ", -1);
	    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
	    Tcl_WriteChars(errChannel, "\n", 1);
	}
    }
    if (Tcl_InterpDeleted(interp)) {
	goto done;
//.........这里部分代码省略.........