* carbon/ (new directory): copy of current state of 'macosx'

	source directory, to preserve legacy TkAqua implementation based on
	Carbon API (with support for Mac OS X releases older than 10.5).

1 files changed, 2306 insertions, 0 deletions

diff --git a/carbon/tkMacOSXDialog.c b/carbon/tkMacOSXDialog.c
new file mode 100644
index 0000000..ff135e5
--- /dev/null
+++ b/carbon/tkMacOSXDialog.c
@@ -0,0 +1,2306 @@
+/*
+ * tkMacOSXDialog.c --
+ *
+ *	Contains the Mac implementation of the common dialog boxes.
+ *
+ * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ * Copyright 2001, Apple Computer, Inc.
+ * Copyright (c) 2006-2008 Daniel A. Steffen <das@users.sourceforge.net>
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tkMacOSXDialog.c,v 1.1 2009/06/26 01:42:46 das Exp $
+ */
+
+#include "tkMacOSXPrivate.h"
+#include "tkFileFilter.h"
+
+#ifndef StrLength
+#define StrLength(s)	(*((unsigned char *) (s)))
+#endif
+#ifndef StrBody
+#define StrBody(s)	((char *) (s) + 1)
+#endif
+
+#define OPEN_POPUP_ITEM 10
+
+#define SAVE_FILE	0
+#define OPEN_FILE	1
+#define CHOOSE_FOLDER	2
+
+#define MATCHED		0
+#define UNMATCHED	1
+
+#define TK_DEFAULT_ABOUT 128
+
+/*
+ * The following structures are used in the GetFileName() function. They store
+ * information about the file dialog and the file filters.
+ */
+
+typedef struct _OpenFileData {
+    FileFilterList fl;          /* List of file filters.                   */
+    SInt16 curType;             /* The filetype currently being listed.    */
+    short initialType;          /* Type to use initially                   */
+    short popupItem;            /* Item number of the popup in the dialog. */
+    short usePopup;             /* True if we show the popup menu (this    */
+                                /* is an open operation and the            */
+                                /* -filetypes option is set).              */
+} OpenFileData;
+
+typedef struct NavHandlerUserData {
+    OpenFileData *ofdPtr;
+    NavReplyRecord reply;
+    OSStatus err;
+    CFStringRef saveNameRef;
+    int sheet;
+    WindowRef dialogWindow, origUnavailWindow;
+    WindowModality origModality;
+} NavHandlerUserData;
+
+/*
+ * The following structure is used in the tk_messageBox implementation.
+ */
+
+typedef struct {
+    int buttonIndex;
+    WindowRef dialogWindow, origUnavailWindow;
+    WindowModality origModality;
+    EventHandlerRef handlerRef;
+} AlertHandlerUserData;
+
+
+static OSStatus		AlertHandler(EventHandlerCallRef callRef,
+			    EventRef eventRef, void *userData);
+static Boolean		MatchOneType(StringPtr fileNamePtr, OSType fileType,
+			    OpenFileData *myofdPtr, FileFilter *filterPtr);
+static pascal Boolean	OpenFileFilterProc(AEDesc* theItem, void* info,
+			    NavCallBackUserData callBackUD,
+			    NavFilterModes filterMode);
+static pascal void	OpenEventProc(NavEventCallbackMessage callBackSelector,
+			    NavCBRecPtr callBackParms,
+			    NavCallBackUserData callBackUD);
+static void		InitFileDialogs(void);
+static int		NavServicesGetFile(Tcl_Interp *interp,
+			    OpenFileData *ofd, AEDesc *initialDescPtr,
+			    char *initialFile, AEDescList *selectDescPtr,
+			    CFStringRef title, CFStringRef message,
+			    const char *initialType, int multiple, int isOpen,
+			    Tk_Window parent);
+static int		HandleInitialDirectory(Tcl_Interp *interp,
+			    char *initialFile, char *initialDir, FSRef *dirRef,
+			    AEDescList *selectDescPtr, AEDesc *dirDescPtr);
+
+/*
+ * Have we initialized the file dialog subsystem
+ */
+
+static int fileDlgInited = 0;
+
+/*
+ * Filter and hook functions used by the tk_getOpenFile and tk_getSaveFile
+ * commands.
+ */
+
+static NavObjectFilterUPP openFileFilterUPP;
+static NavEventUPP openFileEventUPP;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ChooseColorObjCmd --
+ *
+ *	This procedure implements the color dialog box for the Mac platform.
+ *	See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ChooseColorObjCmd(
+    ClientData clientData,	/* Main window associated with interpreter. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    OSStatus err;
+    int result = TCL_ERROR;
+    Tk_Window parent, tkwin = clientData;
+    const char *title;
+    int i, srcRead, dstWrote;
+    CMProfileRef prof;
+    NColorPickerInfo cpinfo;
+    static RGBColor color = {0xffff, 0xffff, 0xffff};
+    static const char *const optionStrings[] = {
+	"-initialcolor", "-parent", "-title", NULL
+    };
+    enum options {
+	COLOR_INITIAL, COLOR_PARENT, COLOR_TITLE
+    };
+
+    title = "Choose a color:";
+    bzero(&cpinfo, sizeof(cpinfo));
+    cpinfo.theColor.color.rgb.red   = color.red;
+    cpinfo.theColor.color.rgb.green = color.green;
+    cpinfo.theColor.color.rgb.blue  = color.blue;
+
+    for (i = 1; i < objc; i += 2) {
+	int index;
+	const char *option, *value;
+
+	if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option",
+		TCL_EXACT, &index) != TCL_OK) {
+	    goto end;
+	}
+	if (i + 1 == objc) {
+	    option = Tcl_GetString(objv[i]);
+	    Tcl_AppendResult(interp, "value for \"", option, "\" missing",
+		    NULL);
+	    goto end;
+	}
+	value = Tcl_GetString(objv[i + 1]);
+
+	switch ((enum options) index) {
+	    case COLOR_INITIAL: {
+		XColor *colorPtr;
+
+		colorPtr = Tk_GetColor(interp, tkwin, value);
+		if (colorPtr == NULL) {
+		    goto end;
+		}
+		cpinfo.theColor.color.rgb.red   = colorPtr->red;
+		cpinfo.theColor.color.rgb.green = colorPtr->green;
+		cpinfo.theColor.color.rgb.blue  = colorPtr->blue;
+		Tk_FreeColor(colorPtr);
+		break;
+	    }
+	    case COLOR_PARENT: {
+		parent = Tk_NameToWindow(interp, value, tkwin);
+		if (parent == NULL) {
+		    goto end;
+		}
+		break;
+	    }
+	    case COLOR_TITLE: {
+		title = value;
+		break;
+	    }
+	}
+    }
+
+    ChkErr(CMGetDefaultProfileBySpace, cmRGBData, &prof);
+    cpinfo.theColor.profile = prof;
+    cpinfo.dstProfile = prof;
+    cpinfo.flags = kColorPickerDialogIsMoveable | kColorPickerDialogIsModal;
+    cpinfo.placeWhere = kCenterOnMainScreen;
+    /* Currently, this does not actually change the colorpicker title */
+    Tcl_UtfToExternal(NULL, TkMacOSXCarbonEncoding, title, -1, 0, NULL,
+	    StrBody(cpinfo.prompt), 255, &srcRead, &dstWrote, NULL);
+    StrLength(cpinfo.prompt) = (unsigned char) dstWrote;
+
+    TkMacOSXTrackingLoop(1);
+    err = ChkErr(NPickColor, &cpinfo);
+    TkMacOSXTrackingLoop(0);
+    ChkErr(CMCloseProfile, prof);
+    if ((err == noErr) && (cpinfo.newColorChosen != 0)) {
+	char colorstr[8];
+
+	color.red   = cpinfo.theColor.color.rgb.red;
+	color.green = cpinfo.theColor.color.rgb.green;
+	color.blue  = cpinfo.theColor.color.rgb.blue;
+	snprintf(colorstr, 8, "#%02x%02x%02x", color.red >> 8,
+		color.green >> 8, color.blue >> 8);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(colorstr, 7));
+    } else {
+	Tcl_ResetResult(interp);
+    }
+    result = TCL_OK;
+
+  end:
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetOpenFileObjCmd --
+ *
+ *	This procedure implements the "open file" dialog box for the Mac
+ *	platform. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See user documentation.
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetOpenFileObjCmd(
+    ClientData clientData,	/* Main window associated with interpreter. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    int i, result = TCL_ERROR, multiple = 0;
+    OpenFileData ofd;
+    Tk_Window parent = NULL;
+    CFStringRef message = NULL, title = NULL;
+    AEDesc initialDesc = {typeNull, NULL};
+    FSRef dirRef;
+    AEDesc *initialPtr = NULL;
+    AEDescList selectDesc = {typeNull, NULL};
+    char *initialFile = NULL, *initialDir = NULL;
+    Tcl_Obj *typeVariablePtr = NULL;
+    const char *initialtype = NULL;
+    static const char *const openOptionStrings[] = {
+	"-defaultextension", "-filetypes", "-initialdir", "-initialfile",
+	"-message", "-multiple", "-parent", "-title", "-typevariable", NULL
+    };
+    enum openOptions {
+	OPEN_DEFAULT, OPEN_FILETYPES, OPEN_INITDIR, OPEN_INITFILE,
+	OPEN_MESSAGE, OPEN_MULTIPLE, OPEN_PARENT, OPEN_TITLE,
+	OPEN_TYPEVARIABLE,
+    };
+
+    if (!fileDlgInited) {
+	InitFileDialogs();
+    }
+    TkInitFileFilters(&ofd.fl);
+    ofd.curType = 0;
+    ofd.initialType = -1;
+    ofd.popupItem = OPEN_POPUP_ITEM;
+    ofd.usePopup = 1;
+
+    for (i = 1; i < objc; i += 2) {
+	char *choice;
+	int index, choiceLen;
+	char *string;
+	Tcl_Obj *types;
+
+	if (Tcl_GetIndexFromObj(interp, objv[i], openOptionStrings, "option",
+		TCL_EXACT, &index) != TCL_OK) {
+	    goto end;
+	}
+	if (i + 1 == objc) {
+	    string = Tcl_GetString(objv[i]);
+	    Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+		    NULL);
+	    goto end;
+	}
+
+	switch (index) {
+	case OPEN_DEFAULT:
+	    break;
+	case OPEN_FILETYPES:
+	    types = objv[i + 1];
+	    if (TkGetFileFilters(interp, &ofd.fl, types, 0) != TCL_OK) {
+		goto end;
+	    }
+	    break;
+	case OPEN_INITDIR:
+	    initialDir = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+	    /* empty strings should be like no selection given */
+	    if (choiceLen == 0) {
+		initialDir = NULL;
+	    }
+	    break;
+	case OPEN_INITFILE:
+	    initialFile = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+	    /* empty strings should be like no selection given */
+	    if (choiceLen == 0) {
+		initialFile = NULL;
+	    }
+	    break;
+	case OPEN_MESSAGE:
+	    choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+	    if (message) {
+		CFRelease(message);
+	    }
+	    message = CFStringCreateWithBytes(NULL, (unsigned char *) choice,
+		    choiceLen, kCFStringEncodingUTF8, false);
+	    break;
+	case OPEN_MULTIPLE:
+	    if (Tcl_GetBooleanFromObj(interp, objv[i + 1],
+		    &multiple) != TCL_OK) {
+		goto end;
+	    }
+	    break;
+	case OPEN_PARENT:
+	    choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+	    parent = Tk_NameToWindow(interp, choice, clientData);
+	    if (parent == NULL) {
+		goto end;
+	    }
+	    break;
+	case OPEN_TITLE:
+	    choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+	    if (title) {
+		CFRelease(title);
+	    }
+	    title = CFStringCreateWithBytes(NULL, (unsigned char *) choice,
+		    choiceLen, kCFStringEncodingUTF8, false);
+	    break;
+	case OPEN_TYPEVARIABLE:
+	    typeVariablePtr = objv[i + 1];
+	    break;
+	}
+    }
+
+    if (HandleInitialDirectory(interp, initialFile, initialDir, &dirRef,
+	    &selectDesc, &initialDesc) != TCL_OK) {
+	goto end;
+    }
+    if (initialDesc.descriptorType == typeFSRef) {
+	initialPtr = &initialDesc;
+    }
+    if (typeVariablePtr) {
+	initialtype = Tcl_GetVar(interp, Tcl_GetString(typeVariablePtr), 0);
+    }
+    result = NavServicesGetFile(interp, &ofd, initialPtr, NULL, &selectDesc,
+	    title, message, initialtype, multiple, OPEN_FILE, parent);
+
+    if (typeVariablePtr) {
+	FileFilter *filterPtr = ofd.fl.filters;
+	int i = ofd.curType;
+
+	while (filterPtr && i-- > 0) {
+	    filterPtr = filterPtr->next;
+	}
+	Tcl_SetVar(interp, Tcl_GetString(typeVariablePtr), filterPtr ?
+		filterPtr->name : "", 0);
+    }
+
+  end:
+    TkFreeFileFilters(&ofd.fl);
+    if (initialDesc.dataHandle) {
+	ChkErr(AEDisposeDesc, &initialDesc);
+    }
+    if (selectDesc.dataHandle) {
+	ChkErr(AEDisposeDesc, &selectDesc);
+    }
+    if (title) {
+	CFRelease(title);
+    }
+    if (message) {
+	CFRelease(message);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetSaveFileObjCmd --
+ *
+ *	Same as Tk_GetOpenFileCmd but opens a "save file" dialog box instead.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See user documentation.
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetSaveFileObjCmd(
+    ClientData clientData,	/* Main window associated with interpreter. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    int i, result = TCL_ERROR;
+    char *initialFile = NULL;
+    Tk_Window parent = NULL;
+    AEDesc initialDesc = {typeNull, NULL};
+    AEDesc *initialPtr = NULL;
+    FSRef dirRef;
+    CFStringRef title = NULL, message = NULL;
+    OpenFileData ofd;
+    static const char *const saveOptionStrings[] = {
+	"-defaultextension", "-filetypes", "-initialdir", "-initialfile",
+	"-message", "-parent", "-title", "-typevariable", NULL
+    };
+    enum saveOptions {
+	SAVE_DEFAULT, SAVE_FILETYPES, SAVE_INITDIR, SAVE_INITFILE,
+	SAVE_MESSAGE, SAVE_PARENT, SAVE_TITLE, SAVE_TYPEVARIABLE,
+    };
+
+    if (!fileDlgInited) {
+	InitFileDialogs();
+    }
+
+    TkInitFileFilters(&ofd.fl);
+    ofd.curType = 0;
+    ofd.usePopup = 0;
+
+    for (i = 1; i < objc; i += 2) {
+	char *choice, *string;
+	int index, choiceLen;
+	Tcl_Obj *types;
+
+	if (Tcl_GetIndexFromObj(interp, objv[i], saveOptionStrings, "option",
+		TCL_EXACT, &index) != TCL_OK) {
+	    goto end;
+	}
+	if (i + 1 == objc) {
+	    string = Tcl_GetString(objv[i]);
+	    Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+		    NULL);
+	    goto end;
+	}
+	switch (index) {
+	case SAVE_DEFAULT:
+	    break;
+	case SAVE_FILETYPES:
+	    types = objv[i + 1];
+	    if (TkGetFileFilters(interp, &ofd.fl, types, 0) != TCL_OK) {
+		goto end;
+	    }
+	    break;
+	case SAVE_INITDIR:
+	    choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+	    /* empty strings should be like no selection given */
+	    if (choiceLen && HandleInitialDirectory(interp, NULL, choice,
+		    &dirRef, NULL, &initialDesc) != TCL_OK) {
+		goto end;
+	    }
+	    break;
+	case SAVE_INITFILE:
+	    initialFile = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+	    /* empty strings should be like no selection given */
+	    if (choiceLen == 0) {
+		initialFile = NULL;
+	    }
+	    break;
+	case SAVE_MESSAGE:
+	    choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+	    if (message) {
+		CFRelease(message);
+	    }
+	    message = CFStringCreateWithBytes(NULL, (unsigned char *) choice,
+		    choiceLen, kCFStringEncodingUTF8, false);
+	    break;
+	case SAVE_PARENT:
+	    choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+	    parent = Tk_NameToWindow(interp, choice, (Tk_Window) clientData);
+	    if (parent == NULL) {
+		goto end;
+	    }
+	    break;
+	case SAVE_TITLE:
+	    choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+	    if (title) {
+		CFRelease(title);
+	    }
+	    title = CFStringCreateWithBytes(NULL, (unsigned char *) choice,
+		    choiceLen, kCFStringEncodingUTF8, false);
+	    break;
+	}
+    }
+
+    if (initialDesc.descriptorType == typeFSRef) {
+	initialPtr = &initialDesc;
+    }
+    result = NavServicesGetFile(interp, &ofd, initialPtr, initialFile, NULL,
+	    title, message, NULL, false, SAVE_FILE, parent);
+    TkFreeFileFilters(&ofd.fl);
+  end:
+    if (initialDesc.dataHandle) {
+	ChkErr(AEDisposeDesc, &initialDesc);
+    }
+    if (title) {
+	CFRelease(title);
+    }
+    if (message) {
+	CFRelease(message);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ChooseDirectoryObjCmd --
+ *
+ *	This procedure implements the "tk_chooseDirectory" dialog box for the
+ *	MacOS X platform. See the user documentation for details on what it
+ *	does.
+ *
+ * Results:
+ *	See user documentation.
+ *
+ * Side effects:
+ *	A modal dialog window is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ChooseDirectoryObjCmd(
+    ClientData clientData,	/* Main window associated with interpreter. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    int i, result = TCL_ERROR;
+    Tk_Window parent = NULL;
+    AEDesc initialDesc = {typeNull, NULL}, *initialPtr = NULL;
+    FSRef dirRef;
+    CFStringRef message = NULL, title = NULL;
+    OpenFileData ofd;
+    static const char *const chooseOptionStrings[] = {
+	"-initialdir", "-message", "-mustexist", "-parent", "-title", NULL
+    };
+    enum chooseOptions {
+	CHOOSE_INITDIR, CHOOSE_MESSAGE, CHOOSE_MUSTEXIST, CHOOSE_PARENT,
+	CHOOSE_TITLE
+    };
+
+    if (!fileDlgInited) {
+	InitFileDialogs();
+    }
+
+    for (i = 1; i < objc; i += 2) {
+	char *string, *choice;
+	int index, choiceLen;
+
+	if (Tcl_GetIndexFromObj(interp, objv[i], chooseOptionStrings, "option",
+		TCL_EXACT, &index) != TCL_OK) {
+	    goto end;
+	}
+	if (i + 1 == objc) {
+	    string = Tcl_GetString(objv[i]);
+	    Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+		    NULL);
+	    goto end;
+	}
+	switch (index) {
+	case CHOOSE_INITDIR:
+	    choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+	    if (choiceLen && HandleInitialDirectory(interp, NULL, choice,
+		    &dirRef, NULL, &initialDesc) != TCL_OK) {
+		goto end;
+	    }
+	    break;
+	case CHOOSE_MESSAGE:
+	    choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+	    if (message) {
+		CFRelease(message);
+	    }
+	    message = CFStringCreateWithBytes(NULL, (unsigned char *) choice,
+		    choiceLen, kCFStringEncodingUTF8, false);
+	    break;
+	case CHOOSE_PARENT:
+	    choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+	    parent = Tk_NameToWindow(interp, choice, clientData);
+	    if (parent == NULL) {
+		goto end;
+	    }
+	    break;
+	case CHOOSE_TITLE:
+	    choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
+	    if (title) {
+		CFRelease(title);
+	    }
+	    title = CFStringCreateWithBytes(NULL, (unsigned char *) choice,
+		    choiceLen, kCFStringEncodingUTF8, false);
+	    break;
+	}
+    }
+
+    TkInitFileFilters(&ofd.fl);
+    ofd.usePopup = 0;
+    if (initialDesc.descriptorType == typeFSRef) {
+	initialPtr = &initialDesc;
+    }
+    result = NavServicesGetFile(interp, &ofd, initialPtr, NULL, NULL, title,
+	    message, NULL, false, CHOOSE_FOLDER, parent);
+    TkFreeFileFilters(&ofd.fl);
+  end:
+    if (initialDesc.dataHandle) {
+	ChkErr(AEDisposeDesc, &initialDesc);
+    }
+    if (title) {
+	CFRelease(title);
+    }
+    if (message) {
+	CFRelease(message);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HandleInitialDirectory --
+ *
+ *	Helper for -initialdir setup.
+ *
+ * Results:
+ *	Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+HandleInitialDirectory(
+    Tcl_Interp *interp,
+    char *initialFile,
+    char *initialDir,
+    FSRef *dirRef,
+    AEDescList *selectDescPtr,
+    AEDesc *dirDescPtr)
+{
+    Tcl_DString ds;
+    OSStatus err;
+    Boolean isDirectory;
+    char *dirName = NULL;
+    int result = TCL_ERROR;
+
+    if (initialDir) {
+	dirName = Tcl_TranslateFileName(interp, initialDir, &ds);
+	if (dirName == NULL) {
+	    goto end;
+	}
+	err = ChkErr(FSPathMakeRef, (unsigned char *) dirName, dirRef,
+		&isDirectory);
+	if (err != noErr) {
+	    Tcl_AppendResult(interp, "bad directory \"", initialDir, "\"",
+		    NULL);
+	    goto end;
+	}
+	if (!isDirectory) {
+	    Tcl_AppendResult(interp, "-intialdir \"", initialDir, "\""
+		    " is a file, not a directory.", NULL);
+	    goto end;
+	}
+	ChkErr(AECreateDesc, typeFSRef, dirRef, sizeof(*dirRef), dirDescPtr);
+    }
+
+    if (initialFile && selectDescPtr) {
+	FSRef fileRef;
+	AEDesc fileDesc;
+	char *namePtr;
+
+	if (initialDir) {
+	    Tcl_DStringAppend(&ds, "/", 1);
+	    Tcl_DStringAppend(&ds, initialFile, -1);
+	    namePtr = Tcl_DStringValue(&ds);
+	} else {
+	    namePtr = initialFile;
+	}
+
+	ChkErr(AECreateList, NULL, 0, false, selectDescPtr);
+
+	err = ChkErr(FSPathMakeRef, (unsigned char *) namePtr, &fileRef,
+		&isDirectory);
+	if (err != noErr) {
+	    Tcl_AppendResult(interp, "bad initialfile \"", initialFile,
+		    "\" file does not exist.", NULL);
+	    goto end;
+	}
+	ChkErr(AECreateDesc, typeFSRef, &fileRef, sizeof(fileRef), &fileDesc);
+	ChkErr(AEPutDesc, selectDescPtr, 1, &fileDesc);
+	ChkErr(AEDisposeDesc, &fileDesc);
+    }
+    result = TCL_OK;
+  end:
+    if (dirName) {
+	Tcl_DStringFree(&ds);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitFileDialogs --
+ *
+ *	Initialize file dialog subsystem.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+InitFileDialogs(void)
+{
+    fileDlgInited = 1;
+    openFileFilterUPP = NewNavObjectFilterUPP(OpenFileFilterProc);
+    openFileEventUPP = NewNavEventUPP(OpenEventProc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NavServicesGetFile --
+ *
+ *	Common wrapper for NavServices API.
+ *
+ * Results:
+ *	Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+NavServicesGetFile(
+    Tcl_Interp *interp,
+    OpenFileData *ofdPtr,
+    AEDesc *initialDescPtr,
+    char *initialFile,
+    AEDescList *selectDescPtr,
+    CFStringRef title,
+    CFStringRef message,
+    const char *initialtype,
+    int multiple,
+    int isOpen,
+    Tk_Window parent)
+{
+    NavHandlerUserData data;
+    NavDialogCreationOptions options;
+    NavDialogRef dialogRef = NULL;
+    CFStringRef *menuItemNames = NULL;
+    OSStatus err;
+    Tcl_Obj *theResult = NULL;
+    int result = TCL_ERROR;
+
+    bzero(&data, sizeof(data));
+    err = NavGetDefaultDialogCreationOptions(&options);
+    if (err != noErr) {
+	return result;
+    }
+    options.optionFlags = kNavDontAutoTranslate | kNavDontAddTranslateItems
+	    | kNavSupportPackages | kNavAllFilesInPopup;
+    if (multiple) {
+	options.optionFlags |= kNavAllowMultipleFiles;
+    }
+    options.modality = kWindowModalityAppModal;
+    if (parent && ((TkWindow *) parent)->window != None &&
+	    TkMacOSXHostToplevelExists(parent)) {
+	options.parentWindow = TkMacOSXDrawableWindow(Tk_WindowId(parent));
+	TK_IF_HI_TOOLBOX (5,
+	    /*
+	     * Impossible to modify dialog modality with the Cocoa-based
+	     * NavServices implementation.
+	     */
+	) TK_ELSE_HI_TOOLBOX (5,
+	    if (options.parentWindow) {
+		options.modality = kWindowModalityWindowModal;
+		data.sheet = 1;
+	    }
+	) TK_ENDIF
+    }
+
+    /*
+     * Now process the selection list. We have to use the popupExtension
+     * to fill the menu.
+     */
+
+    if (ofdPtr && ofdPtr->usePopup) {
+	FileFilter *filterPtr = ofdPtr->fl.filters;
+
+	if (filterPtr == NULL) {
+	    ofdPtr->usePopup = 0;
+	}
+    }
+    if (ofdPtr && ofdPtr->usePopup) {
+	FileFilter *filterPtr;
+	int index = 0;
+	ofdPtr->curType = 0;
+
+	menuItemNames = (CFStringRef *)
+		ckalloc(ofdPtr->fl.numFilters * sizeof(CFStringRef));
+
+	for (filterPtr = ofdPtr->fl.filters; filterPtr != NULL;
+		filterPtr = filterPtr->next, index++) {
+	    menuItemNames[index] = CFStringCreateWithCString(NULL,
+		    filterPtr->name, kCFStringEncodingUTF8);
+	    if (initialtype && strcmp(filterPtr->name, initialtype) == 0) {
+		ofdPtr->initialType = index;
+	    }
+	}
+	options.popupExtension = CFArrayCreate(NULL,
+		(const void **) menuItemNames, ofdPtr->fl.numFilters, NULL);
+    } else {
+	options.optionFlags |= kNavNoTypePopup;
+	options.popupExtension = NULL;
+    }
+    options.clientName = CFSTR("Wish");
+    options.message = message;
+    options.windowTitle = title;
+    if (initialFile) {
+	options.saveFileName = CFStringCreateWithCString(NULL, initialFile,
+		kCFStringEncodingUTF8);
+    } else {
+	options.saveFileName = NULL;
+    }
+    if (isOpen == OPEN_FILE) {
+	data.ofdPtr = ofdPtr;
+	err = ChkErr(NavCreateGetFileDialog, &options, NULL,
+		openFileEventUPP, NULL, openFileFilterUPP, &data, &dialogRef);
+    } else if (isOpen == SAVE_FILE) {
+	err = ChkErr(NavCreatePutFileDialog, &options, 'TEXT', 'WIsH',
+		openFileEventUPP, &data, &dialogRef);
+    } else if (isOpen == CHOOSE_FOLDER) {
+	err = ChkErr(NavCreateChooseFolderDialog, &options,
+		openFileEventUPP, openFileFilterUPP, &data, &dialogRef);
+    }
+    if (err == noErr && dialogRef) {
+	if (initialDescPtr) {
+	    ChkErr(NavCustomControl, dialogRef, kNavCtlSetLocation,
+		initialDescPtr);
+	}
+	if (selectDescPtr && selectDescPtr->descriptorType != typeNull) {
+	    ChkErr(NavCustomControl, dialogRef, kNavCtlSetSelection,
+		    selectDescPtr);
+	}
+	TkMacOSXTrackingLoop(1);
+	err = ChkErr(NavDialogRun, dialogRef);
+	if (err == noErr) {
+	    if (data.sheet) {
+		data.dialogWindow = NavDialogGetWindow(dialogRef);
+		ChkErr(GetWindowModality, data.dialogWindow,
+			&data.origModality, &data.origUnavailWindow);
+		ChkErr(SetWindowModality, data.dialogWindow,
+			kWindowModalityAppModal, NULL);
+		ChkErr(RunAppModalLoopForWindow, data.dialogWindow);
+	    }
+	    err = data.err;
+	}
+	TkMacOSXTrackingLoop(0);
+    }
+
+    /*
+     * Most commands assume that the file dialogs return a single item, not a
+     * list. So only build a list if multiple is true...
+     */
+
+    if (err == noErr) {
+	if (multiple) {
+	    theResult = Tcl_NewListObj(0, NULL);
+	} else {
+	    theResult = Tcl_NewObj();
+	}
+	if (!theResult) {
+	    err = memFullErr;
+	}
+    }
+    if (err == noErr && data.reply.validRecord) {
+	AEDesc resultDesc;
+	long count, i;
+	FSRef fsRef;
+	char pathPtr[PATH_MAX + 1];
+	char saveName[PATH_MAX + 1];
+
+	err = ChkErr(AECountItems, &data.reply.selection, &count);
+	if (err != noErr) {
+	    /*
+	     * There was an error when counting the items? Treat as if no
+	     * items were chosen.
+	     */
+
+	    goto installResult;
+	}
+
+	/*
+	 * Process the chosen files. This will be one unless -multiple was
+	 * specified.
+	 */
+
+	for (i = 1; i <= count; i++) {
+	    /*
+	     * Get the name of the selected file.
+	     */
+
+	    err = ChkErr(AEGetNthDesc, &data.reply.selection, i,
+		    typeFSRef, NULL, &resultDesc);
+	    if (err != noErr) {
+		continue;
+	    }
+	    err = ChkErr(AEGetDescData, &resultDesc, &fsRef, sizeof(fsRef));
+	    if (err != noErr) {
+		goto nextFilename;
+	    }
+	    err = ChkErr(FSRefMakePath, &fsRef, (unsigned char *) pathPtr,
+		    PATH_MAX + 1);
+	    if (err != noErr) {
+		goto nextFilename;
+	    }
+
+	    /*
+	     * If we're saving the file, we're creating a new filename and
+	     * must therefore check whether it is a legal filename (not
+	     * exceeding path length limits, etc.)
+	     */
+
+	    if (isOpen == SAVE_FILE) {
+		if (!data.saveNameRef) {
+		    TkMacOSXDbgMsg("NavDialogGetSaveFileName failed");
+		    goto nextFilename;
+		}
+
+		if (!CFStringGetCString(data.saveNameRef, saveName,
+			PATH_MAX + 1, kCFStringEncodingUTF8)) {
+		    TkMacOSXDbgMsg("CFStringGetCString failed");
+		    goto nextFilename;
+		}
+
+		if (strlen(pathPtr) + strlen(saveName) >= PATH_MAX) {
+		    TkMacOSXDbgMsg("Path name too long");
+		    goto nextFilename;
+		}
+
+		strcat(pathPtr, "/");
+		strcat(pathPtr, saveName);
+	    }
+
+	    /*
+	     * Got a valid file name; put it in the result object.
+	     */
+
+	    if (multiple) {
+		Tcl_ListObjAppendElement(interp, theResult,
+			Tcl_NewStringObj(pathPtr, -1));
+	    } else {
+		Tcl_SetStringObj(theResult, pathPtr, -1);
+	    }
+
+	nextFilename:
+	    ChkErr(AEDisposeDesc, &resultDesc);
+	}
+
+    installResult:
+	Tcl_SetObjResult(interp, theResult);
+	result = TCL_OK;
+    } else if (err == userCanceledErr) {
+	Tcl_ResetResult(interp);
+	result = TCL_OK;
+    }
+
+    /*
+     * Clean up any allocated memory.
+     */
+
+    if (data.reply.validRecord) {
+	ChkErr(NavDisposeReply, &data.reply);
+    }
+    if (data.saveNameRef) {
+	CFRelease(data.saveNameRef);
+    }
+    if (options.saveFileName) {
+	CFRelease(options.saveFileName);
+    }
+    if (options.clientName) {
+	CFRelease(options.clientName);
+    }
+    if (menuItemNames) {
+	int i;
+
+	for (i = 0; i < ofdPtr->fl.numFilters; i++) {
+	    CFRelease(menuItemNames[i]);
+	}
+	ckfree((void *) menuItemNames);
+    }
+    if (options.popupExtension) {
+	CFRelease(options.popupExtension);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * OpenEventProc --
+ *
+ *	NavServices event handling callback.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+pascal void
+OpenEventProc(
+    NavEventCallbackMessage callBackSelector,
+    NavCBRecPtr callBackParams,
+    NavCallBackUserData callBackUD)
+{
+    NavHandlerUserData *data = (NavHandlerUserData*) callBackUD;
+    OpenFileData *ofd = data->ofdPtr;
+
+    switch (callBackSelector) {
+	case kNavCBStart:
+	    if (ofd && ofd->initialType >= 0) {
+		/* Select initial filter */
+		FileFilter *filterPtr = ofd->fl.filters;
+		int i = ofd->initialType;
+
+		while (filterPtr && i-- > 0) {
+		    filterPtr = filterPtr->next;
+		}
+		if (filterPtr) {
+		    NavMenuItemSpec selectItem;
+
+		    selectItem.version = kNavMenuItemSpecVersion;
+		    selectItem.menuCreator = 0;
+		    selectItem.menuType = ofd->initialType;
+		    selectItem.menuItemName[0] = strlen(filterPtr->name);
+		    strncpy((char *) &selectItem.menuItemName[1],
+			    filterPtr->name, 255);
+		    ChkErr(NavCustomControl, callBackParams->context,
+			    kNavCtlSelectCustomType, &selectItem);
+		}
+	    }
+	    break;
+	case kNavCBPopupMenuSelect:
+	    ofd->curType = ((NavMenuItemSpec *)
+		    callBackParams->eventData.eventDataParms.param)->menuType;
+	    break;
+	case kNavCBAccept:
+	case kNavCBCancel:
+	    if (data->sheet) {
+		ChkErr(QuitAppModalLoopForWindow, data->dialogWindow);
+		ChkErr(SetWindowModality, data->dialogWindow,
+			data->origModality, data->origUnavailWindow);
+	    }
+	    break;
+	case kNavCBUserAction:
+	    if (data->reply.validRecord) {
+		ChkErr(NavDisposeReply, &data->reply);
+		data->reply.validRecord = 0;
+	    }
+	    data->err = NavDialogGetReply(callBackParams->context,
+		    &data->reply);
+	    if (callBackParams->userAction == kNavUserActionSaveAs) {
+		data->saveNameRef = NavDialogGetSaveFileName(
+			callBackParams->context);
+		if (data->saveNameRef) {
+		    CFRetain(data->saveNameRef);
+		}
+	    }
+	    break;
+	case kNavCBTerminate:
+	    NavDialogDispose(callBackParams->context);
+	    break;
+	case kNavCBEvent:
+	    TkMacOSXRunTclEventLoop();
+	    break;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * OpenFileFilterProc --
+ *
+ *	NavServices file filter callback.
+ *
+ * Results:
+ *	Whether to use the file in question.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+pascal Boolean
+OpenFileFilterProc(
+    AEDesc *theItem,
+    void *info,
+    NavCallBackUserData callBackUD,
+    NavFilterModes filterMode)
+{
+    OpenFileData *ofdPtr = ((NavHandlerUserData *) callBackUD)->ofdPtr;
+    int result = MATCHED;
+
+    if (ofdPtr && ofdPtr->usePopup && ofdPtr->fl.numFilters > 0 &&
+	    ((theItem->descriptorType == typeFSS)
+	    || (theItem->descriptorType == typeFSRef))) {
+	NavFileOrFolderInfo *theInfo = info;
+	char fileName[256];
+	OSType fileType;
+	StringPtr fileNamePtr = NULL;
+	Tcl_DString fileNameDString;
+	int i;
+	FileFilter *filterPtr;
+
+	if (!theInfo->isFolder) {
+	    fileType = theInfo->fileAndFolder.fileInfo.finderInfo.fdType;
+	    Tcl_DStringInit(&fileNameDString);
+
+	    if (theItem->descriptorType == typeFSS) {
+		int len;
+
+		fileNamePtr = ((FSSpec *) *theItem->dataHandle)->name;
+		len = fileNamePtr[0];
+		strncpy(fileName, (char *) fileNamePtr + 1, len);
+		fileName[len] = '\0';
+		fileNamePtr = (unsigned char *) fileName;
+	    } else if ((theItem->descriptorType == typeFSRef)) {
+		OSStatus err;
+		FSRef *theRef = (FSRef *) *theItem->dataHandle;
+		HFSUniStr255 uniFileName;
+
+		err = ChkErr(FSGetCatalogInfo, theRef, kFSCatInfoNone,
+			NULL, &uniFileName, NULL, NULL);
+
+		if (err == noErr) {
+		    Tcl_UniCharToUtfDString((Tcl_UniChar *)uniFileName.unicode,
+			    uniFileName.length, &fileNameDString);
+		    fileNamePtr = (unsigned char *)
+			    Tcl_DStringValue(&fileNameDString);
+		}
+	    }
+	    if (ofdPtr->usePopup) {
+		i = ofdPtr->curType;
+		for (filterPtr = ofdPtr->fl.filters; filterPtr && i>0; i--) {
+		    filterPtr = filterPtr->next;
+		}
+		if (filterPtr) {
+		    result = MatchOneType(fileNamePtr, fileType, ofdPtr,
+			    filterPtr);
+		} else {
+		    result = UNMATCHED;
+		}
+	    } else {
+		/*
+		 * We are not using the popup menu. In this case, the file is
+		 * considered matched if it matches any of the file filters.
+		 */
+
+		result = UNMATCHED;
+		for (filterPtr = ofdPtr->fl.filters; filterPtr;
+			filterPtr = filterPtr->next) {
+		    if (MatchOneType(fileNamePtr, fileType, ofdPtr,
+			    filterPtr) == MATCHED) {
+			result = MATCHED;
+			break;
+		    }
+		}
+	    }
+	    Tcl_DStringFree(&fileNameDString);
+	}
+    }
+    return (result == MATCHED);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MatchOneType --
+ *
+ *	Match a file with one file type in the list of file types.
+ *
+ * Results:
+ *	Returns MATCHED if the file matches with the file type; returns
+ *	UNMATCHED otherwise.
+ *
+ * Side effects:
+ *	None
+ *
+ *----------------------------------------------------------------------
+ */
+
+Boolean
+MatchOneType(
+    StringPtr fileNamePtr,	/* Name of the file */
+    OSType fileType,		/* Type of the file, 0 means there was no
+				 * specified type. */
+    OpenFileData *ofdPtr,	/* Information about this file dialog */
+    FileFilter *filterPtr)	/* Match the file described by pb against this
+				 * filter */
+{
+    FileFilterClause *clausePtr;
+
+    /*
+     * A file matches with a file type if it matches with at least one clause
+     * of the type.
+     *
+     * If the clause has both glob patterns and ostypes, the file must match
+     * with at least one pattern AND at least one ostype.
+     *
+     * If the clause has glob patterns only, the file must match with at least
+     * one pattern.
+     *
+     * If the clause has mac types only, the file must match with at least one
+     * mac type.
+     *
+     * If the clause has neither glob patterns nor mac types, it's considered
+     * an error.
+     */
+
+    for (clausePtr = filterPtr->clauses; clausePtr;
+	    clausePtr = clausePtr->next) {
+	int macMatched = 0;
+	int globMatched = 0;
+	GlobPattern *globPtr;
+	MacFileType *mfPtr;
+
+	if (clausePtr->patterns == NULL) {
+	    globMatched = 1;
+	}
+	if (clausePtr->macTypes == NULL) {
+	    macMatched = 1;
+	}
+
+	for (globPtr = clausePtr->patterns; globPtr;
+		globPtr = globPtr->next) {
+	    char *q, *ext;
+
+	    if (fileNamePtr == NULL) {
+		continue;
+	    }
+	    ext = globPtr->pattern;
+
+	    if (ext[0] == '\0') {
+		/*
+		 * We don't want any extensions: OK if the filename doesn't
+		 * have "." in it
+		 */
+
+		for (q = (char*) fileNamePtr; *q; q++) {
+		    if (*q == '.') {
+			goto glob_unmatched;
+		    }
+		}
+		goto glob_matched;
+	    }
+
+	    if (Tcl_StringMatch((char*) fileNamePtr, ext)) {
+		goto glob_matched;
+	    }
+	glob_unmatched:
+	    continue;
+
+	glob_matched:
+	    globMatched = 1;
+	    break;
+	}
+
+	for (mfPtr = clausePtr->macTypes; mfPtr; mfPtr = mfPtr->next) {
+	    if (fileType == mfPtr->type) {
+		macMatched = 1;
+		break;
+	    }
+	}
+
+	/*
+	 * On Mac OS X, it is not uncommon for files to have NO file type. But
+	 * folks with Tcl code on Classic MacOS pretty much assume that a
+	 * generic file will have type TEXT. So if we were strict about
+	 * matching types when the source file had NO type set, they would
+	 * have to add another rule always with no fileType. To avoid that, we
+	 * pass the macMatch side of the test if no fileType is set.
+	 */
+
+	if (globMatched && (macMatched || (fileType == 0))) {
+	    return MATCHED;
+	}
+    }
+
+    return UNMATCHED;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkAboutDlg --
+ *
+ *	Displays the default Tk About box. This code uses Macintosh resources
+ *	to define the content of the About Box.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkAboutDlg(void)
+{
+    DialogPtr aboutDlog;
+    WindowRef windowRef;
+    short itemHit = -9;
+
+    aboutDlog = GetNewDialog(TK_DEFAULT_ABOUT, NULL, (void *) (-1));
+    if (!aboutDlog) {
+	return;
+    }
+    windowRef = GetDialogWindow(aboutDlog);
+    SelectWindow(windowRef);
+    TkMacOSXTrackingLoop(1);
+    while (itemHit != 1) {
+	ModalDialog(NULL, &itemHit);
+    }
+    TkMacOSXTrackingLoop(0);
+    DisposeDialog(aboutDlog);
+    SelectWindow(ActiveNonFloatingWindow());
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_MessageBoxObjCmd --
+ *
+ *	Implements the tk_messageBox in native Mac OS X style.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	none
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_MessageBoxObjCmd(
+    ClientData clientData,	/* Main window associated with interpreter. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Tk_Window tkwin = clientData;
+    AlertStdCFStringAlertParamRec paramCFStringRec;
+    AlertType alertType;
+    DialogRef dialogRef;
+    CFStringRef messageTextCF = NULL, finemessageTextCF = NULL;
+    OSStatus err;
+    SInt16 itemHit;
+    Boolean haveDefaultOption = false, haveParentOption = false;
+    char *str;
+    int index, defaultButtonIndex;
+    int defaultNativeButtonIndex; /* 1, 2, 3: right to left */
+    int typeIndex, i, indexDefaultOption = 0, result = TCL_ERROR;
+
+    static const char *const movableAlertStrings[] = {
+	"-default", "-detail", "-icon", "-message", "-parent", "-title",
+	"-type", NULL
+    };
+    static const char *const movableTypeStrings[] = {
+	"abortretryignore", "ok", "okcancel", "retrycancel", "yesno",
+	"yesnocancel", NULL
+    };
+    static const char *const movableButtonStrings[] = {
+	"abort", "retry", "ignore", "ok", "cancel", "yes", "no", NULL
+    };
+    static const char *const movableIconStrings[] = {
+	"error", "info", "question", "warning", NULL
+    };
+    enum movableAlertOptions {
+	ALERT_DEFAULT, ALERT_DETAIL, ALERT_ICON, ALERT_MESSAGE, ALERT_PARENT,
+	ALERT_TITLE, ALERT_TYPE
+    };
+    enum movableTypeOptions {
+	TYPE_ABORTRETRYIGNORE, TYPE_OK, TYPE_OKCANCEL, TYPE_RETRYCANCEL,
+	TYPE_YESNO, TYPE_YESNOCANCEL
+    };
+    enum movableButtonOptions {
+	TEXT_ABORT, TEXT_RETRY, TEXT_IGNORE, TEXT_OK, TEXT_CANCEL, TEXT_YES,
+	TEXT_NO
+    };
+    enum movableIconOptions {
+	ICON_ERROR, ICON_INFO, ICON_QUESTION, ICON_WARNING
+    };
+
+    /*
+     * Need to map from 'movableButtonStrings' and its corresponding integer,
+     * index to the native button index, which is 1, 2, 3, from right to left.
+     * This is necessary to do for each separate '-type' of button sets.
+     */
+
+    short buttonIndexAndTypeToNativeButtonIndex[][7] = {
+    /*	abort retry ignore ok	cancel yes   no */
+	{1,    2,    3,	   0,	 0,    0,    0},	/* abortretryignore */
+	{0,    0,    0,	   1,	 0,    0,    0},	/* ok */
+	{0,    0,    0,	   1,	 2,    0,    0},	/* okcancel */
+	{0,    1,    0,	   0,	 2,    0,    0},	/* retrycancel */
+	{0,    0,    0,	   0,	 0,    1,    2},	/* yesno */
+	{0,    0,    0,	   0,	 3,    1,    2},	/* yesnocancel */
+    };
+
+    /*
+     * Need also the inverse mapping, from native button (1, 2, 3) to the
+     * descriptive button text string index.
+     */
+
+    short nativeButtonIndexAndTypeToButtonIndex[][4] = {
+	{-1, 0, 1, 2},	/* abortretryignore */
+	{-1, 3, 0, 0},	/* ok */
+	{-1, 3, 4, 0},	/* okcancel */
+	{-1, 1, 4, 0},	/* retrycancel */
+	{-1, 5, 6, 0},	/* yesno */
+	{-1, 5, 6, 4},	/* yesnocancel */
+    };
+
+    alertType = kAlertPlainAlert;
+    typeIndex = TYPE_OK;
+
+    ChkErr(GetStandardAlertDefaultParams, &paramCFStringRec,
+	    kStdCFStringAlertVersionOne);
+    paramCFStringRec.movable = true;
+    paramCFStringRec.helpButton = false;
+    paramCFStringRec.defaultButton = kAlertStdAlertOKButton;
+    paramCFStringRec.cancelButton = kAlertStdAlertCancelButton;
+
+    for (i = 1; i < objc; i += 2) {
+	int iconIndex;
+	char *string;
+
+	if (Tcl_GetIndexFromObj(interp, objv[i], movableAlertStrings, "option",
+		TCL_EXACT, &index) != TCL_OK) {
+	    goto end;
+	}
+	if (i + 1 == objc) {
+	    string = Tcl_GetString(objv[i]);
+	    Tcl_AppendResult(interp, "value for \"", string, "\" missing",
+		    NULL);
+	    goto end;
+	}
+
+	switch (index) {
+	case ALERT_DEFAULT:
+	    /*
+	     * Need to postpone processing of this option until we are sure to
+	     * know the '-type' as well.
+	     */
+
+	    haveDefaultOption = true;
+	    indexDefaultOption = i;
+	    break;
+
+	case ALERT_DETAIL:
+	    str = Tcl_GetString(objv[i + 1]);
+	    if (finemessageTextCF) {
+		CFRelease(finemessageTextCF);
+	    }
+	    finemessageTextCF = CFStringCreateWithCString(NULL, str,
+		    kCFStringEncodingUTF8);
+	    break;
+
+	case ALERT_ICON:
+	    if (Tcl_GetIndexFromObj(interp, objv[i + 1], movableIconStrings,
+		    "value", TCL_EXACT, &iconIndex) != TCL_OK) {
+		goto end;
+	    }
+	    switch (iconIndex) {
+	    case ICON_ERROR:
+		alertType = kAlertStopAlert;
+		break;
+	    case ICON_INFO:
+		alertType = kAlertNoteAlert;
+		break;
+	    case ICON_QUESTION:
+		alertType = kAlertCautionAlert;
+		break;
+	    case ICON_WARNING:
+		alertType = kAlertCautionAlert;
+		break;
+	    }
+	    break;
+
+	case ALERT_MESSAGE:
+	    str = Tcl_GetString(objv[i + 1]);
+	    if (messageTextCF) {
+		CFRelease(messageTextCF);
+	    }
+	    messageTextCF = CFStringCreateWithCString(NULL, str,
+		    kCFStringEncodingUTF8);
+	    break;
+
+	case ALERT_PARENT:
+	    str = Tcl_GetString(objv[i + 1]);
+	    tkwin = Tk_NameToWindow(interp, str, tkwin);
+	    if (tkwin == NULL) {
+		goto end;
+	    }
+	    if (((TkWindow *) tkwin)->window != None &&
+		    TkMacOSXHostToplevelExists(tkwin)) {
+		haveParentOption = true;
+	    }
+	    break;
+
+	case ALERT_TITLE:
+	    /* TODO: message box title missing? */
+	    break;
+
+	case ALERT_TYPE:
+	    if (Tcl_GetIndexFromObj(interp, objv[i + 1], movableTypeStrings,
+		    "value", TCL_EXACT, &typeIndex) != TCL_OK) {
+		goto end;
+	    }
+	    switch (typeIndex) {
+	    case TYPE_ABORTRETRYIGNORE:
+		paramCFStringRec.defaultText = CFSTR("Abort");
+		paramCFStringRec.cancelText = CFSTR("Retry");
+		paramCFStringRec.otherText = CFSTR("Ignore");
+		paramCFStringRec.cancelButton = kAlertStdAlertOtherButton;
+		break;
+	    case TYPE_OK:
+		paramCFStringRec.defaultText = CFSTR("OK");
+		break;
+	    case TYPE_OKCANCEL:
+		paramCFStringRec.defaultText = CFSTR("OK");
+		paramCFStringRec.cancelText = CFSTR("Cancel");
+		break;
+	    case TYPE_RETRYCANCEL:
+		paramCFStringRec.defaultText = CFSTR("Retry");
+		paramCFStringRec.cancelText = CFSTR("Cancel");
+		break;
+	    case TYPE_YESNO:
+		paramCFStringRec.defaultText = CFSTR("Yes");
+		paramCFStringRec.cancelText = CFSTR("No");
+		break;
+	    case TYPE_YESNOCANCEL:
+		paramCFStringRec.defaultText = CFSTR("Yes");
+		paramCFStringRec.cancelText = CFSTR("No");
+		paramCFStringRec.otherText = CFSTR("Cancel");
+		paramCFStringRec.cancelButton = kAlertStdAlertOtherButton;
+		break;
+	    }
+	    break;
+	}
+    }
+
+    if (haveDefaultOption) {
+	/*
+	 * Any '-default' option needs to know the '-type' option, which is why
+	 * we do this here.
+	 */
+
+	if (Tcl_GetIndexFromObj(interp, objv[indexDefaultOption + 1],
+		movableButtonStrings, "value", TCL_EXACT, &defaultButtonIndex)
+		!= TCL_OK) {
+	    goto end;
+	}
+
+	/*
+	 * Need to map from "ok" etc. to 1, 2, 3, right to left.
+	 */
+
+	defaultNativeButtonIndex =
+	buttonIndexAndTypeToNativeButtonIndex[typeIndex][defaultButtonIndex];
+	if (defaultNativeButtonIndex == 0) {
+	    Tcl_SetObjResult(interp,
+		    Tcl_NewStringObj("Illegal default option", -1));
+	    goto end;
+	}
+	paramCFStringRec.defaultButton = defaultNativeButtonIndex;
+	if (paramCFStringRec.cancelButton == defaultNativeButtonIndex) {
+	    paramCFStringRec.cancelButton = 0;
+	}
+    }
+    ChkErr(SetThemeCursor, kThemeArrowCursor);
+
+    if (haveParentOption) {
+	AlertHandlerUserData data;
+	static EventHandlerUPP handler = NULL;
+	WindowRef windowRef;
+	const EventTypeSpec kEvents[] = {
+	    {kEventClassCommand, kEventProcessCommand}
+	};
+
+	bzero(&data, sizeof(data));
+	if (!handler) {
+	    handler = NewEventHandlerUPP(AlertHandler);
+	}
+	windowRef = TkMacOSXDrawableWindow(Tk_WindowId(tkwin));
+	if (!windowRef) {
+	    goto end;
+	}
+	err = ChkErr(CreateStandardSheet, alertType, messageTextCF,
+		finemessageTextCF, &paramCFStringRec, NULL, &dialogRef);
+	if(err != noErr) {
+	    goto end;
+	}
+	data.dialogWindow = GetDialogWindow(dialogRef);
+	err = ChkErr(ShowSheetWindow, data.dialogWindow, windowRef);
+	if(err != noErr) {
+	    DisposeDialog(dialogRef);
+	    goto end;
+	}
+	ChkErr(GetWindowModality, data.dialogWindow, &data.origModality,
+		&data.origUnavailWindow);
+	ChkErr(SetWindowModality, data.dialogWindow, kWindowModalityAppModal,
+		NULL);
+	ChkErr(InstallEventHandler, GetWindowEventTarget(data.dialogWindow),
+		handler, GetEventTypeCount(kEvents), kEvents, &data,
+		&data.handlerRef);
+	TkMacOSXTrackingLoop(1);
+	ChkErr(RunAppModalLoopForWindow, data.dialogWindow);
+	TkMacOSXTrackingLoop(0);
+	itemHit = data.buttonIndex;
+    } else {
+	err = ChkErr(CreateStandardAlert, alertType, messageTextCF,
+		finemessageTextCF, &paramCFStringRec, &dialogRef);
+	if(err != noErr) {
+	    goto end;
+	}
+	TkMacOSXTrackingLoop(1);
+	err = ChkErr(RunStandardAlert, dialogRef, NULL, &itemHit);
+	TkMacOSXTrackingLoop(0);
+	if (err != noErr) {
+	    goto end;
+	}
+    }
+    if (err == noErr) {
+	/*
+	 * Map 'itemHit' (1, 2, 3) to descriptive text string.
+	 */
+
+	int ind = nativeButtonIndexAndTypeToButtonIndex[typeIndex][itemHit];
+
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(movableButtonStrings[ind],
+		-1));
+	result = TCL_OK;
+    }
+
+  end:
+    if (finemessageTextCF) {
+	CFRelease(finemessageTextCF);
+    }
+    if (messageTextCF) {
+	CFRelease(messageTextCF);
+    }
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AlertHandler --
+ *
+ *	Carbon event handler for the Standard Sheet dialog.
+ *
+ * Results:
+ *	OSStatus if event handled or not.
+ *
+ * Side effects:
+ *	May set userData.
+ *
+ *----------------------------------------------------------------------
+ */
+
+OSStatus
+AlertHandler(
+    EventHandlerCallRef callRef,
+    EventRef eventRef,
+    void *userData)
+{
+    AlertHandlerUserData *data = userData;
+    HICommand cmd;
+
+    ChkErr(GetEventParameter,eventRef, kEventParamDirectObject, typeHICommand,
+	    NULL, sizeof(cmd), NULL, &cmd);
+    switch (cmd.commandID) {
+    case kHICommandOK:
+	data->buttonIndex = 1;
+	break;
+    case kHICommandCancel:
+	data->buttonIndex = 2;
+	break;
+    case kHICommandOther:
+	data->buttonIndex = 3;
+	break;
+    }
+    if (data->buttonIndex) {
+	ChkErr(QuitAppModalLoopForWindow, data->dialogWindow);
+	ChkErr(RemoveEventHandler, data->handlerRef);
+	ChkErr(SetWindowModality, data->dialogWindow,
+		data->origModality, data->origUnavailWindow);
+    }
+    return eventNotHandledErr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ */
+#pragma mark [tk fontchooser] implementation (TIP 324)
+/*
+ *----------------------------------------------------------------------
+ */
+
+#include "tkMacOSXEvent.h"
+#include "tkMacOSXFont.h"
+
+typedef struct FontchooserData {
+    Tcl_Obj *titleObj;
+    Tcl_Obj *cmdObj;
+    Tk_Window parent;
+} FontchooserData;
+
+static Tcl_Obj *FontchooserCget(FontchooserData *fcdPtr, int optionIndex);
+static int FontchooserConfigureCmd(ClientData clientData, Tcl_Interp *interp,
+	int objc, Tcl_Obj *const objv[]);
+static int FontchooserShowCmd(ClientData clientData, Tcl_Interp *interp,
+	int objc, Tcl_Obj *const objv[]);
+static int FontchooserHideCmd(ClientData clientData, Tcl_Interp *interp,
+	int objc, Tcl_Obj *const objv[]);
+static void FontchooserParentEventHandler(ClientData clientData,
+	XEvent *eventPtr);
+static void DeleteFontchooserData(ClientData clientData, Tcl_Interp *interp);
+
+MODULE_SCOPE const TkEnsemble tkFontchooserEnsemble[];
+const TkEnsemble tkFontchooserEnsemble[] = {
+    { "configure", FontchooserConfigureCmd },
+    { "show", FontchooserShowCmd },
+    { "hide", FontchooserHideCmd },
+};
+
+static Tcl_Interp *fontchooserInterp = NULL;
+static FMFontFamily fontPanelFontFamily = kInvalidFontFamily;
+static FMFontStyle fontPanelFontStyle = -1;
+static FMFontSize fontPanelFontSize = 0;
+static FMFont fontPanelFontID = kInvalidFont;
+
+static const char *fontchooserOptionStrings[] = {
+    "-parent", "-title", "-font", "-command",
+    "-visible", NULL
+};
+enum FontchooserOption {
+    FontchooserParent, FontchooserTitle, FontchooserFont, FontchooserCmd,
+    FontchooserVisible
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacOSXProcessFontEvent --
+ *
+ *	This processes events generated by user interaction with the
+ *	font panel.
+ *
+ * Results:
+ *	True if Tk events are generated - false otherwise.
+ *
+ * Side effects:
+ *	Additional events may be place on the Tk event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+MODULE_SCOPE int
+TkMacOSXProcessFontEvent(
+    TkMacOSXEvent * eventPtr,
+    MacEventStatus * statusPtr)
+{
+    OSStatus err;
+    int eventGenerated = 0;
+    FontchooserData *fcdPtr;
+
+    switch (eventPtr->eKind) {
+	case kEventFontPanelClosed:
+	case kEventFontSelection:
+	    break;
+	default:
+	    goto done;
+    }
+    if (!fontchooserInterp) {
+	goto done;
+    }
+    fcdPtr = Tcl_GetAssocData(fontchooserInterp, "::tk::fontchooser", NULL);
+    switch (eventPtr->eKind) {
+	case kEventFontPanelClosed:
+	    if (!FPIsFontPanelVisible() && fcdPtr->parent != None) {
+		TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserVisibility");
+		fontchooserInterp = NULL;
+		eventGenerated = 1;
+	    }
+	    break;
+	case kEventFontSelection: {
+	    Tcl_Obj *fontObj = NULL;
+
+	    fontPanelFontFamily = kInvalidFontFamily;
+	    fontPanelFontStyle = -1;
+	    fontPanelFontSize = 0;
+	    fontPanelFontID = kInvalidFont;
+	    err = ChkErr(GetEventParameter, eventPtr->eventRef,
+		    kEventParamFMFontFamily, typeFMFontFamily, NULL,
+		    sizeof(FMFontFamily), NULL, &fontPanelFontFamily);
+	    err |= ChkErr(GetEventParameter, eventPtr->eventRef,
+		    kEventParamFMFontStyle, typeFMFontStyle, NULL,
+		    sizeof(FMFontStyle), NULL, &fontPanelFontStyle);
+	    err |= ChkErr(GetEventParameter, eventPtr->eventRef,
+		    kEventParamFMFontSize, typeFMFontSize, NULL,
+		    sizeof(FMFontSize), NULL, &fontPanelFontSize);
+	    if (err != noErr) {
+		/*
+		 * No/incomplete QD font spec, use ATSUI font ID
+		 */
+		Fixed fontFixedSize;
+
+		err = ChkErr(GetEventParameter, eventPtr->eventRef,
+			kEventParamATSUFontID, typeATSUFontID, NULL,
+			sizeof(ATSUFontID), NULL, &fontPanelFontID);
+		if (err == noErr) {
+		    ChkErr(FMGetFontFamilyInstanceFromFont, fontPanelFontID,
+			    &fontPanelFontFamily, &fontPanelFontStyle);
+		}
+		err = ChkErr(GetEventParameter, eventPtr->eventRef,
+			kEventParamATSUFontSize, typeATSUSize, NULL,
+			sizeof(Fixed), NULL, &fontFixedSize);
+		if (err == noErr) {
+		    fontPanelFontSize = FixedToInt(fontFixedSize);
+		}
+	    }
+	    fontObj = TkMacOSXFontDescriptionForFMFontInfo(
+		fontPanelFontFamily, fontPanelFontStyle,
+		fontPanelFontSize, fontPanelFontID);
+	    if (fontObj) {
+		if (fcdPtr->cmdObj) {
+		    int objc, result;
+		    Tcl_Obj **objv, **tmpv;
+
+		    result = Tcl_ListObjGetElements(fontchooserInterp,
+			    fcdPtr->cmdObj, &objc, &objv);
+		    if (result == TCL_OK) {
+			tmpv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) *
+				(unsigned)(objc + 2));
+			memcpy(tmpv, objv, sizeof(Tcl_Obj *) * objc);
+			tmpv[objc] = fontObj;
+			result = TkBackgroundEvalObjv(fontchooserInterp,
+				objc + 1, tmpv, TCL_EVAL_GLOBAL);
+			ckfree((char *)tmpv);
+		    }
+		}
+		TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserFontChanged");
+	    }
+	    break;
+	}
+    }
+done:
+    return eventGenerated;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FontchooserCget --
+ *
+ *	Helper for the FontchooserConfigure command to return the
+ *	current value of any of the options (which may be NULL in
+ *	the structure)
+ *
+ * Results:
+ *	Tcl object of option value.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+FontchooserCget(
+    FontchooserData *fcdPtr,
+    int optionIndex)
+{
+    Tcl_Obj *resObj = NULL;
+
+    switch(optionIndex) {
+	case FontchooserParent: {
+	    if (fcdPtr->parent != None) {
+		resObj = Tcl_NewStringObj(
+			((TkWindow*)fcdPtr->parent)->pathName, -1);
+	    } else {
+		resObj = Tcl_NewStringObj(".", 1);
+	    }
+	    break;
+	}
+	case FontchooserTitle: {
+	    if (fcdPtr->titleObj) {
+		resObj = fcdPtr->titleObj;
+	    } else {
+		resObj = Tcl_NewObj();
+	    }
+	    break;
+	}
+	case FontchooserFont: {
+	    resObj = TkMacOSXFontDescriptionForFMFontInfo(
+		fontPanelFontFamily, fontPanelFontStyle,
+		fontPanelFontSize, fontPanelFontID);
+	    if (!resObj) {
+		resObj = Tcl_NewObj();
+	    }
+	    break;
+	}
+	case FontchooserCmd: {
+	    if (fcdPtr->cmdObj) {
+		resObj = fcdPtr->cmdObj;
+	    } else {
+		resObj = Tcl_NewObj();
+	    }
+	    break;
+	}
+	case FontchooserVisible: {
+	    resObj = Tcl_NewBooleanObj(FPIsFontPanelVisible());
+	    break;
+	}
+	default: {
+	    resObj = Tcl_NewObj();
+	}
+    }
+    return resObj;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * FontchooserConfigureCmd --
+ *
+ *	Implementation of the 'tk fontchooser configure' ensemble command.
+ *	See the user documentation for what it does.
+ *
+ * Results:
+ *	See the user documentation.
+ *
+ * Side effects:
+ *	Per-interp data structure may be modified
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+FontchooserConfigureCmd(
+    ClientData clientData,	/* Main window */
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Tk_Window tkwin = (Tk_Window)clientData;
+    FontchooserData *fcdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser",
+	    NULL);
+    int i, r = TCL_OK;
+
+    /*
+     * With no arguments we return all the options in a dict
+     */
+
+    if (objc == 1) {
+	Tcl_Obj *keyObj, *valueObj;
+	Tcl_Obj *dictObj = Tcl_NewDictObj();
+	for (i = 0; r == TCL_OK && fontchooserOptionStrings[i] != NULL; ++i) {
+	    keyObj = Tcl_NewStringObj(fontchooserOptionStrings[i], -1);
+	    valueObj = FontchooserCget(fcdPtr, i);
+	    r = Tcl_DictObjPut(interp, dictObj, keyObj, valueObj);
+	}
+	if (r == TCL_OK) {
+	    Tcl_SetObjResult(interp, dictObj);
+	}
+	return r;
+    }
+
+    for (i = 1; i < objc; i += 2) {
+	int optionIndex, len;
+	if (Tcl_GetIndexFromObj(interp, objv[i], fontchooserOptionStrings,
+		"option", 0, &optionIndex) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (objc == 2) {
+	    /* With one option and no arg, return the current value */
+	    Tcl_SetObjResult(interp, FontchooserCget(fcdPtr, optionIndex));
+	    return TCL_OK;
+	}
+	if (i + 1 == objc) {
+	    Tcl_AppendResult(interp, "value for \"",
+		Tcl_GetString(objv[i]), "\" missing", NULL);
+	    return TCL_ERROR;
+	}
+	switch (optionIndex) {
+	    case FontchooserVisible: {
+		const char *msg = "cannot change read-only option "
+		    "\"-visible\": use the show or hide command";
+
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, sizeof(msg)-1));
+		return TCL_ERROR;
+	    }
+	    case FontchooserParent: {
+		Tk_Window parent = Tk_NameToWindow(interp,
+		    Tcl_GetString(objv[i+1]), tkwin);
+		if (parent == None) {
+		    return TCL_ERROR;
+		}
+		if (fcdPtr->parent) {
+		    Tk_DeleteEventHandler(fcdPtr->parent, StructureNotifyMask,
+			    FontchooserParentEventHandler, fcdPtr);
+		}
+		fcdPtr->parent = parent;
+		Tk_CreateEventHandler(fcdPtr->parent, StructureNotifyMask,
+			FontchooserParentEventHandler, fcdPtr);
+		break;
+	    }
+	    case FontchooserTitle:
+		if (fcdPtr->titleObj) {
+		    Tcl_DecrRefCount(fcdPtr->titleObj);
+		}
+		Tcl_GetStringFromObj(objv[i+1], &len);
+		if (len) {
+		    fcdPtr->titleObj = objv[i+1];
+		    if (Tcl_IsShared(fcdPtr->titleObj)) {
+			fcdPtr->titleObj = Tcl_DuplicateObj(fcdPtr->titleObj);
+		    }
+		    Tcl_IncrRefCount(fcdPtr->titleObj);
+		} else {
+		    fcdPtr->titleObj = NULL;
+		}
+		break;
+	    case FontchooserFont: {
+
+		Tcl_GetStringFromObj(objv[i+1], &len);
+		if (len) {
+		    Tk_Font f = Tk_AllocFontFromObj(interp, tkwin, objv[i+1]);
+		    if (f) {
+			ATSUStyle atsuStyle;
+
+			TkMacOSXFMFontInfoForFont(f, &fontPanelFontFamily,
+				 &fontPanelFontStyle, &fontPanelFontSize,
+				 &atsuStyle);
+			ChkErr(SetFontInfoForSelection,
+				kFontSelectionATSUIType, 1, &atsuStyle, NULL);
+			Tk_FreeFont(f);
+		    } else {
+			return TCL_ERROR;
+		    }
+		} else {
+		    fontPanelFontFamily = kInvalidFontFamily;
+		    ChkErr(SetFontInfoForSelection,
+			    kFontSelectionATSUIType, 0, NULL, NULL);
+		}
+		if (FPIsFontPanelVisible()) {
+		    TkSendVirtualEvent(fcdPtr->parent,
+			    "TkFontchooserFontChanged");
+		}
+		break;
+	    }
+	    case FontchooserCmd:
+		if (fcdPtr->cmdObj) {
+		    Tcl_DecrRefCount(fcdPtr->cmdObj);
+		}
+		Tcl_GetStringFromObj(objv[i+1], &len);
+		if (len) {
+		    fcdPtr->cmdObj = objv[i+1];
+		    if (Tcl_IsShared(fcdPtr->cmdObj)) {
+			fcdPtr->cmdObj = Tcl_DuplicateObj(fcdPtr->cmdObj);
+		    }
+		    Tcl_IncrRefCount(fcdPtr->cmdObj);
+		} else {
+		    fcdPtr->cmdObj = NULL;
+		}
+		break;
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * FontchooserShowCmd --
+ *
+ *	Implements the 'tk fontchooser show' ensemble command. The
+ *	per-interp configuration data for the dialog is held in an interp
+ *	associated structure.
+ *
+ * Results:
+ *	See the user documentation.
+ *
+ * Side effects:
+ *	Font Panel may be shown.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+FontchooserShowCmd(
+    ClientData clientData,	/* Main window */
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    FontchooserData *fcdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser",
+	    NULL);
+
+    if (fcdPtr->parent == None) {
+	fcdPtr->parent = (Tk_Window) clientData;
+	Tk_CreateEventHandler(fcdPtr->parent, StructureNotifyMask,
+		FontchooserParentEventHandler, fcdPtr);
+    }
+    if (!FPIsFontPanelVisible()) {
+	ChkErr(FPShowHideFontPanel);
+	TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserVisibility");
+    }
+    fontchooserInterp = interp;
+
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * FontchooserHideCmd --
+ *
+ *	Implementation of the 'tk fontchooser hide' ensemble. See the
+ *	user documentation for details.
+ *
+ * Results:
+ *	See the user documentation.
+ *
+ * Side effects:
+ *	Font Panel may be hidden.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+FontchooserHideCmd(
+    ClientData clientData,	/* Main window */
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    if (FPIsFontPanelVisible()) {
+	ChkErr(FPShowHideFontPanel);
+    }
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * FontchooserParentEventHandler --
+ *
+ *	Event handler for StructureNotify events on the font chooser's
+ *	parent window.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Font chooser parent info is cleared and font panel is hidden.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+FontchooserParentEventHandler(
+    ClientData clientData,
+    XEvent *eventPtr)
+{
+    FontchooserData *fcdPtr = clientData;
+
+    if (eventPtr->type == DestroyNotify) {
+	Tk_DeleteEventHandler(fcdPtr->parent, StructureNotifyMask,
+		FontchooserParentEventHandler, fcdPtr);
+	fcdPtr->parent = None;
+	if (FPIsFontPanelVisible()) {
+	    ChkErr(FPShowHideFontPanel);
+	}
+    }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * DeleteFontchooserData --
+ *
+ *	Clean up the font chooser configuration data when the interp
+ *	is destroyed.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	per-interp configuration data is destroyed.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+DeleteFontchooserData(
+    ClientData clientData,
+    Tcl_Interp *interp)
+{
+    FontchooserData *fcdPtr = clientData;
+
+    if (fcdPtr->titleObj) {
+	Tcl_DecrRefCount(fcdPtr->titleObj);
+    }
+    if (fcdPtr->cmdObj) {
+	Tcl_DecrRefCount(fcdPtr->cmdObj);
+    }
+    ckfree((char *)fcdPtr);
+
+    if (fontchooserInterp == interp) {
+	fontchooserInterp = NULL;
+    }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TkInitFontchooser --
+ *
+ *	Associate the font chooser configuration data with the Tcl
+ *	interpreter. There is one font chooser per interp.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	per-interp configuration data is destroyed.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+MODULE_SCOPE int
+TkInitFontchooser(
+    Tcl_Interp *interp,
+    ClientData clientData)
+{
+    FontchooserData *fcdPtr = (FontchooserData*)
+	    ckalloc(sizeof(FontchooserData));
+
+    bzero(fcdPtr, sizeof(FontchooserData));
+    Tcl_SetAssocData(interp, "::tk::fontchooser", DeleteFontchooserData,
+	    fcdPtr);
+    return TCL_OK;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 79
+ * coding: utf-8
+ * End:
+ */