diff options
Diffstat (limited to 'carbon/tkMacOSXDialog.c')
| -rw-r--r-- | carbon/tkMacOSXDialog.c | 2325 |
1 files changed, 0 insertions, 2325 deletions
diff --git a/carbon/tkMacOSXDialog.c b/carbon/tkMacOSXDialog.c deleted file mode 100644 index d3ea74e..0000000 --- a/carbon/tkMacOSXDialog.c +++ /dev/null @@ -1,2325 +0,0 @@ -/* - * 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, - const char *dlgType); - -/* - * 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 *value; - - if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option", - TCL_EXACT, &index) != TCL_OK) { - goto end; - } - if (i + 1 == objc) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "value for \"%s\" missing", Tcl_GetString(objv[i]))); - Tcl_SetErrorCode(interp, "TK", "COLORDIALOG", "VALUE", 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; - Tcl_Obj *types; - - if (Tcl_GetIndexFromObj(interp, objv[i], openOptionStrings, "option", - TCL_EXACT, &index) != TCL_OK) { - goto end; - } - if (i + 1 == objc) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "value for \"%s\" missing", Tcl_GetString(objv[i]))); - Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", 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, "FILEDIALOG") != 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; - 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) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "value for \"%s\" missing", Tcl_GetString(objv[i]))); - Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", 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, "FILEDIALOG") != 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 *choice; - int index, choiceLen; - - if (Tcl_GetIndexFromObj(interp, objv[i], chooseOptionStrings, "option", - TCL_EXACT, &index) != TCL_OK) { - goto end; - } - if (i + 1 == objc) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "value for \"%s\" missing", Tcl_GetString(objv[i]))); - Tcl_SetErrorCode(interp, "TK", "DIRDIALOG", "VALUE", NULL); - goto end; - } - switch (index) { - case CHOOSE_INITDIR: - choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen); - if (choiceLen && HandleInitialDirectory(interp, NULL, choice, - &dirRef, NULL, &initialDesc, "DIRDIALOG") != 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, - const char *dlgType) -{ - 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_SetObjResult(interp, Tcl_ObjPrintf( - "bad directory \"%s\"", initialDir)); - Tcl_SetErrorCode(interp, "TK", dlgType, "NO_INITDIR", NULL); - goto end; - } - if (!isDirectory) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "-intialdir \"%s\" is a file, not a directory.", - initialDir)); - Tcl_SetErrorCode(interp, "TK", dlgType, "BAD_INITDIR", 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_SetObjResult(interp, Tcl_ObjPrintf( - "bad initialfile \"%s\" file does not exist.", - initialFile)); - Tcl_SetErrorCode(interp, "TK", dlgType, "NO_INITFILE", 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, ¶mCFStringRec, - kStdCFStringAlertVersionOne); - paramCFStringRec.movable = true; - paramCFStringRec.helpButton = false; - paramCFStringRec.defaultButton = kAlertStdAlertOKButton; - paramCFStringRec.cancelButton = kAlertStdAlertCancelButton; - - for (i = 1; i < objc; i += 2) { - int iconIndex; - - if (Tcl_GetIndexFromObj(interp, objv[i], movableAlertStrings, "option", - TCL_EXACT, &index) != TCL_OK) { - goto end; - } - if (i + 1 == objc) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "value for \"%s\" missing", Tcl_GetString(objv[i]))); - Tcl_SetErrorCode(interp, "TK", "MSGBOX", "VALUE", 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)); - Tcl_SetErrorCode(interp, "TK", "MSGBOX", "DEFAULT", NULL); - 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, ¶mCFStringRec, 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, ¶mCFStringRec, &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_SetObjResult(interp, Tcl_ObjPrintf( - "value for \"%s\" missing", Tcl_GetString(objv[i]))); - Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "VALUE", 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, -1)); - Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "READONLY", NULL); - 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: - */ |