1 /*
2 * tkUnixInit.c --
3 *
4 * This file contains Unix-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: tkUnixInit.c,v 1.5 2002/01/25 21:09:37 dgp Exp $
13 */
14
15 #include "tkInt.h"
16 #include "tkUnixInt.h"
17
18 /*
19 * The Init script (common to Windows and Unix platforms) is
20 * defined in tkInitScript.h
21 */
22 #include "tkInitScript.h"
23
24
25 /*
26 *----------------------------------------------------------------------
27 *
28 * TkpInit --
29 *
30 * Performs Unix-specific interpreter initialization related to the
31 * tk_library variable.
32 *
33 * Results:
34 * Returns a standard Tcl result. Leaves an error message or result
35 * in the interp's result.
36 *
37 * Side effects:
38 * Sets "tk_library" Tcl variable, runs "tk.tcl" script.
39 *
40 *----------------------------------------------------------------------
41 */
42
43 int
TkpInit(interp)44 TkpInit(interp)
45 Tcl_Interp *interp;
46 {
47 CONST char *libDir;
48
49 libDir = Tcl_GetVar(interp, "tk_library", TCL_GLOBAL_ONLY);
50 if (libDir == NULL || *libDir == '\0') {
51 Tcl_SetVar(interp, "tk_library", TK_LIBRARY, TCL_GLOBAL_ONLY);
52 }
53 TkCreateXEventSource();
54 #ifndef _LANG
55 return Tcl_Eval(interp, initScript);
56 #else
57 return TCL_OK;
58 #endif
59 }
60
61 /*
62 *----------------------------------------------------------------------
63 *
64 * TkpGetAppName --
65 *
66 * Retrieves the name of the current application from a platform
67 * specific location. For Unix, the application name is the tail
68 * of the path contained in the tcl variable argv0.
69 *
70 * Results:
71 * Returns the application name in the given Tcl_DString.
72 *
73 * Side effects:
74 * None.
75 *
76 *----------------------------------------------------------------------
77 */
78
79 void
TkpGetAppName(interp,namePtr)80 TkpGetAppName(interp, namePtr)
81 Tcl_Interp *interp;
82 Tcl_DString *namePtr; /* A previously initialized Tcl_DString. */
83 {
84 CONST char *p, *name;
85
86 name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY);
87 if ((name == NULL) || (*name == 0)) {
88 name = "tk";
89 } else {
90 p = strrchr(name, '/');
91 if (p != NULL) {
92 name = p+1;
93 }
94 }
95 Tcl_DStringAppend(namePtr, name, -1);
96 }
97
98 /*
99 *----------------------------------------------------------------------
100 *
101 * TkpDisplayWarning --
102 *
103 * This routines is called from Tk_Main to display warning
104 * messages that occur during startup.
105 *
106 * Results:
107 * None.
108 *
109 * Side effects:
110 * Generates messages on stdout.
111 *
112 *----------------------------------------------------------------------
113 */
114
115 void
TkpDisplayWarning(msg,title)116 TkpDisplayWarning(msg, title)
117 CONST char *msg; /* Message to be displayed. */
118 CONST char *title; /* Title of warning. */
119 {
120 Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
121 if (errChannel) {
122 Tcl_WriteChars(errChannel, title, -1);
123 Tcl_WriteChars(errChannel, ": ", 2);
124 Tcl_WriteChars(errChannel, msg, -1);
125 Tcl_WriteChars(errChannel, "\n", 1);
126 }
127 }
128
129
130