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