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