1 |
/* $Header$ */
|
2 |
|
3 |
/*
|
4 |
* tkWinInit.c --
|
5 |
*
|
6 |
* This file contains Windows-specific interpreter initialization
|
7 |
* functions.
|
8 |
*
|
9 |
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
|
10 |
*
|
11 |
* See the file "license.terms" for information on usage and redistribution
|
12 |
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
13 |
*
|
14 |
* RCS: @(#) $Id: tkwininit.c,v 1.1.1.1 2001/06/13 05:13:34 dtashley Exp $
|
15 |
*/
|
16 |
|
17 |
#include "tkWinInt.h"
|
18 |
|
19 |
/*
|
20 |
* The Init script (common to Windows and Unix platforms) is
|
21 |
* defined in tkInitScript.h
|
22 |
*/
|
23 |
#include "tkInitScript.h"
|
24 |
|
25 |
|
26 |
/*
|
27 |
*----------------------------------------------------------------------
|
28 |
*
|
29 |
* TkpInit --
|
30 |
*
|
31 |
* Performs Windows-specific interpreter initialization related to the
|
32 |
* tk_library variable.
|
33 |
*
|
34 |
* Results:
|
35 |
* A standard Tcl completion code (TCL_OK or TCL_ERROR). Also
|
36 |
* leaves information in the interp's result.
|
37 |
*
|
38 |
* Side effects:
|
39 |
* Sets "tk_library" Tcl variable, runs "tk.tcl" script.
|
40 |
*
|
41 |
*----------------------------------------------------------------------
|
42 |
*/
|
43 |
|
44 |
int
|
45 |
TkpInit(interp)
|
46 |
Tcl_Interp *interp;
|
47 |
{
|
48 |
/*
|
49 |
* This is necessary for static initialization, and is ok
|
50 |
* otherwise because TkWinXInit flips a static bit to do
|
51 |
* its work just once.
|
52 |
*/
|
53 |
TkWinXInit(GetModuleHandle(NULL));
|
54 |
return Tcl_Eval(interp, initScript);
|
55 |
}
|
56 |
|
57 |
/*
|
58 |
*----------------------------------------------------------------------
|
59 |
*
|
60 |
* TkpGetAppName --
|
61 |
*
|
62 |
* Retrieves the name of the current application from a platform
|
63 |
* specific location. For Windows, the application name is the
|
64 |
* root of the tail of the path contained in the tcl variable argv0.
|
65 |
*
|
66 |
* Results:
|
67 |
* Returns the application name in the given Tcl_DString.
|
68 |
*
|
69 |
* Side effects:
|
70 |
* None.
|
71 |
*
|
72 |
*----------------------------------------------------------------------
|
73 |
*/
|
74 |
|
75 |
void
|
76 |
TkpGetAppName(interp, namePtr)
|
77 |
Tcl_Interp *interp;
|
78 |
Tcl_DString *namePtr; /* A previously initialized Tcl_DString. */
|
79 |
{
|
80 |
int argc;
|
81 |
char **argv = NULL, *name, *p;
|
82 |
|
83 |
name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY);
|
84 |
if (name != NULL) {
|
85 |
Tcl_SplitPath(name, &argc, &argv);
|
86 |
if (argc > 0) {
|
87 |
name = argv[argc-1];
|
88 |
p = strrchr(name, '.');
|
89 |
if (p != NULL) {
|
90 |
*p = '\0';
|
91 |
}
|
92 |
} else {
|
93 |
name = NULL;
|
94 |
}
|
95 |
}
|
96 |
if ((name == NULL) || (*name == 0)) {
|
97 |
name = "tk";
|
98 |
}
|
99 |
Tcl_DStringAppend(namePtr, name, -1);
|
100 |
if (argv != NULL) {
|
101 |
ckfree((char *)argv);
|
102 |
}
|
103 |
}
|
104 |
|
105 |
/*
|
106 |
*----------------------------------------------------------------------
|
107 |
*
|
108 |
* TkpDisplayWarning --
|
109 |
*
|
110 |
* This routines is called from Tk_Main to display warning
|
111 |
* messages that occur during startup.
|
112 |
*
|
113 |
* Results:
|
114 |
* None.
|
115 |
*
|
116 |
* Side effects:
|
117 |
* Displays a message box.
|
118 |
*
|
119 |
*----------------------------------------------------------------------
|
120 |
*/
|
121 |
|
122 |
void
|
123 |
TkpDisplayWarning(msg, title)
|
124 |
char *msg; /* Message to be displayed. */
|
125 |
char *title; /* Title of warning. */
|
126 |
{
|
127 |
MessageBox(NULL, msg, title, MB_OK | MB_ICONEXCLAMATION | MB_SYSTEMMODAL
|
128 |
| MB_SETFOREGROUND | MB_TOPMOST);
|
129 |
}
|
130 |
|
131 |
/* End of tkwininit.c */
|