diff options
Diffstat (limited to 'macosx/tkMacOSXDialog.c')
| -rw-r--r-- | macosx/tkMacOSXDialog.c | 567 |
1 files changed, 565 insertions, 2 deletions
diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c index 1553592..e283f5c 100644 --- a/macosx/tkMacOSXDialog.c +++ b/macosx/tkMacOSXDialog.c @@ -5,12 +5,12 @@ * * Copyright (c) 1996-1997 Sun Microsystems, Inc. * Copyright 2001, Apple Computer, Inc. - * Copyright (c) 2006-2007 Daniel A. Steffen <das@users.sourceforge.net> + * Copyright (c) 2006-2008 Daniel A. Steffen <das@users.sourceforge.net> * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacOSXDialog.c,v 1.42 2008/12/07 16:36:26 das Exp $ + * RCS: @(#) $Id: tkMacOSXDialog.c,v 1.43 2008/12/10 05:02:52 das Exp $ */ #include "tkMacOSXPrivate.h" @@ -1741,3 +1741,566 @@ AlertHandler( } return eventNotHandledErr; } + +/* + *---------------------------------------------------------------------- + */ +#pragma mark [tk fontchooser] implementation (TIP 324) +/* + *---------------------------------------------------------------------- + */ + +#include "tkMacOSXEvent.h" +#include "tkMacOSXFont.h" + +typedef struct FontchooserData { + Tcl_Obj *titleObj; + Tcl_Obj *cmdObj; + Tk_Window parent; +} FontchooserData; + +static Tcl_Obj *FontchooserCget(FontchooserData *fcdPtr, int optionIndex); +static int FontchooserConfigureCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int FontchooserShowCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static int FontchooserHideCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); +static void FontchooserParentEventHandler(ClientData clientData, + XEvent *eventPtr); +static void DeleteFontchooserData(ClientData clientData, Tcl_Interp *interp); + +MODULE_SCOPE const TkEnsemble tkFontchooserEnsemble[]; +const TkEnsemble tkFontchooserEnsemble[] = { + { "configure", FontchooserConfigureCmd }, + { "show", FontchooserShowCmd }, + { "hide", FontchooserHideCmd }, +}; + +static Tcl_Interp *fontchooserInterp = NULL; +static FMFontFamily fontPanelFontFamily = kInvalidFontFamily; +static FMFontStyle fontPanelFontStyle = -1; +static FMFontSize fontPanelFontSize = 0; +static FMFont fontPanelFontID = kInvalidFont; + +static const char *fontchooserOptionStrings[] = { + "-parent", "-title", "-font", "-command", + "-visible", NULL +}; +enum FontchooserOption { + FontchooserParent, FontchooserTitle, FontchooserFont, FontchooserCmd, + FontchooserVisible +}; + +/* + *---------------------------------------------------------------------- + * + * TkMacOSXProcessFontEvent -- + * + * This processes events generated by user interaction with the + * font panel. + * + * Results: + * True if Tk events are generated - false otherwise. + * + * Side effects: + * Additional events may be place on the Tk event queue. + * + *---------------------------------------------------------------------- + */ + +MODULE_SCOPE int +TkMacOSXProcessFontEvent( + TkMacOSXEvent * eventPtr, + MacEventStatus * statusPtr) +{ + OSStatus err; + int eventGenerated = 0; + FontchooserData *fcdPtr; + + switch (eventPtr->eKind) { + case kEventFontPanelClosed: + case kEventFontSelection: + break; + default: + goto done; + } + if (!fontchooserInterp) { + goto done; + } + fcdPtr = Tcl_GetAssocData(fontchooserInterp, "::tk::fontchooser", NULL); + switch (eventPtr->eKind) { + case kEventFontPanelClosed: + if (!FPIsFontPanelVisible() && fcdPtr->parent != None) { + TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserVisibility"); + fontchooserInterp = NULL; + eventGenerated = 1; + } + break; + case kEventFontSelection: { + Tcl_Obj *fontObj = NULL; + + fontPanelFontFamily = kInvalidFontFamily; + fontPanelFontStyle = -1; + fontPanelFontSize = 0; + fontPanelFontID = kInvalidFont; + err = ChkErr(GetEventParameter, eventPtr->eventRef, + kEventParamFMFontFamily, typeFMFontFamily, NULL, + sizeof(FMFontFamily), NULL, &fontPanelFontFamily); + err |= ChkErr(GetEventParameter, eventPtr->eventRef, + kEventParamFMFontStyle, typeFMFontStyle, NULL, + sizeof(FMFontStyle), NULL, &fontPanelFontStyle); + err |= ChkErr(GetEventParameter, eventPtr->eventRef, + kEventParamFMFontSize, typeFMFontSize, NULL, + sizeof(FMFontSize), NULL, &fontPanelFontSize); + if (err != noErr) { + /* + * No/incomplete QD font spec, use ATSUI font ID + */ + Fixed fontFixedSize; + + err = ChkErr(GetEventParameter, eventPtr->eventRef, + kEventParamATSUFontID, typeATSUFontID, NULL, + sizeof(ATSUFontID), NULL, &fontPanelFontID); + if (err == noErr) { + ChkErr(FMGetFontFamilyInstanceFromFont, fontPanelFontID, + &fontPanelFontFamily, &fontPanelFontStyle); + } + err = ChkErr(GetEventParameter, eventPtr->eventRef, + kEventParamATSUFontSize, typeATSUSize, NULL, + sizeof(Fixed), NULL, &fontFixedSize); + if (err == noErr) { + fontPanelFontSize = FixedToInt(fontFixedSize); + } + } + fontObj = TkMacOSXFontDescriptionForFMFontInfo( + fontPanelFontFamily, fontPanelFontStyle, + fontPanelFontSize, fontPanelFontID); + if (fontObj) { + if (fcdPtr->cmdObj) { + int objc, result; + Tcl_Obj **objv, **tmpv; + + result = Tcl_ListObjGetElements(fontchooserInterp, + fcdPtr->cmdObj, &objc, &objv); + if (result == TCL_OK) { + tmpv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * + (unsigned)(objc + 2)); + memcpy(tmpv, objv, sizeof(Tcl_Obj *) * objc); + tmpv[objc] = fontObj; + result = TkBackgroundEvalObjv(fontchooserInterp, + objc + 1, tmpv, TCL_EVAL_GLOBAL); + ckfree((char *)tmpv); + } + } + TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserFontChanged"); + } + break; + } + } +done: + return eventGenerated; +} + +/* + *---------------------------------------------------------------------- + * + * FontchooserCget -- + * + * Helper for the FontchooserConfigure command to return the + * current value of any of the options (which may be NULL in + * the structure) + * + * Results: + * Tcl object of option value. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static Tcl_Obj * +FontchooserCget( + FontchooserData *fcdPtr, + int optionIndex) +{ + Tcl_Obj *resObj = NULL; + + switch(optionIndex) { + case FontchooserParent: { + if (fcdPtr->parent != None) { + resObj = Tcl_NewStringObj( + ((TkWindow*)fcdPtr->parent)->pathName, -1); + } else { + resObj = Tcl_NewStringObj(".", 1); + } + break; + } + case FontchooserTitle: { + if (fcdPtr->titleObj) { + resObj = fcdPtr->titleObj; + } else { + resObj = Tcl_NewObj(); + } + break; + } + case FontchooserFont: { + resObj = TkMacOSXFontDescriptionForFMFontInfo( + fontPanelFontFamily, fontPanelFontStyle, + fontPanelFontSize, fontPanelFontID); + if (!resObj) { + resObj = Tcl_NewObj(); + } + break; + } + case FontchooserCmd: { + if (fcdPtr->cmdObj) { + resObj = fcdPtr->cmdObj; + } else { + resObj = Tcl_NewObj(); + } + break; + } + case FontchooserVisible: { + resObj = Tcl_NewBooleanObj(FPIsFontPanelVisible()); + break; + } + default: { + resObj = Tcl_NewObj(); + } + } + return resObj; +} + +/* + * ---------------------------------------------------------------------- + * + * FontchooserConfigureCmd -- + * + * Implementation of the 'tk fontchooser configure' ensemble command. + * See the user documentation for what it does. + * + * Results: + * See the user documentation. + * + * Side effects: + * Per-interp data structure may be modified + * + * ---------------------------------------------------------------------- + */ + +static int +FontchooserConfigureCmd( + ClientData clientData, /* Main window */ + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + Tk_Window tkwin = (Tk_Window)clientData; + FontchooserData *fcdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", + NULL); + int i, r = TCL_OK; + + /* + * With no arguments we return all the options in a dict + */ + + if (objc == 1) { + Tcl_Obj *keyObj, *valueObj; + Tcl_Obj *dictObj = Tcl_NewDictObj(); + for (i = 0; r == TCL_OK && fontchooserOptionStrings[i] != NULL; ++i) { + keyObj = Tcl_NewStringObj(fontchooserOptionStrings[i], -1); + valueObj = FontchooserCget(fcdPtr, i); + r = Tcl_DictObjPut(interp, dictObj, keyObj, valueObj); + } + if (r == TCL_OK) { + Tcl_SetObjResult(interp, dictObj); + } + return r; + } + + for (i = 1; i < objc; i += 2) { + int optionIndex, len; + if (Tcl_GetIndexFromObj(interp, objv[i], fontchooserOptionStrings, + "option", 0, &optionIndex) != TCL_OK) { + return TCL_ERROR; + } + if (objc == 2) { + /* With one option and no arg, return the current value */ + Tcl_SetObjResult(interp, FontchooserCget(fcdPtr, optionIndex)); + return TCL_OK; + } + if (i + 1 == objc) { + Tcl_AppendResult(interp, "value for \"", + Tcl_GetString(objv[i]), "\" missing", NULL); + return TCL_ERROR; + } + switch (optionIndex) { + case FontchooserVisible: { + const char *msg = "cannot change read-only option " + "\"-visible\": use the show or hide command"; + + Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, sizeof(msg)-1)); + return TCL_ERROR; + } + case FontchooserParent: { + Tk_Window parent = Tk_NameToWindow(interp, + Tcl_GetString(objv[i+1]), tkwin); + if (parent == None) { + return TCL_ERROR; + } + if (fcdPtr->parent) { + Tk_DeleteEventHandler(fcdPtr->parent, StructureNotifyMask, + FontchooserParentEventHandler, fcdPtr); + } + fcdPtr->parent = parent; + Tk_CreateEventHandler(fcdPtr->parent, StructureNotifyMask, + FontchooserParentEventHandler, fcdPtr); + break; + } + case FontchooserTitle: + if (fcdPtr->titleObj) { + Tcl_DecrRefCount(fcdPtr->titleObj); + } + Tcl_GetStringFromObj(objv[i+1], &len); + if (len) { + fcdPtr->titleObj = objv[i+1]; + if (Tcl_IsShared(fcdPtr->titleObj)) { + fcdPtr->titleObj = Tcl_DuplicateObj(fcdPtr->titleObj); + } + Tcl_IncrRefCount(fcdPtr->titleObj); + } else { + fcdPtr->titleObj = NULL; + } + break; + case FontchooserFont: { + + Tcl_GetStringFromObj(objv[i+1], &len); + if (len) { + Tk_Font f = Tk_AllocFontFromObj(interp, tkwin, objv[i+1]); + if (f) { + ATSUStyle atsuStyle; + + TkMacOSXFMFontInfoForFont(f, &fontPanelFontFamily, + &fontPanelFontStyle, &fontPanelFontSize, + &atsuStyle); + ChkErr(SetFontInfoForSelection, + kFontSelectionATSUIType, 1, &atsuStyle, NULL); + Tk_FreeFont(f); + } else { + return TCL_ERROR; + } + } else { + fontPanelFontFamily = kInvalidFontFamily; + ChkErr(SetFontInfoForSelection, + kFontSelectionATSUIType, 0, NULL, NULL); + } + if (FPIsFontPanelVisible()) { + TkSendVirtualEvent(fcdPtr->parent, + "TkFontchooserFontChanged"); + } + break; + } + case FontchooserCmd: + if (fcdPtr->cmdObj) { + Tcl_DecrRefCount(fcdPtr->cmdObj); + } + Tcl_GetStringFromObj(objv[i+1], &len); + if (len) { + fcdPtr->cmdObj = objv[i+1]; + if (Tcl_IsShared(fcdPtr->cmdObj)) { + fcdPtr->cmdObj = Tcl_DuplicateObj(fcdPtr->cmdObj); + } + Tcl_IncrRefCount(fcdPtr->cmdObj); + } else { + fcdPtr->cmdObj = NULL; + } + break; + } + } + return TCL_OK; +} + +/* + * ---------------------------------------------------------------------- + * + * FontchooserShowCmd -- + * + * Implements the 'tk fontchooser show' ensemble command. The + * per-interp configuration data for the dialog is held in an interp + * associated structure. + * + * Results: + * See the user documentation. + * + * Side effects: + * Font Panel may be shown. + * + * ---------------------------------------------------------------------- + */ + +static int +FontchooserShowCmd( + ClientData clientData, /* Main window */ + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + FontchooserData *fcdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", + NULL); + + if (fcdPtr->parent == None) { + fcdPtr->parent = (Tk_Window) clientData; + Tk_CreateEventHandler(fcdPtr->parent, StructureNotifyMask, + FontchooserParentEventHandler, fcdPtr); + } + if (!FPIsFontPanelVisible()) { + ChkErr(FPShowHideFontPanel); + TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserVisibility"); + } + fontchooserInterp = interp; + + return TCL_OK; +} + +/* + * ---------------------------------------------------------------------- + * + * FontchooserHideCmd -- + * + * Implementation of the 'tk fontchooser hide' ensemble. See the + * user documentation for details. + * + * Results: + * See the user documentation. + * + * Side effects: + * Font Panel may be hidden. + * + * ---------------------------------------------------------------------- + */ + +static int +FontchooserHideCmd( + ClientData clientData, /* Main window */ + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + if (FPIsFontPanelVisible()) { + ChkErr(FPShowHideFontPanel); + } + return TCL_OK; +} + +/* + * ---------------------------------------------------------------------- + * + * FontchooserParentEventHandler -- + * + * Event handler for StructureNotify events on the font chooser's + * parent window. + * + * Results: + * None. + * + * Side effects: + * Font chooser parent info is cleared and font panel is hidden. + * + * ---------------------------------------------------------------------- + */ + +static void +FontchooserParentEventHandler( + ClientData clientData, + XEvent *eventPtr) +{ + FontchooserData *fcdPtr = clientData; + + if (eventPtr->type == DestroyNotify) { + Tk_DeleteEventHandler(fcdPtr->parent, StructureNotifyMask, + FontchooserParentEventHandler, fcdPtr); + fcdPtr->parent = None; + if (FPIsFontPanelVisible()) { + ChkErr(FPShowHideFontPanel); + } + } +} + +/* + * ---------------------------------------------------------------------- + * + * DeleteFontchooserData -- + * + * Clean up the font chooser configuration data when the interp + * is destroyed. + * + * Results: + * None. + * + * Side effects: + * per-interp configuration data is destroyed. + * + * ---------------------------------------------------------------------- + */ + +static void +DeleteFontchooserData( + ClientData clientData, + Tcl_Interp *interp) +{ + FontchooserData *fcdPtr = clientData; + + if (fcdPtr->titleObj) { + Tcl_DecrRefCount(fcdPtr->titleObj); + } + if (fcdPtr->cmdObj) { + Tcl_DecrRefCount(fcdPtr->cmdObj); + } + ckfree((char *)fcdPtr); + + if (fontchooserInterp == interp) { + fontchooserInterp = NULL; + } +} + +/* + * ---------------------------------------------------------------------- + * + * TkInitFontchooser -- + * + * Associate the font chooser configuration data with the Tcl + * interpreter. There is one font chooser per interp. + * + * Results: + * None. + * + * Side effects: + * per-interp configuration data is destroyed. + * + * ---------------------------------------------------------------------- + */ + +MODULE_SCOPE int +TkInitFontchooser( + Tcl_Interp *interp, + ClientData clientData) +{ + FontchooserData *fcdPtr = (FontchooserData*) + ckalloc(sizeof(FontchooserData)); + + bzero(fcdPtr, sizeof(FontchooserData)); + Tcl_SetAssocData(interp, "::tk::fontchooser", DeleteFontchooserData, + fcdPtr); + return TCL_OK; +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 79 + * coding: utf-8 + * End: + */ |