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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

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