/[dtapublic]/projs/dtats/trunk/shared_source/c_tcl_base_7_5_w_mods/tclinitscript.h
ViewVC logotype

Diff of /projs/dtats/trunk/shared_source/c_tcl_base_7_5_w_mods/tclinitscript.h

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

projs/trunk/shared_source/tcl_base/tclinitscript.h revision 42 by dashley, Fri Oct 14 01:50:00 2016 UTC projs/dtats/trunk/shared_source/c_tcl_base_7_5_w_mods/tclinitscript.h revision 98 by dashley, Sun Dec 18 00:57:31 2016 UTC
# Line 1  Line 1 
 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclinitscript.h,v 1.1.1.1 2001/06/13 04:39:33 dtashley Exp $ */  
   
 /*  
  * tclInitScript.h --  
  *  
  *      This file contains Unix & Windows common init script  
  *      It is not used on the Mac. (the mac init script is in tclMacInit.c)  
  *  
  * Copyright (c) 1998 Sun Microsystems, Inc.  
  * Copyright (c) 1999 by Scriptics Corporation.  
  * All rights reserved.  
  *  
  * RCS: @(#) $Id: tclinitscript.h,v 1.1.1.1 2001/06/13 04:39:33 dtashley Exp $  
  */  
   
 /*  
  * In order to find init.tcl during initialization, the following script  
  * is invoked by Tcl_Init().  It looks in several different directories:  
  *  
  *      $tcl_library            - can specify a primary location, if set  
  *                                no other locations will be checked  
  *  
  *      $env(TCL_LIBRARY)       - highest priority so user can always override  
  *                                the search path unless the application has  
  *                                specified an exact directory above  
  *  
  *      $tclDefaultLibrary      - this value is initialized by TclPlatformInit  
  *                                from a static C variable that was set at  
  *                                compile time  
  *  
  *      $tcl_libPath            - this value is initialized by a call to  
  *                                TclGetLibraryPath called from Tcl_Init.  
  *  
  * The first directory on this path that contains a valid init.tcl script  
  * will be set as the value of tcl_library.  
  *  
  * Note that this entire search mechanism can be bypassed by defining an  
  * alternate tclInit procedure before calling Tcl_Init().  
  */  
   
 static char initScript[] = "if {[info proc tclInit]==\"\"} {\n\  
   proc tclInit {} {\n\  
     global tcl_libPath tcl_library errorInfo\n\  
     global env tclDefaultLibrary\n\  
     rename tclInit {}\n\  
     set errors {}\n\  
     set dirs {}\n\  
     if {[info exists tcl_library]} {\n\  
         lappend dirs $tcl_library\n\  
     } else {\n\  
         if {[info exists env(TCL_LIBRARY)]} {\n\  
             lappend dirs $env(TCL_LIBRARY)\n\  
         }\n\  
         lappend dirs $tclDefaultLibrary\n\  
         unset tclDefaultLibrary\n\  
         set dirs [concat $dirs $tcl_libPath]\n\  
     }\n\  
     foreach i $dirs {\n\  
         set tcl_library $i\n\  
         set tclfile [file join $i init.tcl]\n\  
         if {[file exists $tclfile]} {\n\  
             if {![catch {uplevel #0 [list source $tclfile]} msg]} {\n\  
                 return\n\  
             } else {\n\  
                 append errors \"$tclfile: $msg\n$errorInfo\n\"\n\  
             }\n\  
         }\n\  
     }\n\  
     set msg \"Can't find a usable init.tcl in the following directories: \n\"\n\  
     append msg \"    $dirs\n\n\"\n\  
     append msg \"$errors\n\n\"\n\  
     append msg \"This probably means that Tcl wasn't installed properly.\n\"\n\  
     error $msg\n\  
   }\n\  
 }\n\  
 tclInit";  
   
   
 /*  
  * A pointer to a string that holds an initialization script that if non-NULL  
  * is evaluated in Tcl_Init() prior to the the built-in initialization script  
  * above.  This variable can be modified by the procedure below.  
  */  
   
 static char *          tclPreInitScript = NULL;  
   
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclSetPreInitScript --  
  *  
  *      This routine is used to change the value of the internal  
  *      variable, tclPreInitScript.  
  *  
  * Results:  
  *      Returns the current value of tclPreInitScript.  
  *  
  * Side effects:  
  *      Changes the way Tcl_Init() routine behaves.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 char *  
 TclSetPreInitScript (string)  
     char *string;               /* Pointer to a script. */  
 {  
     char *prevString = tclPreInitScript;  
     tclPreInitScript = string;  
     return(prevString);  
 }  
   
   
 /* $History: tclinitscript.h $  
  *  
  * *****************  Version 1  *****************  
  * User: Dtashley     Date: 1/02/01    Time: 1:29a  
  * Created in $/IjuScripter, IjuConsole/Source/Tcl Base  
  * Initial check-in.  
  */  
   
 /* End of TCLINITSCRIPT.H */  
1    /* $Header$ */
2    /*
3     * tclInitScript.h --
4     *
5     *      This file contains Unix & Windows common init script
6     *      It is not used on the Mac. (the mac init script is in tclMacInit.c)
7     *
8     * Copyright (c) 1998 Sun Microsystems, Inc.
9     * Copyright (c) 1999 by Scriptics Corporation.
10     * All rights reserved.
11     *
12     * RCS: @(#) $Id: tclinitscript.h,v 1.1.1.1 2001/06/13 04:39:33 dtashley Exp $
13     */
14    
15    /*
16     * In order to find init.tcl during initialization, the following script
17     * is invoked by Tcl_Init().  It looks in several different directories:
18     *
19     *      $tcl_library            - can specify a primary location, if set
20     *                                no other locations will be checked
21     *
22     *      $env(TCL_LIBRARY)       - highest priority so user can always override
23     *                                the search path unless the application has
24     *                                specified an exact directory above
25     *
26     *      $tclDefaultLibrary      - this value is initialized by TclPlatformInit
27     *                                from a static C variable that was set at
28     *                                compile time
29     *
30     *      $tcl_libPath            - this value is initialized by a call to
31     *                                TclGetLibraryPath called from Tcl_Init.
32     *
33     * The first directory on this path that contains a valid init.tcl script
34     * will be set as the value of tcl_library.
35     *
36     * Note that this entire search mechanism can be bypassed by defining an
37     * alternate tclInit procedure before calling Tcl_Init().
38     */
39    
40    static char initScript[] = "if {[info proc tclInit]==\"\"} {\n\
41      proc tclInit {} {\n\
42        global tcl_libPath tcl_library errorInfo\n\
43        global env tclDefaultLibrary\n\
44        rename tclInit {}\n\
45        set errors {}\n\
46        set dirs {}\n\
47        if {[info exists tcl_library]} {\n\
48            lappend dirs $tcl_library\n\
49        } else {\n\
50            if {[info exists env(TCL_LIBRARY)]} {\n\
51                lappend dirs $env(TCL_LIBRARY)\n\
52            }\n\
53            lappend dirs $tclDefaultLibrary\n\
54            unset tclDefaultLibrary\n\
55            set dirs [concat $dirs $tcl_libPath]\n\
56        }\n\
57        foreach i $dirs {\n\
58            set tcl_library $i\n\
59            set tclfile [file join $i init.tcl]\n\
60            if {[file exists $tclfile]} {\n\
61                if {![catch {uplevel #0 [list source $tclfile]} msg]} {\n\
62                    return\n\
63                } else {\n\
64                    append errors \"$tclfile: $msg\n$errorInfo\n\"\n\
65                }\n\
66            }\n\
67        }\n\
68        set msg \"Can't find a usable init.tcl in the following directories: \n\"\n\
69        append msg \"    $dirs\n\n\"\n\
70        append msg \"$errors\n\n\"\n\
71        append msg \"This probably means that Tcl wasn't installed properly.\n\"\n\
72        error $msg\n\
73      }\n\
74    }\n\
75    tclInit";
76    
77    
78    /*
79     * A pointer to a string that holds an initialization script that if non-NULL
80     * is evaluated in Tcl_Init() prior to the the built-in initialization script
81     * above.  This variable can be modified by the procedure below.
82     */
83    
84    static char *          tclPreInitScript = NULL;
85    
86    
87    /*
88     *----------------------------------------------------------------------
89     *
90     * TclSetPreInitScript --
91     *
92     *      This routine is used to change the value of the internal
93     *      variable, tclPreInitScript.
94     *
95     * Results:
96     *      Returns the current value of tclPreInitScript.
97     *
98     * Side effects:
99     *      Changes the way Tcl_Init() routine behaves.
100     *
101     *----------------------------------------------------------------------
102     */
103    
104    char *
105    TclSetPreInitScript (string)
106        char *string;               /* Pointer to a script. */
107    {
108        char *prevString = tclPreInitScript;
109        tclPreInitScript = string;
110        return(prevString);
111    }
112    
113    /* End of tclinitscript.h */
Legend:
Removed from v.42  
changed lines
  Added in v.98
dashley@gmail.com
 ViewVC Help
Powered by ViewVC 1.1.25