Initial revision

1 files changed, 240 insertions, 0 deletions

diff --git a/mac/tkMacInit.c b/mac/tkMacInit.c
new file mode 100644
index 0000000..bb1f8b3
--- /dev/null
+++ b/mac/tkMacInit.c
@@ -0,0 +1,240 @@
+/* 
+ * 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.
+ *
+ * SCCS: @(#) tkMacInit.c 1.30 96/12/17 15:20:16
+ */
+
+#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);
+}