Ejemplo n.º 1
0
static void
gdbtk_command_loop (void)
{
  extern FILE *instream;

  /* We no longer want to use stdin as the command input stream */
  instream = NULL;

  if (Tcl_Eval (gdbtk_interp, "gdbtk_tcl_preloop") != TCL_OK)
    {
      const char *msg;

      /* Force errorInfo to be set up propertly.  */
      Tcl_AddErrorInfo (gdbtk_interp, "");

      msg = Tcl_GetVar (gdbtk_interp, "errorInfo", TCL_GLOBAL_ONLY);
#ifdef _WIN32
      MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL);
#else
      fputs_unfiltered (msg, gdb_stderr);
#endif
    }

#ifdef _WIN32
  close_bfds ();
#endif

  Tk_MainLoop ();
}
Ejemplo n.º 2
0
/*
 *----------------------------------------------------------------------
 *
 * MainEx -- Main program for Tk-based applications.
 *
 *----------------------------------------------------------------------
 */
void
MainEx( int argc, char** argv, Tcl_AppInitProc *appInitProc,
        Tcl_Interp *pintrp, char *fileName )
{
    int code;

    (*appInitProc)(pintrp);

    if ( Commands_Init(pintrp) != TCL_OK) 
        Panic (pintrp,"Can't initialise commands!");

    char set_path[1000];
    strcat( strcat( strcpy( set_path, "set ::image_path \"" ), module_path ), "\"" );
    code = Tcl_Eval( pintrp, set_path );
    
    if (fileName != NULL) 
    {
        char  script[1000];
        strcat( strcat( strcpy( script, module_path ), "" ), fileName );
        code = Tcl_EvalFile(pintrp, script);
        if (code != TCL_OK)
            Panic (pintrp,"Evaluate file error!");
    }
    else Tcl_SourceRCFile(pintrp);

    Tcl_ResetResult(pintrp);

    Tk_MainLoop();
    
    Tcl_DeleteInterp(pintrp);
    return;
}
Ejemplo n.º 3
0
void XGStart()
{
  char thePDumpFile[80], thePDFRoot[80];

  strncpy(thePDFRoot,theDumpFile,findlen(theDumpFile));
  thePDFRoot[findlen(theDumpFile)] = '\0';
  while (!theExitFlag) {
    if (theRunWithXFlag == TRUE) {
      SortWindows();
      if(numberOfSpecials!=0)
	if(Tcl_Eval(interp,"CreateSpecialDialog\n")!=TCL_OK) {
	  printf("Error creating Special Dialog\n");
	  printf("%s\n",interp->result);
	}
      sprintf(TclCommand,"UpdateTime %g ; DoGraphics; update idletasks\n",*theTimeStep);
      /* Tcl_Eval(interp,TclCommand);  put below */
      if(Tcl_Eval(interp,"Tk_XGStart\n")!=TCL_OK) {
	printf("Error calling Tk_XGStart\n");
      }
      Tcl_Eval(interp,TclCommand); 

      if (theNumberOfSteps != 0) {
	Tcl_Eval(interp,".lbframe.run invoke\n");
      }
      
      /* Change the procedure for the HUP signal. */
      signal(SIGUSR1, Signal_KillGraphicsProc);

      Tk_MainLoop();
    }
    
    if (theRunWithXFlag == FALSE) {
      signal(SIGUSR1, Signal_RestoreGraphicsProc);
      
      while ((theNumberOfSteps==0 || theCurrentStep<=theNumberOfSteps) && 
	     (theRunWithXFlag == FALSE)) {
	XGMainLoop();
	if (theDumpPeriod!=0 && theCurrentStep%theDumpPeriod==0) {
	  sprintf(thePDumpFile,"%s%d%s",thePDFRoot,
		  theCurrentStep/theDumpPeriod,theDumpExtension);
	  if (theIDumpFlag) Dump(thePDumpFile);
	  else Dump(theDumpFile);
	}
	theCurrentStep++;
      }
      if ((theDumpPeriod!=0) && (theCurrentStep%theDumpPeriod==0)) {
	sprintf(thePDumpFile,"%s%d%s",thePDFRoot,
		theCurrentStep/theDumpPeriod,theDumpExtension);
	if (theIDumpFlag) Dump(thePDumpFile);
	else Dump(theDumpFile);
      }
      if(theCurrentStep>theNumberOfSteps && (theRunWithXFlag == FALSE)) {
	XG_Quit();
      }
      if (theRunWithXFlag == TRUE) StartGraphics();
    }
  }
  XG_Quit();
}
Ejemplo n.º 4
0
CAMLprim value camltk_tk_mainloop(void)
{
  CheckInit();

  if (cltk_slave_mode) return Val_unit;

  if (!signal_events) {
    /* Initialise signal handling */
    signal_events = 1;
    Tk_CreateTimerHandler(100, invoke_pending_caml_signals, NULL);
  }
  Tk_MainLoop();
  return Val_unit;
}
Ejemplo n.º 5
0
void tcltk_set_graph_mode (int mode, void (*drawimage)()) {
    if (Tcl_EvalFile (interp,"rbd.tcl")==TCL_ERROR) {
        printf ("rbd.tcl script error <%s>\n",interp->result);
        exit (1);
    }

    canvas=Tk_NameToWindow (interp,".c",window);
    if (canvas==NULL) {
        printf ("Error: <%s>\n",interp->result);
    }

    gen_image=drawimage;

    Tcl_CreateCommand
    (interp,"drawimage",draw_image,(ClientData)window,NULL);
    Tk_CreateEventHandler
    (canvas,ExposureMask,(Tk_EventProc *)expose_handler,(ClientData)canvas);
    Tk_MainLoop ();
}
Ejemplo n.º 6
0
/***************************************************************************
* test function
***************************************************************************/
int test() {
  int code;

  Tcl_Interp *interp;
  interp = Tcl_CreateInterp();

  Tk_Window tkwin;
  tkwin=Tk_CreateMainWindow(interp,"unix:0.0","appName","className");

  Tk_Window button;
  button=Tk_CreateWindowFromPath(interp,tkwin,".appName","unix:0.0");
    
  Tk_Window what;
  what = Tk_NameToWindow(interp,".appName",tkwin);
  what = Tk_NameToWindow(interp,".",tkwin);

  Tk_MainLoop();

  Tk_DestroyWindow(tkwin);
}
Ejemplo n.º 7
0
void
Tk_MainEx(
    int argc,			/* Number of arguments. */
    TCHAR **argv,		/* Array of argument strings. */
    Tcl_AppInitProc *appInitProc,
				/* Application-specific initialization
				 * function to call after most initialization
				 * but before starting to execute commands. */
    Tcl_Interp *interp)
{
    Tcl_Obj *path, *argvPtr, *appName;
    const char *encodingName;
    int code, nullStdin = 0;
    Tcl_Channel chan;
    InteractiveState is;

    /*
     * Ensure that we are getting a compatible version of Tcl. This is really
     * only an issue when Tk is loaded dynamically.
     */

    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
	abort();
    }

#if defined(__WIN32__) && !defined(__WIN64__) && !defined(UNICODE) && !defined(STATIC_BUILD)

    if (tclStubsPtr->reserved9) {
	/* We are running win32 Tk under Cygwin, so let's check
	 * whether the env("DISPLAY") variable or the -display
	 * argument is set. If so, we really want to run the
	 * Tk_MainEx function of libtk8.?.dll, not this one. */
	if (Tcl_GetVar2(interp, "env", "DISPLAY", TCL_GLOBAL_ONLY)) {
	loadCygwinTk:
	    if (TkCygwinMainEx(argc, argv, appInitProc, interp)) {
		/* Should never reach here. */
		return;
	    }
	} else {
	    int i;

	    for (i = 1; i < argc; ++i) {
		if (!_tcscmp(argv[i], TEXT("-display"))) {
		    goto loadCygwinTk;
		}
	    }
	}
    }
#endif

    Tcl_InitMemory(interp);

    is.interp = interp;
    is.gotPartial = 0;
    Tcl_Preserve(interp);

#if defined(__WIN32__) && !defined(__CYGWIN__)
    Tk_InitConsoleChannels(interp);
#endif

#ifdef MAC_OSX_TK
    if (Tcl_GetStartupScript(NULL) == NULL) {
	TkMacOSXDefaultStartupScript();
    }
#endif

    /*
     * 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)) {
	size_t length;

	/*
	 * Check whether first 3 args (argv[1] - argv[3]) look like
	 *  -encoding ENCODING FILENAME
	 * or like
	 *  FILENAME
	 * or like
	 *  -file FILENAME		(ancient history support only)
	 */

	if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1]))
		&& (TEXT('-') != argv[3][0])) {
		Tcl_Obj *value = NewNativeObj(argv[2], -1);
	    Tcl_SetStartupScript(NewNativeObj(argv[3], -1), Tcl_GetString(value));
	    Tcl_DecrRefCount(value);
	    argc -= 3;
	    argv += 3;
	} else if ((argc > 1) && (TEXT('-') != argv[1][0])) {
	    Tcl_SetStartupScript(NewNativeObj(argv[1], -1), NULL);
	    argc--;
	    argv++;
	} else if ((argc > 2) && (length = _tcslen(argv[1]))
		&& (length > 1) && (0 == _tcsncmp(TEXT("-file"), argv[1], length))
		&& (TEXT('-') != argv[2][0])) {
	    Tcl_SetStartupScript(NewNativeObj(argv[2], -1), NULL);
	    argc -= 2;
	    argv += 2;
	}
    }

    path = Tcl_GetStartupScript(&encodingName);
    if (path == NULL) {
	appName = NewNativeObj(argv[0], -1);
    } else {
	appName = path;
    }
    Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY);
    argc--;
    argv++;

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

    argvPtr = Tcl_NewListObj(0, NULL);
    while (argc--) {
	Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++, -1));
    }
    Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);

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

    is.tty = isatty(0);
#if defined(MAC_OSX_TK)
    /*
     * On TkAqua, if we don't have a TTY and stdin is a special character file
     * of length 0, (e.g. /dev/null, which is what Finder sets when double
     * clicking Wish) then use the GUI console.
     */

    if (!is.tty) {
	struct stat st;

	nullStdin = fstat(0, &st) || (S_ISCHR(st.st_mode) && !st.st_blocks);
    }
#endif
    Tcl_SetVar2Ex(interp, "tcl_interactive", NULL,
	    Tcl_NewIntObj(!path && (is.tty || nullStdin)), TCL_GLOBAL_ONLY);

    /*
     * Invoke application-specific initialization.
     */

    if (appInitProc(interp) != TCL_OK) {
	TkpDisplayWarning(Tcl_GetStringResult(interp),
		"application-specific initialization failed");
    }

    /*
     * Invoke the script specified on the command line, if any. Must fetch it
     * again, as the appInitProc might have reset it.
     */

    path = Tcl_GetStartupScript(&encodingName);
    if (path != NULL) {
	Tcl_ResetResult(interp);
	code = Tcl_FSEvalFileEx(interp, path, encodingName);
	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);
	}
	is.tty = 0;
    } else {

	/*
	 * Evaluate the .rc file, if one has been specified.
	 */

	Tcl_SourceRCFile(interp);

	/*
	 * Establish a channel handler for stdin.
	 */

	is.input = Tcl_GetStdChannel(TCL_STDIN);
	if (is.input) {
	    Tcl_CreateChannelHandler(is.input, TCL_READABLE, StdinProc, &is);
	}
	if (is.tty) {
	    Prompt(interp, &is);
	}
    }

    chan = Tcl_GetStdChannel(TCL_STDOUT);
    if (chan) {
	Tcl_Flush(chan);
    }
    Tcl_DStringInit(&is.command);
    Tcl_DStringInit(&is.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_Release(interp);
    Tcl_SetStartupScript(NULL, NULL);
    Tcl_Exit(0);
}
Ejemplo n.º 8
0
/*
** This routine runs first.  
*/
int main(int argc, char **argv){
  Tcl_Interp *interp;
  char *args;
  char buf[100];
  int tty;
  char TCLdir[20];
  char TKdir[20];
  char autopath[20];
  char sourceCmd[80];

#ifdef WITHOUT_TK
    Tcl_Obj *resultPtr;
    Tcl_Obj *commandPtr = NULL;
    char buffer[1000];
    int code, gotPartial, length;
    Tcl_Channel inChannel, outChannel, errChannel;
#endif

  /* Create a Tcl interpreter
  */
  Tcl_FindExecutable(argv[0]);
  interp = Tcl_CreateInterp();
  if( Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1)==0 ){
    return 1;
  }
  args = Tcl_Merge(argc-1, (CONST84 char * CONST *)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", argv[0], TCL_GLOBAL_ONLY);
  tty = isatty(0);
  Tcl_SetVar(interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);

  /* We have to initialize the virtual filesystem before calling
  ** Tcl_Init().  Otherwise, Tcl_Init() will not be able to find
  ** its startup script files.
  */

  Zvfs_Init(interp);
  Tcl_SetVar(interp, "extname", "", TCL_GLOBAL_ONLY);
  Zvfs_Mount(interp, (char *)Tcl_GetNameOfExecutable(), "/");
  sprintf(TCLdir, "%s/tcl", mountPt);
  Tcl_SetVar2(interp, "env", "TCL_LIBRARY", TCLdir, TCL_GLOBAL_ONLY);
  sprintf(TKdir, "%s/tk", mountPt);
  Tcl_SetVar2(interp, "env", "TK_LIBRARY", TKdir, TCL_GLOBAL_ONLY);

  /* Initialize Tcl and Tk
  */
  if( Tcl_Init(interp) ) return TCL_ERROR;

  sprintf(autopath, " %s", TCLdir);
  Tcl_SetVar(interp, "auto_path", autopath, TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
  Tcl_SetVar(interp, "tcl_libPath", TCLdir, TCL_GLOBAL_ONLY);

#ifdef WITHOUT_TK
  Tcl_SetVar(interp, "extname", "tclsh", TCL_GLOBAL_ONLY);
#else
  Tk_InitConsoleChannels(interp);
  if ( Tk_Init(interp) ) {
       return TCL_ERROR;
    }

  Tcl_StaticPackage(interp,"Tk", Tk_Init, 0);
  Tk_CreateConsoleWindow(interp);
#endif

  /* Start up all extensions.
  */
#if defined(__WIN32__)
  /* DRL - Do the standard Windows extentions */

  if (Registry_Init(interp) == TCL_ERROR) {
      return TCL_ERROR;
     }
  Tcl_StaticPackage(interp, "Registry", Registry_Init, 0);

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

#ifndef WITHOUT_TDOM
  if (Tdom_Init(interp) == TCL_ERROR) {
      return TCL_ERROR;
     }

  Tcl_StaticPackage(interp, "Tdom", Tdom_Init, Tdom_SafeInit);
#endif

#ifndef WITHOUT_TLS
  if (Tls_Init(interp) == TCL_ERROR) {
      return TCL_ERROR;
     }

  Tcl_StaticPackage(interp, "Tls", Tls_Init, Tls_SafeInit);
#endif

/*
#ifndef WITHOUT_MKZIPLIB
  if (Mkziplib_Init(interp) == TCL_ERROR) {
      return TCL_ERROR;
     }

  Tcl_StaticPackage(interp, "Mkziplib", Mkziplib_Init, Mkziplib_SafeInit);
#endif
*/

#ifndef WITHOUT_XOTCL
  if (Xotcl_Init(interp) == TCL_ERROR) {
      return TCL_ERROR;
     }

  Tcl_StaticPackage(interp, "Xotcl", Xotcl_Init, Xotcl_SafeInit);

/*  
  if (Xotclexpat_Init(interp) == TCL_ERROR) {
      return TCL_ERROR;
     }

  Tcl_StaticPackage(interp, "xotclexpat", Xotclexpat_Init, 0);
*/
/*  
  if (Xotclsdbm_Init(interp) == TCL_ERROR) {
      return TCL_ERROR;
  }
*/

//  Tcl_StaticPackage(interp, "xotclsdbm", Xotclsdbm_Init, Xotclsdbm_SafeInit);

/* 
  if (Xotclgdbm_Init(interp) == TCL_ERROR) {
      return TCL_ERROR;
     }
*/
//  Tcl_StaticPackage(interp, "xotclgdbm", Xotclgdbm_Init, Xotclgdbm_SafeInit);

#endif

#ifndef WITHOUT_TGDBM
  if (Tgdbm_Init(interp) == TCL_ERROR) {
      return TCL_ERROR;
     }

  Tcl_StaticPackage(interp, "Tgdbm", Tgdbm_Init, 0);
#endif

#ifndef WITHOUT_THREAD
  if (Thread_Init(interp) == TCL_ERROR) {
      return TCL_ERROR;
     }

  Tcl_StaticPackage(interp, "Thread", Thread_Init, 0);
#endif

#if !defined(WITHOUT_TK) && !defined(WITHOUT_WINICO) && (defined(__WIN32__) || defined(_WIN32))
  if (Winico_Init(interp) == TCL_ERROR) return TCL_ERROR;

  Tcl_StaticPackage(interp, "Winico", Winico_Init, Winico_SafeInit);
#endif

   /* Add some freeWrap commands */
  if (Freewrap_Init(interp) == TCL_ERROR) return TCL_ERROR;

  /* After all extensions are registered, start up the
  ** program by running freewrapCmds.tcl.
  */
    sprintf(sourceCmd, "source %s/freewrapCmds.tcl", mountPt);
    Tcl_Eval(interp, sourceCmd);

#ifndef WITHOUT_TK
    /*
     * 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);
#else
    /*
     * Process commands from stdin until there's an end-of-file.  Note
     * that we need to fetch the standard channels again after every
     * eval, since they may have been changed.
     */
    commandPtr = Tcl_NewObj();
    Tcl_IncrRefCount(commandPtr);

    inChannel = Tcl_GetStdChannel(TCL_STDIN);
    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
    gotPartial = 0;
    while (1) {
	if (tty) {
	    Tcl_Obj *promptCmdPtr;

	    promptCmdPtr = Tcl_GetVar2Ex(interp,
		    (gotPartial ? "tcl_prompt2" : "tcl_prompt1"),
		    NULL, TCL_GLOBAL_ONLY);
	    if (promptCmdPtr == NULL) {
                defaultPrompt:
		if (!gotPartial && outChannel) {
		    Tcl_WriteChars(outChannel, "% ", 2);
		}
	    } else {
		code = Tcl_EvalObjEx(interp, promptCmdPtr, 0);
		inChannel = Tcl_GetStdChannel(TCL_STDIN);
		outChannel = Tcl_GetStdChannel(TCL_STDOUT);
		errChannel = Tcl_GetStdChannel(TCL_STDERR);
		if (code != TCL_OK) {
		    if (errChannel) {
			Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
			Tcl_WriteChars(errChannel, "\n", 1);
		    }
		    Tcl_AddErrorInfo(interp,
			    "\n    (script that generates prompt)");
		    goto defaultPrompt;
		}
	    }
	    if (outChannel) {
		Tcl_Flush(outChannel);
	    }
	}
	if (!inChannel) {
	    goto done;
	}
        length = Tcl_GetsObj(inChannel, commandPtr);
	if (length < 0) {
	    goto done;
	}
	if ((length == 0) && Tcl_Eof(inChannel) && (!gotPartial)) {
	    goto done;
	}

        /*
         * Add the newline removed by Tcl_GetsObj back to the string.
         */

	Tcl_AppendToObj(commandPtr, "\n", 1);
	if (!TclObjCommandComplete(commandPtr)) {
	    gotPartial = 1;
	    continue;
	}

	gotPartial = 0;
	code = Tcl_RecordAndEvalObj(interp, commandPtr, 0);
	inChannel = Tcl_GetStdChannel(TCL_STDIN);
	outChannel = Tcl_GetStdChannel(TCL_STDOUT);
	errChannel = Tcl_GetStdChannel(TCL_STDERR);
	Tcl_DecrRefCount(commandPtr);
	commandPtr = Tcl_NewObj();
	Tcl_IncrRefCount(commandPtr);
	if (code != TCL_OK) {
	    if (errChannel) {
		Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
		Tcl_WriteChars(errChannel, "\n", 1);
	    }
	} else if (tty) {
	    resultPtr = Tcl_GetObjResult(interp);
	    Tcl_GetStringFromObj(resultPtr, &length);
	    if ((length > 0) && outChannel) {
		Tcl_WriteObj(outChannel, resultPtr);
		Tcl_WriteChars(outChannel, "\n", 1);
	    }
	}
    }

    /*
     * Rather than calling exit, invoke the "exit" command so that
     * users can replace "exit" with some other command to do additional
     * cleanup on exit.  The Tcl_Eval call should never return.
     */

    done:
    if (commandPtr != NULL) {
	Tcl_DecrRefCount(commandPtr);
    }
    sprintf(buffer, "exit %d", 0);
    Tcl_Eval(interp, buffer);

#endif

  return TCL_OK;
}
Ejemplo n.º 9
0
/*
 *----------------------------------------------------------------------
 *
 * Tk_MainOpenSees --
 *
 *	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_MainOpenSees(int argc, char **argv, Tcl_AppInitProc *appInitProc, 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

    /* fmk - beginning of modifications for OpenSees */
    fprintf(stderr,"\n\n\t OpenSees -- Open System For Earthquake Engineering Simulation");
    fprintf(stderr,"\n\tPacific Earthquake Engineering Research Center -- %s\n\n", OPS_VERSION);
    
    fprintf(stderr,"\t    (c) Copyright 1999 The Regents of the University of California");
    fprintf(stderr,"\n\t\t\t\t All Rights Reserved \n\n\n");    
    fprintf(stderr,"\t(Copyright statement @ http://www.berkeley.edu/OpenSees/copyright.html)\n\n\n");
    /* fmk - end of modifications for OpenSees */

    /*
     * 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++;
	}
    }
    
	OpenSeesParseArgv(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
    char one[2] = "1";
    char zero[2] = "0";
    Tcl_SetVar(interp, "tcl_interactive",
	    ((fileName == NULL) && tsdPtr->tty) ? one : zero, TCL_GLOBAL_ONLY);

    /*
     * Invoke application-specific initialization.
     */
	if ((*appInitProc)(interp) != TCL_OK) {
      TkpDisplayWarning(Tcl_GetStringResult(interp), "Application Inititialization Failed");
	}
    /*
     * 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, "error Info",
					 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);
}
Ejemplo n.º 10
0
void
Tk_MainEx(
    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_Interp *interp)
{
    Tcl_Obj *path, *argvPtr;
    const char *encodingName;
    int code, nullStdin = 0;
    Tcl_Channel inChannel, outChannel;
    ThreadSpecificData *tsdPtr;
#ifdef __WIN32__
    HANDLE handle;
#endif
    Tcl_DString appName;

    /*
     * Ensure that we are getting a compatible version of Tcl. This is really
     * only an issue when Tk is loaded dynamically.
     */

    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
	abort();
    }

    tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    Tcl_FindExecutable(argv[0]);
    tsdPtr->interp = interp;
    Tcl_Preserve(interp);

#if defined(__WIN32__)
    Tk_InitConsoleChannels(interp);
#endif

#ifdef MAC_OSX_TK
    if (Tcl_GetStartupScript(NULL) == NULL) {
	TkMacOSXDefaultStartupScript();
    }
#endif

#ifdef TCL_MEM_DEBUG
    Tcl_InitMemory(interp);
#endif

    /*
     * 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)) {
	size_t length;

	/*
	 * Check whether first 3 args (argv[1] - argv[3]) look like
	 * 	-encoding ENCODING FILENAME
	 * or like
	 * 	FILENAME
	 * or like
	 *	-file FILENAME		(ancient history support only)
	 */

	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++;
	} else if ((argc > 2) && (length = strlen(argv[1]))
		&& (length > 1) && (0 == strncmp("-file", argv[1], length))
		&& ('-' != argv[2][0])) {
	    Tcl_SetStartupScript(Tcl_NewStringObj(argv[2], -1), NULL);
	    argc -= 2;
	    argv += 2;
	}
    }

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

	Tcl_ExternalToUtfDString(NULL, pathName, numBytes, &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.
     */

#ifdef __WIN32__
    /*
     * 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.
     */

    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
#if defined(MAC_OSX_TK)
    /*
     * On TkAqua, if we don't have a TTY and stdin is a special character file
     * of length 0, (e.g. /dev/null, which is what Finder sets when double
     * clicking Wish) then use the GUI console.
     */
    
    if (!tsdPtr->tty) {
	struct stat st;

	nullStdin = fstat(0, &st) || (S_ISCHR(st.st_mode) && !st.st_blocks);
    }
#endif
    Tcl_SetVar(interp, "tcl_interactive",
	    ((path == NULL) && (tsdPtr->tty || nullStdin)) ? "1" : "0",
	    TCL_GLOBAL_ONLY);

    /*
     * Invoke application-specific initialization.
     */

    if (appInitProc(interp) != TCL_OK) {
	TkpDisplayWarning(Tcl_GetStringResult(interp),
		"Application initialization failed");
    }

    /*
     * Invoke the script specified on the command line, if any. Must fetch it
     * again, as the appInitProc might have reset it.
     */

    path = Tcl_GetStartupScript(&encodingName);
    if (path != NULL) {
	Tcl_ResetResult(interp);
	code = Tcl_FSEvalFileEx(interp, path, encodingName);
	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,
		    inChannel);
	}
	if (tsdPtr->tty) {
	    Prompt(interp, 0);
	}
    }

    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_Release(interp);
    Tcl_SetStartupScript(NULL, NULL);
    Tcl_Exit(0);
}
Ejemplo n.º 11
0
void WildCard_MainLoop() {
  signal(SIGINT,cintfront);
  G__init_process_cmd();
  Tk_MainLoop();
}
Ejemplo n.º 12
0
static AP_Result tk_main_loop(AP_World *ignore)
{
	Tk_MainLoop();
	return AP_SUCCESS;
}
Ejemplo n.º 13
0
int main(int argc, char **argv) {

    bool sawParadynFlag = false;

#if defined(os_windows)
    // initialize our use of the WinSock library
    InitSockets( __argv[0] );    
#endif

    for( unsigned int i = 1; i < argc; i++ )
    {
        if( strcmp(argv[i], "--debug" ) == 0 )
        {
          xsynch_flag = true;
#if !defined(i386_unknown_nt4_0)
          cout << "tableVisi at sigpause...pid=" << getpid() << endl;
          sigpause(0);
#endif // !defined(i386_unknown_nt4_0)
        }
        else if( strcmp( argv[i], "--paradyn" ) == 0 )
        {
            sawParadynFlag = true;
        }
        else
        {
            Tcl_Panic( "unrecognized argument seen", NULL );
        }
    }

    if( !sawParadynFlag )
    {
        ShowNoSoloVisiMessage( argv[0] );
    }

    // Let Tcl know something about our executable (and do some filesystem-
    // specific initialization).
    //
    // NOTE: this is obligatory with modern versions of Tcl.
    Tcl_FindExecutable( argv[0] );

   mainInterp = Tcl_CreateInterp();
   assert(mainInterp);

#if !defined(i386_unknown_nt4_0)
   if (xsynch_flag) {
      cout << "xsynching..." << endl;
      XSynchronize(Tk_Display(Tk_MainWindow(mainInterp)), 1);
   }
#endif // !defined(i386_unknown_nt4_0)

   if (TCL_OK != Tcl_Init(mainInterp))
      tclpanic(mainInterp, "Could not Tcl_Init");

    // Set argv0 before we do any other Tk program initialization because
    // Tk takes the main window's class and instance name from argv0
    // We set it to "paradyn" instead of "termwin" so that we can 
    // set resources for all paradyn-related windows with the same root.
    Tcl_SetVar( mainInterp,
                "argv0", 
                "paradyn",
                TCL_GLOBAL_ONLY );

   if (TCL_OK != Tk_Init(mainInterp))
      tclpanic(mainInterp, "Could not Tk_Init");

   if (TCL_OK != Dg2_Init(mainInterp))
      tclpanic(mainInterp, "Could not Dg2_Init");

   PDSOCKET visi_sock = visi_Init();
   if (visi_sock < 0)
      Tcl_Panic("failed to initialize w/ visi lib", NULL);

   Tcl_SetVar(mainInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);

   // Install our new tcl commands here:
   installTableVisiCommands(mainInterp);

   if (visi_RegistrationCallback(ADDMETRICSRESOURCES,Dg2AddMetricsCallback)!=0)
      Tcl_Panic("Dg2_Init() -- couldn't install ADDMETRICSRESOURCES callback",
        NULL);

   if (visi_RegistrationCallback(DATAVALUES, Dg2NewDataCallback) != 0)
      Tcl_Panic("Dg2_Init() -- couldn't install DATAVALUES callback", NULL);

   if (visi_RegistrationCallback(PARADYNEXITED, Dg2ParadynExitedCallback) != 0)
       panic("Dg2_Init() -- couldn't install PARADYNEXITED callback");

//   if (visi_RegistrationCallback(PHASEDATA, Dg2PhaseDataCallback) != 0)
//      panic("Dg2_Init() -- couldn't install PHASEINFO callback");

	// install a handler to notify us when there is data to be read
	Tcl_Channel visi_chan = 
	  Tcl_MakeTcpClientChannel((ClientData)(Address)(PDDESC)visi_sock);
	Tcl_CreateChannelHandler(visi_chan,
				 TCL_READABLE,
				 (Tcl_FileProc*)visiFdReadableHandler,
				 0);

   // Krishna's tcl2c stuff:
   extern int initialize_tcl_sources(Tcl_Interp *);
   if (TCL_OK != initialize_tcl_sources(mainInterp))
      tclpanic(mainInterp, "tableVisi: could not initialize_tcl_sources");

//if (Tcl_EvalFile(mainInterp, "/p/paradyn/development/tamches/core/visiClients/tableVisi/tcl/tableVisi.tcl") != TCL_OK)
//   tclpanic(mainInterp, "could not open tableVisi.tcl");

   pdLogo::install_fixed_logo("paradynLogo", logo_bits, logo_width, logo_height);
   tcl_cmd_installer createPdLogo(mainInterp, "makeLogo", pdLogo::makeLogoCommand,
				  (ClientData)Tk_MainWindow(mainInterp));

   myTclEval(mainInterp, "initializeTableVisi");

   // Create our main data structure:
   theTableVisi = new tableVisi(mainInterp,
                                Tk_NameToWindow(mainInterp, ".body",
                                Tk_MainWindow(mainInterp)),
                                "lightBlue", // line color
                                "blue", // metric color
                                "black", // metric units color
                                "maroon3", // focus color
                                "black", // cell color
                                "gray", // background color
                                "lightGray", // highlight background color
                                3 // initial # sig figs
                                );
   assert(theTableVisi);

   Tk_MainLoop(); // returns when all tk windows are closed

   delete theTableVisi;
   theTableVisi = NULL;

   return 0;
}