1/* 2 * tkUnixInit.c -- 3 * 4 * This file contains Unix-specific interpreter initialization functions. 5 * 6 * Copyright (c) 1995-1997 Sun Microsystems, Inc. 7 * 8 * See the file "license.terms" for information on usage and redistribution of 9 * this file, and for a DISCLAIMER OF ALL WARRANTIES. 10 * 11 * RCS: @(#) $Id$ 12 */ 13 14#include "tkUnixInt.h" 15 16#ifdef HAVE_COREFOUNDATION 17static int GetLibraryPath(Tcl_Interp *interp); 18#else 19#define GetLibraryPath(dummy) (void)0 20#endif /* HAVE_COREFOUNDATION */ 21 22/* 23 *---------------------------------------------------------------------- 24 * 25 * TkpInit -- 26 * 27 * Performs Unix-specific interpreter initialization related to the 28 * tk_library variable. 29 * 30 * Results: 31 * Returns a standard Tcl result. Leaves an error message or result in 32 * the interp's result. 33 * 34 * Side effects: 35 * Sets "tk_library" Tcl variable, runs "tk.tcl" script. 36 * 37 *---------------------------------------------------------------------- 38 */ 39 40int 41TkpInit( 42 Tcl_Interp *interp) 43{ 44 TkCreateXEventSource(); 45 GetLibraryPath(interp); 46 return TCL_OK; 47} 48 49/* 50 *---------------------------------------------------------------------- 51 * 52 * TkpGetAppName -- 53 * 54 * Retrieves the name of the current application from a platform specific 55 * location. For Unix, the application name is the tail of the path 56 * 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 67void 68TkpGetAppName( 69 Tcl_Interp *interp, 70 Tcl_DString *namePtr) /* A previously initialized Tcl_DString. */ 71{ 72 CONST char *p, *name; 73 74 name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY); 75 if ((name == NULL) || (*name == 0)) { 76 name = "tk"; 77 } else { 78 p = strrchr(name, '/'); 79 if (p != NULL) { 80 name = p+1; 81 } 82 } 83 Tcl_DStringAppend(namePtr, name, -1); 84} 85 86/* 87 *---------------------------------------------------------------------- 88 * 89 * TkpDisplayWarning -- 90 * 91 * This routines is called from Tk_Main to display warning messages that 92 * occur during startup. 93 * 94 * Results: 95 * None. 96 * 97 * Side effects: 98 * Generates messages on stdout. 99 * 100 *---------------------------------------------------------------------- 101 */ 102 103void 104TkpDisplayWarning( 105 CONST char *msg, /* Message to be displayed. */ 106 CONST char *title) /* Title of warning. */ 107{ 108 Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR); 109 if (errChannel) { 110 Tcl_WriteChars(errChannel, title, -1); 111 Tcl_WriteChars(errChannel, ": ", 2); 112 Tcl_WriteChars(errChannel, msg, -1); 113 Tcl_WriteChars(errChannel, "\n", 1); 114 } 115} 116 117#ifdef HAVE_COREFOUNDATION 118 119/* 120 *---------------------------------------------------------------------- 121 * 122 * GetLibraryPath -- 123 * 124 * If we have a bundle structure for the Tk installation, then check 125 * there first to see if we can find the libraries there. 126 * 127 * Results: 128 * TCL_OK if we have found the tk library; TCL_ERROR otherwise. 129 * 130 * Side effects: 131 * Same as for Tcl_MacOSXOpenVersionedBundleResources. 132 * 133 *---------------------------------------------------------------------- 134 */ 135 136static int 137GetLibraryPath( 138 Tcl_Interp *interp) 139{ 140#ifdef TK_FRAMEWORK 141 int foundInFramework = TCL_ERROR; 142 char tkLibPath[PATH_MAX + 1]; 143 144 foundInFramework = Tcl_MacOSXOpenVersionedBundleResources(interp, 145 "com.tcltk.tklibrary", TK_FRAMEWORK_VERSION, 0, PATH_MAX, 146 tkLibPath); 147 if (tkLibPath[0] != '\0') { 148 Tcl_SetVar(interp, "tk_library", tkLibPath, TCL_GLOBAL_ONLY); 149 } 150 return foundInFramework; 151#else 152 return TCL_ERROR; 153#endif 154} 155#endif /* HAVE_COREFOUNDATION */ 156 157/* 158 * Local Variables: 159 * mode: c 160 * c-basic-offset: 4 161 * fill-column: 78 162 * End: 163 */ 164