/[dtapublic]/projs/ets/trunk/src/c_tk_base_7_5_w_mods/tkwininit.c
ViewVC logotype

Diff of /projs/ets/trunk/src/c_tk_base_7_5_w_mods/tkwininit.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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