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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

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