tk/macosx/tkMacOSXInit.c

   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  * Copyright 2001, Apple Computer, Inc.
   9  *
  10  * See the file "license.terms" for information on usage and redistribution
  11  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12  *
  13  * RCS: @(#) $Id$
  14  */
  15
  16 #include "tkInt.h"
  17 #include "tkMacOSXInt.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  * The following structures are used to map the script/language codes of a
  27  * font to the name that should be passed to Tcl_GetEncoding() to obtain
  28  * the encoding for that font.  The set of numeric constants is fixed and
  29  * defined by Apple.
  30  */
  31
  32 typedef struct Map {
  33     int numKey;
  34     char *strKey;
  35 } Map;
  36
  37 static Map scriptMap[] = {
  38     {smRoman,           "macRoman"},
  39     {smJapanese,        "macJapan"},
  40     {smTradChinese,     "macChinese"},
  41     {smKorean,          "macKorean"},
  42     {smArabic,          "macArabic"},
  43     {smHebrew,          "macHebrew"},
  44     {smGreek,           "macGreek"},
  45     {smCyrillic,        "macCyrillic"},
  46     {smRSymbol,         "macRSymbol"},
  47     {smDevanagari,      "macDevanagari"},
  48     {smGurmukhi,        "macGurmukhi"},
  49     {smGujarati,        "macGujarati"},
  50     {smOriya,           "macOriya"},
  51     {smBengali,         "macBengali"},
  52     {smTamil,           "macTamil"},
  53     {smTelugu,          "macTelugu"},
  54     {smKannada,         "macKannada"},
  55     {smMalayalam,       "macMalayalam"},
  56     {smSinhalese,       "macSinhalese"},
  57     {smBurmese,         "macBurmese"},
  58     {smKhmer,           "macKhmer"},
  59     {smThai,            "macThailand"},
  60     {smLaotian,         "macLaos"},
  61     {smGeorgian,        "macGeorgia"},
  62     {smArmenian,        "macArmenia"},
  63     {smSimpChinese,     "macSimpChinese"},
  64     {smTibetan,         "macTIbet"},
  65     {smMongolian,       "macMongolia"},
  66     {smGeez,            "macEthiopia"},
  67     {smEastEurRoman,    "macCentEuro"},
  68     {smVietnamese,      "macVietnam"},
  69     {smExtArabic,       "macSindhi"},
  70     {NULL,              NULL}
  71 };
  72
  73 Tcl_Encoding TkMacOSXCarbonEncoding = NULL;
  74
  75 \f
  76 /*
  77  *----------------------------------------------------------------------
  78  *
  79  * TkpInit --
  80  *
  81  *        Performs Mac-specific interpreter initialization related to the
  82  *      tk_library variable.
  83  *
  84  * Results:
  85  *        Returns a standard Tcl result.  Leaves an error message or result
  86  *        in the interp's result.
  87  *
  88  * Side effects:
  89  *        Sets "tk_library" Tcl variable, runs "tk.tcl" script.
  90  *
  91  *----------------------------------------------------------------------
  92  */
  93
  94 int
  95 TkpInit(interp)
  96     Tcl_Interp *interp;
  97 {
  98     char tkLibPath[1024];
  99     int result;
 100     static int menusInitialized = false;
 101     static int carbonEncodingInitialized = false;
 102
 103     /*
 104      * Since it is possible for TkInit to be called multiple times
 105      * and we don't want to do the menu initialization multiple times
 106      * we protect against doing it more than once.
 107      */
 108
 109     if (menusInitialized == false) {
 110         menusInitialized = true;
 111         Tk_MacOSXSetupTkNotifier();
 112         TkMacOSXInitAppleEvents(interp);
 113         TkMacOSXInitMenus(interp);
 114     }
 115
 116     if (carbonEncodingInitialized == false) {
 117         CFStringEncoding encoding;
 118         char *encodingStr = NULL;
 119         int  i;
 120
 121         encoding = CFStringGetSystemEncoding();
 122
 123         for (i = 0; scriptMap[i].strKey != NULL; i++) {
 124             if (scriptMap[i].numKey == encoding) {
 125                 encodingStr = scriptMap[i].strKey;
 126                 break;
 127             }
 128         }
 129         if (encodingStr == NULL) {
 130             encodingStr = "macRoman";
 131         }
 132
 133         TkMacOSXCarbonEncoding = Tcl_GetEncoding (NULL, encodingStr);
 134         if (TkMacOSXCarbonEncoding == NULL) {
 135             TkMacOSXCarbonEncoding = Tcl_GetEncoding (NULL, NULL);
 136         }
 137     }
 138
 139     /*
 140      * When Tk is in a framework, force tcl_findLibrary to look in the
 141      * framework scripts directory.
 142      * FIXME: Should we come up with a more generic way of doing this?
 143      */
 144
 145     result = Tcl_MacOSXOpenBundleResources(interp, "com.tcltk.tklibrary",
 146                 1, 1024, tkLibPath);
 147
 148     if (result != TCL_ERROR) {
 149         Tcl_SetVar(interp, "tk_library", tkLibPath, TCL_GLOBAL_ONLY);
 150     }
 151
 152     return Tcl_Eval(interp, initScript);
 153 }
 154 \f
 155 /*
 156  *----------------------------------------------------------------------
 157  *
 158  * TkpGetAppName --
 159  *
 160  *        Retrieves the name of the current application from a platform
 161  *        specific location.  For Unix, the application name is the tail
 162  *        of the path contained in the tcl variable argv0.
 163  *
 164  * Results:
 165  *        Returns the application name in the given Tcl_DString.
 166  *
 167  * Side effects:
 168  *        None.
 169  *
 170  *----------------------------------------------------------------------
 171  */
 172
 173 void
 174 TkpGetAppName(interp, namePtr)
 175     Tcl_Interp *interp;
 176     Tcl_DString *namePtr;        /* A previously initialized Tcl_DString. */
 177 {
 178     CONST char *p, *name;
 179
 180     name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY);
 181     if ((name == NULL) || (*name == 0)) {
 182         name = "tk";
 183     } else {
 184         p = strrchr(name, '/');
 185         if (p != NULL) {
 186             name = p+1;
 187         }
 188     }
 189     Tcl_DStringAppend(namePtr, name, -1);
 190 }
 191 \f
 192 /*
 193  *----------------------------------------------------------------------
 194  *
 195  * TkpDisplayWarning --
 196  *
 197  *        This routines is called from Tk_Main to display warning
 198  *        messages that occur during startup.
 199  *
 200  * Results:
 201  *        None.
 202  *
 203  * Side effects:
 204  *        Generates messages on stdout.
 205  *
 206  *----------------------------------------------------------------------
 207  */
 208
 209 void
 210 TkpDisplayWarning(msg, title)
 211     CONST char *msg;                  /* Message to be displayed. */
 212     CONST char *title;                /* Title of warning. */
 213 {
 214     Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
 215     if (errChannel) {
 216         Tcl_WriteChars(errChannel, title, -1);
 217         Tcl_WriteChars(errChannel, ": ", 2);
 218         Tcl_WriteChars(errChannel, msg, -1);
 219         Tcl_WriteChars(errChannel, "\n", 1);
 220     }
 221 }