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

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