tk/win/tkWinInit.c

   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$
  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 \f
  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 interp->result.
  35  *
  36  * Side effects:
  37  *      Sets "tk_library" Tcl variable, runs "tk.tcl" script.
  38  *
  39  *----------------------------------------------------------------------
  40  */
  41
  42 int
  43 TkpInit(interp)
  44     Tcl_Interp *interp;
  45 {
  46     return Tcl_Eval(interp, initScript);
  47 }
  48 \f
  49 /*
  50  *----------------------------------------------------------------------
  51  *
  52  * TkpGetAppName --
  53  *
  54  *      Retrieves the name of the current application from a platform
  55  *      specific location.  For Windows, the application name is the
  56  *      root of the tail of the path contained in the tcl variable argv0.
  57  *
  58  * Results:
  59  *      Returns the application name in the given Tcl_DString.
  60  *
  61  * Side effects:
  62  *      None.
  63  *
  64  *----------------------------------------------------------------------
  65  */
  66
  67 void
  68 TkpGetAppName(interp, namePtr)
  69     Tcl_Interp *interp;
  70     Tcl_DString *namePtr;       /* A previously initialized Tcl_DString. */
  71 {
  72     int argc;
  73     char **argv = NULL, *name, *p;
  74
  75     name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY);
  76     if (name != NULL) {
  77         Tcl_SplitPath(name, &argc, &argv);
  78         if (argc > 0) {
  79             name = argv[argc-1];
  80             p = strrchr(name, '.');
  81             if (p != NULL) {
  82                 *p = '\0';
  83             }
  84         } else {
  85             name = NULL;
  86         }
  87     }
  88     if ((name == NULL) || (*name == 0)) {
  89         name = "tk";
  90     }
  91     Tcl_DStringAppend(namePtr, name, -1);
  92     if (argv != NULL) {
  93         ckfree((char *)argv);
  94     }
  95 }
  96 \f
  97 /*
  98  *----------------------------------------------------------------------
  99  *
 100  * TkpDisplayWarning --
 101  *
 102  *      This routines is called from Tk_Main to display warning
 103  *      messages that occur during startup.
 104  *
 105  * Results:
 106  *      None.
 107  *
 108  * Side effects:
 109  *      Displays a message box.
 110  *
 111  *----------------------------------------------------------------------
 112  */
 113
 114 void
 115 TkpDisplayWarning(msg, title)
 116     char *msg;                  /* Message to be displayed. */
 117     char *title;                /* Title of warning. */
 118 {
 119     MessageBox(NULL, msg, title, MB_OK | MB_ICONEXCLAMATION | MB_SYSTEMMODAL
 120             | MB_SETFOREGROUND | MB_TOPMOST);
 121 }