/[ascend]/trunk/tcltk/generic/interface/Driver.c
ViewVC logotype

Contents of /trunk/tcltk/generic/interface/Driver.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 586 - (show annotations) (download) (as text)
Thu May 11 00:47:54 2006 UTC (14 years, 6 months ago) by johnpye
File MIME type: text/x-csrc
File size: 31474 byte(s)
Working on improving handling of paths.
1 /* ASCEND modelling environment
2 Copyright 1997, Carnegie Mellon University
3 Copyright (C) 2006 Carnegie Mellon University
4
5 This program is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2, or (at your option)
8 any later version.
9
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
14
15 You should have received a copy of the GNU General Public License
16 along with this program; if not, write to the Free Software
17 Foundation, Inc., 59 Temple Place - Suite 330,
18 Boston, MA 02111-1307, USA.
19 *//*
20 Driver.c
21 by Kirk Abbott and Ben Allan
22 Created: 1/94
23 Version: $Revision: 1.48 $
24 Version control file: $RCSfile: Driver.c,v $
25 Date last modified: $Date: 2003/08/23 18:43:06 $
26 Last modified by: $Author: ballan $
27 */
28
29 #include <stdarg.h>
30 #include <ctype.h>
31 #include <signal.h>
32 #include <time.h>
33 #include <tcl.h>
34 #include <tk.h>
35 #include <utilities/ascConfig.h>
36 #include <general/ospath.h>
37 #include <utilities/ascPrint.h>
38
39 #ifndef __WIN32__
40 # include <unistd.h>
41 #else
42
43 /* jds20041229 - windows.h now included in ascConfig.h. */
44 /* jp - i took it back out of ascConfig.h - Apr 2005 */
45 # define WIN32_LEAN_AND_MEAN
46 # include <windows.h>
47
48 # include <locale.h>
49 # include "tkConsole.h"
50 # undef WIN32_LEAN_AND_MEAN
51 #endif /* __WIN32__ */
52
53 #include <utilities/config.h>
54 #include <utilities/ascMalloc.h> /* for ascshutdown */
55 #include <utilities/ascPanic.h> /* for Asc_Panic */
56 #include <utilities/ascEnvVar.h>
57 #include <compiler/compiler.h>
58 #include <compiler/ascCompiler.h>
59 #include <compiler/instance_enum.h>
60 #include <compiler/fractions.h>
61 #include <compiler/dimen.h>
62 #include <compiler/compiler.h> /* for symchar for units.h */
63 #include <compiler/units.h>
64 #include <compiler/redirectFile.h> /* for Asc_RedirectCompilerDefault() */
65 #include <solver/slv_types.h>
66 #include <solver/var.h>
67 #include <solver/rel.h>
68 #include <solver/logrel.h>
69 #include <solver/discrete.h>
70 #include <solver/mtx.h>
71 #include <solver/slv_stdcalls.h>
72 #include "AscBitmaps.h"
73 #include <utilities/ascPrint.h>
74 #include "AscPrintTcl.h"
75 #include "HelpProc.h"
76 #include "Commands.h"
77 #include "Driver.h"
78 #include "ScriptProc.h"
79 #include "SolverProc.h"
80 #include "UnitsProc.h"
81
82 #ifndef lint
83 static CONST char DriverID[] = "$Id: Driver.c,v 1.48 2003/08/23 18:43:06 ballan Exp $";
84 #endif
85
86 /*
87 * EXPORTED VARIABLES
88 */
89
90 /**
91 * g_compiler_timing
92 *
93 * TRUE if compiler timing is to be printed.
94 * default is false, set to TRUE by passing -t on the command line
95 */
96 /* int g_compiler_timing = 0; */
97 /* moved to compiler/simlist.c */
98
99 /**
100 * g_interp
101 *
102 * Interpreter for this application. We need to make it global
103 * so that our signal/floating-porint traps can access it.
104 */
105 Tcl_Interp *g_interp;
106
107 /*
108 * zz_debug
109 *
110 * Comes from the yacc file if yacc was built with debugging information
111 */
112 #ifdef ZZ_DEBUG
113 extern int zz_debug;
114 #endif
115
116
117 /*
118 * Declarations for procedures defined outside of this file.
119 */
120 extern int Tktable_Init(Tcl_Interp*);
121
122 static void AscTrap(int);
123 static int AscCheckEnvironVars(Tcl_Interp*,const char *progname);
124 static void AscPrintHelpExit(CONST char *);
125 static int AscProcessCommandLine(Tcl_Interp*, int, CONST char **);
126 static void Prompt(Tcl_Interp*, int);
127 static int AscSetStartupFile(Tcl_Interp*);
128 static void StdinProc(ClientData, int);
129 #ifdef DEBUG_MALLOC
130 static void InitDebugMalloc(void);
131 #endif /* DEBUG_MALLOC */
132
133
134 /*
135 * LOCALLY GLOBAL VARIABLES
136 */
137
138 /*
139 * g_interface_simplify_relations
140 *
141 * TRUE for compiler optimizations
142 * default is TRUE, set to FALSE by passing +s on the command line
143 */
144 static int g_interface_simplify_relations = TRUE;
145
146 /*
147 * g_interfacever
148 *
149 * TRUE if windows to be built; default is TRUE, false is not supported
150 */
151 static int g_interfacever = 1;
152
153 /*
154 * g_command
155 *
156 * Used to assemble lines of terminal input into Tcl commands.
157 */
158 static Tcl_DString g_command;
159
160 /*
161 * g_line
162 *
163 * Used to read the next line from the terminal input.
164 */
165 static Tcl_DString g_line;
166
167 /*
168 * tty
169 *
170 * Non-zero means standard input is a terminal-like device.
171 * Zero means it's a file.
172 */
173 static int tty;
174
175 /*
176 * initScriptTclAdjust
177 * initScriptTkAdjust
178 *
179 * These two variables hold Tcl scripts that will set the TCL_LIBRARY
180 * and TK_LIBRARY environment variables if they are not already
181 * set in the user's environment.
182 * TCL_LIBRARY is set to: dirnameofexecutable/../../Tcl/lib/tcl8.0
183 * TK_LIBRARY is set to $tcl_library/../tk8.0
184 */
185 static char initScriptTclAdjust[] =
186 "proc asc_tclInit {} {\n\
187 global env\n\
188 rename asc_tclInit {}\n\
189 set errors {}\n\
190 set dirs {}\n\
191 if [info exists env(TCL_LIBRARY)] {\n\
192 return\n\
193 } else {\n\
194 set parentDir [file dirname [info nameofexecutable]]\n\
195 set env(TCL_LIBRARY) $parentDir/../../Tcl/lib/tcl8.0\n\
196 }\n\
197 }\n\
198 asc_tclInit";
199 /* for tcl, FOO/ascend4/bin/ascend4.exe is the executable, then
200 * /-- up to FOO/ascend4/bin
201 * set parentDir [file dirname [info nameofexecutable]]\n\
202 * Then if Tcl is next to ascend4, ../../Tcl/lib/tcl8.0 should work.
203 */
204
205 static char initScriptTkAdjust[] =
206 "proc asc_tkInit {} {\n\
207 global env\n\
208 rename asc_tkInit {}\n\
209 set errors {}\n\
210 set dirs {}\n\
211 if [info exists env(TK_LIBRARY)] {\n\
212 return\n\
213 } else {\n\
214 set parentDir [file dirname [info library]]\n\
215 set env(TK_LIBRARY) $parentDir/tk8.0\n\
216 }\n\
217 }\n\
218 asc_tkInit";
219 /*
220 * This assumes tcl_library has been found and that tcl8.0 and tk8.0
221 * are installed in the same lib directory -- the default tcl/tk install.
222 */
223
224 /*
225 * build_name
226 *
227 * who built this binary and when
228 */
229 #ifndef TIMESTAMP
230 static char build_name[]="by anonymous";
231 #else
232 static char build_name[]=TIMESTAMP;
233 #endif /* TIMESTAMP */
234
235 /**
236 Moved 'main' and 'WinMain' to separate 'main.c'
237 so that ascend4.exe can be built without linkage to Tcl/Tk
238 */
239
240
241 /*
242 * int AscDriver( argc, argv )
243 * int argc;
244 * char *argv;
245 *
246 * A common entry point for Windows and Unix. The corresponding
247 * WinMain() and main() functions just call this function.
248 *
249 * This function creates a Tcl interpreter, initializes Tcl and Tk,
250 * initializes the Ascend data structures, sets up the user's
251 * environment, sources ASCEND's startup script, and calls Tk_MainLoop
252 * so the user can interact with ASCEND. Cleans up and exits the
253 * program when Tk_MainLoop returns.
254 *
255 * This function is based on the functions Tk_Main and Tcl_AppInit
256 * from the Tk8.0 distribution. See the files tkMain.c and tkAppInit.c
257 * in the Tk sources.
258 *
259 */
260 int AscDriver(int argc, CONST char *argv[])
261 {
262 Tcl_Interp *interp; /* local version of global g_interp */
263 Tcl_Channel inChannel;
264 Tcl_Channel outChannel;
265
266 /* jds20050119: Initialize ASCERR before any calls to ascPanic(). */
267 /* TODO: revisit when interface is decoupled from base - this may change. */
268 Asc_RedirectCompilerDefault();
269 #ifdef USE_ASC_PRINTF
270 Asc_PrintInit_TclVtable();
271 #endif /* USE_ASC_PRINTF */
272 /*
273 * Create the Tk Console
274 *
275 * Create the console channels and install them as the standard
276 * channels. All I/O will be discarded until TkConsoleInit() is
277 * called to attach the console to a text widget.
278 */
279 #ifdef ASC_USE_TK_CONSOLE
280 TkConsoleCreate();
281 #endif /* ASC_USE_TK_CONSOLE */
282
283 /*
284 * Find the name of the current executable---available in the
285 * Tcl command `info nameofexecutable'
286 */
287 Tcl_FindExecutable(argv[0]);
288
289 /*
290 * Create the interpreter
291 */
292 g_interp = Tcl_CreateInterp();
293 interp = g_interp;
294 if( interp == NULL ) {
295 Asc_Panic(2, "Asc_Driver",
296 "Call to Tcl_CreateInterp returned NULL interpreter");
297 }
298
299 /*
300 * Check the arguments on the command line
301 */
302 AscProcessCommandLine(interp, argc, argv);
303
304 /*
305 * Set the "tcl_interactive" variable.
306 *
307 * ASCEND sets tty to `1', since we assume ASCEND is always interactive.
308 */
309 tty = 1;
310 Tcl_SetVar(interp, "tcl_interactive", "1", TCL_GLOBAL_ONLY);
311
312 /*
313 * Initialize Tcl and Tk
314 */
315 (void)Tcl_Eval(interp,initScriptTclAdjust);
316 if (Tcl_Init(interp) == TCL_ERROR) {
317 Asc_Panic(2, "Asc_Driver", "Tcl initialization failed:\n%s",
318 Tcl_GetStringResult(interp));
319 }
320 (void)Tcl_Eval(interp,initScriptTkAdjust);
321 if (Tk_Init(interp) == TCL_ERROR) {
322 Asc_Panic(2, "Asc_Driver", "Tk initialization failed:\n%s",
323 Tcl_GetStringResult(interp));
324 }
325 Tcl_StaticPackage( interp, "Tk", Tk_Init, Tk_SafeInit );
326
327 /*
328 * Initialize the console and the ASCEND printf() substitutes.
329 * All output before this point is lost.
330 */
331 #ifdef ASC_USE_TK_CONSOLE
332 if (TkConsoleInit(interp) == TCL_ERROR) {
333 Asc_Panic(2, "Asc_Driver",
334 "Call to TkConsoleInit failed:\n%s",
335 Tcl_GetStringResult(interp));
336 }
337 #endif /* ASC_USE_TK_CONSOLE */
338 #ifdef USE_ASC_PRINTF
339 Asc_PrintInit_Tcl();
340 #endif /* USE_ASC_PRINTF */
341
342 /*
343 * Now that our console and printing functions are properly
344 * initialized, print our startup banner.
345 */
346
347 color_on(stderr,"34;1");
348 ASC_FPRINTF(stderr,"\nASCEND modelling environment\n");
349 ASC_FPRINTF(stderr,"Copyright(C) 1997, 2006 Carnegie Mellon University\n");
350 ASC_FPRINTF(stderr,"Copyright(C) 1993-1996 Kirk Andre Abbott, Ben Allan\n");
351 ASC_FPRINTF(stderr,"Copyright(C) 1990, 1993, 1994 Thomas Guthrie Epperly\n");
352 ASC_FPRINTF(stderr,"Built %s %s %s\n\n",__DATE__,__TIME__,build_name);
353 ASC_FPRINTF(stderr,"ASCEND comes with ABSOLUTELY NO WARRANTY, and is free software that you may\n");
354 ASC_FPRINTF(stderr,"redistribute within the conditions of the GNU General Public License. See the\n");
355 ASC_FPRINTF(stderr,"included file 'LICENSE.txt' for full details.\n\n");
356 color_off(stderr);
357
358 /*
359 * Call the init procedures for included packages.
360 */
361 #ifdef STATIC_TKTABLE
362 if( Tktable_Init(interp) == TCL_ERROR ) {
363 Asc_Panic(2, "Asc_Driver",
364 "Call to Tktable_Init failed:\n%s",
365 Tcl_GetStringResult(interp));
366 }
367 #endif /* STATIC_TKTABLE */
368
369 /*
370 * Initialize ASCEND C Structures
371 * Create ASCEND Tcl Commands
372 */
373 clock();
374 /* the next line should NOT be Asc_SignalHandlerPush */
375 (void)signal(SIGINT, AscTrap);
376 #ifdef DEBUG_MALLOC
377 InitDebugMalloc();
378 ascstatus("Memory status after calling InitDebugMalloc()");
379 #endif /* DEBUG_MALLOC */
380 if ( Asc_CompilerInit(g_interface_simplify_relations) != 0 ) {
381 Asc_Panic(2, "Asc_CompilerInit",
382 "Insufficient memory to initialize compiler.");
383 }
384 SlvRegisterStandardClients();
385 if( Asc_HelpInit() == TCL_ERROR ) {
386 Asc_Panic(2, "Asc_HelpInit",
387 "Insufficient memory to initialize help system.");
388 }
389 Asc_CreateCommands(interp);
390 Asc_RegisterBitmaps(interp);
391
392 /*
393 * Set the environment, and set find the
394 * location of ASCEND's startup file.
395 */
396 AscCheckEnvironVars(interp,argv[0]);
397 if( AscSetStartupFile(interp) != TCL_OK ) {
398 Asc_Panic(2, "Asc_Driver",
399 "Cannot find ~/.ascendrc nor the default AscendRC\n%s",
400 Tcl_GetStringResult(interp));
401 }
402
403 /*
404 * Evaluate the ~/.ascendrc or $ASCENDTK/AscendRC file
405 */
406 Tcl_SourceRCFile(interp);
407
408 /*
409 * Establish a channel handlers for stdin and stdout
410 */
411 inChannel = Tcl_GetStdChannel(TCL_STDIN);
412 if (inChannel) {
413 Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
414 (ClientData) inChannel);
415 }
416 if (tty) {
417 Prompt(interp, 0);
418 }
419 outChannel = Tcl_GetStdChannel(TCL_STDOUT);
420 if (outChannel) {
421 Tcl_Flush(outChannel);
422 }
423
424 /*
425 * Initialize the Dynamic Strings used in StdinProc()
426 */
427 Tcl_DStringInit(&g_command);
428 Tcl_DStringInit(&g_line);
429 Tcl_ResetResult(interp);
430
431 /*
432 * Loop infinitely, waiting for commands to execute. When there
433 * are no windows left, Tk_MainLoop returns and we exit.
434 */
435 #ifdef DEBUG_MALLOC
436 ascstatus("Memory status before calling Tk_MainLoop()");
437 #endif /* DEBUG_MALLOC */
438 if (Asc_ScriptConfigureInterrupt(1,interp)!=0) {
439 Asc_Panic(2, "Asc_ScriptConfigureInterrupt",
440 "Unable to configure script interrupt.");
441 }
442 Tk_MainLoop();
443 Asc_ScriptConfigureInterrupt(0,interp);
444 #ifdef USE_ASC_PRINTF
445 Asc_PrintFinalize_Tcl();
446 #endif /* USE_ASC_PRINTF */
447 #ifdef DEBUG_MALLOC
448 ascstatus("Memory status after Tk_MainLoop() exits");
449 #endif /* DEBUG_MALLOC */
450
451 /*
452 * Do ASCEND Cleanup
453 */
454 Asc_HelpDestroy();
455 Asc_UnitValue(NULL);
456 Asc_SolvMemoryCleanup();
457 Asc_CompilerDestroy();
458 Asc_DestroyEnvironment();
459 #ifdef DEBUG_MALLOC
460 ascshutdown("Memory status just before exiting");
461 #endif /* DEBUG_MALLOC */
462
463 /*
464 * Destroy the interpreter and exit
465 */
466 Tcl_DeleteInterp(interp);
467 Tcl_Exit(0);
468 return 0;
469 }
470
471 /*-------------------------------------------------------
472 SETTING UP ENVIRONMENT...
473 */
474
475 #define GETENV Asc_GetEnv
476 #define PUTENV Asc_PutEnv
477
478 /**
479 This is a quick macro to output a FilePath to an environment
480 variable.
481 */
482 #define OSPATH_PUTENV(VAR,FP) \
483 snprintf(envcmd,MAX_ENV_VAR_LENGTH,"%s=",VAR); \
484 ospath_strcat(FP,envcmd,MAX_ENV_VAR_LENGTH); \
485 PUTENV(envcmd)
486
487 /**
488 This is a quick macro to send data to Tcl using Tcl_SetVar.
489 It uses an intermediate buffer which is assumed to be
490 empty already.
491
492 usage: ASC_SEND_TO_TCL(tclvarname,"some string value");
493 */
494 #define ASC_SEND_TO_TCL(VAR,VAL) \
495 Tcl_DStringAppend(&buffer,VAL,-1); \
496 Tcl_SetVar(interp,#VAR,Tcl_DStringValue(&buffer),TCL_GLOBAL_ONLY); \
497 Tcl_DStringFree(&buffer);
498
499 /**
500 This is a quick macro to send data to Tcl using Tcl_SetVar2.
501 It uses an intermediate buffer which is assumed to be
502 empty already.
503
504 usage: ASC_SEND_TO_TCL2(arrayname,"keyname","some string value");
505 */
506 #define ASC_SEND_TO_TCL2(ARR,KEY,VAL) \
507 Tcl_DStringAppend(&buffer,VAL,-1); \
508 Tcl_SetVar2(interp,#ARR,KEY,Tcl_DStringValue(&buffer),TCL_GLOBAL_ONLY); \
509 Tcl_DStringFree(&buffer);
510
511 /**
512 Ensure that all required environment variables are present
513 and set values for them if they are not present. The names
514 for the environment variables are specified in
515 <utilities/config.h>. The following comments assume that you
516 use the usual names for each of these:
517
518 ASCENDDIST defaults to @ASC_DATADIR@ (also in config.h)
519 ASCENDTK defaults to $ASCENDDIST/@ASC_TK_SUBDIR_NAME@ (latter is from config.h)
520 ASCENDBITMAPS defaults $ASCENDTK/bitmaps
521 ASCENDLIBRARY defaults to $ASCENDDIST/models
522
523 Also check for the existence of the file AscendRC in $ASCENDTK
524 and if found, export the location of that file to the Tcl
525 variable tcl_rcFileName.
526 */
527 static int AscCheckEnvironVars(Tcl_Interp *interp,const char *progname){
528 char *distdir, *tkdir, *bitmapsdir, *librarydir;
529 struct FilePath *fp, *fp1, *distfp, *tkfp, *bitmapsfp, *libraryfp;
530 char envcmd[MAX_ENV_VAR_LENGTH];
531 char s1[PATH_MAX];
532
533 Tcl_DString buffer;
534
535 Tcl_DStringInit(&buffer);
536
537 /*
538 Asc_ImportPathList(ASC_ENV_DIST);
539 Asc_ImportPathList(ASC_ENV_TK);
540 Asc_ImportPathList(ASC_ENV_BITMAPS);
541 Asc_ImportPathList(ASC_ENV_LIBRARY);
542 */
543
544 CONSOLE_DEBUG("IMPORTING VARS");
545
546 distdir = getenv(ASC_ENV_DIST);
547 tkdir = getenv(ASC_ENV_TK);
548 bitmapsdir = getenv(ASC_ENV_BITMAPS);
549 librarydir = getenv(ASC_ENV_LIBRARY);
550
551 int guessedtk=0;
552
553 /* Create an ASCENDDIST value if it's missing */
554
555 if(distdir == NULL){
556 CONSOLE_DEBUG("NO " ASC_ENV_DIST " VAR DEFINED");
557
558 # ifdef ASC_RELATIVE_PATHS
559
560 // read the executable's name/relative path.
561 fp = ospath_new(progname);
562
563 ospath_strcpy(fp,s1,PATH_MAX);
564 CONSOLE_DEBUG("PROGNAME = %s",s1);
565
566 // get the directory name from the exe path
567 CONSOLE_DEBUG("Calculating dir...");
568 fp1 = ospath_getdir(fp);
569 CONSOLE_DEBUG("Done calculating dir...");
570 ospath_free(fp);
571
572 ospath_strcpy(fp1,s1,PATH_MAX);
573 CONSOLE_DEBUG("DIR = %s",s1);
574
575 // append the contents of ASC_DISTDIR to this path
576 fp = ospath_new_noclean(ASC_DISTDIR);
577 distfp = ospath_concat(fp1,fp);
578 ospath_cleanup(distfp);
579
580 ospath_strcpy(fp1,s1,PATH_MAX);
581 CONSOLE_DEBUG("DIST = %s",s1);
582
583 # else
584 distfp = ospath_new(ASC_DATADIR);
585 fp = ospath_new("ascend");
586
587 ospath_append(distfp,fp);
588 ospath_free(fp);
589 # endif
590 distdir = ospath_str(distfp);
591 ERROR_REPORTER_NOLINE(ASC_USER_NOTE,"GUESSING %s = %s\n",ASC_ENV_DIST,distdir);
592 OSPATH_PUTENV(ASC_ENV_DIST,distfp);
593 }
594
595 if(tkdir == NULL){
596 CONSOLE_DEBUG("NO " ASC_ENV_TK " VAR DEFINED");
597
598 guessedtk=1;
599 /* Create a path $ASCENDDIST/tcltk */
600 strcpy(envcmd,"$ASCENDDIST/");
601 strcat(envcmd,ASC_TK_SUBDIR_NAME);
602 CONSOLE_DEBUG("TK RAW = %s",envcmd);
603 tkfp = ospath_new_expand_env(envcmd, &GETENV);
604 tkdir = ospath_str(tkfp);
605
606 ospath_strcpy(tkfp,envcmd,MAX_ENV_VAR_LENGTH);
607 CONSOLE_DEBUG("TK = %s",envcmd);
608
609 OSPATH_PUTENV(ASC_ENV_TK,tkfp);
610 }
611
612 if(bitmapsdir == NULL){
613 CONSOLE_DEBUG("NO " ASC_ENV_BITMAPS " VAR DEFINED");
614 /* Create a path $ASCENDTK/bitmaps */
615 bitmapsfp = ospath_new_expand_env("$ASCENDTK/bitmaps", &GETENV);
616 OSPATH_PUTENV(ASC_ENV_BITMAPS,bitmapsfp);
617 }
618
619 /**
620 @TODO FIXME Note, at present this default library path only caters for a
621 ** SINGLE PATH COMPONENT **
622
623 @TODO Also, what about ASCEND_DEFAULTLIBRARY ?
624 */
625 if(librarydir == NULL){
626 CONSOLE_DEBUG("NO " ASC_ENV_LIBRARY " VAR DEFINED");
627 libraryfp = ospath_new_expand_env("$ASCENDDIST/models", &GETENV);
628 ospath_free(fp);
629 OSPATH_PUTENV(ASC_ENV_LIBRARY,libraryfp);
630 }
631
632
633 CONSOLE_DEBUG("CHECKING FOR AscendRC FILE");
634
635 fp1 = ospath_new("AscendRC");
636 fp = ospath_concat(tkfp,fp1);
637 ospath_free(fp1);
638 FILE *f = ospath_fopen(fp,"r");
639 if(f==NULL){
640 if(guessedtk){
641 Asc_Panic(2, "AscCheckEnvironVars",
642 "Cannot located AscendRC file in expected (guessed) location:\n%s\n"
643 "Please set the %s environment variable to the correct location (typically\n"
644 "it would be c:\\Program Files\\ASCEND\\TK or /usr/share/ascend/tcltk/TK. You\n"
645 "should do this, then start ASCEND again."
646 ,tkdir,ASC_ENV_TK
647 );
648 }else{
649 Asc_Panic(2, "AscCheckEnvironVars",
650 "Cannot located AscendRC file in the specified location:\n%s\n"
651 "Please check your value for the %s environment variable.\n"
652 ,tkdir,ASC_ENV_TK
653 );
654 }
655 /* can't get here, hopefully */
656 }
657 fclose(f);
658 /* reuse 'envcmd' to get the string file location for AscendRC */
659 ospath_strcpy(fp,envcmd,MAX_ENV_VAR_LENGTH);
660 ospath_free(fp);
661
662 /* export the value to Tcl/Tk */
663 ASC_SEND_TO_TCL(tcl_rcFileName, envcmd);
664
665 /* send all the environment variables to Tcl/Tk as well */
666 ASC_SEND_TO_TCL2(env,ASC_ENV_DIST,distdir);
667 ASC_SEND_TO_TCL2(env,ASC_ENV_LIBRARY,librarydir);
668 ASC_SEND_TO_TCL2(env,ASC_ENV_BITMAPS,bitmapsdir);
669 ASC_SEND_TO_TCL2(env,ASC_ENV_TK,tkdir);
670 }
671
672
673
674 /*
675 * int AscSetStartupFile(interp)
676 * Tcl_Interp *interp;
677 *
678 * Look for ~/.ascendrc; if found, set the Tcl variable tcl_rcFileName
679 * to this file's location. This overrides the value set in
680 * AscCheckEnvironVars().
681 * If ~/_ascendrc is available it only gets used if ~/.ascendrc is not.
682 * Returns a standard Tcl return code.
683 */
684 static int AscSetStartupFile(Tcl_Interp *interp)
685 {
686 char *fullname; /* try to find this if first fails */
687 Tcl_DString buffer;
688 Tcl_Channel c; /* used to check for file existance */
689
690 Tcl_ResetResult(interp);
691
692 fullname = Tcl_TranslateFileName( interp, "~/.ascendrc", &buffer );
693 if( fullname != NULL ) {
694 /*
695 * Use the Tcl file channel routines to determine if ~/.ascendrc
696 * exists. We cannot use access() since Windows doesn't use it.
697 */
698 c = Tcl_OpenFileChannel( NULL, fullname, "r", 0 );
699 if( c != (Tcl_Channel)NULL ) {
700 /* file exists. close the channel and set tcl_rcFileName. */
701 Tcl_Close( NULL, c );
702 Tcl_SetVar(interp, "tcl_rcFileName", fullname, TCL_GLOBAL_ONLY);
703 Tcl_DStringFree(&buffer);
704 return TCL_OK;
705 }
706 Tcl_DStringFree(&buffer);
707 }
708 fullname = Tcl_TranslateFileName( interp, "~/_ascendrc", &buffer );
709 if( fullname != NULL ) {
710 /*
711 * Use the Tcl file channel routines to determine if ~/_ascendrc
712 * exists. We cannot use access() since Windows doesn't use it.
713 */
714 c = Tcl_OpenFileChannel( NULL, fullname, "r", 0 );
715 if( c != (Tcl_Channel)NULL ) {
716 /* file exists. close the channel and set tcl_rcFileName */
717 Tcl_Close( NULL, c );
718 Tcl_SetVar(interp, "tcl_rcFileName", fullname, TCL_GLOBAL_ONLY);
719 Tcl_DStringFree(&buffer);
720 return TCL_OK;
721 }
722 Tcl_DStringFree(&buffer);
723 }
724 return TCL_OK; /* probably should be TCL_ERROR */
725 }
726
727
728
729 /*
730 * file = AscProcessCommandLine(argc, argv)
731 * char *file;
732 * int argc;
733 * char *argv[];
734 *
735 * Process the options given on the command line `argv' where `argc' is
736 * the length of argv.
737 *
738 * Strip out ASCEND specific flags and then pass the rest to Tcl so it
739 * can set what it needs.
740 *
741 * This function may call exit() if the user requests help.
742 */
743 static int AscProcessCommandLine(Tcl_Interp *interp, int argc, CONST char **argv)
744 {
745 int i;
746 int flag; /* set to 1 for `+arg', -1 for `-arg' */
747 size_t length; /* length of an argv */
748 char *args;
749 char buf[MAXIMUM_NUMERIC_LENGTH]; /* space for integer->string conversion */
750 int new_argc = 0; /* the argc we will pass to Tcl */
751 #ifdef ZZ_DEBUG
752 zz_debug = 0; /* nonzero to print parser debugging info*/
753 #endif
754
755 for( i = 1; i < argc; i++ ) {
756 if( (length = strlen(argv[i])) == 0 ) {
757 /* ignore 0-length arguments */
758 continue;
759 }
760
761 if(( length >= 2 ) && ( strncmp(argv[i],"-h",2) == 0 )) {
762 AscPrintHelpExit(argv[0]);
763 }
764 if(( length >= 2 ) && ( strncmp(argv[i],"-H",2) == 0 )) {
765 AscPrintHelpExit(argv[0]);
766 }
767 if(( length >= 4 ) && ( strncmp(argv[i],"help",4) == 0 )) {
768 AscPrintHelpExit(argv[0]);
769 }
770
771 if( argv[i][0] == '-' ) {
772 flag = -1;
773 } else if( argv[i][0] == '+' ) {
774 flag = 1;
775 } else {
776 flag = 0;
777 }
778
779 if(( length == 2 ) && ( flag != 0 )) {
780 switch( argv[i][1] ) {
781 case 'd':
782 /* '-d' turns on scanner debugging (if ascend was built with it)
783 * '+d' turns off scanner debugging [default]
784 */
785 if( flag == -1 ) {
786 #ifdef ZZ_DEBUG
787 zz_debug = 1;
788 } else {
789 zz_debug = 0;
790 #else
791 FPRINTF(ASCERR, "Sorry, %s wasn't compiled with %s defined.\n",
792 argv[0], "ZZ_DEBUG");
793 #endif /* ZZ_DEBUG */
794 }
795 break;
796 case 's':
797 /* '-s' turns on compiler optimizations [default]
798 * '+s' turns off compiler optimizations
799 */
800 if( flag == -1 ) {
801 g_interface_simplify_relations = 1;
802 } else {
803 g_interface_simplify_relations = 0;
804 }
805 break;
806 case 't':
807 /* '-t' turns on timing of compiler optimizations
808 * '+t' turns off timing of compiler optimizations [default]
809 */
810 if( flag == 0 ) {
811 g_compiler_timing = 1;
812 } else {
813 g_compiler_timing = 0;
814 }
815 break;
816 case 'c':
817 case 'g':
818 fprintf(ASCERR, "WARNING! Obsolete ASCEND option \"%s\"\n", argv[i]);
819 break;
820 default:
821 /* unknown ASCEND option, pass it on to Tcl
822 */
823 argv[++new_argc] = argv[i];
824 break;
825 }
826 } else {
827 /* unknown ASCEND option, pass it on to Tcl
828 */
829 argv[++new_argc] = argv[i];
830 }
831 }
832
833 /*
834 * Make command-line arguments available in the Tcl variables "argc"
835 * and "argv".
836 */
837 args = Tcl_Merge(new_argc, (argv+1));
838 Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
839 ckfree(args);
840 sprintf(buf, "%d", new_argc);
841 Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
842 Tcl_SetVar(interp, "argv0", argv[0], TCL_GLOBAL_ONLY);
843
844 return TCL_OK;
845 }
846
847
848 /*
849 * AscPrintHelpExit(invoke_name)
850 * CONST char *invoke_name;
851 *
852 * Print a help message and exit. Use invoke_name as the name of
853 * the binary
854 */
855 static
856 void AscPrintHelpExit(CONST char *invoke_name)
857 {
858 PRINTF("usage: %s [options]\n"
859 "\n"
860 "where options include [default value]:\n"
861 " -h print this message\n"
862 " -/+d turn on/off yacc debugging [off]\n"
863 " -/+s turn on/off compiler optimizations [on]\n"
864 " -/+t turn on/off timing of compiler operations [off]\n",
865 invoke_name);
866 Tcl_Exit(0); /* Show this help message and leave */
867 }
868
869
870 /*
871 * AscTrap(sig)
872 * int sig;
873 *
874 * Function to call when we receive an interrupt.
875 */
876 static
877 void AscTrap(int sig)
878 {
879 putchar('\n');
880 Asc_Panic(sig, "AscTrap", "Caught Signal: %d", sig);
881 }
882
883
884 /*
885 * See this file's header for documentation.
886 */
887 int Asc_LoadWin(ClientData cdata, Tcl_Interp *interp,
888 int argc, CONST84 char *argv[])
889 {
890 (void)cdata; /* stop gcc whine about unused parameter */
891 (void)argv; /* stop gcc whine about unused parameter */
892
893 if ( argc != 1 ) {
894 FPRINTF(stderr,"call is: ascloadwin <no args> \n");
895 return TCL_ERROR;
896 }
897 if (g_interfacever) {
898 Tcl_SetResult(interp, "1", TCL_STATIC);
899 } else {
900 Tcl_SetResult(interp, "0", TCL_STATIC);
901 }
902 return TCL_OK;
903 }
904
905
906 /*
907 *----------------------------------------------------------------------
908 *----------------------------------------------------------------------
909 * The following StdinProc() and Prompt() are from tkMain.c in
910 * the Tk4.1 distribution (and did not change in Tk8.0).
911 *----------------------------------------------------------------------
912 *----------------------------------------------------------------------
913 */
914 /*
915 *----------------------------------------------------------------------
916 *
917 * StdinProc --
918 *
919 * This procedure is invoked by the event dispatcher whenever
920 * standard input becomes readable. It grabs the next line of
921 * input characters, adds them to a command being assembled, and
922 * executes the command if it's complete.
923 *
924 * Results:
925 * None.
926 *
927 * Side effects:
928 * Could be almost arbitrary, depending on the command that's
929 * typed.
930 *
931 *----------------------------------------------------------------------
932 */
933
934 /* ARGSUSED */
935 static void
936 StdinProc(ClientData clientData, int mask)
937 {
938 static int gotPartial = 0;
939 char *cmd;
940 int code, count;
941 Tcl_Channel chan = (Tcl_Channel) clientData;
942
943 Tcl_Interp *interp = g_interp; /* use a local copy of the
944 * global tcl interpreter
945 */
946
947 (void)clientData; /* stop gcc whine about unused parameter */
948 (void)mask; /* stop gcc whine about unused parameter */
949
950 count = Tcl_Gets(chan, &g_line);
951
952 if (count < 0) {
953 if (!gotPartial) {
954 if (tty) {
955 return;
956 } else {
957 Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
958 }
959 return;
960 } else {
961 count = 0;
962 }
963 }
964
965 (void) Tcl_DStringAppend(&g_command, Tcl_DStringValue(&g_line), -1);
966 cmd = Tcl_DStringAppend(&g_command, "\n", -1);
967 Tcl_DStringFree(&g_line);
968
969 if (!Tcl_CommandComplete(cmd)) {
970 gotPartial = 1;
971 goto prompt;
972 }
973 gotPartial = 0;
974
975 /*
976 * Disable the stdin channel handler while evaluating the command;
977 * otherwise if the command re-enters the event loop we might
978 * process commands from stdin before the current command is
979 * finished. Among other things, this will trash the text of the
980 * command being evaluated.
981 */
982
983 Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan);
984 code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
985 Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
986 (ClientData) chan);
987 Tcl_DStringFree(&g_command);
988 if (*interp->result != 0) {
989 if ((code != TCL_OK) || (tty)) {
990 /*
991 * The statement below used to call "printf", but that resulted
992 * in core dumps under Solaris 2.3 if the result was very long.
993 *
994 * NOTE: This probably will not work under Windows either.
995 */
996
997 puts(interp->result);
998 }
999 }
1000
1001 /*
1002 * Output a prompt.
1003 */
1004
1005 prompt:
1006 if (tty) {
1007 Prompt(interp, gotPartial);
1008 }
1009 Tcl_ResetResult(interp);
1010 }
1011
1012 /*
1013 *----------------------------------------------------------------------
1014 *
1015 * Prompt --
1016 *
1017 * Issue a prompt on standard output, or invoke a script
1018 * to issue the prompt.
1019 *
1020 * Results:
1021 * None.
1022 *
1023 * Side effects:
1024 * A prompt gets output, and a Tcl script may be evaluated
1025 * in interp.
1026 *
1027 * Parameters:
1028 * interp Interpreter to use for prompting.
1029 * partial Non-zero means there already exists a partial
1030 * command, so use the secondary prompt.
1031 *
1032 *----------------------------------------------------------------------
1033 */
1034
1035 static void
1036 Prompt(Tcl_Interp *interp, int partial)
1037 {
1038 CONST84 char *promptCmd;
1039 int code;
1040 Tcl_Channel outChannel, errChannel;
1041 CONST84 char *subPrompt;
1042
1043 errChannel = Tcl_GetChannel(interp, "stderr", NULL);
1044
1045 subPrompt = (partial ? "tcl_prompt2" : "tcl_prompt1");
1046 promptCmd = Tcl_GetVar(interp, subPrompt, TCL_GLOBAL_ONLY);
1047 if (promptCmd == NULL) {
1048 defaultPrompt:
1049
1050 /*
1051 * We must check that outChannel is a real channel - it
1052 * is possible that someone has transferred stdout out of
1053 * this interpreter with "interp transfer".
1054 */
1055
1056 outChannel = Tcl_GetChannel(interp, "stdout", NULL);
1057 if (outChannel != (Tcl_Channel) NULL) {
1058 if (!partial) {
1059 Tcl_Write(outChannel, "AscendIV% ", 10);
1060 } else {
1061 Tcl_Write(outChannel, "more? ", 6);
1062 }
1063 }
1064 } else {
1065 code = Tcl_Eval(interp, promptCmd);
1066 if (code != TCL_OK) {
1067 Tcl_AddErrorInfo(interp,
1068 "\n (script that generates prompt)");
1069 /*
1070 * We must check that errChannel is a real channel - it
1071 * is possible that someone has transferred stderr out of
1072 * this interpreter with "interp transfer".
1073 */
1074
1075 errChannel = Tcl_GetChannel(interp, "stderr", NULL);
1076 if (errChannel != (Tcl_Channel) NULL) {
1077 Tcl_Write(errChannel, interp->result, -1);
1078 Tcl_Write(errChannel, "\n", 1);
1079 }
1080 goto defaultPrompt;
1081 }
1082 }
1083 outChannel = Tcl_GetChannel(interp, "stdout", NULL);
1084 if (outChannel != (Tcl_Channel) NULL) {
1085 Tcl_Flush(outChannel);
1086 }
1087 }
1088
1089 /*
1090 *----------------------------------------------------------------------
1091 * Tom Epperly's Malloc Debugger
1092 *----------------------------------------------------------------------
1093 */
1094 #ifdef DEBUG_MALLOC
1095 static void InitDebugMalloc(void)
1096 {
1097 union dbmalloptarg m;
1098 m.str = NULL;
1099 m.i = 0;
1100 dbmallopt(MALLOC_CKDATA,&m);
1101 }
1102
1103 int Asc_DebugMallocCmd(ClientData cdata, Tcl_Interp *interp,
1104 int argc, CONST84 char *argv[])
1105 {
1106 union dbmalloptarg m;
1107
1108 if ( argc != 2 ) {
1109 Tcl_SetResult(interp, "wrong # args : Usage __dbmalloc ?on?off?",
1110 TCL_STATIC);
1111 return TCL_ERROR;
1112 }
1113 m.str = NULL;
1114 if (strcmp(argv[1],"on")==0) {
1115 m.i = 1;
1116 } else if (strcmp(argv[1],"off")==0) {
1117 m.i = 0;
1118 } else {
1119 Tcl_SetResult(interp, "incorrect args : should be \"on\" or \"off\"",
1120 TCL_STATIC);
1121 return TCL_ERROR;
1122 }
1123 dbmallopt(MALLOC_CKDATA,&m); /* turn on str* mem* and b* checking */
1124 return TCL_OK;
1125 }
1126 #endif /* DEBUG_MALLOC */
1127
1128

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22