src/c_tk_base_7_5_w_mods/tkwininit.c

/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tk_base/tkwininit.c,v 1.1.1.1 2001/06/13 05:13:34 dtashley Exp $ */

/* 
 * tkWinInit.c --
 *
 *      This file contains Windows-specific interpreter initialization
 *      functions.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkwininit.c,v 1.1.1.1 2001/06/13 05:13:34 dtashley Exp $
 */

#include "tkWinInt.h"

/*
 * The Init script (common to Windows and Unix platforms) is
 * defined in tkInitScript.h
 */
#include "tkInitScript.h"


/*
 *----------------------------------------------------------------------
 *
 * TkpInit --
 *
 *      Performs Windows-specific interpreter initialization related to the
 *      tk_library variable.
 *
 * Results:
 *      A standard Tcl completion code (TCL_OK or TCL_ERROR).  Also
 *      leaves information in the interp's result.
 *
 * Side effects:
 *      Sets "tk_library" Tcl variable, runs "tk.tcl" script.
 *
 *----------------------------------------------------------------------
 */

int
TkpInit(interp)
    Tcl_Interp *interp;
{
    /*
     * This is necessary for static initialization, and is ok
     * otherwise because TkWinXInit flips a static bit to do
     * its work just once.
     */
    TkWinXInit(GetModuleHandle(NULL));
    return Tcl_Eval(interp, initScript);
}

/*
 *----------------------------------------------------------------------
 *
 * TkpGetAppName --
 *
 *      Retrieves the name of the current application from a platform
 *      specific location.  For Windows, the application name is the
 *      root of the tail of the path contained in the tcl variable argv0.
 *
 * Results:
 *      Returns the application name in the given Tcl_DString.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

void
TkpGetAppName(interp, namePtr)
    Tcl_Interp *interp;
    Tcl_DString *namePtr;       /* A previously initialized Tcl_DString. */
{
    int argc;
    char **argv = NULL, *name, *p;

    name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY);
    if (name != NULL) {
        Tcl_SplitPath(name, &argc, &argv);
        if (argc > 0) {
            name = argv[argc-1];
            p = strrchr(name, '.');
            if (p != NULL) {
                *p = '\0';
            }
        } else {
            name = NULL;
        }
    }
    if ((name == NULL) || (*name == 0)) {
        name = "tk";
    }
    Tcl_DStringAppend(namePtr, name, -1);
    if (argv != NULL) {
        ckfree((char *)argv);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TkpDisplayWarning --
 *
 *      This routines is called from Tk_Main to display warning
 *      messages that occur during startup.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Displays a message box.
 *
 *----------------------------------------------------------------------
 */

void
TkpDisplayWarning(msg, title)
    char *msg;                  /* Message to be displayed. */
    char *title;                /* Title of warning. */
{
    MessageBox(NULL, msg, title, MB_OK | MB_ICONEXCLAMATION | MB_SYSTEMMODAL
            | MB_SETFOREGROUND | MB_TOPMOST);
}


/* $History: tkWinInit.c $
 * 
 * *****************  Version 1  *****************
 * User: Dtashley     Date: 1/02/01    Time: 3:15a
 * Created in $/IjuScripter, IjuConsole/Source/Tk Base
 * Initial check-in.
 */

/* End of TKWININIT.C */
1	dashley	25	/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tk_base/tkwininit.c,v 1.1.1.1 2001/06/13 05:13:34 dtashley Exp $ */
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
132			/* $History: tkWinInit.c $
133			*
134			* *************** Version 1 ***************
135			* User: Dtashley Date: 1/02/01 Time: 3:15a
136			* Created in $/IjuScripter, IjuConsole/Source/Tk Base
137			* Initial check-in.
138			*/
139
140			/* End of TKWININIT.C */