summaryrefslogtreecommitdiffstats
path: root/macosx/tkMacOSXDialog.c
diff options
context:
space:
mode:
Diffstat (limited to 'macosx/tkMacOSXDialog.c')
-rw-r--r--macosx/tkMacOSXDialog.c809
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