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

Contents of /projs/dtats/trunk/shared_source/c_tcl_base_7_5_w_mods/tclwininit.c

Parent Directory Parent Directory | Revision Log Revision Log


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

Properties

Name Value
svn:eol-style native
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25