summaryrefslogtreecommitdiffstats
path: root/macosx/tkMacOSXDialog.c
diff options
context:
space:
mode:
authordas <das>2008-12-10 05:02:39 (GMT)
committerdas <das>2008-12-10 05:02:39 (GMT)
commit987b7068ea831ae0c3d20fb14f28499cc11449c3 (patch)
tree2f061501366a0706fb1db4d2cd36d5c490ace9f6 /macosx/tkMacOSXDialog.c
parent497e9cc2059d61d104050b8fdd54a72fbd7f121e (diff)
downloadtk-987b7068ea831ae0c3d20fb14f28499cc11449c3.zip
tk-987b7068ea831ae0c3d20fb14f28499cc11449c3.tar.gz
tk-987b7068ea831ae0c3d20fb14f28499cc11449c3.tar.bz2
TIP #324 IMPLEMENTATION
Diffstat (limited to 'macosx/tkMacOSXDialog.c')
-rw-r--r--macosx/tkMacOSXDialog.c567
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:
+ */