sl@0
|
1 |
/*
|
sl@0
|
2 |
* tclMacInit.c --
|
sl@0
|
3 |
*
|
sl@0
|
4 |
* Contains the Mac-specific interpreter initialization functions.
|
sl@0
|
5 |
*
|
sl@0
|
6 |
* Copyright (c) 1995-1998 Sun Microsystems, Inc.
|
sl@0
|
7 |
*
|
sl@0
|
8 |
* See the file "license.terms" for information on usage and redistribution
|
sl@0
|
9 |
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
sl@0
|
10 |
*
|
sl@0
|
11 |
* RCS: @(#) $Id: tclMacInit.c,v 1.9.2.2 2005/10/23 22:01:31 msofer Exp $
|
sl@0
|
12 |
*/
|
sl@0
|
13 |
|
sl@0
|
14 |
#include <AppleEvents.h>
|
sl@0
|
15 |
#include <AEDataModel.h>
|
sl@0
|
16 |
#include <AEObjects.h>
|
sl@0
|
17 |
#include <AEPackObject.h>
|
sl@0
|
18 |
#include <AERegistry.h>
|
sl@0
|
19 |
#include <Files.h>
|
sl@0
|
20 |
#include <Folders.h>
|
sl@0
|
21 |
#include <Gestalt.h>
|
sl@0
|
22 |
#include <TextUtils.h>
|
sl@0
|
23 |
#include <Resources.h>
|
sl@0
|
24 |
#include <Strings.h>
|
sl@0
|
25 |
#include "tclInt.h"
|
sl@0
|
26 |
#include "tclMacInt.h"
|
sl@0
|
27 |
#include "tclPort.h"
|
sl@0
|
28 |
#include "tclInitScript.h"
|
sl@0
|
29 |
|
sl@0
|
30 |
/*
|
sl@0
|
31 |
* The following string is the startup script executed in new
|
sl@0
|
32 |
* interpreters. It looks on the library path and in the resource fork for
|
sl@0
|
33 |
* a script "init.tcl" that is compatible with this version of Tcl. The
|
sl@0
|
34 |
* init.tcl script does all of the real work of initialization.
|
sl@0
|
35 |
*/
|
sl@0
|
36 |
|
sl@0
|
37 |
static char initCmd[] = "if {[info proc tclInit]==\"\"} {\n\
|
sl@0
|
38 |
proc tclInit {} {\n\
|
sl@0
|
39 |
global tcl_pkgPath env\n\
|
sl@0
|
40 |
proc sourcePath {file} {\n\
|
sl@0
|
41 |
foreach i $::auto_path {\n\
|
sl@0
|
42 |
set init [file join $i $file.tcl]\n\
|
sl@0
|
43 |
if {[catch {uplevel #0 [list source $init]}] == 0} {\n\
|
sl@0
|
44 |
return\n\
|
sl@0
|
45 |
}\n\
|
sl@0
|
46 |
}\n\
|
sl@0
|
47 |
if {[catch {uplevel #0 [list source -rsrc $file]}] == 0} {\n\
|
sl@0
|
48 |
return\n\
|
sl@0
|
49 |
}\n\
|
sl@0
|
50 |
rename sourcePath {}\n\
|
sl@0
|
51 |
set msg \"Can't find $file resource or a usable $file.tcl file\"\n\
|
sl@0
|
52 |
append msg \" in the following directories:\"\n\
|
sl@0
|
53 |
append msg \" $::auto_path\"\n\
|
sl@0
|
54 |
append msg \" perhaps you need to install Tcl or set your\"\n\
|
sl@0
|
55 |
append msg \" TCL_LIBRARY environment variable?\"\n\
|
sl@0
|
56 |
error $msg\n\
|
sl@0
|
57 |
}\n\
|
sl@0
|
58 |
if {[info exists env(EXT_FOLDER)]} {\n\
|
sl@0
|
59 |
lappend tcl_pkgPath [file join $env(EXT_FOLDER) {Tool Command Language}]\n\
|
sl@0
|
60 |
}\n\
|
sl@0
|
61 |
if {[info exists tcl_pkgPath] == 0} {\n\
|
sl@0
|
62 |
set tcl_pkgPath {no extension folder}\n\
|
sl@0
|
63 |
}\n\
|
sl@0
|
64 |
sourcePath init\n\
|
sl@0
|
65 |
sourcePath auto\n\
|
sl@0
|
66 |
sourcePath package\n\
|
sl@0
|
67 |
sourcePath history\n\
|
sl@0
|
68 |
sourcePath word\n\
|
sl@0
|
69 |
sourcePath parray\n\
|
sl@0
|
70 |
rename sourcePath {}\n\
|
sl@0
|
71 |
} }\n\
|
sl@0
|
72 |
tclInit";
|
sl@0
|
73 |
|
sl@0
|
74 |
/*
|
sl@0
|
75 |
* The following structures are used to map the script/language codes of a
|
sl@0
|
76 |
* font to the name that should be passed to Tcl_GetEncoding() to obtain
|
sl@0
|
77 |
* the encoding for that font. The set of numeric constants is fixed and
|
sl@0
|
78 |
* defined by Apple.
|
sl@0
|
79 |
*/
|
sl@0
|
80 |
|
sl@0
|
81 |
typedef struct Map {
|
sl@0
|
82 |
int numKey;
|
sl@0
|
83 |
char *strKey;
|
sl@0
|
84 |
} Map;
|
sl@0
|
85 |
|
sl@0
|
86 |
static Map scriptMap[] = {
|
sl@0
|
87 |
{smRoman, "macRoman"},
|
sl@0
|
88 |
{smJapanese, "macJapan"},
|
sl@0
|
89 |
{smTradChinese, "macChinese"},
|
sl@0
|
90 |
{smKorean, "macKorean"},
|
sl@0
|
91 |
{smArabic, "macArabic"},
|
sl@0
|
92 |
{smHebrew, "macHebrew"},
|
sl@0
|
93 |
{smGreek, "macGreek"},
|
sl@0
|
94 |
{smCyrillic, "macCyrillic"},
|
sl@0
|
95 |
{smRSymbol, "macRSymbol"},
|
sl@0
|
96 |
{smDevanagari, "macDevanagari"},
|
sl@0
|
97 |
{smGurmukhi, "macGurmukhi"},
|
sl@0
|
98 |
{smGujarati, "macGujarati"},
|
sl@0
|
99 |
{smOriya, "macOriya"},
|
sl@0
|
100 |
{smBengali, "macBengali"},
|
sl@0
|
101 |
{smTamil, "macTamil"},
|
sl@0
|
102 |
{smTelugu, "macTelugu"},
|
sl@0
|
103 |
{smKannada, "macKannada"},
|
sl@0
|
104 |
{smMalayalam, "macMalayalam"},
|
sl@0
|
105 |
{smSinhalese, "macSinhalese"},
|
sl@0
|
106 |
{smBurmese, "macBurmese"},
|
sl@0
|
107 |
{smKhmer, "macKhmer"},
|
sl@0
|
108 |
{smThai, "macThailand"},
|
sl@0
|
109 |
{smLaotian, "macLaos"},
|
sl@0
|
110 |
{smGeorgian, "macGeorgia"},
|
sl@0
|
111 |
{smArmenian, "macArmenia"},
|
sl@0
|
112 |
{smSimpChinese, "macSimpChinese"},
|
sl@0
|
113 |
{smTibetan, "macTIbet"},
|
sl@0
|
114 |
{smMongolian, "macMongolia"},
|
sl@0
|
115 |
{smGeez, "macEthiopia"},
|
sl@0
|
116 |
{smEastEurRoman, "macCentEuro"},
|
sl@0
|
117 |
{smVietnamese, "macVietnam"},
|
sl@0
|
118 |
{smExtArabic, "macSindhi"},
|
sl@0
|
119 |
{NULL, NULL}
|
sl@0
|
120 |
};
|
sl@0
|
121 |
|
sl@0
|
122 |
static Map romanMap[] = {
|
sl@0
|
123 |
{langCroatian, "macCroatian"},
|
sl@0
|
124 |
{langSlovenian, "macCroatian"},
|
sl@0
|
125 |
{langIcelandic, "macIceland"},
|
sl@0
|
126 |
{langRomanian, "macRomania"},
|
sl@0
|
127 |
{langTurkish, "macTurkish"},
|
sl@0
|
128 |
{langGreek, "macGreek"},
|
sl@0
|
129 |
{NULL, NULL}
|
sl@0
|
130 |
};
|
sl@0
|
131 |
|
sl@0
|
132 |
static Map cyrillicMap[] = {
|
sl@0
|
133 |
{langUkrainian, "macUkraine"},
|
sl@0
|
134 |
{langBulgarian, "macBulgaria"},
|
sl@0
|
135 |
{NULL, NULL}
|
sl@0
|
136 |
};
|
sl@0
|
137 |
|
sl@0
|
138 |
static int GetFinderFont(int *finderID);
|
sl@0
|
139 |
|
sl@0
|
140 |
/* Used to store the encoding used for binary files */
|
sl@0
|
141 |
static Tcl_Encoding binaryEncoding = NULL;
|
sl@0
|
142 |
/* Has the basic library path encoding issue been fixed */
|
sl@0
|
143 |
static int libraryPathEncodingFixed = 0;
|
sl@0
|
144 |
|
sl@0
|
145 |
|
sl@0
|
146 |
/*
|
sl@0
|
147 |
*----------------------------------------------------------------------
|
sl@0
|
148 |
*
|
sl@0
|
149 |
* GetFinderFont --
|
sl@0
|
150 |
*
|
sl@0
|
151 |
* Gets the "views" font of the Macintosh Finder
|
sl@0
|
152 |
*
|
sl@0
|
153 |
* Results:
|
sl@0
|
154 |
* Standard Tcl result, and sets finderID to the font family
|
sl@0
|
155 |
* id for the current finder font.
|
sl@0
|
156 |
*
|
sl@0
|
157 |
* Side effects:
|
sl@0
|
158 |
* None.
|
sl@0
|
159 |
*
|
sl@0
|
160 |
*----------------------------------------------------------------------
|
sl@0
|
161 |
*/
|
sl@0
|
162 |
static int
|
sl@0
|
163 |
GetFinderFont(int *finderID)
|
sl@0
|
164 |
{
|
sl@0
|
165 |
OSErr err = noErr;
|
sl@0
|
166 |
OSType finderPrefs, viewFont = 'vfnt';
|
sl@0
|
167 |
DescType returnType;
|
sl@0
|
168 |
Size returnSize;
|
sl@0
|
169 |
long result, sys8Mask = 0x0800;
|
sl@0
|
170 |
static AppleEvent outgoingAevt = {typeNull, NULL};
|
sl@0
|
171 |
AppleEvent returnAevt;
|
sl@0
|
172 |
AEAddressDesc fndrAddress;
|
sl@0
|
173 |
AEDesc nullContainer = {typeNull, NULL},
|
sl@0
|
174 |
tempDesc = {typeNull, NULL},
|
sl@0
|
175 |
tempDesc2 = {typeNull, NULL},
|
sl@0
|
176 |
finalDesc = {typeNull, NULL};
|
sl@0
|
177 |
const OSType finderSignature = 'MACS';
|
sl@0
|
178 |
|
sl@0
|
179 |
|
sl@0
|
180 |
if (outgoingAevt.descriptorType == typeNull) {
|
sl@0
|
181 |
if ((Gestalt(gestaltSystemVersion, &result) != noErr)
|
sl@0
|
182 |
|| (result >= sys8Mask)) {
|
sl@0
|
183 |
finderPrefs = 'pfrp';
|
sl@0
|
184 |
} else {
|
sl@0
|
185 |
finderPrefs = 'pvwp';
|
sl@0
|
186 |
}
|
sl@0
|
187 |
|
sl@0
|
188 |
AECreateDesc(typeApplSignature, &finderSignature,
|
sl@0
|
189 |
sizeof(finderSignature), &fndrAddress);
|
sl@0
|
190 |
|
sl@0
|
191 |
err = AECreateAppleEvent(kAECoreSuite, kAEGetData, &fndrAddress,
|
sl@0
|
192 |
kAutoGenerateReturnID, kAnyTransactionID, &outgoingAevt);
|
sl@0
|
193 |
|
sl@0
|
194 |
AEDisposeDesc(&fndrAddress);
|
sl@0
|
195 |
|
sl@0
|
196 |
/*
|
sl@0
|
197 |
* The structure is:
|
sl@0
|
198 |
* the property view font ('vfnt')
|
sl@0
|
199 |
* of the property view preferences ('pvwp')
|
sl@0
|
200 |
* of the Null Container (i.e. the Finder itself).
|
sl@0
|
201 |
*/
|
sl@0
|
202 |
|
sl@0
|
203 |
AECreateDesc(typeType, &finderPrefs, sizeof(finderPrefs), &tempDesc);
|
sl@0
|
204 |
err = CreateObjSpecifier(typeType, &nullContainer, formPropertyID,
|
sl@0
|
205 |
&tempDesc, true, &tempDesc2);
|
sl@0
|
206 |
AECreateDesc(typeType, &viewFont, sizeof(viewFont), &tempDesc);
|
sl@0
|
207 |
err = CreateObjSpecifier(typeType, &tempDesc2, formPropertyID,
|
sl@0
|
208 |
&tempDesc, true, &finalDesc);
|
sl@0
|
209 |
|
sl@0
|
210 |
AEPutKeyDesc(&outgoingAevt, keyDirectObject, &finalDesc);
|
sl@0
|
211 |
AEDisposeDesc(&finalDesc);
|
sl@0
|
212 |
}
|
sl@0
|
213 |
|
sl@0
|
214 |
err = AESend(&outgoingAevt, &returnAevt, kAEWaitReply, kAEHighPriority,
|
sl@0
|
215 |
kAEDefaultTimeout, NULL, NULL);
|
sl@0
|
216 |
if (err == noErr) {
|
sl@0
|
217 |
err = AEGetKeyPtr(&returnAevt, keyDirectObject, typeInteger,
|
sl@0
|
218 |
&returnType, (void *) finderID, sizeof(int), &returnSize);
|
sl@0
|
219 |
if (err == noErr) {
|
sl@0
|
220 |
return TCL_OK;
|
sl@0
|
221 |
}
|
sl@0
|
222 |
}
|
sl@0
|
223 |
return TCL_ERROR;
|
sl@0
|
224 |
}
|
sl@0
|
225 |
|
sl@0
|
226 |
/*
|
sl@0
|
227 |
*---------------------------------------------------------------------------
|
sl@0
|
228 |
*
|
sl@0
|
229 |
* TclMacGetFontEncoding --
|
sl@0
|
230 |
*
|
sl@0
|
231 |
* Determine the encoding of the specified font. The encoding
|
sl@0
|
232 |
* can be used to convert bytes from UTF-8 into the encoding of
|
sl@0
|
233 |
* that font.
|
sl@0
|
234 |
*
|
sl@0
|
235 |
* Results:
|
sl@0
|
236 |
* The return value is a string that specifies the font's encoding
|
sl@0
|
237 |
* and that can be passed to Tcl_GetEncoding() to construct the
|
sl@0
|
238 |
* encoding. If the font's encoding could not be identified, NULL
|
sl@0
|
239 |
* is returned.
|
sl@0
|
240 |
*
|
sl@0
|
241 |
* Side effects:
|
sl@0
|
242 |
* None.
|
sl@0
|
243 |
*
|
sl@0
|
244 |
*---------------------------------------------------------------------------
|
sl@0
|
245 |
*/
|
sl@0
|
246 |
|
sl@0
|
247 |
char *
|
sl@0
|
248 |
TclMacGetFontEncoding(
|
sl@0
|
249 |
int fontId)
|
sl@0
|
250 |
{
|
sl@0
|
251 |
int script, lang;
|
sl@0
|
252 |
char *name;
|
sl@0
|
253 |
Map *mapPtr;
|
sl@0
|
254 |
|
sl@0
|
255 |
script = FontToScript(fontId);
|
sl@0
|
256 |
lang = GetScriptVariable(script, smScriptLang);
|
sl@0
|
257 |
name = NULL;
|
sl@0
|
258 |
if (script == smRoman) {
|
sl@0
|
259 |
for (mapPtr = romanMap; mapPtr->strKey != NULL; mapPtr++) {
|
sl@0
|
260 |
if (mapPtr->numKey == lang) {
|
sl@0
|
261 |
name = mapPtr->strKey;
|
sl@0
|
262 |
break;
|
sl@0
|
263 |
}
|
sl@0
|
264 |
}
|
sl@0
|
265 |
} else if (script == smCyrillic) {
|
sl@0
|
266 |
for (mapPtr = cyrillicMap; mapPtr->strKey != NULL; mapPtr++) {
|
sl@0
|
267 |
if (mapPtr->numKey == lang) {
|
sl@0
|
268 |
name = mapPtr->strKey;
|
sl@0
|
269 |
break;
|
sl@0
|
270 |
}
|
sl@0
|
271 |
}
|
sl@0
|
272 |
}
|
sl@0
|
273 |
if (name == NULL) {
|
sl@0
|
274 |
for (mapPtr = scriptMap; mapPtr->strKey != NULL; mapPtr++) {
|
sl@0
|
275 |
if (mapPtr->numKey == script) {
|
sl@0
|
276 |
name = mapPtr->strKey;
|
sl@0
|
277 |
break;
|
sl@0
|
278 |
}
|
sl@0
|
279 |
}
|
sl@0
|
280 |
}
|
sl@0
|
281 |
return name;
|
sl@0
|
282 |
}
|
sl@0
|
283 |
|
sl@0
|
284 |
/*
|
sl@0
|
285 |
*---------------------------------------------------------------------------
|
sl@0
|
286 |
*
|
sl@0
|
287 |
* TclpInitPlatform --
|
sl@0
|
288 |
*
|
sl@0
|
289 |
* Initialize all the platform-dependant things like signals and
|
sl@0
|
290 |
* floating-point error handling.
|
sl@0
|
291 |
*
|
sl@0
|
292 |
* Called at process initialization time.
|
sl@0
|
293 |
*
|
sl@0
|
294 |
* Results:
|
sl@0
|
295 |
* None.
|
sl@0
|
296 |
*
|
sl@0
|
297 |
* Side effects:
|
sl@0
|
298 |
* None.
|
sl@0
|
299 |
*
|
sl@0
|
300 |
*---------------------------------------------------------------------------
|
sl@0
|
301 |
*/
|
sl@0
|
302 |
|
sl@0
|
303 |
void
|
sl@0
|
304 |
TclpInitPlatform()
|
sl@0
|
305 |
{
|
sl@0
|
306 |
tclPlatform = TCL_PLATFORM_MAC;
|
sl@0
|
307 |
}
|
sl@0
|
308 |
|
sl@0
|
309 |
/*
|
sl@0
|
310 |
*---------------------------------------------------------------------------
|
sl@0
|
311 |
*
|
sl@0
|
312 |
* TclpInitLibraryPath --
|
sl@0
|
313 |
*
|
sl@0
|
314 |
* Initialize the library path at startup. We have a minor
|
sl@0
|
315 |
* metacircular problem that we don't know the encoding of the
|
sl@0
|
316 |
* operating system but we may need to talk to operating system
|
sl@0
|
317 |
* to find the library directories so that we know how to talk to
|
sl@0
|
318 |
* the operating system.
|
sl@0
|
319 |
*
|
sl@0
|
320 |
* We do not know the encoding of the operating system.
|
sl@0
|
321 |
* We do know that the encoding is some multibyte encoding.
|
sl@0
|
322 |
* In that multibyte encoding, the characters 0..127 are equivalent
|
sl@0
|
323 |
* to ascii.
|
sl@0
|
324 |
*
|
sl@0
|
325 |
* So although we don't know the encoding, it's safe:
|
sl@0
|
326 |
* to look for the last colon character in a path in the encoding.
|
sl@0
|
327 |
* to append an ascii string to a path.
|
sl@0
|
328 |
* to pass those strings back to the operating system.
|
sl@0
|
329 |
*
|
sl@0
|
330 |
* But any strings that we remembered before we knew the encoding of
|
sl@0
|
331 |
* the operating system must be translated to UTF-8 once we know the
|
sl@0
|
332 |
* encoding so that the rest of Tcl can use those strings.
|
sl@0
|
333 |
*
|
sl@0
|
334 |
* This call sets the library path to strings in the unknown native
|
sl@0
|
335 |
* encoding. TclpSetInitialEncodings() will translate the library
|
sl@0
|
336 |
* path from the native encoding to UTF-8 as soon as it determines
|
sl@0
|
337 |
* what the native encoding actually is.
|
sl@0
|
338 |
*
|
sl@0
|
339 |
* Called at process initialization time.
|
sl@0
|
340 |
*
|
sl@0
|
341 |
* Results:
|
sl@0
|
342 |
* Return 1, indicating that the UTF may be dirty and require "cleanup"
|
sl@0
|
343 |
* after encodings are initialized.
|
sl@0
|
344 |
*
|
sl@0
|
345 |
* Side effects:
|
sl@0
|
346 |
* None.
|
sl@0
|
347 |
*
|
sl@0
|
348 |
*---------------------------------------------------------------------------
|
sl@0
|
349 |
*/
|
sl@0
|
350 |
|
sl@0
|
351 |
int
|
sl@0
|
352 |
TclpInitLibraryPath(argv0)
|
sl@0
|
353 |
CONST char *argv0; /* Name of executable from argv[0] to main().
|
sl@0
|
354 |
* Not used because we can determine the name
|
sl@0
|
355 |
* by querying the module handle. */
|
sl@0
|
356 |
{
|
sl@0
|
357 |
Tcl_Obj *objPtr, *pathPtr;
|
sl@0
|
358 |
CONST char *str;
|
sl@0
|
359 |
Tcl_DString ds;
|
sl@0
|
360 |
|
sl@0
|
361 |
TclMacCreateEnv();
|
sl@0
|
362 |
|
sl@0
|
363 |
pathPtr = Tcl_NewObj();
|
sl@0
|
364 |
|
sl@0
|
365 |
/*
|
sl@0
|
366 |
* Look for the library relative to default encoding dir.
|
sl@0
|
367 |
*/
|
sl@0
|
368 |
|
sl@0
|
369 |
str = Tcl_GetDefaultEncodingDir();
|
sl@0
|
370 |
if ((str != NULL) && (str[0] != '\0')) {
|
sl@0
|
371 |
objPtr = Tcl_NewStringObj(str, -1);
|
sl@0
|
372 |
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
|
sl@0
|
373 |
}
|
sl@0
|
374 |
|
sl@0
|
375 |
str = TclGetEnv("TCL_LIBRARY", &ds);
|
sl@0
|
376 |
if ((str != NULL) && (str[0] != '\0')) {
|
sl@0
|
377 |
/*
|
sl@0
|
378 |
* If TCL_LIBRARY is set, search there.
|
sl@0
|
379 |
*/
|
sl@0
|
380 |
|
sl@0
|
381 |
objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
|
sl@0
|
382 |
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
|
sl@0
|
383 |
Tcl_DStringFree(&ds);
|
sl@0
|
384 |
}
|
sl@0
|
385 |
|
sl@0
|
386 |
objPtr = TclGetLibraryPath();
|
sl@0
|
387 |
if (objPtr != NULL) {
|
sl@0
|
388 |
Tcl_ListObjAppendList(NULL, pathPtr, objPtr);
|
sl@0
|
389 |
}
|
sl@0
|
390 |
|
sl@0
|
391 |
/*
|
sl@0
|
392 |
* lappend path [file join $env(EXT_FOLDER) \
|
sl@0
|
393 |
* "Tool Command Language" "tcl[info version]"
|
sl@0
|
394 |
*/
|
sl@0
|
395 |
|
sl@0
|
396 |
str = TclGetEnv("EXT_FOLDER", &ds);
|
sl@0
|
397 |
if ((str != NULL) && (str[0] != '\0')) {
|
sl@0
|
398 |
Tcl_DString libPath, path;
|
sl@0
|
399 |
CONST char *argv[3];
|
sl@0
|
400 |
|
sl@0
|
401 |
argv[0] = str;
|
sl@0
|
402 |
argv[1] = "Tool Command Language";
|
sl@0
|
403 |
Tcl_DStringInit(&libPath);
|
sl@0
|
404 |
Tcl_DStringAppend(&libPath, "tcl", -1);
|
sl@0
|
405 |
argv[2] = Tcl_DStringAppend(&libPath, TCL_VERSION, -1);
|
sl@0
|
406 |
Tcl_DStringInit(&path);
|
sl@0
|
407 |
str = Tcl_JoinPath(3, argv, &path);
|
sl@0
|
408 |
objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&path));
|
sl@0
|
409 |
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
|
sl@0
|
410 |
Tcl_DStringFree(&ds);
|
sl@0
|
411 |
Tcl_DStringFree(&libPath);
|
sl@0
|
412 |
Tcl_DStringFree(&path);
|
sl@0
|
413 |
}
|
sl@0
|
414 |
TclSetLibraryPath(pathPtr);
|
sl@0
|
415 |
|
sl@0
|
416 |
return 1; /* 1 indicates that pathPtr may be dirty utf (needs cleaning) */
|
sl@0
|
417 |
}
|
sl@0
|
418 |
|
sl@0
|
419 |
/*
|
sl@0
|
420 |
*---------------------------------------------------------------------------
|
sl@0
|
421 |
*
|
sl@0
|
422 |
* TclpSetInitialEncodings --
|
sl@0
|
423 |
*
|
sl@0
|
424 |
* Based on the locale, determine the encoding of the operating
|
sl@0
|
425 |
* system and the default encoding for newly opened files.
|
sl@0
|
426 |
*
|
sl@0
|
427 |
* Called at process initialization time, and part way through
|
sl@0
|
428 |
* startup, we verify that the initial encodings were correctly
|
sl@0
|
429 |
* setup. Depending on Tcl's environment, there may not have been
|
sl@0
|
430 |
* enough information first time through (above).
|
sl@0
|
431 |
*
|
sl@0
|
432 |
* Results:
|
sl@0
|
433 |
* None.
|
sl@0
|
434 |
*
|
sl@0
|
435 |
* Side effects:
|
sl@0
|
436 |
* The Tcl library path is converted from native encoding to UTF-8,
|
sl@0
|
437 |
* on the first call, and the encodings may be changed on first or
|
sl@0
|
438 |
* second call.
|
sl@0
|
439 |
*
|
sl@0
|
440 |
*---------------------------------------------------------------------------
|
sl@0
|
441 |
*/
|
sl@0
|
442 |
|
sl@0
|
443 |
void
|
sl@0
|
444 |
TclpSetInitialEncodings()
|
sl@0
|
445 |
{
|
sl@0
|
446 |
CONST char *encoding;
|
sl@0
|
447 |
Tcl_Obj *pathPtr;
|
sl@0
|
448 |
int fontId, err;
|
sl@0
|
449 |
|
sl@0
|
450 |
fontId = 0;
|
sl@0
|
451 |
GetFinderFont(&fontId);
|
sl@0
|
452 |
encoding = TclMacGetFontEncoding(fontId);
|
sl@0
|
453 |
if (encoding == NULL) {
|
sl@0
|
454 |
encoding = "macRoman";
|
sl@0
|
455 |
}
|
sl@0
|
456 |
|
sl@0
|
457 |
err = Tcl_SetSystemEncoding(NULL, encoding);
|
sl@0
|
458 |
|
sl@0
|
459 |
if (err == TCL_OK && libraryPathEncodingFixed == 0) {
|
sl@0
|
460 |
|
sl@0
|
461 |
/*
|
sl@0
|
462 |
* Until the system encoding was actually set, the library path was
|
sl@0
|
463 |
* actually in the native multi-byte encoding, and not really UTF-8
|
sl@0
|
464 |
* as advertised. We cheated as follows:
|
sl@0
|
465 |
*
|
sl@0
|
466 |
* 1. It was safe to allow the Tcl_SetSystemEncoding() call to
|
sl@0
|
467 |
* append the ASCII chars that make up the encoding's filename to
|
sl@0
|
468 |
* the names (in the native encoding) of directories in the library
|
sl@0
|
469 |
* path, since all Unix multi-byte encodings have ASCII in the
|
sl@0
|
470 |
* beginning.
|
sl@0
|
471 |
*
|
sl@0
|
472 |
* 2. To open the encoding file, the native bytes in the file name
|
sl@0
|
473 |
* were passed to the OS, without translating from UTF-8 to native,
|
sl@0
|
474 |
* because the name was already in the native encoding.
|
sl@0
|
475 |
*
|
sl@0
|
476 |
* Now that the system encoding was actually successfully set,
|
sl@0
|
477 |
* translate all the names in the library path to UTF-8. That way,
|
sl@0
|
478 |
* next time we search the library path, we'll translate the names
|
sl@0
|
479 |
* from UTF-8 to the system encoding which will be the native
|
sl@0
|
480 |
* encoding.
|
sl@0
|
481 |
*/
|
sl@0
|
482 |
|
sl@0
|
483 |
pathPtr = TclGetLibraryPath();
|
sl@0
|
484 |
if (pathPtr != NULL) {
|
sl@0
|
485 |
int i, objc;
|
sl@0
|
486 |
Tcl_Obj **objv;
|
sl@0
|
487 |
|
sl@0
|
488 |
objc = 0;
|
sl@0
|
489 |
Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
|
sl@0
|
490 |
for (i = 0; i < objc; i++) {
|
sl@0
|
491 |
int length;
|
sl@0
|
492 |
char *string;
|
sl@0
|
493 |
Tcl_DString ds;
|
sl@0
|
494 |
|
sl@0
|
495 |
string = Tcl_GetStringFromObj(objv[i], &length);
|
sl@0
|
496 |
Tcl_ExternalToUtfDString(NULL, string, length, &ds);
|
sl@0
|
497 |
Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds),
|
sl@0
|
498 |
Tcl_DStringLength(&ds));
|
sl@0
|
499 |
Tcl_DStringFree(&ds);
|
sl@0
|
500 |
}
|
sl@0
|
501 |
Tcl_InvalidateStringRep(pathPtr);
|
sl@0
|
502 |
}
|
sl@0
|
503 |
libraryPathEncodingFixed = 1;
|
sl@0
|
504 |
}
|
sl@0
|
505 |
|
sl@0
|
506 |
/* This is only ever called from the startup thread */
|
sl@0
|
507 |
if (binaryEncoding == NULL) {
|
sl@0
|
508 |
/*
|
sl@0
|
509 |
* Keep the iso8859-1 encoding preloaded. The IO package uses
|
sl@0
|
510 |
* it for gets on a binary channel.
|
sl@0
|
511 |
*/
|
sl@0
|
512 |
binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
|
sl@0
|
513 |
}
|
sl@0
|
514 |
}
|
sl@0
|
515 |
|
sl@0
|
516 |
/*
|
sl@0
|
517 |
*---------------------------------------------------------------------------
|
sl@0
|
518 |
*
|
sl@0
|
519 |
* TclpSetVariables --
|
sl@0
|
520 |
*
|
sl@0
|
521 |
* Performs platform-specific interpreter initialization related to
|
sl@0
|
522 |
* the tcl_library and tcl_platform variables, and other platform-
|
sl@0
|
523 |
* specific things.
|
sl@0
|
524 |
*
|
sl@0
|
525 |
* Results:
|
sl@0
|
526 |
* None.
|
sl@0
|
527 |
*
|
sl@0
|
528 |
* Side effects:
|
sl@0
|
529 |
* Sets "tcl_library" and "tcl_platform" Tcl variables.
|
sl@0
|
530 |
*
|
sl@0
|
531 |
*----------------------------------------------------------------------
|
sl@0
|
532 |
*/
|
sl@0
|
533 |
|
sl@0
|
534 |
void
|
sl@0
|
535 |
TclpSetVariables(interp)
|
sl@0
|
536 |
Tcl_Interp *interp;
|
sl@0
|
537 |
{
|
sl@0
|
538 |
long int gestaltResult;
|
sl@0
|
539 |
int minor, major, objc;
|
sl@0
|
540 |
Tcl_Obj **objv;
|
sl@0
|
541 |
char versStr[2 * TCL_INTEGER_SPACE];
|
sl@0
|
542 |
CONST char *str;
|
sl@0
|
543 |
Tcl_Obj *pathPtr;
|
sl@0
|
544 |
Tcl_DString ds;
|
sl@0
|
545 |
|
sl@0
|
546 |
str = "no library";
|
sl@0
|
547 |
pathPtr = TclGetLibraryPath();
|
sl@0
|
548 |
if (pathPtr != NULL) {
|
sl@0
|
549 |
objc = 0;
|
sl@0
|
550 |
Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
|
sl@0
|
551 |
if (objc > 0) {
|
sl@0
|
552 |
str = Tcl_GetStringFromObj(objv[0], NULL);
|
sl@0
|
553 |
}
|
sl@0
|
554 |
}
|
sl@0
|
555 |
Tcl_SetVar(interp, "tcl_library", str, TCL_GLOBAL_ONLY);
|
sl@0
|
556 |
|
sl@0
|
557 |
if (pathPtr != NULL) {
|
sl@0
|
558 |
Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, pathPtr, TCL_GLOBAL_ONLY);
|
sl@0
|
559 |
}
|
sl@0
|
560 |
|
sl@0
|
561 |
Tcl_SetVar2(interp, "tcl_platform", "platform", "macintosh",
|
sl@0
|
562 |
TCL_GLOBAL_ONLY);
|
sl@0
|
563 |
Tcl_SetVar2(interp, "tcl_platform", "os", "MacOS", TCL_GLOBAL_ONLY);
|
sl@0
|
564 |
Gestalt(gestaltSystemVersion, &gestaltResult);
|
sl@0
|
565 |
major = (gestaltResult & 0x0000FF00) >> 8;
|
sl@0
|
566 |
minor = (gestaltResult & 0x000000F0) >> 4;
|
sl@0
|
567 |
sprintf(versStr, "%d.%d", major, minor);
|
sl@0
|
568 |
Tcl_SetVar2(interp, "tcl_platform", "osVersion", versStr, TCL_GLOBAL_ONLY);
|
sl@0
|
569 |
#if GENERATINGPOWERPC
|
sl@0
|
570 |
Tcl_SetVar2(interp, "tcl_platform", "machine", "ppc", TCL_GLOBAL_ONLY);
|
sl@0
|
571 |
#else
|
sl@0
|
572 |
Tcl_SetVar2(interp, "tcl_platform", "machine", "68k", TCL_GLOBAL_ONLY);
|
sl@0
|
573 |
#endif
|
sl@0
|
574 |
|
sl@0
|
575 |
/*
|
sl@0
|
576 |
* Copy USER or LOGIN environment variable into tcl_platform(user)
|
sl@0
|
577 |
* These are set by SystemVariables in tclMacEnv.c
|
sl@0
|
578 |
*/
|
sl@0
|
579 |
|
sl@0
|
580 |
Tcl_DStringInit(&ds);
|
sl@0
|
581 |
str = TclGetEnv("USER", &ds);
|
sl@0
|
582 |
if (str == NULL) {
|
sl@0
|
583 |
str = TclGetEnv("LOGIN", &ds);
|
sl@0
|
584 |
if (str == NULL) {
|
sl@0
|
585 |
str = "";
|
sl@0
|
586 |
}
|
sl@0
|
587 |
}
|
sl@0
|
588 |
Tcl_SetVar2(interp, "tcl_platform", "user", str, TCL_GLOBAL_ONLY);
|
sl@0
|
589 |
Tcl_DStringFree(&ds);
|
sl@0
|
590 |
}
|
sl@0
|
591 |
|
sl@0
|
592 |
/*
|
sl@0
|
593 |
*----------------------------------------------------------------------
|
sl@0
|
594 |
*
|
sl@0
|
595 |
* TclpCheckStackSpace --
|
sl@0
|
596 |
*
|
sl@0
|
597 |
* On a 68K Mac, we can detect if we are about to blow the stack.
|
sl@0
|
598 |
* Called before an evaluation can happen when nesting depth is
|
sl@0
|
599 |
* checked.
|
sl@0
|
600 |
*
|
sl@0
|
601 |
* Results:
|
sl@0
|
602 |
* 1 if there is enough stack space to continue; 0 if not.
|
sl@0
|
603 |
*
|
sl@0
|
604 |
* Side effects:
|
sl@0
|
605 |
* None.
|
sl@0
|
606 |
*
|
sl@0
|
607 |
*----------------------------------------------------------------------
|
sl@0
|
608 |
*/
|
sl@0
|
609 |
|
sl@0
|
610 |
int
|
sl@0
|
611 |
TclpCheckStackSpace()
|
sl@0
|
612 |
{
|
sl@0
|
613 |
return StackSpace() > TCL_MAC_STACK_THRESHOLD;
|
sl@0
|
614 |
}
|
sl@0
|
615 |
|
sl@0
|
616 |
/*
|
sl@0
|
617 |
*----------------------------------------------------------------------
|
sl@0
|
618 |
*
|
sl@0
|
619 |
* TclpFindVariable --
|
sl@0
|
620 |
*
|
sl@0
|
621 |
* Locate the entry in environ for a given name. On Unix and Macthis
|
sl@0
|
622 |
* routine is case sensitive, on Windows this matches mixed case.
|
sl@0
|
623 |
*
|
sl@0
|
624 |
* Results:
|
sl@0
|
625 |
* The return value is the index in environ of an entry with the
|
sl@0
|
626 |
* name "name", or -1 if there is no such entry. The integer at
|
sl@0
|
627 |
* *lengthPtr is filled in with the length of name (if a matching
|
sl@0
|
628 |
* entry is found) or the length of the environ array (if no matching
|
sl@0
|
629 |
* entry is found).
|
sl@0
|
630 |
*
|
sl@0
|
631 |
* Side effects:
|
sl@0
|
632 |
* None.
|
sl@0
|
633 |
*
|
sl@0
|
634 |
*----------------------------------------------------------------------
|
sl@0
|
635 |
*/
|
sl@0
|
636 |
|
sl@0
|
637 |
int
|
sl@0
|
638 |
TclpFindVariable(name, lengthPtr)
|
sl@0
|
639 |
CONST char *name; /* Name of desired environment variable
|
sl@0
|
640 |
* (native). */
|
sl@0
|
641 |
int *lengthPtr; /* Used to return length of name (for
|
sl@0
|
642 |
* successful searches) or number of non-NULL
|
sl@0
|
643 |
* entries in environ (for unsuccessful
|
sl@0
|
644 |
* searches). */
|
sl@0
|
645 |
{
|
sl@0
|
646 |
int i, result = -1;
|
sl@0
|
647 |
register CONST char *env, *p1, *p2;
|
sl@0
|
648 |
Tcl_DString envString;
|
sl@0
|
649 |
|
sl@0
|
650 |
Tcl_DStringInit(&envString);
|
sl@0
|
651 |
for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
|
sl@0
|
652 |
p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
|
sl@0
|
653 |
p2 = name;
|
sl@0
|
654 |
|
sl@0
|
655 |
for (; *p2 == *p1; p1++, p2++) {
|
sl@0
|
656 |
/* NULL loop body. */
|
sl@0
|
657 |
}
|
sl@0
|
658 |
if ((*p1 == '=') && (*p2 == '\0')) {
|
sl@0
|
659 |
*lengthPtr = p2 - name;
|
sl@0
|
660 |
result = i;
|
sl@0
|
661 |
goto done;
|
sl@0
|
662 |
}
|
sl@0
|
663 |
|
sl@0
|
664 |
Tcl_DStringFree(&envString);
|
sl@0
|
665 |
}
|
sl@0
|
666 |
|
sl@0
|
667 |
*lengthPtr = i;
|
sl@0
|
668 |
|
sl@0
|
669 |
done:
|
sl@0
|
670 |
Tcl_DStringFree(&envString);
|
sl@0
|
671 |
return result;
|
sl@0
|
672 |
}
|
sl@0
|
673 |
|
sl@0
|
674 |
/*
|
sl@0
|
675 |
*----------------------------------------------------------------------
|
sl@0
|
676 |
*
|
sl@0
|
677 |
* Tcl_Init --
|
sl@0
|
678 |
*
|
sl@0
|
679 |
* This procedure is typically invoked by Tcl_AppInit procedures
|
sl@0
|
680 |
* to perform additional initialization for a Tcl interpreter,
|
sl@0
|
681 |
* such as sourcing the "init.tcl" script.
|
sl@0
|
682 |
*
|
sl@0
|
683 |
* Results:
|
sl@0
|
684 |
* Returns a standard Tcl completion code and sets the interp's result
|
sl@0
|
685 |
* if there is an error.
|
sl@0
|
686 |
*
|
sl@0
|
687 |
* Side effects:
|
sl@0
|
688 |
* Depends on what's in the init.tcl script.
|
sl@0
|
689 |
*
|
sl@0
|
690 |
*----------------------------------------------------------------------
|
sl@0
|
691 |
*/
|
sl@0
|
692 |
|
sl@0
|
693 |
int
|
sl@0
|
694 |
Tcl_Init(
|
sl@0
|
695 |
Tcl_Interp *interp) /* Interpreter to initialize. */
|
sl@0
|
696 |
{
|
sl@0
|
697 |
Tcl_Obj *pathPtr;
|
sl@0
|
698 |
|
sl@0
|
699 |
if (tclPreInitScript != NULL) {
|
sl@0
|
700 |
if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
|
sl@0
|
701 |
return (TCL_ERROR);
|
sl@0
|
702 |
};
|
sl@0
|
703 |
}
|
sl@0
|
704 |
|
sl@0
|
705 |
/*
|
sl@0
|
706 |
* For Macintosh applications the Init function may be contained in
|
sl@0
|
707 |
* the application resources. If it exists we use it - otherwise we
|
sl@0
|
708 |
* look in the tcl_library directory. Ditto for the history command.
|
sl@0
|
709 |
*/
|
sl@0
|
710 |
|
sl@0
|
711 |
pathPtr = TclGetLibraryPath();
|
sl@0
|
712 |
if (pathPtr == NULL) {
|
sl@0
|
713 |
pathPtr = Tcl_NewObj();
|
sl@0
|
714 |
}
|
sl@0
|
715 |
Tcl_IncrRefCount(pathPtr);
|
sl@0
|
716 |
Tcl_SetVar2Ex(interp, "auto_path", NULL, pathPtr, TCL_GLOBAL_ONLY);
|
sl@0
|
717 |
Tcl_DecrRefCount(pathPtr);
|
sl@0
|
718 |
return Tcl_Eval(interp, initCmd);
|
sl@0
|
719 |
}
|
sl@0
|
720 |
|
sl@0
|
721 |
/*
|
sl@0
|
722 |
*----------------------------------------------------------------------
|
sl@0
|
723 |
*
|
sl@0
|
724 |
* Tcl_SourceRCFile --
|
sl@0
|
725 |
*
|
sl@0
|
726 |
* This procedure is typically invoked by Tcl_Main or Tk_Main
|
sl@0
|
727 |
* procedure to source an application specific rc file into the
|
sl@0
|
728 |
* interpreter at startup time. This will either source a file
|
sl@0
|
729 |
* in the "tcl_rcFileName" variable or a TEXT resource in the
|
sl@0
|
730 |
* "tcl_rcRsrcName" variable.
|
sl@0
|
731 |
*
|
sl@0
|
732 |
* Results:
|
sl@0
|
733 |
* None.
|
sl@0
|
734 |
*
|
sl@0
|
735 |
* Side effects:
|
sl@0
|
736 |
* Depends on what's in the rc script.
|
sl@0
|
737 |
*
|
sl@0
|
738 |
*----------------------------------------------------------------------
|
sl@0
|
739 |
*/
|
sl@0
|
740 |
|
sl@0
|
741 |
void
|
sl@0
|
742 |
Tcl_SourceRCFile(
|
sl@0
|
743 |
Tcl_Interp *interp) /* Interpreter to source rc file into. */
|
sl@0
|
744 |
{
|
sl@0
|
745 |
Tcl_DString temp;
|
sl@0
|
746 |
CONST char *fileName;
|
sl@0
|
747 |
Tcl_Channel errChannel;
|
sl@0
|
748 |
Handle h;
|
sl@0
|
749 |
|
sl@0
|
750 |
fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
|
sl@0
|
751 |
|
sl@0
|
752 |
if (fileName != NULL) {
|
sl@0
|
753 |
Tcl_Channel c;
|
sl@0
|
754 |
CONST char *fullName;
|
sl@0
|
755 |
|
sl@0
|
756 |
Tcl_DStringInit(&temp);
|
sl@0
|
757 |
fullName = Tcl_TranslateFileName(interp, fileName, &temp);
|
sl@0
|
758 |
if (fullName == NULL) {
|
sl@0
|
759 |
/*
|
sl@0
|
760 |
* Couldn't translate the file name (e.g. it referred to a
|
sl@0
|
761 |
* bogus user or there was no HOME environment variable).
|
sl@0
|
762 |
* Just do nothing.
|
sl@0
|
763 |
*/
|
sl@0
|
764 |
} else {
|
sl@0
|
765 |
|
sl@0
|
766 |
/*
|
sl@0
|
767 |
* Test for the existence of the rc file before trying to read it.
|
sl@0
|
768 |
*/
|
sl@0
|
769 |
|
sl@0
|
770 |
c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
|
sl@0
|
771 |
if (c != (Tcl_Channel) NULL) {
|
sl@0
|
772 |
Tcl_Close(NULL, c);
|
sl@0
|
773 |
if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
|
sl@0
|
774 |
errChannel = Tcl_GetStdChannel(TCL_STDERR);
|
sl@0
|
775 |
if (errChannel) {
|
sl@0
|
776 |
Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
|
sl@0
|
777 |
Tcl_WriteChars(errChannel, "\n", 1);
|
sl@0
|
778 |
}
|
sl@0
|
779 |
}
|
sl@0
|
780 |
}
|
sl@0
|
781 |
}
|
sl@0
|
782 |
Tcl_DStringFree(&temp);
|
sl@0
|
783 |
}
|
sl@0
|
784 |
|
sl@0
|
785 |
fileName = Tcl_GetVar(interp, "tcl_rcRsrcName", TCL_GLOBAL_ONLY);
|
sl@0
|
786 |
|
sl@0
|
787 |
if (fileName != NULL) {
|
sl@0
|
788 |
Str255 rezName;
|
sl@0
|
789 |
Tcl_DString ds;
|
sl@0
|
790 |
Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
|
sl@0
|
791 |
strcpy((char *) rezName + 1, Tcl_DStringValue(&ds));
|
sl@0
|
792 |
rezName[0] = (unsigned) Tcl_DStringLength(&ds);
|
sl@0
|
793 |
h = GetNamedResource('TEXT', rezName);
|
sl@0
|
794 |
Tcl_DStringFree(&ds);
|
sl@0
|
795 |
if (h != NULL) {
|
sl@0
|
796 |
if (Tcl_MacEvalResource(interp, fileName, 0, NULL) != TCL_OK) {
|
sl@0
|
797 |
errChannel = Tcl_GetStdChannel(TCL_STDERR);
|
sl@0
|
798 |
if (errChannel) {
|
sl@0
|
799 |
Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
|
sl@0
|
800 |
Tcl_WriteChars(errChannel, "\n", 1);
|
sl@0
|
801 |
}
|
sl@0
|
802 |
}
|
sl@0
|
803 |
Tcl_ResetResult(interp);
|
sl@0
|
804 |
ReleaseResource(h);
|
sl@0
|
805 |
}
|
sl@0
|
806 |
}
|
sl@0
|
807 |
}
|