/[dtapublic]/projs/trunk/shared_source/tcl_base/tclwininit.c
ViewVC logotype

Contents of /projs/trunk/shared_source/tcl_base/tclwininit.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 29 - (show annotations) (download)
Sat Oct 8 07:08:47 2016 UTC (7 years, 5 months ago) by dashley
Original Path: to_be_filed/sf_code/esrgpcpj/shared/tcl_base/tclwininit.c
File MIME type: text/plain
File size: 23360 byte(s)
Directories relocated.
1 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclwininit.c,v 1.1.1.1 2001/06/13 04:49:17 dtashley Exp $ */
2
3 /*
4 * tclWinInit.c --
5 *
6 * Contains the Windows-specific interpreter initialization functions.
7 *
8 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
9 * Copyright (c) 1998-1999 by Scriptics Corporation.
10 * All rights reserved.
11 *
12 * RCS: @(#) $Id: tclwininit.c,v 1.1.1.1 2001/06/13 04:49:17 dtashley Exp $
13 */
14
15 #include "tclWinInt.h"
16 #include <winreg.h>
17 #include <winnt.h>
18 #include <winbase.h>
19
20 /*
21 * The following macro can be defined at compile time to specify
22 * the root of the Tcl registry keys.
23 */
24
25 #ifndef TCL_REGISTRY_KEY
26 #define TCL_REGISTRY_KEY "Software\\Scriptics\\Tcl\\" TCL_VERSION
27 #endif
28
29 /*
30 * The following declaration is a workaround for some Microsoft brain damage.
31 * The SYSTEM_INFO structure is different in various releases, even though the
32 * layout is the same. So we overlay our own structure on top of it so we
33 * can access the interesting slots in a uniform way.
34 */
35
36 typedef struct {
37 WORD wProcessorArchitecture;
38 WORD wReserved;
39 } OemId;
40
41 /*
42 * The following macros are missing from some versions of winnt.h.
43 */
44
45 #ifndef PROCESSOR_ARCHITECTURE_INTEL
46 #define PROCESSOR_ARCHITECTURE_INTEL 0
47 #endif
48 #ifndef PROCESSOR_ARCHITECTURE_MIPS
49 #define PROCESSOR_ARCHITECTURE_MIPS 1
50 #endif
51 #ifndef PROCESSOR_ARCHITECTURE_ALPHA
52 #define PROCESSOR_ARCHITECTURE_ALPHA 2
53 #endif
54 #ifndef PROCESSOR_ARCHITECTURE_PPC
55 #define PROCESSOR_ARCHITECTURE_PPC 3
56 #endif
57 #ifndef PROCESSOR_ARCHITECTURE_UNKNOWN
58 #define PROCESSOR_ARCHITECTURE_UNKNOWN 0xFFFF
59 #endif
60
61 /*
62 * The following arrays contain the human readable strings for the Windows
63 * platform and processor values.
64 */
65
66
67 #define NUMPLATFORMS 3
68 static char* platforms[NUMPLATFORMS] = {
69 "Win32s", "Windows 95", "Windows NT"
70 };
71
72 #define NUMPROCESSORS 4
73 static char* processors[NUMPROCESSORS] = {
74 "intel", "mips", "alpha", "ppc"
75 };
76
77 /*
78 * Thread id used for asynchronous notification from signal handlers.
79 */
80
81 static DWORD mainThreadId;
82
83 /*
84 * The Init script (common to Windows and Unix platforms) is
85 * defined in tkInitScript.h
86 */
87
88 #include "tclInitScript.h"
89
90 static void AppendEnvironment(Tcl_Obj *listPtr, CONST char *lib);
91 static void AppendDllPath(Tcl_Obj *listPtr, HMODULE hModule,
92 CONST char *lib);
93 static void AppendRegistry(Tcl_Obj *listPtr, CONST char *lib);
94 static int ToUtf(CONST WCHAR *wSrc, char *dst);
95
96 /*
97 *---------------------------------------------------------------------------
98 *
99 * TclpInitPlatform --
100 *
101 * Initialize all the platform-dependant things like signals and
102 * floating-point error handling.
103 *
104 * Called at process initialization time.
105 *
106 * Results:
107 * None.
108 *
109 * Side effects:
110 * None.
111 *
112 *---------------------------------------------------------------------------
113 */
114
115 void
116 TclpInitPlatform()
117 {
118 tclPlatform = TCL_PLATFORM_WINDOWS;
119
120 /*
121 * The following code stops Windows 3.X and Windows NT 3.51 from
122 * automatically putting up Sharing Violation dialogs, e.g, when
123 * someone tries to access a file that is locked or a drive with no
124 * disk in it. Tcl already returns the appropriate error to the
125 * caller, and they can decide to put up their own dialog in response
126 * to that failure.
127 *
128 * Under 95 and NT 4.0, this is a NOOP because the system doesn't
129 * automatically put up dialogs when the above operations fail.
130 */
131
132 SetErrorMode(SetErrorMode(0) | SEM_FAILCRITICALERRORS);
133
134 /*
135 * Save the id of the first thread to intialize the Tcl library. This
136 * thread will be used to handle notifications from async event
137 * procedures. This is not strictly correct. A better solution involves
138 * using a designated "main" notifier that is kept up to date as threads
139 * come and go.
140 */
141
142 mainThreadId = GetCurrentThreadId();
143
144 #ifdef STATIC_BUILD
145 /*
146 * If we are in a statically linked executable, then we need to
147 * explicitly initialize the Windows function tables here since
148 * DllMain() will not be invoked.
149 */
150
151 TclWinInit(GetModuleHandle(NULL));
152 #endif
153 }
154
155 /*
156 *---------------------------------------------------------------------------
157 *
158 * TclpInitLibraryPath --
159 *
160 * Initialize the library path at startup.
161 *
162 * This call sets the library path to strings in UTF-8. Any
163 * pre-existing library path information is assumed to have been
164 * in the native multibyte encoding.
165 *
166 * Called at process initialization time.
167 *
168 * Results:
169 * None.
170 *
171 * Side effects:
172 * None.
173 *
174 *---------------------------------------------------------------------------
175 */
176
177 void
178 TclpInitLibraryPath(path)
179 CONST char *path; /* Potentially dirty UTF string that is */
180 /* the path to the executable name. */
181 {
182 #define LIBRARY_SIZE 32
183 Tcl_Obj *pathPtr, *objPtr;
184 char *str;
185 Tcl_DString ds;
186 int pathc;
187 char **pathv;
188 char installLib[LIBRARY_SIZE], developLib[LIBRARY_SIZE];
189
190 Tcl_DStringInit(&ds);
191 pathPtr = Tcl_NewObj();
192
193 /*
194 * Initialize the substrings used when locating an executable. The
195 * installLib variable computes the path as though the executable
196 * is installed. The developLib computes the path as though the
197 * executable is run from a develpment directory.
198 */
199
200 sprintf(installLib, "lib/tcl%s", TCL_VERSION);
201 sprintf(developLib, "../tcl%s/library",
202 ((TCL_RELEASE_LEVEL < 2) ? TCL_PATCH_LEVEL : TCL_VERSION));
203
204 /*
205 * Look for the library relative to default encoding dir.
206 */
207
208 str = Tcl_GetDefaultEncodingDir();
209 if ((str != NULL) && (str[0] != '\0')) {
210 objPtr = Tcl_NewStringObj(str, -1);
211 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
212 }
213
214 /*
215 * Look for the library relative to the TCL_LIBRARY env variable.
216 * If the last dirname in the TCL_LIBRARY path does not match the
217 * last dirname in the installLib variable, use the last dir name
218 * of installLib in addition to the orginal TCL_LIBRARY path.
219 */
220
221 AppendEnvironment(pathPtr, installLib);
222
223 /*
224 * Look for the library relative to the DLL. Only use the installLib
225 * because in practice, the DLL is always installed.
226 */
227
228 AppendDllPath(pathPtr, TclWinGetTclInstance(), installLib);
229
230
231 /*
232 * Look for the library relative to the executable. This algorithm
233 * should be the same as the one in the tcl_findLibrary procedure.
234 *
235 * This code looks in the following directories:
236 *
237 * <bindir>/../<installLib>
238 * (e.g. /usr/local/bin/../lib/tcl8.2)
239 * <bindir>/../../<installLib>
240 * (e.g. /usr/local/TclPro/solaris-sparc/bin/../../lib/tcl8.2)
241 * <bindir>/../library
242 * (e.g. /usr/src/tcl8.2/unix/../library)
243 * <bindir>/../../library
244 * (e.g. /usr/src/tcl8.2/unix/solaris-sparc/../../library)
245 * <bindir>/../../<developLib>
246 * (e.g. /usr/src/tcl8.2/unix/../../tcl8.2/library)
247 * <bindir>/../../../<devlopLib>
248 * (e.g. /usr/src/tcl8.2/unix/solaris-sparc/../../../tcl8.2/library)
249 */
250
251 if (path != NULL) {
252 Tcl_SplitPath(path, &pathc, &pathv);
253 if (pathc > 1) {
254 pathv[pathc - 2] = installLib;
255 path = Tcl_JoinPath(pathc - 1, pathv, &ds);
256 objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
257 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
258 Tcl_DStringFree(&ds);
259 }
260 if (pathc > 2) {
261 pathv[pathc - 3] = installLib;
262 path = Tcl_JoinPath(pathc - 2, pathv, &ds);
263 objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
264 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
265 Tcl_DStringFree(&ds);
266 }
267 if (pathc > 1) {
268 pathv[pathc - 2] = "library";
269 path = Tcl_JoinPath(pathc - 1, pathv, &ds);
270 objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
271 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
272 Tcl_DStringFree(&ds);
273 }
274 if (pathc > 2) {
275 pathv[pathc - 3] = "library";
276 path = Tcl_JoinPath(pathc - 2, pathv, &ds);
277 objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
278 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
279 Tcl_DStringFree(&ds);
280 }
281 if (pathc > 1) {
282 pathv[pathc - 3] = developLib;
283 path = Tcl_JoinPath(pathc - 2, pathv, &ds);
284 objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
285 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
286 Tcl_DStringFree(&ds);
287 }
288 if (pathc > 3) {
289 pathv[pathc - 4] = developLib;
290 path = Tcl_JoinPath(pathc - 3, pathv, &ds);
291 objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
292 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
293 Tcl_DStringFree(&ds);
294 }
295 ckfree((char *) pathv);
296 }
297
298 TclSetLibraryPath(pathPtr);
299 }
300
301 /*
302 *---------------------------------------------------------------------------
303 *
304 * AppendEnvironment --
305 *
306 * Append the value of the TCL_LIBRARY environment variable onto the
307 * path pointer. If the env variable points to another version of
308 * tcl (e.g. "tcl7.6") also append the path to this version (e.g.,
309 * "tcl7.6/../tcl8.2")
310 *
311 * Results:
312 * None.
313 *
314 * Side effects:
315 * None.
316 *
317 *---------------------------------------------------------------------------
318 */
319
320 static void
321 AppendEnvironment(
322 Tcl_Obj *pathPtr,
323 CONST char *lib)
324 {
325 int pathc;
326 WCHAR wBuf[MAX_PATH];
327 char buf[MAX_PATH * TCL_UTF_MAX];
328 Tcl_Obj *objPtr;
329 char *str;
330 Tcl_DString ds;
331 char **pathv;
332
333 /*
334 * The "L" preceeding the TCL_LIBRARY string is used to tell VC++
335 * that this is a unicode string.
336 */
337
338 if (GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH) == 0) {
339 buf[0] = '\0';
340 GetEnvironmentVariableA("TCL_LIBRARY", buf, MAX_PATH);
341 } else {
342 ToUtf(wBuf, buf);
343 }
344
345 if (buf[0] != '\0') {
346 objPtr = Tcl_NewStringObj(buf, -1);
347 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
348
349 TclWinNoBackslash(buf);
350 Tcl_SplitPath(buf, &pathc, &pathv);
351
352 /*
353 * The lstrcmpi() will work even if pathv[pathc - 1] is random
354 * UTF-8 chars because I know lib is ascii.
355 */
356
357 if ((pathc > 0) && (lstrcmpiA(lib + 4, pathv[pathc - 1]) != 0)) {
358 /*
359 * TCL_LIBRARY is set but refers to a different tcl
360 * installation than the current version. Try fiddling with the
361 * specified directory to make it refer to this installation by
362 * removing the old "tclX.Y" and substituting the current
363 * version string.
364 */
365
366 pathv[pathc - 1] = (char *) (lib + 4);
367 Tcl_DStringInit(&ds);
368 str = Tcl_JoinPath(pathc, pathv, &ds);
369 objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
370 Tcl_DStringFree(&ds);
371 } else {
372 objPtr = Tcl_NewStringObj(buf, -1);
373 }
374 Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
375 ckfree((char *) pathv);
376 }
377 }
378
379 /*
380 *---------------------------------------------------------------------------
381 *
382 * AppendDllPath --
383 *
384 * Append a path onto the path pointer that tries to locate the Tcl
385 * library relative to the location of the Tcl DLL.
386 *
387 * Results:
388 * None.
389 *
390 * Side effects:
391 * None.
392 *
393 *---------------------------------------------------------------------------
394 */
395
396 static void
397 AppendDllPath(
398 Tcl_Obj *pathPtr,
399 HMODULE hModule,
400 CONST char *lib)
401 {
402 WCHAR wName[MAX_PATH + LIBRARY_SIZE];
403 char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX];
404
405 if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) {
406 GetModuleFileNameA(hModule, name, MAX_PATH);
407 } else {
408 ToUtf(wName, name);
409 }
410 if (lib != NULL) {
411 char *end, *p;
412
413 end = strrchr(name, '\\');
414 *end = '\0';
415 p = strrchr(name, '\\');
416 if (p != NULL) {
417 end = p;
418 }
419 *end = '\\';
420 strcpy(end + 1, lib);
421 }
422 TclWinNoBackslash(name);
423 Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_NewStringObj(name, -1));
424 }
425
426 /*
427 *---------------------------------------------------------------------------
428 *
429 * ToUtf --
430 *
431 * Convert a char string to a UTF string.
432 *
433 * Results:
434 * None.
435 *
436 * Side effects:
437 * None.
438 *
439 *---------------------------------------------------------------------------
440 */
441
442 static int
443 ToUtf(
444 CONST WCHAR *wSrc,
445 char *dst)
446 {
447 char *start;
448
449 start = dst;
450 while (*wSrc != '\0') {
451 dst += Tcl_UniCharToUtf(*wSrc, dst);
452 wSrc++;
453 }
454 *dst = '\0';
455 return dst - start;
456 }
457
458
459 /*
460 *---------------------------------------------------------------------------
461 *
462 * TclpSetInitialEncodings --
463 *
464 * Based on the locale, determine the encoding of the operating
465 * system and the default encoding for newly opened files.
466 *
467 * Called at process initialization time.
468 *
469 * Results:
470 * None.
471 *
472 * Side effects:
473 * The Tcl library path is converted from native encoding to UTF-8.
474 *
475 *---------------------------------------------------------------------------
476 */
477
478 void
479 TclpSetInitialEncodings()
480 {
481 CONST char *encoding;
482 char buf[4 + TCL_INTEGER_SPACE];
483 int platformId;
484 Tcl_Obj *pathPtr;
485
486 platformId = TclWinGetPlatformId();
487
488 TclWinSetInterfaces(platformId == VER_PLATFORM_WIN32_NT);
489
490 wsprintfA(buf, "cp%d", GetACP());
491 Tcl_SetSystemEncoding(NULL, buf);
492
493 if (platformId != VER_PLATFORM_WIN32_NT) {
494 pathPtr = TclGetLibraryPath();
495 if (pathPtr != NULL) {
496 int i, objc;
497 Tcl_Obj **objv;
498
499 objc = 0;
500 Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
501 for (i = 0; i < objc; i++) {
502 int length;
503 char *string;
504 Tcl_DString ds;
505
506 string = Tcl_GetStringFromObj(objv[i], &length);
507 Tcl_ExternalToUtfDString(NULL, string, length, &ds);
508 Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds),
509 Tcl_DStringLength(&ds));
510 Tcl_DStringFree(&ds);
511 }
512 }
513 }
514
515 /*
516 * Keep this encoding preloaded. The IO package uses it for gets on a
517 * binary channel.
518 */
519
520 encoding = "iso8859-1";
521 Tcl_GetEncoding(NULL, encoding);
522 }
523
524 /*
525 *---------------------------------------------------------------------------
526 *
527 * TclpSetVariables --
528 *
529 * Performs platform-specific interpreter initialization related to
530 * the tcl_platform and env variables, and other platform-specific
531 * things.
532 *
533 * Results:
534 * None.
535 *
536 * Side effects:
537 * Sets "tclDefaultLibrary", "tcl_platform", and "env(HOME)" Tcl
538 * variables.
539 *
540 *----------------------------------------------------------------------
541 */
542
543 void
544 TclpSetVariables(interp)
545 Tcl_Interp *interp; /* Interp to initialize. */
546 {
547 char *ptr;
548 char buffer[TCL_INTEGER_SPACE * 2];
549 SYSTEM_INFO sysInfo;
550 OemId *oemId;
551 OSVERSIONINFOA osInfo;
552 Tcl_DString ds;
553
554 osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
555 GetVersionExA(&osInfo);
556
557 oemId = (OemId *) &sysInfo;
558 GetSystemInfo(&sysInfo);
559
560 /*
561 * Initialize the tclDefaultLibrary variable from the registry.
562 */
563
564 Tcl_SetVar(interp, "tclDefaultLibrary", "", TCL_GLOBAL_ONLY);
565
566 /*
567 * Define the tcl_platform array.
568 */
569
570 Tcl_SetVar2(interp, "tcl_platform", "platform", "windows",
571 TCL_GLOBAL_ONLY);
572 if (osInfo.dwPlatformId < NUMPLATFORMS) {
573 Tcl_SetVar2(interp, "tcl_platform", "os",
574 platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY);
575 }
576 wsprintfA(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
577 Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
578 if (oemId->wProcessorArchitecture < NUMPROCESSORS) {
579 Tcl_SetVar2(interp, "tcl_platform", "machine",
580 processors[oemId->wProcessorArchitecture],
581 TCL_GLOBAL_ONLY);
582 }
583
584 #ifdef _DEBUG
585 /*
586 * The existence of the "debug" element of the tcl_platform array indicates
587 * that this particular Tcl shell has been compiled with debug information.
588 * Using "info exists tcl_platform(debug)" a Tcl script can direct the
589 * interpreter to load debug versions of DLLs with the load command.
590 */
591
592 Tcl_SetVar2(interp, "tcl_platform", "debug", "1",
593 TCL_GLOBAL_ONLY);
594 #endif
595
596 /*
597 * Set up the HOME environment variable from the HOMEDRIVE & HOMEPATH
598 * environment variables, if necessary.
599 */
600
601 Tcl_DStringInit(&ds);
602 ptr = Tcl_GetVar2(interp, "env", "HOME", TCL_GLOBAL_ONLY);
603 if (ptr == NULL) {
604 ptr = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY);
605 if (ptr != NULL) {
606 Tcl_DStringAppend(&ds, ptr, -1);
607 }
608 ptr = Tcl_GetVar2(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY);
609 if (ptr != NULL) {
610 Tcl_DStringAppend(&ds, ptr, -1);
611 }
612 if (Tcl_DStringLength(&ds) > 0) {
613 Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds),
614 TCL_GLOBAL_ONLY);
615 } else {
616 Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY);
617 }
618 }
619
620 /*
621 * Initialize the user name from the environment first, since this is much
622 * faster than asking the system.
623 */
624
625 Tcl_DStringSetLength(&ds, 100);
626 if (TclGetEnv("USERNAME", &ds) == NULL) {
627 if (GetUserName(Tcl_DStringValue(&ds), &Tcl_DStringLength(&ds)) == 0) {
628 Tcl_DStringSetLength(&ds, 0);
629 }
630 }
631 Tcl_SetVar2(interp, "tcl_platform", "user", Tcl_DStringValue(&ds),
632 TCL_GLOBAL_ONLY);
633 Tcl_DStringFree(&ds);
634 }
635
636 /*
637 *----------------------------------------------------------------------
638 *
639 * TclpFindVariable --
640 *
641 * Locate the entry in environ for a given name. On Unix this
642 * routine is case sensetive, on Windows this matches mioxed case.
643 *
644 * Results:
645 * The return value is the index in environ of an entry with the
646 * name "name", or -1 if there is no such entry. The integer at
647 * *lengthPtr is filled in with the length of name (if a matching
648 * entry is found) or the length of the environ array (if no matching
649 * entry is found).
650 *
651 * Side effects:
652 * None.
653 *
654 *----------------------------------------------------------------------
655 */
656
657 int
658 TclpFindVariable(name, lengthPtr)
659 CONST char *name; /* Name of desired environment variable
660 * (UTF-8). */
661 int *lengthPtr; /* Used to return length of name (for
662 * successful searches) or number of non-NULL
663 * entries in environ (for unsuccessful
664 * searches). */
665 {
666 int i, length, result = -1;
667 register CONST char *env, *p1, *p2;
668 char *envUpper, *nameUpper;
669 Tcl_DString envString;
670
671 /*
672 * Convert the name to all upper case for the case insensitive
673 * comparison.
674 */
675
676 length = strlen(name);
677 nameUpper = (char *) ckalloc((unsigned) length+1);
678 memcpy((VOID *) nameUpper, (VOID *) name, (size_t) length+1);
679 Tcl_UtfToUpper(nameUpper);
680
681 Tcl_DStringInit(&envString);
682 for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
683 /*
684 * Chop the env string off after the equal sign, then Convert
685 * the name to all upper case, so we do not have to convert
686 * all the characters after the equal sign.
687 */
688
689 envUpper = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
690 p1 = strchr(envUpper, '=');
691 if (p1 == NULL) {
692 continue;
693 }
694 length = p1 - envUpper;
695 Tcl_DStringSetLength(&envString, length+1);
696 Tcl_UtfToUpper(envUpper);
697
698 p1 = envUpper;
699 p2 = nameUpper;
700 for (; *p2 == *p1; p1++, p2++) {
701 /* NULL loop body. */
702 }
703 if ((*p1 == '=') && (*p2 == '\0')) {
704 *lengthPtr = length;
705 result = i;
706 goto done;
707 }
708
709 Tcl_DStringFree(&envString);
710 }
711
712 *lengthPtr = i;
713
714 done:
715 Tcl_DStringFree(&envString);
716 ckfree(nameUpper);
717 return result;
718 }
719
720 /*
721 *----------------------------------------------------------------------
722 *
723 * Tcl_Init --
724 *
725 * This procedure is typically invoked by Tcl_AppInit procedures
726 * to perform additional initialization for a Tcl interpreter,
727 * such as sourcing the "init.tcl" script.
728 *
729 * Results:
730 * Returns a standard Tcl completion code and sets the interp's
731 * result if there is an error.
732 *
733 * Side effects:
734 * Depends on what's in the init.tcl script.
735 *
736 *----------------------------------------------------------------------
737 */
738
739 int
740 Tcl_Init(interp)
741 Tcl_Interp *interp; /* Interpreter to initialize. */
742 {
743 Tcl_Obj *pathPtr;
744
745 if (tclPreInitScript != NULL) {
746 if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
747 return (TCL_ERROR);
748 };
749 }
750
751 pathPtr = TclGetLibraryPath();
752 if (pathPtr == NULL) {
753 pathPtr = Tcl_NewObj();
754 }
755 Tcl_SetVar2Ex(interp, "tcl_libPath", NULL, pathPtr, TCL_GLOBAL_ONLY);
756 return Tcl_Eval(interp, initScript);
757 }
758
759 /*
760 *----------------------------------------------------------------------
761 *
762 * Tcl_SourceRCFile --
763 *
764 * This procedure is typically invoked by Tcl_Main of Tk_Main
765 * procedure to source an application specific rc file into the
766 * interpreter at startup time.
767 *
768 * Results:
769 * None.
770 *
771 * Side effects:
772 * Depends on what's in the rc script.
773 *
774 *----------------------------------------------------------------------
775 */
776
777 void
778 Tcl_SourceRCFile(interp)
779 Tcl_Interp *interp; /* Interpreter to source rc file into. */
780 {
781 Tcl_DString temp;
782 char *fileName;
783 Tcl_Channel errChannel;
784
785 fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
786
787 if (fileName != NULL) {
788 Tcl_Channel c;
789 char *fullName;
790
791 Tcl_DStringInit(&temp);
792 fullName = Tcl_TranslateFileName(interp, fileName, &temp);
793 if (fullName == NULL) {
794 /*
795 * Couldn't translate the file name (e.g. it referred to a
796 * bogus user or there was no HOME environment variable).
797 * Just do nothing.
798 */
799 } else {
800
801 /*
802 * Test for the existence of the rc file before trying to read it.
803 */
804
805 c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
806 if (c != (Tcl_Channel) NULL) {
807 Tcl_Close(NULL, c);
808 if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
809 errChannel = Tcl_GetStdChannel(TCL_STDERR);
810 if (errChannel) {
811 Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
812 Tcl_WriteChars(errChannel, "\n", 1);
813 }
814 }
815 }
816 }
817 Tcl_DStringFree(&temp);
818 }
819 }
820
821 /*
822 *----------------------------------------------------------------------
823 *
824 * TclpAsyncMark --
825 *
826 * Wake up the main thread from a signal handler.
827 *
828 * Results:
829 * None.
830 *
831 * Side effects:
832 * Sends a message to the main thread.
833 *
834 *----------------------------------------------------------------------
835 */
836
837 void
838 TclpAsyncMark(async)
839 Tcl_AsyncHandler async; /* Token for handler. */
840 {
841 /*
842 * Need a way to kick the Windows event loop and tell it to go look at
843 * asynchronous events.
844 */
845
846 PostThreadMessage(mainThreadId, WM_USER, 0, 0);
847 }
848
849 /* $History: tclwininit.c $
850 *
851 * ***************** Version 1 *****************
852 * User: Dtashley Date: 1/02/01 Time: 12:39a
853 * Created in $/IjuScripter, IjuConsole/Source/Tcl Base
854 * Initial check-in.
855 */
856
857 /* End of TCLWININIT.C */

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25