diff options
Diffstat (limited to 'macosx/tkMacOSXDialog.c')
-rw-r--r-- | macosx/tkMacOSXDialog.c | 809 |
1 files changed, 669 insertions, 140 deletions
diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c index b5ff48b..4b19260 100644 --- a/macosx/tkMacOSXDialog.c +++ b/macosx/tkMacOSXDialog.c @@ -7,24 +7,21 @@ * Copyright 2001-2009, Apple Inc. * Copyright (c) 2006-2009 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. - */ + * 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" -static int TkBackgroundEvalObjv(Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv, int flags); - -static const char *colorOptionStrings[] = { +static const char *const colorOptionStrings[] = { "-initialcolor", "-parent", "-title", NULL }; enum colorOptions { COLOR_INITIAL, COLOR_PARENT, COLOR_TITLE }; -static const char *openOptionStrings[] = { +static const char *const openOptionStrings[] = { "-defaultextension", "-filetypes", "-initialdir", "-initialfile", "-message", "-multiple", "-parent", "-title", "-typevariable", "-command", NULL @@ -34,7 +31,7 @@ enum openOptions { OPEN_MESSAGE, OPEN_MULTIPLE, OPEN_PARENT, OPEN_TITLE, OPEN_TYPEVARIABLE, OPEN_COMMAND, }; -static const char *saveOptionStrings[] = { +static const char *const saveOptionStrings[] = { "-defaultextension", "-filetypes", "-initialdir", "-initialfile", "-message", "-parent", "-title", "-typevariable", "-command", "-confirmoverwrite", NULL @@ -44,7 +41,7 @@ enum saveOptions { SAVE_MESSAGE, SAVE_PARENT, SAVE_TITLE, SAVE_TYPEVARIABLE, SAVE_COMMAND, SAVE_CONFIRMOW }; -static const char *chooseOptionStrings[] = { +static const char *const chooseOptionStrings[] = { "-initialdir", "-message", "-mustexist", "-parent", "-title", "-command", NULL }; @@ -58,7 +55,7 @@ typedef struct { int multiple; } FilePanelCallbackInfo; -static const char *alertOptionStrings[] = { +static const char *const alertOptionStrings[] = { "-default", "-detail", "-icon", "-message", "-parent", "-title", "-type", "-command", NULL }; @@ -71,7 +68,7 @@ typedef struct { Tcl_Obj *cmdObj; int typeIndex; } AlertCallbackInfo; -static const char *alertTypeStrings[] = { +static const char *const alertTypeStrings[] = { "abortretryignore", "ok", "okcancel", "retrycancel", "yesno", "yesnocancel", NULL }; @@ -79,13 +76,13 @@ enum alertTypeOptions { TYPE_ABORTRETRYIGNORE, TYPE_OK, TYPE_OKCANCEL, TYPE_RETRYCANCEL, TYPE_YESNO, TYPE_YESNOCANCEL }; -static const char *alertIconStrings[] = { +static const char *const alertIconStrings[] = { "error", "info", "question", "warning", NULL }; enum alertIconOptions { ICON_ERROR, ICON_INFO, ICON_QUESTION, ICON_WARNING }; -static const char *alertButtonStrings[] = { +static const char *const alertButtonStrings[] = { "abort", "retry", "ignore", "ok", "cancel", "yes", "no", NULL }; @@ -105,9 +102,9 @@ static const NSAlertStyle alertStyles[] = { }; /* - * Need to map from 'alertButtonStrings' 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. + * Need to map from 'alertButtonStrings' 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. */ static const short alertButtonIndexAndTypeToNativeButtonIndex[][7] = { @@ -133,20 +130,23 @@ static const short alertNativeButtonIndexAndTypeToButtonIndex[][3] = { [TYPE_YESNO] = {5, 6, 0}, [TYPE_YESNOCANCEL] = {5, 6, 4}, }; - + #pragma mark TKApplication(TKDialog) @interface NSColorPanel(TKDialog) -- (void)_setUseModalAppearance:(BOOL)flag; +- (void) _setUseModalAppearance: (BOOL) flag; @end @implementation TKApplication(TKDialog) -- (void)tkFilePanelDidEnd:(NSSavePanel *)panel returnCode:(NSInteger)returnCode - contextInfo:(void *)contextInfo { + +- (void) tkFilePanelDidEnd: (NSSavePanel *) panel + returnCode: (NSInteger) returnCode contextInfo: (void *) contextInfo +{ FilePanelCallbackInfo *callbackInfo = contextInfo; if (returnCode == NSFileHandlingPanelOKButton) { Tcl_Obj *resultObj; + if (callbackInfo->multiple) { resultObj = Tcl_NewListObj(0, NULL); for (NSString *name in [(NSOpenPanel*)panel filenames]) { @@ -160,13 +160,14 @@ static const short alertNativeButtonIndexAndTypeToButtonIndex[][3] = { Tcl_Obj **objv, **tmpv; int objc, result = Tcl_ListObjGetElements(callbackInfo->interp, callbackInfo->cmdObj, &objc, &objv); + if (result == TCL_OK && objc) { - tmpv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * (objc + 2)); + tmpv = ckalloc(sizeof(Tcl_Obj *) * (objc + 2)); memcpy(tmpv, objv, sizeof(Tcl_Obj *) * objc); tmpv[objc] = resultObj; TkBackgroundEvalObjv(callbackInfo->interp, objc + 1, tmpv, TCL_EVAL_GLOBAL); - ckfree((char *)tmpv); + ckfree(tmpv); } } else { Tcl_SetObjResult(callbackInfo->interp, resultObj); @@ -179,28 +180,32 @@ static const short alertNativeButtonIndexAndTypeToButtonIndex[][3] = { } if (callbackInfo->cmdObj) { Tcl_DecrRefCount(callbackInfo->cmdObj); - ckfree((char*) callbackInfo); + ckfree(callbackInfo); } } -- (void)tkAlertDidEnd:(NSAlert *)alert returnCode:(NSInteger)returnCode - contextInfo:(void *)contextInfo { + +- (void) tkAlertDidEnd: (NSAlert *) alert returnCode: (NSInteger) returnCode + contextInfo: (void *) contextInfo +{ AlertCallbackInfo *callbackInfo = contextInfo; if (returnCode != NSAlertErrorReturn) { Tcl_Obj *resultObj = Tcl_NewStringObj(alertButtonStrings[ alertNativeButtonIndexAndTypeToButtonIndex[callbackInfo-> typeIndex][returnCode - NSAlertFirstButtonReturn]], -1); + if (callbackInfo->cmdObj) { Tcl_Obj **objv, **tmpv; int objc, result = Tcl_ListObjGetElements(callbackInfo->interp, callbackInfo->cmdObj, &objc, &objv); + if (result == TCL_OK && objc) { - tmpv = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * (objc + 2)); + tmpv = ckalloc(sizeof(Tcl_Obj *) * (objc + 2)); memcpy(tmpv, objv, sizeof(Tcl_Obj *) * objc); tmpv[objc] = resultObj; TkBackgroundEvalObjv(callbackInfo->interp, objc + 1, tmpv, TCL_EVAL_GLOBAL); - ckfree((char *)tmpv); + ckfree(tmpv); } } else { Tcl_SetObjResult(callbackInfo->interp, resultObj); @@ -211,7 +216,7 @@ static const short alertNativeButtonIndexAndTypeToButtonIndex[][3] = { } if (callbackInfo->cmdObj) { Tcl_DecrRefCount(callbackInfo->cmdObj); - ckfree((char*) callbackInfo); + ckfree(callbackInfo); } } @end @@ -252,43 +257,41 @@ Tk_ChooseColorObjCmd( for (i = 1; i < objc; i += 2) { int index; - const char *option, *value; + const char *value; - if (Tcl_GetIndexFromObj(interp, objv[i], colorOptionStrings, "option", - TCL_EXACT, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], colorOptionStrings, + sizeof(char *), "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); + 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 (index) { - case COLOR_INITIAL: { - XColor *colorPtr; + case COLOR_INITIAL: { + XColor *colorPtr; - colorPtr = Tk_GetColor(interp, tkwin, value); - if (colorPtr == NULL) { - goto end; - } - initialColor = TkMacOSXGetNSColor(NULL, colorPtr->pixel); - Tk_FreeColor(colorPtr); - break; - } - case COLOR_PARENT: { - parent = Tk_NameToWindow(interp, value, tkwin); - if (parent == NULL) { - goto end; - } - break; + colorPtr = Tk_GetColor(interp, tkwin, value); + if (colorPtr == NULL) { + goto end; } - case COLOR_TITLE: { - title = value; - break; + initialColor = TkMacOSXGetNSColor(NULL, colorPtr->pixel); + 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; } } colorPanel = [NSColorPanel sharedColorPanel]; @@ -325,6 +328,7 @@ Tk_ChooseColorObjCmd( Tcl_ResetResult(interp); } result = TCL_OK; + end: return result; } @@ -369,13 +373,14 @@ Tk_GetOpenFileObjCmd( TkInitFileFilters(&fl); for (i = 1; i < objc; i += 2) { - if (Tcl_GetIndexFromObj(interp, objv[i], openOptionStrings, "option", - TCL_EXACT, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], openOptionStrings, + sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) { goto end; } if (i + 1 == objc) { - str = Tcl_GetString(objv[i]); - Tcl_AppendResult(interp, "value for \"", str, "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL); goto end; } switch (index) { @@ -468,8 +473,7 @@ Tk_GetOpenFileObjCmd( } [panel setAllowsMultipleSelection:multiple]; if (cmdObj) { - callbackInfo = (FilePanelCallbackInfo *) - ckalloc(sizeof(FilePanelCallbackInfo)); + callbackInfo = ckalloc(sizeof(FilePanelCallbackInfo)); if (Tcl_IsShared(cmdObj)) { cmdObj = Tcl_DuplicateObj(cmdObj); } @@ -498,10 +502,11 @@ Tk_GetOpenFileObjCmd( * The -typevariable option is not really supported. */ - Tcl_SetVar(interp, Tcl_GetString(typeVariablePtr), "", - TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, Tcl_GetString(typeVariablePtr), NULL, + "", TCL_GLOBAL_ONLY); } -end: + + end: TkFreeFileFilters(&fl); return result; } @@ -547,14 +552,14 @@ Tk_GetSaveFileObjCmd( TkInitFileFilters(&fl); for (i = 1; i < objc; i += 2) { - if (Tcl_GetIndexFromObj(interp, objv[i], saveOptionStrings, "option", - TCL_EXACT, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], saveOptionStrings, + sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) { goto end; } if (i + 1 == objc) { - str = Tcl_GetString(objv[i]); - Tcl_AppendResult(interp, "value for \"", str, "\" missing", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL); goto end; } switch (index) { @@ -614,7 +619,7 @@ Tk_GetSaveFileObjCmd( break; case SAVE_CONFIRMOW: if (Tcl_GetBooleanFromObj(interp, objv[i + 1], - &confirmOverwrite) != TCL_OK) { + &confirmOverwrite) != TCL_OK) { goto end; } break; @@ -649,8 +654,7 @@ Tk_GetSaveFileObjCmd( [panel setCanSelectHiddenExtension:YES]; [panel setExtensionHidden:NO]; if (cmdObj) { - callbackInfo = (FilePanelCallbackInfo *) - ckalloc(sizeof(FilePanelCallbackInfo)); + callbackInfo = ckalloc(sizeof(FilePanelCallbackInfo)); if (Tcl_IsShared(cmdObj)) { cmdObj = Tcl_DuplicateObj(cmdObj); } @@ -673,7 +677,8 @@ Tk_GetSaveFileObjCmd( contextInfo:callbackInfo]; } result = (returnCode != NSAlertErrorReturn) ? TCL_OK : TCL_ERROR; -end: + + end: TkFreeFileFilters(&fl); return result; } @@ -717,13 +722,14 @@ Tk_ChooseDirectoryObjCmd( NSInteger returnCode = NSAlertErrorReturn; for (i = 1; i < objc; i += 2) { - if (Tcl_GetIndexFromObj(interp, objv[i], chooseOptionStrings, "option", - TCL_EXACT, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], chooseOptionStrings, + sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) { goto end; } if (i + 1 == objc) { - str = Tcl_GetString(objv[i]); - Tcl_AppendResult(interp, "value for \"", str, "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "DIRDIALOG", "VALUE", NULL); goto end; } switch (index) { @@ -770,8 +776,7 @@ Tk_ChooseDirectoryObjCmd( [panel setCanChooseDirectories:YES]; [panel setCanCreateDirectories:!mustexist]; if (cmdObj) { - callbackInfo = (FilePanelCallbackInfo *) - ckalloc(sizeof(FilePanelCallbackInfo)); + callbackInfo = ckalloc(sizeof(FilePanelCallbackInfo)); if (Tcl_IsShared(cmdObj)) { cmdObj = Tcl_DuplicateObj(cmdObj); } @@ -794,7 +799,8 @@ Tk_ChooseDirectoryObjCmd( contextInfo:callbackInfo]; } result = (returnCode != NSAlertErrorReturn) ? TCL_OK : TCL_ERROR; -end: + + end: return result; } @@ -818,20 +824,29 @@ void TkAboutDlg(void) { NSImage *image; - NSString *path = [NSApp tkFrameworkImagePath:@"Tk.tiff"]; + NSString *path = [NSApp tkFrameworkImagePath: @"Tk.tiff"]; + if (path) { image = [[[NSImage alloc] initWithContentsOfFile:path] autorelease]; } else { image = [NSApp applicationIconImage]; } + NSDateFormatter *dateFormatter = [[NSDateFormatter alloc] init]; + [dateFormatter setFormatterBehavior:NSDateFormatterBehavior10_4]; [dateFormatter setDateFormat:@"Y"]; + NSString *year = [dateFormatter stringFromDate:[NSDate date]]; + [dateFormatter release]; - NSMutableParagraphStyle *style = [[[NSParagraphStyle defaultParagraphStyle] - mutableCopy] autorelease]; + + NSMutableParagraphStyle *style = + [[[NSParagraphStyle defaultParagraphStyle] mutableCopy] + autorelease]; + [style setAlignment:NSCenterTextAlignment]; + NSDictionary *options = [NSDictionary dictionaryWithObjectsAndKeys: @"Tcl & Tk", @"ApplicationName", @"Tcl " TCL_VERSION " & Tk " TK_VERSION, @"ApplicationVersion", @@ -842,15 +857,15 @@ TkAboutDlg(void) [[[NSAttributedString alloc] initWithString: [NSString stringWithFormat: @"%1$C 1987-%2$@ Tcl Core Team." "\n\n" - "%1$C 1989-%2$@ Contributors." "\n\n" + "%1$C 1989-%2$@ Contributors." "\n\n" "%1$C 2011-%2$@ Kevin Walzer/WordTech Communications LLC." "\n\n" "%1$C 2014-%2$@ Marc Culler." "\n\n" - "%1$C 2002-%2$@ Daniel A. Steffen." "\n\n" - "%1$C 2001-2009 Apple Inc." "\n\n" - "%1$C 2001-2002 Jim Ingham & Ian Reid" "\n\n" - "%1$C 1998-2000 Jim Ingham & Ray Johnson" "\n\n" - "%1$C 1998-2000 Scriptics Inc." "\n\n" - "%1$C 1996-1997 Sun Microsystems Inc.", 0xA9, year] attributes: + "%1$C 2002-%2$@ Daniel A. Steffen." "\n\n" + "%1$C 2001-2009 Apple Inc." "\n\n" + "%1$C 2001-2002 Jim Ingham & Ian Reid" "\n\n" + "%1$C 1998-2000 Jim Ingham & Ray Johnson" "\n\n" + "%1$C 1998-2000 Scriptics Inc." "\n\n" + "%1$C 1996-1997 Sun Microsystems Inc.", 0xA9, year] attributes: [NSDictionary dictionaryWithObject:style forKey:NSParagraphStyleAttributeName]] autorelease], @"Credits", nil]; @@ -927,13 +942,14 @@ Tk_MessageBoxObjCmd( iconIndex = ICON_INFO; typeIndex = TYPE_OK; for (i = 1; i < objc; i += 2) { - if (Tcl_GetIndexFromObj(interp, objv[i], alertOptionStrings, "option", - TCL_EXACT, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], alertOptionStrings, + sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) { goto end; } if (i + 1 == objc) { - str = Tcl_GetString(objv[i]); - Tcl_AppendResult(interp, "value for \"", str, "\" missing", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "value for \"%s\" missing", Tcl_GetString(objv[i]))); + Tcl_SetErrorCode(interp, "TK", "MSGBOX", "VALUE", NULL); goto end; } switch (index) { @@ -954,8 +970,8 @@ Tk_MessageBoxObjCmd( break; case ALERT_ICON: - if (Tcl_GetIndexFromObj(interp, objv[i + 1], alertIconStrings, - "value", TCL_EXACT, &iconIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i + 1], alertIconStrings, + sizeof(char *), "value", TCL_EXACT, &iconIndex) != TCL_OK) { goto end; } break; @@ -984,8 +1000,8 @@ Tk_MessageBoxObjCmd( break; case ALERT_TYPE: - if (Tcl_GetIndexFromObj(interp, objv[i + 1], alertTypeStrings, - "value", TCL_EXACT, &typeIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i + 1], alertTypeStrings, + sizeof(char *), "value", TCL_EXACT, &typeIndex) != TCL_OK) { goto end; } break; @@ -996,13 +1012,12 @@ Tk_MessageBoxObjCmd( } if (indexDefaultOption) { /* - * Any '-default' option needs to know the '-type' option, which is why - * we do this here. + * Any '-default' option needs to know the '-type' option, which is + * why we do this here. */ - if (Tcl_GetIndexFromObj(interp, objv[indexDefaultOption + 1], - alertButtonStrings, "value", TCL_EXACT, &index) - != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[indexDefaultOption + 1], + alertButtonStrings, sizeof(char *), "value", TCL_EXACT, &index) != TCL_OK) { goto end; } @@ -1015,6 +1030,7 @@ Tk_MessageBoxObjCmd( if (!defaultNativeButtonIndex) { Tcl_SetObjResult(interp, Tcl_NewStringObj("Illegal default option", -1)); + Tcl_SetErrorCode(interp, "TK", "MSGBOX", "DEFAULT", NULL); goto end; } } @@ -1027,15 +1043,17 @@ Tk_MessageBoxObjCmd( buttons = [alert buttons]; for (NSButton *b in buttons) { NSString *ke = [b keyEquivalent]; + if (([ke isEqualToString:@"\r"] || [ke isEqualToString:@"\033"]) && ![b keyEquivalentModifierMask]) { [b setKeyEquivalent:@""]; } } - [[buttons objectAtIndex:[buttons count]-1] setKeyEquivalent:@"\033"]; - [[buttons objectAtIndex:defaultNativeButtonIndex-1] setKeyEquivalent:@"\r"]; + [[buttons objectAtIndex: [buttons count]-1] setKeyEquivalent: @"\033"]; + [[buttons objectAtIndex: defaultNativeButtonIndex-1] + setKeyEquivalent: @"\r"]; if (cmdObj) { - callbackInfo = (AlertCallbackInfo *) ckalloc(sizeof(AlertCallbackInfo)); + callbackInfo = ckalloc(sizeof(AlertCallbackInfo)); if (Tcl_IsShared(cmdObj)) { cmdObj = Tcl_DuplicateObj(cmdObj); } @@ -1057,73 +1075,584 @@ Tk_MessageBoxObjCmd( contextInfo:callbackInfo]; } result = (returnCode != NSAlertErrorReturn) ? TCL_OK : TCL_ERROR; -end: + end: [alert release]; return result; } /* + *---------------------------------------------------------------------- + */ +#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; + +enum FontchooserEvent { FontchooserClosed, FontchooserSelection }; + +static void FontchooserEvent(int kind); +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 NSFont *fontPanelFont = nil; +static NSMutableDictionary *fontPanelFontAttributes = nil; + +static const char *const fontchooserOptionStrings[] = { + "-parent", "-title", "-font", "-command", + "-visible", NULL +}; +enum FontchooserOption { + FontchooserParent, FontchooserTitle, FontchooserFont, FontchooserCmd, + FontchooserVisible +}; + +@implementation TKApplication(TKFontPanel) + +- (void) changeFont: (id) sender +{ + NSFontManager *fm = [NSFontManager sharedFontManager]; + + if ([fm currentFontAction] == NSViaPanelFontAction) { + NSFont *font = [fm convertFont:fontPanelFont]; + + if (![fontPanelFont isEqual:font]) { + [fontPanelFont release]; + fontPanelFont = [font retain]; + FontchooserEvent(FontchooserSelection); + } + } +} + +- (void) changeAttributes: (id) sender +{ + NSDictionary *attributes = [sender convertAttributes: + fontPanelFontAttributes]; + + if (![fontPanelFontAttributes isEqual:attributes]) { + [fontPanelFontAttributes setDictionary:attributes]; + FontchooserEvent(FontchooserSelection); + } +} + +- (NSUInteger) validModesForFontPanel: (NSFontPanel *) fontPanel +{ + return (NSFontPanelStandardModesMask & ~NSFontPanelAllEffectsModeMask) | + NSFontPanelUnderlineEffectModeMask | + NSFontPanelStrikethroughEffectModeMask; +} + +- (void) windowDidOrderOffScreen: (NSNotification *) notification +{ +#ifdef TK_MAC_DEBUG_NOTIFICATIONS + TKLog(@"-[%@(%p) %s] %@", [self class], self, _cmd, notification); +#endif + if ([[notification object] isEqual:[[NSFontManager sharedFontManager] + fontPanel:NO]]) { + FontchooserEvent(FontchooserClosed); + } +} +@end + +/* + *---------------------------------------------------------------------- + * + * FontchooserEvent -- + * + * This processes events generated by user interaction with the + * font panel. + * + * Results: + * None. + * + * Side effects: + * Additional events may be place on the Tk event queue. + * + *---------------------------------------------------------------------- + */ + +static void +FontchooserEvent( + int kind) +{ + FontchooserData *fcdPtr; + Tcl_Obj *fontObj; + + if (!fontchooserInterp) { + return; + } + fcdPtr = Tcl_GetAssocData(fontchooserInterp, "::tk::fontchooser", NULL); + switch (kind) { + case FontchooserClosed: + if (fcdPtr->parent != None) { + TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserVisibility"); + fontchooserInterp = NULL; + } + break; + case FontchooserSelection: + fontObj = TkMacOSXFontDescriptionForNSFontAndNSFontAttributes( + fontPanelFont, fontPanelFontAttributes); + 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; + TkBackgroundEvalObjv(fontchooserInterp, objc + 1, tmpv, + TCL_EVAL_GLOBAL); + ckfree(tmpv); + } + } + TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserFontChanged"); + } + break; + } +} + +/* + *---------------------------------------------------------------------- + * + * 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 = TkMacOSXFontDescriptionForNSFontAndNSFontAttributes( + fontPanelFont, fontPanelFontAttributes); + if (!resObj) { + resObj = Tcl_NewObj(); + } + break; + case FontchooserCmd: + if (fcdPtr->cmdObj) { + resObj = fcdPtr->cmdObj; + } else { + resObj = Tcl_NewObj(); + } + break; + case FontchooserVisible: + resObj = Tcl_NewBooleanObj([[[NSFontManager sharedFontManager] + fontPanel:NO] isVisible]); + break; + default: + resObj = Tcl_NewObj(); + } + return resObj; +} + +/* * ---------------------------------------------------------------------- * - * TkBackgroundEvalObjv -- + * FontchooserConfigureCmd -- * - * Evaluate a command while ensuring that we do not affect the - * interpreters state. This is important when evaluating script - * during background tasks. + * Implementation of the 'tk fontchooser configure' ensemble command. + * See the user documentation for what it does. * * Results: - * A standard Tcl result code. + * See the user documentation. * - * Side Effects: - * The interpreters variables and code may be modified by the script - * but the result will not be modified. + * Side effects: + * Per-interp data structure may be modified * * ---------------------------------------------------------------------- */ -int -TkBackgroundEvalObjv( +static int +FontchooserConfigureCmd( + ClientData clientData, /* Main window */ Tcl_Interp *interp, int objc, - Tcl_Obj *const *objv, - int flags) + Tcl_Obj *const objv[]) { - Tcl_InterpState state; - int n, r = TCL_OK; + Tk_Window tkwin = (Tk_Window)clientData; + FontchooserData *fcdPtr = Tcl_GetAssocData(interp, "::tk::fontchooser", + NULL); + int i, r = TCL_OK; /* - * Record the state of the interpreter. + * With no arguments we return all the options in a dict */ - Tcl_Preserve(interp); - state = Tcl_SaveInterpState(interp, TCL_OK); + if (objc == 1) { + Tcl_Obj *keyObj, *valueObj; + Tcl_Obj *dictObj = Tcl_NewDictObj(); - /* - * Evaluate the command and handle any error. - */ + 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_GetIndexFromObjStruct(interp, objv[i], fontchooserOptionStrings, + sizeof(char *), "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) { + return TCL_ERROR; + } + [fontPanelFont autorelease]; + fontPanelFont = [TkMacOSXNSFontForFont(f) retain]; + [fontPanelFontAttributes setDictionary: + TkMacOSXNSFontAttributesForFont(f)]; + [fontPanelFontAttributes removeObjectsForKeys:[NSArray + arrayWithObjects:NSFontAttributeName, + NSLigatureAttributeName, NSKernAttributeName, nil]]; + Tk_FreeFont(f); + } else { + [fontPanelFont release]; + fontPanelFont = nil; + [fontPanelFontAttributes removeAllObjects]; + } + + NSFontManager *fm = [NSFontManager sharedFontManager]; + NSFontPanel *fp = [fm fontPanel:NO]; + + [fp setPanelFont:fontPanelFont isMultiple:NO]; + [fm setSelectedFont:fontPanelFont isMultiple:NO]; + [fm setSelectedAttributes:fontPanelFontAttributes + isMultiple:NO]; + if ([fp isVisible]) { + 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. + * + * ---------------------------------------------------------------------- + */ - for (n = 0; n < objc; ++n) { - Tcl_IncrRefCount(objv[n]); +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); } - r = Tcl_EvalObjv(interp, objc, objv, flags); - for (n = 0; n < objc; ++n) { - Tcl_DecrRefCount(objv[n]); + NSFontManager *fm = [NSFontManager sharedFontManager]; + NSFontPanel *fp = [fm fontPanel:YES]; + if ([fp delegate] != NSApp) { + [fp setDelegate:NSApp]; } - if (r == TCL_ERROR) { - Tcl_AddErrorInfo(interp, "\n (background event handler)"); - Tcl_BackgroundError(interp); + if (![fp isVisible]) { + [fm orderFrontFontPanel:NSApp]; + TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserVisibility"); } + fontchooserInterp = interp; - /* - * Restore the state of the interpreter. - */ + 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[]) +{ + NSFontPanel *fp = [[NSFontManager sharedFontManager] fontPanel:NO]; + if ([fp isVisible]) { + [fp orderOut:NSApp]; + } + 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. + * + * ---------------------------------------------------------------------- + */ - (void) Tcl_RestoreInterpState(interp, state); - Tcl_Release(interp); +static void +FontchooserParentEventHandler( + ClientData clientData, + XEvent *eventPtr) +{ + FontchooserData *fcdPtr = clientData; - return r; + if (eventPtr->type == DestroyNotify) { + Tk_DeleteEventHandler(fcdPtr->parent, StructureNotifyMask, + FontchooserParentEventHandler, fcdPtr); + fcdPtr->parent = None; + FontchooserHideCmd(NULL, NULL, 0, NULL); + } } + +/* + * ---------------------------------------------------------------------- + * + * 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); + if (!fontPanelFontAttributes) { + NSAutoreleasePool *pool = [NSAutoreleasePool new]; + fontPanelFontAttributes = [NSMutableDictionary new]; + [pool drain]; + } + return TCL_OK; +} + /* * Local Variables: * mode: objc |