Subversion Repositories or1k

/*

 * tkMacInit.c --

 *

 *      This file contains Mac-specific interpreter initialization

 *      functions.

 *

 * Copyright (c) 1995-1996 Sun Microsystems, Inc.

 *

 * See the file "license.terms" for information on usage and redistribution

 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

 *

 * RCS: @(#) $Id: tkMacInit.c,v 1.1.1.1 2002-01-16 10:25:55 markom Exp $

 */

#include <Resources.h>

#include <Files.h>

#include <TextUtils.h>

#include <Strings.h>

#include "tkInt.h"

#include "tkMacInt.h"

#include "tclMacInt.h"

/*

 * The following global is used by various parts of Tk to access

 * information in the global qd variable.  It is provided as a pointer

 * in the AppInit because we don't assume that Tk is running as an

 * application.  For example, Tk could be a plugin and may not have

 * access to the qd variable.  This mechanism provides a way for the

 * container application to give a pointer to the qd variable.

 */

QDGlobalsPtr tcl_macQdPtr = NULL;

/*

 *----------------------------------------------------------------------

 *

 * TkpInit --

 *

 *      Performs Mac-specific interpreter initialization related to the

 *      tk_library variable.

 *

 * Results:

 *      A standard Tcl completion code (TCL_OK or TCL_ERROR).  Also

 *      leaves information in interp->result.

 *

 * Side effects:

 *      Sets "tk_library" Tcl variable, runs initialization scripts

 *      for Tk.

 *

 *----------------------------------------------------------------------

 */

int

TkpInit(

    Tcl_Interp *interp)         /* Interp to initialize. */

{

    char *libDir, *tempPath;

    Tcl_DString path;

    int result;

    /*

     * The following does not work with

     * safe interps because file exists is restricted.

     * to be fixed using [interp issafe] like in Unix & Windows.

     */

    static char initCmd[] =

        "if [file exists $tk_library:tk.tcl] {\n\

            source $tk_library:tk.tcl\n\

            source $tk_library:button.tcl\n\

            source $tk_library:entry.tcl\n\

            source $tk_library:listbox.tcl\n\

            source $tk_library:menu.tcl\n\

            source $tk_library:scale.tcl\n\

            source $tk_library:scrlbar.tcl\n\

            source $tk_library:text.tcl\n\

            source $tk_library:comdlg.tcl\n\

            source $tk_library:msgbox.tcl\n\

        } else {\n\

            set msg \"can't find tk resource or $tk_library:tk.tcl;\"\n\

            append msg \" perhaps you need to\\ninstall Tk or set your \"\n\

            append msg \"TK_LIBRARY environment variable?\"\n\

            error $msg\n\

        }";

    Tcl_DStringInit(&path);

    /*

     * The tk_library path can be found in several places.  Here is the order

     * in which the are searched.

     *          1) the variable may already exist

     *          2) env array

     *          3) System Folder:Extensions:Tool Command Language:

     */

    libDir = Tcl_GetVar(interp, "tk_library", TCL_GLOBAL_ONLY);

    if (libDir == NULL) {

        libDir = Tcl_GetVar2(interp, "env", "TK_LIBRARY", TCL_GLOBAL_ONLY);

    }

    if (libDir == NULL) {

        tempPath = Tcl_GetVar2(interp, "env", "EXT_FOLDER", TCL_GLOBAL_ONLY);

        if (tempPath != NULL) {

            Tcl_DString libPath;

            Tcl_JoinPath(1, &tempPath, &path);

            Tcl_DStringInit(&libPath);

            Tcl_DStringAppend(&libPath, ":Tool Command Language:tk", -1);

            Tcl_DStringAppend(&libPath, TK_VERSION, -1);

            Tcl_JoinPath(1, &libPath.string, &path);

            Tcl_DStringFree(&libPath);

            libDir = path.string;

        }

    }

    if (libDir == NULL) {

        libDir = "no library";

    }

    /*

     * Assign path to the global Tcl variable tcl_library.

     */

    Tcl_SetVar(interp, "tk_library", libDir, TCL_GLOBAL_ONLY);

    Tcl_DStringFree(&path);

    /*

     * Source the needed Tk libraries from the resource

     * fork of the application.

     */

    result = Tcl_MacEvalResource(interp, "tk", 0, NULL);

    result |= Tcl_MacEvalResource(interp, "button", 0, NULL);

    result |= Tcl_MacEvalResource(interp, "entry", 0, NULL);

    result |= Tcl_MacEvalResource(interp, "listbox", 0, NULL);

    result |= Tcl_MacEvalResource(interp, "menu", 0, NULL);

    result |= Tcl_MacEvalResource(interp, "scale", 0, NULL);

    result |= Tcl_MacEvalResource(interp, "scrollbar", 0, NULL);

    result |= Tcl_MacEvalResource(interp, "text", 0, NULL);

    result |= Tcl_MacEvalResource(interp, "dialog", 0, NULL);

    result |= Tcl_MacEvalResource(interp, "focus", 0, NULL);

    result |= Tcl_MacEvalResource(interp, "optionMenu", 0, NULL);

    result |= Tcl_MacEvalResource(interp, "palette", 0, NULL);

    result |= Tcl_MacEvalResource(interp, "tearoff", 0, NULL);

    result |= Tcl_MacEvalResource(interp, "tkerror", 0, NULL);

    result |= Tcl_MacEvalResource(interp, "comdlg", 0, NULL);

    result |= Tcl_MacEvalResource(interp, "msgbox", 0, NULL);

    if (result != TCL_OK) {

        result = Tcl_Eval(interp, initCmd);

    }

    return result;

}

/*

 *----------------------------------------------------------------------

 *

 * TkpGetAppName --

 *

 *      Retrieves the name of the current application from a platform

 *      specific location.  On the Macintosh we look to see if the

 *      App Name is specified in a resource.  If not, the application

 *      name is the root of the tail of the path contained in the tcl

 *      variable argv0.

 *

 * Results:

 *      Returns the application name in the given Tcl_DString.

 *

 * Side effects:

 *      None.

 *

 *----------------------------------------------------------------------

 */

void

TkpGetAppName(

    Tcl_Interp *interp,         /* The main interpreter. */

    Tcl_DString *namePtr)       /* A previously initialized Tcl_DString. */

{

    int argc;

    char **argv = NULL, *name, *p;

    Handle h = NULL;

    h = GetNamedResource('STR ', "\pTk App Name");

    if (h != NULL) {

        HLock(h);

        Tcl_DStringAppend(namePtr, (*h)+1, **h);

        HUnlock(h);

        ReleaseResource(h);

        return;

    }

    name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY);

    if (name != NULL) {

        Tcl_SplitPath(name, &argc, &argv);

        if (argc > 0) {

            name = argv[argc-1];

            p = strrchr(name, '.');

            if (p != NULL) {

                *p = '\0';

            }

        } else {

            name = NULL;

        }

    }

    if ((name == NULL) || (*name == 0)) {

        name = "tk";

    }

    Tcl_DStringAppend(namePtr, name, -1);

    if (argv != NULL) {

        ckfree((char *)argv);

    }

}

/*

 *----------------------------------------------------------------------

 *

 * TkpDisplayWarning --

 *

 *      This routines is called from Tk_Main to display warning

 *      messages that occur during startup.

 *

 * Results:

 *      None.

 *

 * Side effects:

 *      Displays a message box.

 *

 *----------------------------------------------------------------------

 */

void

TkpDisplayWarning(

    char *msg,                  /* Message to be displayed. */

    char *title)                /* Title of warning. */

{

    Tcl_DString ds;

    Tcl_DStringInit(&ds);

    Tcl_DStringAppend(&ds, title, -1);

    Tcl_DStringAppend(&ds, ": ", -1);

    Tcl_DStringAppend(&ds, msg, -1);

    panic(Tcl_DStringValue(&ds));

    Tcl_DStringFree(&ds);

}