/[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 624 - (show annotations) (download) (as text)
Thu May 18 15:39:38 2006 UTC (16 years, 6 months ago) by ben.allan
File MIME type: text/x-csrc
File size: 32088 byte(s)
Summary: most of the recent complaints about autotools build fixed,
but the buildbot might find a problem with the scons build/install/rpmbuild.


Details:

configure,Driver.c,utilities/config.h.in:
The choice of INSTALL_DATA as a configure variable name
has been repaired (renamed INSTALL_SHARE); INSTALL_DATA is the unix
canonical name for the program 'install' handling a data file.
Both autotools and scons builds have been updated to reflect this,
in the process correcting the definition from prefix/share to
prefix/share/ascend. 

autotools build:
Added --with-quiet option to make the install of already installed and
unchanged files less verbose.
Put in a workaround for the '' problem in tkConfig.sh seen by KC/JP.
Added --datadir support to autotools configure. If you configure
the autotools --datadir=PREFIX/share/ascend you get the same behavior
as the Pye packaging; by default you get the CMU packaging convention instead.
Added utilities/env.c to build.

compiler:
Turned off AWAL in anontype.c.
Noodling away at blackboxes continues...

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 $PROGDIR/@ASC_DATADIR_REL_BIN@ (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 int err;
543
544 Tcl_DString buffer;
545
546 Tcl_DStringInit(&buffer);
547
548 /* import these into the environment */
549 err = env_import(ASC_ENV_DIST,getenv,PUTENV);
550 if(err)CONSOLE_DEBUG("No %s var imported, error %d",ASC_ENV_DIST,err);
551 env_import(ASC_ENV_TK,getenv,PUTENV);
552 env_import(ASC_ENV_BITMAPS,getenv,PUTENV);
553 env_import(ASC_ENV_LIBRARY,getenv,PUTENV);
554
555 CONSOLE_DEBUG("IMPORTING VARS");
556
557 distdir = GETENV(ASC_ENV_DIST);
558 tkdir = GETENV(ASC_ENV_TK);
559 bitmapsdir = GETENV(ASC_ENV_BITMAPS);
560 librarydir = GETENV(ASC_ENV_LIBRARY);
561
562 int guessedtk=0;
563
564 /* Create an ASCENDDIST value if it's missing */
565
566 if(distdir == NULL){
567 CONSOLE_DEBUG("NO " ASC_ENV_DIST " VAR DEFINED");
568
569 # ifdef ASC_RELATIVE_PATHS
570
571 // read the executable's name/relative path.
572 fp = ospath_new(progname);
573
574 ospath_strcpy(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 ospath_strcpy(fp1,s1,PATH_MAX);
582 CONSOLE_DEBUG("DIR = %s",s1);
583
584 // append the contents of ASC_DISTDIR_REL_BIN to this path
585 fp = ospath_new_noclean(ASC_DISTDIR_REL_BIN);
586 distfp = ospath_concat(fp1,fp);
587 ospath_cleanup(distfp);
588
589 ospath_strcpy(fp1,s1,PATH_MAX);
590 CONSOLE_DEBUG("DIST = %s",s1);
591
592 # else
593 distfp = ospath_new(ASC_DATADIR);
594 #if 0
595 /* umm, no, you may NOT stick an arbitrary subdirectory in underneath
596 the configured value of the $datadir (which in the CMU packaging is $prefix).
597 */
598 fp = ospath_new("ascend");
599
600 ospath_append(distfp,fp);
601 ospath_free(fp);
602 #endif /* 0*/
603 # endif
604 distdir = ospath_str(distfp);
605 CONSOLE_DEBUG("GUESSING %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 }
611
612 if(tkdir == NULL){
613 CONSOLE_DEBUG("USING DEFAULT %s = %s",ASC_ENV_TK,ASC_ENV_TK_DEFAULT);
614 guessedtk=1;
615 tkfp = ospath_new_expand_env(ASC_ENV_TK_DEFAULT, &GETENV);
616 tkdir = ospath_str(tkfp);
617
618 ospath_strcpy(tkfp,envcmd,MAX_ENV_VAR_LENGTH);
619 CONSOLE_DEBUG("TK = %s",envcmd);
620
621 OSPATH_PUTENV(ASC_ENV_TK,tkfp);
622 }else{
623 tkfp = ospath_new_expand_env(tkdir, &GETENV);
624 tkdir = ospath_str(tkfp);
625 OSPATH_PUTENV(ASC_ENV_TK,tkfp);
626 }
627
628 if(bitmapsdir == NULL){
629 CONSOLE_DEBUG("NO " ASC_ENV_BITMAPS " VAR DEFINED");
630 /* Create a path $ASCENDTK/bitmaps */
631 bitmapsfp = ospath_new_expand_env("$ASCENDTK/bitmaps", &GETENV);
632 OSPATH_PUTENV(ASC_ENV_BITMAPS,bitmapsfp);
633 bitmapsdir = ospath_str(bitmapsfp);
634 }
635
636 /**
637 @TODO FIXME Note, at present this default library path only caters for a
638 ** SINGLE PATH COMPONENT **
639
640 @TODO Also, what about ASCEND_DEFAULTLIBRARY ?
641 */
642 if(librarydir == NULL){
643 CONSOLE_DEBUG("NO " ASC_ENV_LIBRARY " VAR DEFINED");
644 libraryfp = ospath_new_expand_env("$ASCENDDIST/models", &GETENV);
645 CONSOLE_DEBUG("CREATED LIBRARY VAL");
646 OSPATH_PUTENV(ASC_ENV_LIBRARY,libraryfp);
647 librarydir = ospath_str(libraryfp);
648 }
649
650
651 CONSOLE_DEBUG("CHECKING FOR AscendRC FILE");
652
653 fp1 = ospath_new("AscendRC");
654 fp = ospath_concat(tkfp,fp1);
655 ospath_free(fp1);
656 FILE *f = ospath_fopen(fp,"r");
657 if(f==NULL){
658 if(guessedtk){
659 Asc_Panic(2, "AscCheckEnvironVars",
660 "Cannot located AscendRC file in expected (guessed) location:\n%s\n"
661 "Please set the %s environment variable to the correct location (typically\n"
662 "it would be c:\\Program Files\\ASCEND\\TK or /usr/share/ascend/tcltk/TK. You\n"
663 "should do this, then start ASCEND again."
664 ,tkdir,ASC_ENV_TK
665 );
666 }else{
667 Asc_Panic(2, "AscCheckEnvironVars",
668 "Cannot located AscendRC file in the specified location:\n%s\n"
669 "Please check your value for the %s environment variable.\n"
670 ,tkdir,ASC_ENV_TK
671 );
672 }
673 /* can't get here, hopefully */
674 }
675 fclose(f);
676 /* reuse 'envcmd' to get the string file location for AscendRC */
677 ospath_strcpy(fp,envcmd,MAX_ENV_VAR_LENGTH);
678 ospath_free(fp);
679
680 /* export the value to Tcl/Tk */
681 ASC_SEND_TO_TCL(tcl_rcFileName, envcmd);
682
683 /* send all the environment variables to Tcl/Tk as well */
684 ASC_SEND_TO_TCL2(env,ASC_ENV_DIST,distdir);
685 ASC_SEND_TO_TCL2(env,ASC_ENV_LIBRARY,librarydir);
686 ASC_SEND_TO_TCL2(env,ASC_ENV_BITMAPS,bitmapsdir);
687 ASC_SEND_TO_TCL2(env,ASC_ENV_TK,tkdir);
688 }
689
690
691
692 /*
693 * int AscSetStartupFile(interp)
694 * Tcl_Interp *interp;
695 *
696 * Look for ~/.ascendrc; if found, set the Tcl variable tcl_rcFileName
697 * to this file's location. This overrides the value set in
698 * AscCheckEnvironVars().
699 * If ~/_ascendrc is available it only gets used if ~/.ascendrc is not.
700 * Returns a standard Tcl return code.
701 */
702 static int AscSetStartupFile(Tcl_Interp *interp)
703 {
704 char *fullname; /* try to find this if first fails */
705 Tcl_DString buffer;
706 Tcl_Channel c; /* used to check for file existance */
707
708 Tcl_ResetResult(interp);
709
710 fullname = Tcl_TranslateFileName( interp, "~/.ascendrc", &buffer );
711 if( fullname != NULL ) {
712 /*
713 * Use the Tcl file channel routines to determine if ~/.ascendrc
714 * exists. We cannot use access() since Windows doesn't use it.
715 */
716 c = Tcl_OpenFileChannel( NULL, fullname, "r", 0 );
717 if( c != (Tcl_Channel)NULL ) {
718 /* file exists. close the channel and set tcl_rcFileName. */
719 Tcl_Close( NULL, c );
720 Tcl_SetVar(interp, "tcl_rcFileName", fullname, TCL_GLOBAL_ONLY);
721 Tcl_DStringFree(&buffer);
722 return TCL_OK;
723 }
724 Tcl_DStringFree(&buffer);
725 }
726 fullname = Tcl_TranslateFileName( interp, "~/_ascendrc", &buffer );
727 if( fullname != NULL ) {
728 /*
729 * Use the Tcl file channel routines to determine if ~/_ascendrc
730 * exists. We cannot use access() since Windows doesn't use it.
731 */
732 c = Tcl_OpenFileChannel( NULL, fullname, "r", 0 );
733 if( c != (Tcl_Channel)NULL ) {
734 /* file exists. close the channel and set tcl_rcFileName */
735 Tcl_Close( NULL, c );
736 Tcl_SetVar(interp, "tcl_rcFileName", fullname, TCL_GLOBAL_ONLY);
737 Tcl_DStringFree(&buffer);
738 return TCL_OK;
739 }
740 Tcl_DStringFree(&buffer);
741 }
742 return TCL_OK; /* probably should be TCL_ERROR */
743 }
744
745
746
747 /*
748 * file = AscProcessCommandLine(argc, argv)
749 * char *file;
750 * int argc;
751 * char *argv[];
752 *
753 * Process the options given on the command line `argv' where `argc' is
754 * the length of argv.
755 *
756 * Strip out ASCEND specific flags and then pass the rest to Tcl so it
757 * can set what it needs.
758 *
759 * This function may call exit() if the user requests help.
760 */
761 static int AscProcessCommandLine(Tcl_Interp *interp, int argc, CONST char **argv)
762 {
763 int i;
764 int flag; /* set to 1 for `+arg', -1 for `-arg' */
765 size_t length; /* length of an argv */
766 char *args;
767 char buf[MAXIMUM_NUMERIC_LENGTH]; /* space for integer->string conversion */
768 int new_argc = 0; /* the argc we will pass to Tcl */
769 #ifdef ZZ_DEBUG
770 zz_debug = 0; /* nonzero to print parser debugging info*/
771 #endif
772
773 for( i = 1; i < argc; i++ ) {
774 if( (length = strlen(argv[i])) == 0 ) {
775 /* ignore 0-length arguments */
776 continue;
777 }
778
779 if(( length >= 2 ) && ( strncmp(argv[i],"-h",2) == 0 )) {
780 AscPrintHelpExit(argv[0]);
781 }
782 if(( length >= 2 ) && ( strncmp(argv[i],"-H",2) == 0 )) {
783 AscPrintHelpExit(argv[0]);
784 }
785 if(( length >= 4 ) && ( strncmp(argv[i],"help",4) == 0 )) {
786 AscPrintHelpExit(argv[0]);
787 }
788
789 if( argv[i][0] == '-' ) {
790 flag = -1;
791 } else if( argv[i][0] == '+' ) {
792 flag = 1;
793 } else {
794 flag = 0;
795 }
796
797 if(( length == 2 ) && ( flag != 0 )) {
798 switch( argv[i][1] ) {
799 case 'd':
800 /* '-d' turns on scanner debugging (if ascend was built with it)
801 * '+d' turns off scanner debugging [default]
802 */
803 if( flag == -1 ) {
804 #ifdef ZZ_DEBUG
805 zz_debug = 1;
806 } else {
807 zz_debug = 0;
808 #else
809 FPRINTF(ASCERR, "Sorry, %s wasn't compiled with %s defined.\n",
810 argv[0], "ZZ_DEBUG");
811 #endif /* ZZ_DEBUG */
812 }
813 break;
814 case 's':
815 /* '-s' turns on compiler optimizations [default]
816 * '+s' turns off compiler optimizations
817 */
818 if( flag == -1 ) {
819 g_interface_simplify_relations = 1;
820 } else {
821 g_interface_simplify_relations = 0;
822 }
823 break;
824 case 't':
825 /* '-t' turns on timing of compiler optimizations
826 * '+t' turns off timing of compiler optimizations [default]
827 */
828 if( flag == 0 ) {
829 g_compiler_timing = 1;
830 } else {
831 g_compiler_timing = 0;
832 }
833 break;
834 case 'c':
835 case 'g':
836 fprintf(ASCERR, "WARNING! Obsolete ASCEND option \"%s\"\n", argv[i]);
837 break;
838 default:
839 /* unknown ASCEND option, pass it on to Tcl
840 */
841 argv[++new_argc] = argv[i];
842 break;
843 }
844 } else {
845 /* unknown ASCEND option, pass it on to Tcl
846 */
847 argv[++new_argc] = argv[i];
848 }
849 }
850
851 /*
852 * Make command-line arguments available in the Tcl variables "argc"
853 * and "argv".
854 */
855 args = Tcl_Merge(new_argc, (argv+1));
856 Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
857 ckfree(args);
858 sprintf(buf, "%d", new_argc);
859 Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
860 Tcl_SetVar(interp, "argv0", argv[0], TCL_GLOBAL_ONLY);
861
862 return TCL_OK;
863 }
864
865
866 /*
867 * AscPrintHelpExit(invoke_name)
868 * CONST char *invoke_name;
869 *
870 * Print a help message and exit. Use invoke_name as the name of
871 * the binary
872 */
873 static
874 void AscPrintHelpExit(CONST char *invoke_name)
875 {
876 PRINTF("usage: %s [options]\n"
877 "\n"
878 "where options include [default value]:\n"
879 " -h print this message\n"
880 " -/+d turn on/off yacc debugging [off]\n"
881 " -/+s turn on/off compiler optimizations [on]\n"
882 " -/+t turn on/off timing of compiler operations [off]\n",
883 invoke_name);
884 Tcl_Exit(0); /* Show this help message and leave */
885 }
886
887
888 /*
889 * AscTrap(sig)
890 * int sig;
891 *
892 * Function to call when we receive an interrupt.
893 */
894 static
895 void AscTrap(int sig)
896 {
897 putchar('\n');
898 Asc_Panic(sig, "AscTrap", "Caught Signal: %d", sig);
899 }
900
901
902 /*
903 * See this file's header for documentation.
904 */
905 int Asc_LoadWin(ClientData cdata, Tcl_Interp *interp,
906 int argc, CONST84 char *argv[])
907 {
908 (void)cdata; /* stop gcc whine about unused parameter */
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 /*
925 *----------------------------------------------------------------------
926 *----------------------------------------------------------------------
927 * The following StdinProc() and Prompt() are from tkMain.c in
928 * the Tk4.1 distribution (and did not change in Tk8.0).
929 *----------------------------------------------------------------------
930 *----------------------------------------------------------------------
931 */
932 /*
933 *----------------------------------------------------------------------
934 *
935 * StdinProc --
936 *
937 * This procedure is invoked by the event dispatcher whenever
938 * standard input becomes readable. It grabs the next line of
939 * input characters, adds them to a command being assembled, and
940 * executes the command if it's complete.
941 *
942 * Results:
943 * None.
944 *
945 * Side effects:
946 * Could be almost arbitrary, depending on the command that's
947 * typed.
948 *
949 *----------------------------------------------------------------------
950 */
951
952 /* ARGSUSED */
953 static void
954 StdinProc(ClientData clientData, int mask)
955 {
956 static int gotPartial = 0;
957 char *cmd;
958 int code, count;
959 Tcl_Channel chan = (Tcl_Channel) clientData;
960
961 Tcl_Interp *interp = g_interp; /* use a local copy of the
962 * global tcl interpreter
963 */
964
965 (void)clientData; /* stop gcc whine about unused parameter */
966 (void)mask; /* stop gcc whine about unused parameter */
967
968 count = Tcl_Gets(chan, &g_line);
969
970 if (count < 0) {
971 if (!gotPartial) {
972 if (tty) {
973 return;
974 } else {
975 Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
976 }
977 return;
978 } else {
979 count = 0;
980 }
981 }
982
983 (void) Tcl_DStringAppend(&g_command, Tcl_DStringValue(&g_line), -1);
984 cmd = Tcl_DStringAppend(&g_command, "\n", -1);
985 Tcl_DStringFree(&g_line);
986
987 if (!Tcl_CommandComplete(cmd)) {
988 gotPartial = 1;
989 goto prompt;
990 }
991 gotPartial = 0;
992
993 /*
994 * Disable the stdin channel handler while evaluating the command;
995 * otherwise if the command re-enters the event loop we might
996 * process commands from stdin before the current command is
997 * finished. Among other things, this will trash the text of the
998 * command being evaluated.
999 */
1000
1001 Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan);
1002 code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
1003 Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
1004 (ClientData) chan);
1005 Tcl_DStringFree(&g_command);
1006 if (*interp->result != 0) {
1007 if ((code != TCL_OK) || (tty)) {
1008 /*
1009 * The statement below used to call "printf", but that resulted
1010 * in core dumps under Solaris 2.3 if the result was very long.
1011 *
1012 * NOTE: This probably will not work under Windows either.
1013 */
1014
1015 puts(interp->result);
1016 }
1017 }
1018
1019 /*
1020 * Output a prompt.
1021 */
1022
1023 prompt:
1024 if (tty) {
1025 Prompt(interp, gotPartial);
1026 }
1027 Tcl_ResetResult(interp);
1028 }
1029
1030 /*
1031 *----------------------------------------------------------------------
1032 *
1033 * Prompt --
1034 *
1035 * Issue a prompt on standard output, or invoke a script
1036 * to issue the prompt.
1037 *
1038 * Results:
1039 * None.
1040 *
1041 * Side effects:
1042 * A prompt gets output, and a Tcl script may be evaluated
1043 * in interp.
1044 *
1045 * Parameters:
1046 * interp Interpreter to use for prompting.
1047 * partial Non-zero means there already exists a partial
1048 * command, so use the secondary prompt.
1049 *
1050 *----------------------------------------------------------------------
1051 */
1052
1053 static void
1054 Prompt(Tcl_Interp *interp, int partial)
1055 {
1056 CONST84 char *promptCmd;
1057 int code;
1058 Tcl_Channel outChannel, errChannel;
1059 CONST84 char *subPrompt;
1060
1061 errChannel = Tcl_GetChannel(interp, "stderr", NULL);
1062
1063 subPrompt = (partial ? "tcl_prompt2" : "tcl_prompt1");
1064 promptCmd = Tcl_GetVar(interp, subPrompt, TCL_GLOBAL_ONLY);
1065 if (promptCmd == NULL) {
1066 defaultPrompt:
1067
1068 /*
1069 * We must check that outChannel is a real channel - it
1070 * is possible that someone has transferred stdout out of
1071 * this interpreter with "interp transfer".
1072 */
1073
1074 outChannel = Tcl_GetChannel(interp, "stdout", NULL);
1075 if (outChannel != (Tcl_Channel) NULL) {
1076 if (!partial) {
1077 Tcl_Write(outChannel, "AscendIV% ", 10);
1078 } else {
1079 Tcl_Write(outChannel, "more? ", 6);
1080 }
1081 }
1082 } else {
1083 code = Tcl_Eval(interp, promptCmd);
1084 if (code != TCL_OK) {
1085 Tcl_AddErrorInfo(interp,
1086 "\n (script that generates prompt)");
1087 /*
1088 * We must check that errChannel is a real channel - it
1089 * is possible that someone has transferred stderr out of
1090 * this interpreter with "interp transfer".
1091 */
1092
1093 errChannel = Tcl_GetChannel(interp, "stderr", NULL);
1094 if (errChannel != (Tcl_Channel) NULL) {
1095 Tcl_Write(errChannel, interp->result, -1);
1096 Tcl_Write(errChannel, "\n", 1);
1097 }
1098 goto defaultPrompt;
1099 }
1100 }
1101 outChannel = Tcl_GetChannel(interp, "stdout", NULL);
1102 if (outChannel != (Tcl_Channel) NULL) {
1103 Tcl_Flush(outChannel);
1104 }
1105 }
1106
1107 /*
1108 *----------------------------------------------------------------------
1109 * Tom Epperly's Malloc Debugger
1110 *----------------------------------------------------------------------
1111 */
1112 #ifdef DEBUG_MALLOC
1113 static void InitDebugMalloc(void)
1114 {
1115 union dbmalloptarg m;
1116 m.str = NULL;
1117 m.i = 0;
1118 dbmallopt(MALLOC_CKDATA,&m);
1119 }
1120
1121 int Asc_DebugMallocCmd(ClientData cdata, Tcl_Interp *interp,
1122 int argc, CONST84 char *argv[])
1123 {
1124 union dbmalloptarg m;
1125
1126 if ( argc != 2 ) {
1127 Tcl_SetResult(interp, "wrong # args : Usage __dbmalloc ?on?off?",
1128 TCL_STATIC);
1129 return TCL_ERROR;
1130 }
1131 m.str = NULL;
1132 if (strcmp(argv[1],"on")==0) {
1133 m.i = 1;
1134 } else if (strcmp(argv[1],"off")==0) {
1135 m.i = 0;
1136 } else {
1137 Tcl_SetResult(interp, "incorrect args : should be \"on\" or \"off\"",
1138 TCL_STATIC);
1139 return TCL_ERROR;
1140 }
1141 dbmallopt(MALLOC_CKDATA,&m); /* turn on str* mem* and b* checking */
1142 return TCL_OK;
1143 }
1144 #endif /* DEBUG_MALLOC */
1145
1146

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