OpenCores
URL https://opencores.org/ocsvn/or1k_old/or1k_old/trunk

Subversion Repositories or1k_old

[/] [or1k_old/] [trunk/] [insight/] [tcl/] [win/] [tclWinInit.c] - Blame information for rev 1782

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
/*
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
 * RCS: @(#) $Id: tclWinInit.c,v 1.1.1.1 2002-01-16 10:25:38 markom Exp $
12
 */
13
 
14
#include "tclInt.h"
15
#include "tclPort.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
 * The Init script, tclPreInitScript variable, and the routine
79
 * TclSetPreInitScript (common to Windows and Unix platforms) are defined
80
 * in generic/tclInitScript.h
81
 */
82
 
83
#include "tclInitScript.h"
84
 
85
 
86
/*
87
 *----------------------------------------------------------------------
88
 *
89
 * TclPlatformInit --
90
 *
91
 *      Performs Windows-specific interpreter initialization related to the
92
 *      tcl_library variable.  Also sets up the HOME environment variable
93
 *      if it is not already set.
94
 *
95
 * Results:
96
 *      None.
97
 *
98
 * Side effects:
99
 *      Sets "tcl_library" and "env(HOME)" Tcl variables
100
 *
101
 *----------------------------------------------------------------------
102
 */
103
 
104
void
105
TclPlatformInit(interp)
106
    Tcl_Interp *interp;
107
{
108
    char *p;
109
    char buffer[13];
110
    Tcl_DString ds;
111
    OSVERSIONINFO osInfo;
112
    SYSTEM_INFO sysInfo;
113
    int isWin32s;               /* True if we are running under Win32s. */
114
    OemId *oemId;
115
    HKEY key;
116
    DWORD size, result, type;
117
 
118
    tclPlatform = TCL_PLATFORM_WINDOWS;
119
 
120
    Tcl_DStringInit(&ds);
121
 
122
    /*
123
     * Find out what kind of system we are running on.
124
     */
125
 
126
    osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
127
    GetVersionEx(&osInfo);
128
 
129
    isWin32s = (osInfo.dwPlatformId == VER_PLATFORM_WIN32s);
130
 
131
    /*
132
     * Since Win32s doesn't support GetSystemInfo, we use a default value.
133
     */
134
 
135
    oemId = (OemId *) &sysInfo;
136
    if (!isWin32s) {
137
        GetSystemInfo(&sysInfo);
138
    } else {
139
        oemId->wProcessorArchitecture = PROCESSOR_ARCHITECTURE_INTEL;
140
    }
141
 
142
    /* CYGNUS LOCAL: don't set tclDefaultLibrary from the registry; instead
143
       always compute it at runtime.  We do have to set it to
144
       something, though, so that initScript will work correctly.  */
145
    Tcl_SetVar(interp, "tclDefaultLibrary", "", TCL_GLOBAL_ONLY);
146
    /* ditto, but this is a hack - dj */
147
    Tcl_SetVar(interp, "tcl_pkgPath", "", TCL_GLOBAL_ONLY);
148
    /* END CYGNUS LOCAL */
149
 
150
    /*
151
     * Define the tcl_platform array.
152
     */
153
 
154
    Tcl_SetVar2(interp, "tcl_platform", "platform", "windows",
155
            TCL_GLOBAL_ONLY);
156
    if (osInfo.dwPlatformId < NUMPLATFORMS) {
157
        Tcl_SetVar2(interp, "tcl_platform", "os",
158
                platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY);
159
    }
160
    sprintf(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
161
    Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
162
    if (oemId->wProcessorArchitecture < NUMPROCESSORS) {
163
        Tcl_SetVar2(interp, "tcl_platform", "machine",
164
                processors[oemId->wProcessorArchitecture],
165
                TCL_GLOBAL_ONLY);
166
    }
167
 
168
#ifdef _DEBUG
169
    /*
170
     * The existence of the "debug" element of the tcl_platform array indicates
171
     * that this particular Tcl shell has been compiled with debug information.
172
     * Using "info exists tcl_platform(debug)" a Tcl script can direct the
173
     * interpreter to load debug versions of DLLs with the load command.
174
     */
175
 
176
    Tcl_SetVar2(interp, "tcl_platform", "debug", "1",
177
                TCL_GLOBAL_ONLY);
178
#endif
179
 
180
    /*
181
     * Set up the HOME environment variable from the HOMEDRIVE & HOMEPATH
182
     * environment variables, if necessary.
183
     */
184
 
185
    p = Tcl_GetVar2(interp, "env", "HOME", TCL_GLOBAL_ONLY);
186
    if (p == NULL) {
187
        Tcl_DStringSetLength(&ds, 0);
188
        p = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY);
189
        if (p != NULL) {
190
            Tcl_DStringAppend(&ds, p, -1);
191
        }
192
        p = Tcl_GetVar2(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY);
193
        if (p != NULL) {
194
            Tcl_DStringAppend(&ds, p, -1);
195
        }
196
        if (Tcl_DStringLength(&ds) > 0) {
197
            Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds),
198
                    TCL_GLOBAL_ONLY);
199
        } else {
200
            Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY);
201
        }
202
    }
203
 
204
    Tcl_DStringFree(&ds);
205
}
206
 
207
/*
208
 *----------------------------------------------------------------------
209
 *
210
 * Tcl_Init --
211
 *
212
 *      This procedure is typically invoked by Tcl_AppInit procedures
213
 *      to perform additional initialization for a Tcl interpreter,
214
 *      such as sourcing the "init.tcl" script.
215
 *
216
 * Results:
217
 *      Returns a standard Tcl completion code and sets interp->result
218
 *      if there is an error.
219
 *
220
 * Side effects:
221
 *      Depends on what's in the init.tcl script.
222
 *
223
 *----------------------------------------------------------------------
224
 */
225
 
226
int
227
Tcl_Init(interp)
228
    Tcl_Interp *interp;         /* Interpreter to initialize. */
229
{
230
    if (tclPreInitScript != NULL) {
231
        if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
232
            return (TCL_ERROR);
233
        };
234
    }
235
    return(Tcl_Eval(interp, initScript));
236
}
237
 
238
/*
239
 *----------------------------------------------------------------------
240
 *
241
 * TclWinGetPlatform --
242
 *
243
 *      This is a kludge that allows the test library to get access
244
 *      the internal tclPlatform variable.
245
 *
246
 * Results:
247
 *      Returns a pointer to the tclPlatform variable.
248
 *
249
 * Side effects:
250
 *      None.
251
 *
252
 *----------------------------------------------------------------------
253
 */
254
 
255
TclPlatformType *
256
TclWinGetPlatform()
257
{
258
    return &tclPlatform;
259
}
260
 
261
/*
262
 *----------------------------------------------------------------------
263
 *
264
 * Tcl_SourceRCFile --
265
 *
266
 *      This procedure is typically invoked by Tcl_Main of Tk_Main
267
 *      procedure to source an application specific rc file into the
268
 *      interpreter at startup time.
269
 *
270
 * Results:
271
 *      None.
272
 *
273
 * Side effects:
274
 *      Depends on what's in the rc script.
275
 *
276
 *----------------------------------------------------------------------
277
 */
278
 
279
void
280
Tcl_SourceRCFile(interp)
281
    Tcl_Interp *interp;         /* Interpreter to source rc file into. */
282
{
283
    Tcl_DString temp;
284
    char *fileName;
285
    Tcl_Channel errChannel;
286
 
287
    fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
288
 
289
    if (fileName != NULL) {
290
        Tcl_Channel c;
291
        char *fullName;
292
 
293
        Tcl_DStringInit(&temp);
294
        fullName = Tcl_TranslateFileName(interp, fileName, &temp);
295
        if (fullName == NULL) {
296
            /*
297
             * Couldn't translate the file name (e.g. it referred to a
298
             * bogus user or there was no HOME environment variable).
299
             * Just do nothing.
300
             */
301
        } else {
302
 
303
            /*
304
             * Test for the existence of the rc file before trying to read it.
305
             */
306
 
307
            c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
308
            if (c != (Tcl_Channel) NULL) {
309
                Tcl_Close(NULL, c);
310
                if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
311
                    errChannel = Tcl_GetStdChannel(TCL_STDERR);
312
                    if (errChannel) {
313
                        Tcl_Write(errChannel, interp->result, -1);
314
                        Tcl_Write(errChannel, "\n", 1);
315
                    }
316
                }
317
            }
318
        }
319
        Tcl_DStringFree(&temp);
320
    }
321
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.