home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / mac / tkMacInit.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  6.7 KB  |  241 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tkMacInit.c --
  3.  *
  4.  *    This file contains Mac-specific interpreter initialization
  5.  *    functions.
  6.  *
  7.  * Copyright (c) 1995-1996 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.  * SCCS: @(#) tkMacInit.c 1.30 96/12/17 15:20:16
  13.  */
  14.  
  15. #include <Resources.h>
  16. #include <Files.h>
  17. #include <TextUtils.h>
  18. #include <Strings.h>
  19. #include "tkInt.h"
  20. #include "tkMacInt.h"
  21. #include "tclMacInt.h"
  22.  
  23. /*
  24.  * The following global is used by various parts of Tk to access
  25.  * information in the global qd variable.  It is provided as a pointer
  26.  * in the AppInit because we don't assume that Tk is running as an
  27.  * application.  For example, Tk could be a plugin and may not have
  28.  * access to the qd variable.  This mechanism provides a way for the
  29.  * container application to give a pointer to the qd variable.
  30.  */
  31.  
  32. QDGlobalsPtr tcl_macQdPtr = NULL;
  33.  
  34. /*
  35.  *----------------------------------------------------------------------
  36.  *
  37.  * TkpInit --
  38.  *
  39.  *    Performs Mac-specific interpreter initialization related to the
  40.  *      tk_library variable.
  41.  *
  42.  * Results:
  43.  *    A standard Tcl completion code (TCL_OK or TCL_ERROR).  Also
  44.  *    leaves information in interp->result.
  45.  *
  46.  * Side effects:
  47.  *    Sets "tk_library" Tcl variable, runs initialization scripts
  48.  *    for Tk.
  49.  *
  50.  *----------------------------------------------------------------------
  51.  */
  52.  
  53. int
  54. TkpInit(
  55.     Tcl_Interp *interp)        /* Interp to initialize. */
  56. {
  57.     char *libDir, *tempPath;
  58.     Tcl_DString path;
  59.     int result;
  60.  
  61.     /*
  62.      * The following does not work with
  63.      * safe interps because file exists is restricted.
  64.      * to be fixed using [interp issafe] like in Unix & Windows.
  65.      */
  66.     static char initCmd[] =
  67.     "if [file exists $tk_library:tk.tcl] {\n\
  68.         source $tk_library:tk.tcl\n\
  69.         source $tk_library:button.tcl\n\
  70.         source $tk_library:entry.tcl\n\
  71.         source $tk_library:listbox.tcl\n\
  72.         source $tk_library:menu.tcl\n\
  73.         source $tk_library:scale.tcl\n\
  74.         source $tk_library:scrlbar.tcl\n\
  75.         source $tk_library:text.tcl\n\
  76.         source $tk_library:comdlg.tcl\n\
  77.         source $tk_library:msgbox.tcl\n\
  78.     } else {\n\
  79.         set msg \"can't find tk resource or $tk_library:tk.tcl;\"\n\
  80.         append msg \" perhaps you need to\\ninstall Tk or set your \"\n\
  81.         append msg \"TK_LIBRARY environment variable?\"\n\
  82.         error $msg\n\
  83.     }";
  84.  
  85.     Tcl_DStringInit(&path);
  86.  
  87.     /*
  88.      * The tk_library path can be found in several places.  Here is the order
  89.      * in which the are searched.
  90.      *        1) the variable may already exist
  91.      *        2) env array
  92.      *        3) System Folder:Extensions:Tool Command Language:
  93.      */
  94.      
  95.     libDir = Tcl_GetVar(interp, "tk_library", TCL_GLOBAL_ONLY);
  96.     if (libDir == NULL) {
  97.     libDir = Tcl_GetVar2(interp, "env", "TK_LIBRARY", TCL_GLOBAL_ONLY);
  98.     }
  99.     if (libDir == NULL) {
  100.     tempPath = Tcl_GetVar2(interp, "env", "EXT_FOLDER", TCL_GLOBAL_ONLY);
  101.     if (tempPath != NULL) {
  102.         Tcl_DString libPath;
  103.         
  104.         Tcl_JoinPath(1, &tempPath, &path);
  105.         
  106.         Tcl_DStringInit(&libPath);
  107.         Tcl_DStringAppend(&libPath, ":Tool Command Language:tk", -1);
  108.         Tcl_DStringAppend(&libPath, TK_VERSION, -1);
  109.         Tcl_JoinPath(1, &libPath.string, &path);
  110.         Tcl_DStringFree(&libPath);
  111.         libDir = path.string;
  112.     }
  113.     }
  114.     if (libDir == NULL) {
  115.     libDir = "no library";
  116.     }
  117.  
  118.     /*
  119.      * Assign path to the global Tcl variable tcl_library.
  120.      */
  121.     Tcl_SetVar(interp, "tk_library", libDir, TCL_GLOBAL_ONLY);
  122.     Tcl_DStringFree(&path);
  123.  
  124.     /*
  125.      * Source the needed Tk libraries from the resource
  126.      * fork of the application.
  127.      */
  128.     result = Tcl_MacEvalResource(interp, "tk", 0, NULL);
  129.     result |= Tcl_MacEvalResource(interp, "button", 0, NULL);
  130.     result |= Tcl_MacEvalResource(interp, "entry", 0, NULL);
  131.     result |= Tcl_MacEvalResource(interp, "listbox", 0, NULL);
  132.     result |= Tcl_MacEvalResource(interp, "menu", 0, NULL);
  133.     result |= Tcl_MacEvalResource(interp, "scale", 0, NULL);
  134.     result |= Tcl_MacEvalResource(interp, "scrollbar", 0, NULL);
  135.     result |= Tcl_MacEvalResource(interp, "text", 0, NULL);
  136.     result |= Tcl_MacEvalResource(interp, "dialog", 0, NULL);
  137.     result |= Tcl_MacEvalResource(interp, "focus", 0, NULL);
  138.     result |= Tcl_MacEvalResource(interp, "optionMenu", 0, NULL);
  139.     result |= Tcl_MacEvalResource(interp, "palette", 0, NULL);
  140.     result |= Tcl_MacEvalResource(interp, "tearoff", 0, NULL);
  141.     result |= Tcl_MacEvalResource(interp, "tkerror", 0, NULL);
  142.     result |= Tcl_MacEvalResource(interp, "comdlg", 0, NULL);
  143.     result |= Tcl_MacEvalResource(interp, "msgbox", 0, NULL);
  144.  
  145.     if (result != TCL_OK) {
  146.     result = Tcl_Eval(interp, initCmd);
  147.     }
  148.     return result;
  149. }
  150.  
  151. /*
  152.  *----------------------------------------------------------------------
  153.  *
  154.  * TkpGetAppName --
  155.  *
  156.  *    Retrieves the name of the current application from a platform
  157.  *    specific location.  On the Macintosh we look to see if the
  158.  *    App Name is specified in a resource.  If not, the application 
  159.  *    name is the root of the tail of the path contained in the tcl
  160.  *    variable argv0.
  161.  *
  162.  * Results:
  163.  *    Returns the application name in the given Tcl_DString.
  164.  *
  165.  * Side effects:
  166.  *    None.
  167.  *
  168.  *----------------------------------------------------------------------
  169.  */
  170.  
  171. void
  172. TkpGetAppName(
  173.     Tcl_Interp *interp,        /* The main interpreter. */
  174.     Tcl_DString *namePtr)    /* A previously initialized Tcl_DString. */
  175. {
  176.     int argc;
  177.     char **argv = NULL, *name, *p;
  178.     Handle h = NULL;
  179.  
  180.     h = GetNamedResource('STR ', "\pTk App Name");
  181.     if (h != NULL) {
  182.     HLock(h);
  183.     Tcl_DStringAppend(namePtr, (*h)+1, **h);
  184.     HUnlock(h);
  185.     ReleaseResource(h);
  186.     return;
  187.     }
  188.     
  189.     name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY);
  190.     if (name != NULL) {
  191.     Tcl_SplitPath(name, &argc, &argv);
  192.     if (argc > 0) {
  193.         name = argv[argc-1];
  194.         p = strrchr(name, '.');
  195.         if (p != NULL) {
  196.         *p = '\0';
  197.         }
  198.     } else {
  199.         name = NULL;
  200.     }
  201.     }
  202.     if ((name == NULL) || (*name == 0)) {
  203.     name = "tk";
  204.     }
  205.     Tcl_DStringAppend(namePtr, name, -1);
  206.     if (argv != NULL) {
  207.     ckfree((char *)argv);
  208.     }
  209. }
  210.  
  211. /*
  212.  *----------------------------------------------------------------------
  213.  *
  214.  * TkpDisplayWarning --
  215.  *
  216.  *    This routines is called from Tk_Main to display warning
  217.  *    messages that occur during startup.
  218.  *
  219.  * Results:
  220.  *    None.
  221.  *
  222.  * Side effects:
  223.  *    Displays a message box.
  224.  *
  225.  *----------------------------------------------------------------------
  226.  */
  227.  
  228. void
  229. TkpDisplayWarning(
  230.     char *msg,            /* Message to be displayed. */
  231.     char *title)        /* Title of warning. */
  232. {
  233.     Tcl_DString ds;
  234.     Tcl_DStringInit(&ds);
  235.     Tcl_DStringAppend(&ds, title, -1);
  236.     Tcl_DStringAppend(&ds, ": ", -1);
  237.     Tcl_DStringAppend(&ds, msg, -1);
  238.     panic(Tcl_DStringValue(&ds));
  239.     Tcl_DStringFree(&ds);
  240. }
  241.