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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

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