root/tcl-8.0/trunk/win/tclWinInit.c @ 1098

Revision 1098, 10.3 KB (checked in by ucaccsp, 16 years ago)

Fixes for win32 [csp]

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1/*
2 * tclWinInit.c --
3 *
4 *      Contains the Windows-specific interpreter initialization functions.
5 *
6 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
7 *
8 * See the file "license.terms" for information on usage and redistribution
9 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
10 *
11 * SCCS: @(#) tclWinInit.c 1.32 97/06/24 17:28:26
12 */
13
14#include "tclInt.h"
15#include "tclPort.h"
16#include <winreg.h>
17#include <winnt.h>
18#include <winbase.h>
19
20extern char lib_history[];
21extern char lib_init[];
22extern char lib_ldAout[];
23extern char lib_http[];
24extern char lib_optparse[];
25extern char lib_parray[];
26extern char lib_safe[];
27extern char lib_word[];
28
29/*
30 * The following macro can be defined at compile time to specify
31 * the root of the Tcl registry keys.
32 */
33 
34#ifndef TCL_REGISTRY_KEY
35#define TCL_REGISTRY_KEY "Software\\Scriptics\\Tcl\\" TCL_VERSION
36#endif
37
38/*
39 * The following declaration is a workaround for some Microsoft brain damage.
40 * The SYSTEM_INFO structure is different in various releases, even though the
41 * layout is the same.  So we overlay our own structure on top of it so we
42 * can access the interesting slots in a uniform way.
43 */
44
45typedef struct {
46    WORD wProcessorArchitecture;
47    WORD wReserved;
48} OemId;
49
50/*
51 * The following macros are missing from some versions of winnt.h.
52 */
53
54#ifndef PROCESSOR_ARCHITECTURE_INTEL
55#define PROCESSOR_ARCHITECTURE_INTEL 0
56#endif
57#ifndef PROCESSOR_ARCHITECTURE_MIPS
58#define PROCESSOR_ARCHITECTURE_MIPS  1
59#endif
60#ifndef PROCESSOR_ARCHITECTURE_ALPHA
61#define PROCESSOR_ARCHITECTURE_ALPHA 2
62#endif
63#ifndef PROCESSOR_ARCHITECTURE_PPC
64#define PROCESSOR_ARCHITECTURE_PPC   3
65#endif
66#ifndef PROCESSOR_ARCHITECTURE_UNKNOWN
67#define PROCESSOR_ARCHITECTURE_UNKNOWN 0xFFFF
68#endif
69
70/*
71 * The following arrays contain the human readable strings for the Windows
72 * platform and processor values.
73 */
74
75
76#define NUMPLATFORMS 3
77static char* platforms[NUMPLATFORMS] = {
78    "Win32s", "Windows 95", "Windows NT"
79};
80
81#define NUMPROCESSORS 4
82static char* processors[NUMPROCESSORS] = {
83    "intel", "mips", "alpha", "ppc"
84};
85
86/*
87 * The Init script, tclPreInitScript variable, and the routine
88 * TclSetPreInitScript (common to Windows and Unix platforms) are defined
89 * in generic/tclInitScript.h
90 */
91
92#include "tclInitScript.h"
93
94
95/*
96 *----------------------------------------------------------------------
97 *
98 * TclPlatformInit --
99 *
100 *      Performs Windows-specific interpreter initialization related to the
101 *      tcl_library variable.  Also sets up the HOME environment variable
102 *      if it is not already set.
103 *
104 * Results:
105 *      None.
106 *
107 * Side effects:
108 *      Sets "tcl_library" and "env(HOME)" Tcl variables
109 *
110 *----------------------------------------------------------------------
111 */
112
113void
114TclPlatformInit(interp)
115    Tcl_Interp *interp;
116{
117    char *p;
118    char buffer[13];
119    Tcl_DString ds;
120    OSVERSIONINFO osInfo;
121    SYSTEM_INFO sysInfo;
122    int isWin32s;               /* True if we are running under Win32s. */
123    OemId *oemId;
124    HKEY key;
125    DWORD size, result, type;
126
127    tclPlatform = TCL_PLATFORM_WINDOWS;
128
129    Tcl_DStringInit(&ds);
130
131    /*
132     * Find out what kind of system we are running on.
133     */
134
135    osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
136    GetVersionEx(&osInfo);
137
138    isWin32s = (osInfo.dwPlatformId == VER_PLATFORM_WIN32s);
139
140    /*
141     * Since Win32s doesn't support GetSystemInfo, we use a default value.
142     */
143
144    oemId = (OemId *) &sysInfo;
145    if (!isWin32s) {
146        GetSystemInfo(&sysInfo);
147    } else {
148        oemId->wProcessorArchitecture = PROCESSOR_ARCHITECTURE_INTEL;
149    }
150
151    /*
152     * Initialize the tcl_library variable from the registry.
153     */
154
155    Tcl_SetVar(interp, "tclDefaultLibrary", "", TCL_GLOBAL_ONLY);
156    if (!isWin32s) {
157        result = RegOpenKeyEx(HKEY_LOCAL_MACHINE, TCL_REGISTRY_KEY, 0,
158                KEY_READ, &key);
159    } else {
160        result = RegOpenKeyEx(HKEY_CLASSES_ROOT, TCL_REGISTRY_KEY, 0,
161                KEY_READ, &key);
162    }
163    if (result == ERROR_SUCCESS) {
164        if (RegQueryValueEx(key, "", NULL, NULL, NULL, &size)
165                == ERROR_SUCCESS) {
166            char *argv[3];
167            Tcl_DStringSetLength(&ds, size);
168            RegQueryValueEx(key, "", NULL, NULL,
169                    (LPBYTE) Tcl_DStringValue(&ds), &size);
170            Tcl_SetVar(interp, "tclDefaultLibrary", Tcl_DStringValue(&ds),
171                    TCL_GLOBAL_ONLY);
172            argv[0] = Tcl_GetVar(interp, "tclDefaultLibrary", TCL_GLOBAL_ONLY);
173            argv[1] = "lib/tcl" TCL_VERSION;
174            argv[2] = NULL;
175            Tcl_DStringSetLength(&ds, 0);
176            Tcl_SetVar(interp, "tclDefaultLibrary",
177                    Tcl_JoinPath(2, argv, &ds), TCL_GLOBAL_ONLY);
178        }
179        if ((RegQueryValueEx(key, "PkgPath", NULL, &type, NULL, &size)
180                == ERROR_SUCCESS) && (type == REG_MULTI_SZ)) {
181            char **argv;
182            int argc;
183
184            /*
185             * PkgPath is stored as an array of null terminated strings
186             * terminated by two null characters.  First count the number
187             * of strings, then allocate an argv array so we can construct
188             * a valid list.
189             */
190
191            Tcl_DStringSetLength(&ds, size);
192            RegQueryValueEx(key, "PkgPath", NULL, NULL,
193                    (LPBYTE)Tcl_DStringValue(&ds), &size);
194            argc = 0;
195            p = Tcl_DStringValue(&ds);
196            do {
197                if (*p) {
198                    argc++;
199                }
200                p += strlen(p) + 1;
201            } while (*p);
202
203            argv = (char **) ckalloc((sizeof(char *) * argc) + 1);
204            argc = 0;
205            p = Tcl_DStringValue(&ds);
206            do {
207                if (*p) {
208                    argv[argc++] = p;
209                    while (*p) {
210                        if (*p == '\\') {
211                            *p = '/';
212                        }
213                        p++;
214                    }
215                }
216                p++;
217            } while (*p);
218
219            p = Tcl_Merge(argc, argv);
220            Tcl_SetVar(interp, "tcl_pkgPath", p, TCL_GLOBAL_ONLY);
221            ckfree(p);
222            ckfree((char*) argv);
223        } else {
224            char *argv[3];
225            argv[0] = Tcl_GetVar(interp, "tclDefaultLibrary", TCL_GLOBAL_ONLY);
226            argv[1] = "..";
227            argv[2] = NULL;
228            Tcl_DStringSetLength(&ds, 0);
229            Tcl_SetVar(interp, "tcl_pkgPath", Tcl_JoinPath(2, argv, &ds),
230                    TCL_GLOBAL_ONLY|TCL_LIST_ELEMENT);
231        }
232    }
233
234    /*
235     * Define the tcl_platform array.
236     */
237
238    Tcl_SetVar2(interp, "tcl_platform", "platform", "windows",
239            TCL_GLOBAL_ONLY);
240    if (osInfo.dwPlatformId < NUMPLATFORMS) {
241        Tcl_SetVar2(interp, "tcl_platform", "os",
242                platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY);
243    }
244    sprintf(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
245    Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
246    if (oemId->wProcessorArchitecture < NUMPROCESSORS) {
247        Tcl_SetVar2(interp, "tcl_platform", "machine",
248                processors[oemId->wProcessorArchitecture],
249                TCL_GLOBAL_ONLY);
250    }
251
252    /*
253     * Set up the HOME environment variable from the HOMEDRIVE & HOMEPATH
254     * environment variables, if necessary.
255     */
256
257    p = Tcl_GetVar2(interp, "env", "HOME", TCL_GLOBAL_ONLY);
258    if (p == NULL) {
259        Tcl_DStringSetLength(&ds, 0);
260        p = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY);
261        if (p != NULL) {
262            Tcl_DStringAppend(&ds, p, -1);
263        }
264        p = Tcl_GetVar2(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY);
265        if (p != NULL) {
266            Tcl_DStringAppend(&ds, p, -1);
267        }
268        if (Tcl_DStringLength(&ds) > 0) {
269            Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds),
270                    TCL_GLOBAL_ONLY);
271        } else {
272            Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY);
273        }
274    }
275
276    Tcl_DStringFree(&ds);
277}
278
279/*
280 *----------------------------------------------------------------------
281 *
282 * Tcl_Init --
283 *
284 *      This procedure is typically invoked by Tcl_AppInit procedures
285 *      to perform additional initialization for a Tcl interpreter,
286 *      such as sourcing the "init.tcl" script.
287 *
288 * Results:
289 *      Returns a standard Tcl completion code and sets interp->result
290 *      if there is an error.
291 *
292 * Side effects:
293 *      Depends on what's in the init.tcl script.
294 *
295 *----------------------------------------------------------------------
296 */
297
298int
299Tcl_Init(interp)
300    Tcl_Interp *interp;         /* Interpreter to initialize. */
301{
302    if (tclPreInitScript != NULL) {
303        if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
304            return (TCL_ERROR);
305        };
306    }
307    if (Tcl_Eval(interp, lib_init) != TCL_OK) {
308        return TCL_ERROR;
309    }
310    if (Tcl_Eval(interp, lib_optparse) != TCL_OK) {
311        return TCL_ERROR;
312    }
313    if (Tcl_Eval(interp, lib_safe) != TCL_OK) {
314        return TCL_ERROR;
315    }
316    if (Tcl_Eval(interp, lib_history) != TCL_OK) {
317        return TCL_ERROR;
318    }
319    if (Tcl_Eval(interp, lib_ldAout) != TCL_OK) {
320        return TCL_ERROR;
321    }
322    if (Tcl_Eval(interp, lib_parray) != TCL_OK) {
323        return TCL_ERROR;
324    }
325    if (Tcl_Eval(interp, lib_word) != TCL_OK) {
326        return TCL_ERROR;
327    }
328    if (Tcl_Eval(interp, lib_http) != TCL_OK) {
329        return TCL_ERROR;
330    }
331    return(Tcl_Eval(interp, initScript));
332}
333
334/*
335 *----------------------------------------------------------------------
336 *
337 * TclWinGetPlatform --
338 *
339 *      This is a kludge that allows the test library to get access
340 *      the internal tclPlatform variable.
341 *
342 * Results:
343 *      Returns a pointer to the tclPlatform variable.
344 *
345 * Side effects:
346 *      None.
347 *
348 *----------------------------------------------------------------------
349 */
350
351TclPlatformType *
352TclWinGetPlatform()
353{
354    return &tclPlatform;
355}
356
357/*
358 *----------------------------------------------------------------------
359 *
360 * Tcl_SourceRCFile --
361 *
362 *      This procedure is typically invoked by Tcl_Main of Tk_Main
363 *      procedure to source an application specific rc file into the
364 *      interpreter at startup time.
365 *
366 * Results:
367 *      None.
368 *
369 * Side effects:
370 *      Depends on what's in the rc script.
371 *
372 *----------------------------------------------------------------------
373 */
374
375void
376Tcl_SourceRCFile(interp)
377    Tcl_Interp *interp;         /* Interpreter to source rc file into. */
378{
379    Tcl_DString temp;
380    char *fileName;
381    Tcl_Channel errChannel;
382
383    fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
384
385    if (fileName != NULL) {
386        Tcl_Channel c;
387        char *fullName;
388
389        Tcl_DStringInit(&temp);
390        fullName = Tcl_TranslateFileName(interp, fileName, &temp);
391        if (fullName == NULL) {
392            /*
393             * Couldn't translate the file name (e.g. it referred to a
394             * bogus user or there was no HOME environment variable).
395             * Just do nothing.
396             */
397        } else {
398
399            /*
400             * Test for the existence of the rc file before trying to read it.
401             */
402
403            c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
404            if (c != (Tcl_Channel) NULL) {
405                Tcl_Close(NULL, c);
406                if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
407                    errChannel = Tcl_GetStdChannel(TCL_STDERR);
408                    if (errChannel) {
409                        Tcl_Write(errChannel, interp->result, -1);
410                        Tcl_Write(errChannel, "\n", 1);
411                    }
412                }
413            }
414        }
415        Tcl_DStringFree(&temp);
416    }
417}
Note: See TracBrowser for help on using the browser.