/* 
 * tkMacInit.c --
 *
 *	This file contains Mac-specific interpreter initialization
 *	functions.
 *
 * Copyright (c) 1995-1997 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.3 1999/04/16 01:51:31 stanton 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;

/*
 * Default directory in which to look for libraries:
 */

#ifndef TK_LIBRARY
#define TK_LIBRARY "."
#endif

static char defaultLibraryDir[200] = TK_LIBRARY;

/*
 * The following string is the startup script executed in new
 * interpreters.  It looks on disk in several different directories
 * for a script "tk.tcl" that is compatible with this version
 * of Tk.  The tk.tcl script does all of the real work of
 * initialization.
 */

static char initScript[] =
"proc tkInit {} {\n\
    global tk_library tk_version tk_patchLevel env\n\
    set errors \"\"\n\
    rename tkInit {}\n\
    set dirs {}\n\
    if [info exists env(TK_LIBRARY)] {\n\
	lappend dirs $env(TK_LIBRARY)\n\
    }\n\
    lappend dirs $tk_library\n\
    set tk_library {}\n\
    if ![catch {uplevel #0 source -rsrc tk}] {\n\
	uplevel #0 {\n\
    	    source -rsrc button\n\
    	    source -rsrc entry\n\
    	    source -rsrc listbox\n\
    	    source -rsrc menu\n\
    	    source -rsrc scale\n\
    	    source -rsrc scrollbar\n\
    	    source -rsrc text\n\
    	    source -rsrc dialog\n\
    	    source -rsrc focus\n\
    	    source -rsrc optionMenu\n\
    	    source -rsrc palette\n\
    	    source -rsrc tearoff\n\
    	    source -rsrc tkerror\n\
    	    source -rsrc comdlg\n\
    	    source -rsrc msgbox\n\\n\
	}\n\
	return\n\
    }\n\
    lappend dirs [file join [file dirname [info library]] tk$tk_version]\n\
    set parentDir [file dirname [file dirname [info nameofexecutable]]]\n\
    lappend dirs [file join $parentDir lib tk$tk_version]\n\
    if {![regexp {.*[ab][12345]} $tk_patchLevel version]} {\n\
	set version $tk_version\n\
    }\n\
    lappend dirs [file join [file dirname $parentDir] tk$version library]\n\
    lappend dirs [file join $parentDir library]\n\
    foreach i $dirs {\n\
	set tk_library $i\n\
	if ![catch {uplevel #0 source [list [file join $i tk.tcl]]}] {\n\
	    return\n\
	} else {\n\
	    append errors \"[file join $i tk.tcl]: $msg\n$errorInfo\n\"\n\
	}\n\
    }\n\
    set tk_library {}\n\
    set msg \"Can't find a usable tk.tcl in the following directories: \n\"\n\
    append msg \"    $dirs\n\"\n\
    append msg \"This probably means that Tk wasn't installed properly.\n\"\n\
    error $msg\n\
}\n\
tkInit";

/*
 * The following script is used to initialize Tk in a safe interpreter.
 */

static char safeInitScript[] =
"proc tkInit {} {\n\
    global tk_library tk_version tk_patchLevel env\n\
    set errors \"\"\n\
    rename tkInit {}\n\
    set dirs {}\n\
    if [info exists env(TK_LIBRARY)] {\n\
	lappend dirs $env(TK_LIBRARY)\n\
    }\n\
    lappend dirs $tk_library\n\
    set tk_library {}\n\
    if ![catch {uplevel #0 source -rsrc tk}] {\n\
	uplevel #0 {\n\
    	    source -rsrc button\n\
    	    source -rsrc entry\n\
    	    source -rsrc listbox\n\
    	    source -rsrc menu\n\
    	    source -rsrc scale\n\
    	    source -rsrc scrollbar\n\
    	    source -rsrc text\n\
    	    source -rsrc dialog\n\
    	    source -rsrc focus\n\
    	    source -rsrc optionMenu\n\
    	    source -rsrc palette\n\
    	    source -rsrc tearoff\n\
    	    source -rsrc tkerror\n\
    	    source -rsrc comdlg\n\
    	    source -rsrc msgbox\n\\n\
	}\n\
	return\n\
    }\n\
    lappend dirs [file join [file dirname [info library]] tk$tk_version]\n\
    set parentDir [file dirname [file dirname [info nameofexecutable]]]\n\
    lappend dirs [file join $parentDir lib tk$tk_version]\n\
    if {![regexp {.*[ab][1-9]} $tk_patchLevel version]} {\n\
	set version $tk_version\n\
    }\n\
    lappend dirs [file join [file dirname [file dirname [info library]]] tk$version library]\n\
    foreach i $dirs {\n\
	set tk_library $i\n\
	if ![catch {uplevel #0 source [list [file join $i tk.tcl]]}] {\n\
	    return\n\
	} else {\n\
	    append errors \"[file join $i tk.tcl]: $msg\n$errorInfo\n\"\n\
	}\n\
    }\n\
    set tk_library {}\n\
    set msg \"Can't find a usable tk.tcl in the following directories: \n\"\n\
    append msg \"    $dirs\n\n\"\n\
    append msg \"$errors\n\n\"\n\
    append msg \"This probably means that Tk wasn't installed properly.\n\"\n\
    error $msg\n\
}\n\
tkInit";


/*
 *----------------------------------------------------------------------
 *
 * 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 the interp's 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;

    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) System Folder:Extensions:Tool Command Language:
     *		3) env array
     */

    libDir = Tcl_GetVar(interp, "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 = "";
    }

    /*
     * Assign path to the global Tcl variable tcl_library.
     */
    Tcl_SetVar(interp, "tk_library", libDir, TCL_GLOBAL_ONLY);
    Tcl_DStringFree(&path);

    if (doSafe) {
	return Tcl_Eval(interp, safeInitScript);
    }
    return Tcl_Eval(interp, initScript);
}

/*
 *----------------------------------------------------------------------
 *
 * 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);
}
