summaryrefslogtreecommitdiffstats
path: root/carbon/tkMacOSXDialog.c
diff options
context:
space:
mode:
Diffstat (limited to 'carbon/tkMacOSXDialog.c')
-rw-r--r--carbon/tkMacOSXDialog.c2316
1 files changed, 2316 insertions, 0 deletions
diff --git a/carbon/tkMacOSXDialog.c b/carbon/tkMacOSXDialog.c
new file mode 100644
index 0000000..8097f2c
--- /dev/null
+++ b/carbon/tkMacOSXDialog.c
@@ -0,0 +1,2316 @@
+/*
+ * 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.
+ */
+
+#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 confirmOverwrite, 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, false, 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;
+ int confirmOverwrite = 1;
+ 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",
+ "-confirmoverwrite", NULL
+ };
+ enum saveOptions {
+ SAVE_DEFAULT, SAVE_FILETYPES, SAVE_INITDIR, SAVE_INITFILE,
+ SAVE_MESSAGE, SAVE_PARENT, SAVE_TITLE, SAVE_TYPEVARIABLE,
+ SAVE_CONFIRMOW
+ };
+
+ 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;
+ case SAVE_CONFIRMOW:
+ if (Tcl_GetBooleanFromObj(interp, objv[i + 1], &confirmOverwrite)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ if (initialDesc.descriptorType == typeFSRef) {
+ initialPtr = &initialDesc;
+ }
+ result = NavServicesGetFile(interp, &ofd, initialPtr, initialFile, NULL,
+ title, message, NULL, false, confirmOverwrite, 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, 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 confirmOverwrite,
+ 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;
+ }
+ if (!confirmOverwrite) {
+ options.optionFlags |= kNavDontConfirmReplacement;
+ }
+ 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 =
+ 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(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, NULL },
+ { "show", FontchooserShowCmd, NULL },
+ { "hide", FontchooserHideCmd, NULL },
+ { NULL, NULL, NULL }
+};
+
+static Tcl_Interp *fontchooserInterp = NULL;
+static FMFontFamily fontPanelFontFamily = kInvalidFontFamily;
+static FMFontStyle fontPanelFontStyle = -1;
+static FMFontSize fontPanelFontSize = 0;
+static FMFont fontPanelFontID = kInvalidFont;
+
+static const char *const 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 = ckalloc(sizeof(Tcl_Obj *) * (objc + 2));
+ memcpy(tmpv, objv, sizeof(Tcl_Obj *) * objc);
+ tmpv[objc] = fontObj;
+ result = TkBackgroundEvalObjv(fontchooserInterp,
+ objc + 1, tmpv, TCL_EVAL_GLOBAL);
+ ckfree(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(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 = 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:
+ */
generated by cgit v0.12 at 2024-11-08 22:47:18 (GMT)