blob: 25ce3a9392c2abfe2e69600c191eedb51995352e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
/*
* 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)
* This file should only be included once in the entire set of C
* source files for Tcl (by the respective platform initialization
* C source file, tclUnixInit.c and tclWinInit.c) and thus the
* presence of the routine, TclSetPreInitScript, below, should be
* harmless.
*
* Copyright (c) 1998 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* RCS: @(#) $Id: tclInitScript.h,v 1.8 1998/10/23 22:22:15 welch 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
*
* <executable directory>/../lib/tcl$tcl_version
* - look for a lib/tcl<ver> in a sibling of
* the bin directory (e.g. install hierarchy)
*
* <executable directory>/../../lib/tcl$tcl_version
* - look for a lib/tcl<ver> in a sibling of
* the bin/arch directory
*
* <executable directory>/../library
* - look in build directory
*
* <executable directory>/../../library
* - look in build directory from unix/arch
*
* <executable directory>/../../tcl$tcl_patchLevel/library
* - look for tcl build directory relative
* to a parallel build directory (e.g. Tk)
*
* <executable directory>/../../../tcl$tcl_patchLevel/library
* - look for tcl build directory relative
* to a parallel build directory from
* down inside unix/arch directory
*
* 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_library tcl_version tcl_patchLevel 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 parentDir [file dirname [file dirname [info nameofexecutable]]]\n\
lappend dirs [file join $parentDir lib tcl$tcl_version]\n\
lappend dirs [file join [file dirname $parentDir] lib tcl$tcl_version]\n\
lappend dirs [file join $parentDir library]\n\
lappend dirs [file join [file dirname $parentDir] library]\n\
if {[string match {*[ab]*} $tcl_patchLevel]} {\n\
set ver $tcl_patchLevel\n\
} else {\n\
set ver $tcl_version\n\
}\n\
lappend dirs [file join [file dirname $parentDir] tcl$ver library]\n\
lappend dirs [file join [file dirname [file dirname $parentDir]] tcl$ver library]\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);
}
|
