1 /*
2  * tkMacOSXDialog.c --
3  *
4  *	Contains the Mac implementation of the common dialog boxes.
5  *
6  * Copyright (c) 1996-1997 Sun Microsystems, Inc.
7  * Copyright 2001-2009, Apple Inc.
8  * Copyright (c) 2006-2009 Daniel A. Steffen <das@users.sourceforge.net>
9  * Copyright (c) 2017 Christian Gollwitzer.
10  *
11  * See the file "license.terms" for information on usage and redistribution of
12  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
13  */
14 
15 #include "tkMacOSXPrivate.h"
16 #include "tkFileFilter.h"
17 #include "tkMacOSXConstants.h"
18 
19 #if MAC_OS_X_VERSION_MIN_REQUIRED < 1090
20 #define modalOK     NSOKButton
21 #define modalCancel NSCancelButton
22 #else
23 #define modalOK     NSModalResponseOK
24 #define modalCancel NSModalResponseCancel
25 #endif // MAC_OS_X_VERSION_MIN_REQUIRED < 1090
26 #define modalOther  -1 // indicates that the -command option was used.
27 #define modalError  -2
28 
29 /*
30  * Vars for filtering in "open file" and "save file" dialogs.
31  */
32 
33 typedef struct {
34     bool doFileTypes;			/* Show the accessory view which
35 					 * displays the filter menu */
36     bool preselectFilter;		/* A filter was selected by the
37 					 * typevariable. */
38     bool userHasSelectedFilter;		/* The user has changed the filter in
39 					 * the accessory view. */
40     NSMutableArray *fileTypeNames;	/* Array of names, e.g. "Text
41 					 * document". */
42     NSMutableArray *fileTypeExtensions;	/* Array of allowed extensions per
43 					 * name, e.g. "txt", "doc". */
44     NSMutableArray *fileTypeLabels;	/* Displayed string, e.g. "Text
45 					 * document (.txt, .doc)". */
46     NSMutableArray *fileTypeAllowsAll;	/* Boolean if the all pattern (*.*) is
47 					 * included. */
48     NSMutableArray *allowedExtensions;	/* Set of all allowed extensions. */
49     bool allowedExtensionsAllowAll;	/* Set of all allowed extensions
50 					 * includes *.* */
51     NSUInteger fileTypeIndex;		/* Index of currently selected
52 					 * filter. */
53 } filepanelFilterInfo;
54 
55 /*
56  * Only one of these is needed for the application, so they can be static.
57  */
58 
59 static filepanelFilterInfo filterInfo;
60 static NSOpenPanel *openpanel;
61 static NSSavePanel *savepanel;
62 
63 static const char *const colorOptionStrings[] = {
64     "-initialcolor", "-parent", "-title", NULL
65 };
66 enum colorOptions {
67     COLOR_INITIAL, COLOR_PARENT, COLOR_TITLE
68 };
69 
70 static const char *const openOptionStrings[] = {
71     "-defaultextension", "-filetypes", "-initialdir", "-initialfile",
72     "-message", "-multiple", "-parent", "-title", "-typevariable",
73     "-command", NULL
74 };
75 enum openOptions {
76     OPEN_DEFAULT, OPEN_FILETYPES, OPEN_INITDIR, OPEN_INITFILE,
77     OPEN_MESSAGE, OPEN_MULTIPLE, OPEN_PARENT, OPEN_TITLE,
78     OPEN_TYPEVARIABLE, OPEN_COMMAND,
79 };
80 static const char *const saveOptionStrings[] = {
81     "-defaultextension", "-filetypes", "-initialdir", "-initialfile",
82     "-message", "-parent", "-title", "-typevariable", "-command",
83     "-confirmoverwrite", NULL
84 };
85 enum saveOptions {
86     SAVE_DEFAULT, SAVE_FILETYPES, SAVE_INITDIR, SAVE_INITFILE,
87     SAVE_MESSAGE, SAVE_PARENT, SAVE_TITLE, SAVE_TYPEVARIABLE, SAVE_COMMAND,
88     SAVE_CONFIRMOW
89 };
90 static const char *const chooseOptionStrings[] = {
91     "-initialdir", "-message", "-mustexist", "-parent", "-title", "-command",
92     NULL
93 };
94 enum chooseOptions {
95     CHOOSE_INITDIR, CHOOSE_MESSAGE, CHOOSE_MUSTEXIST, CHOOSE_PARENT,
96     CHOOSE_TITLE, CHOOSE_COMMAND,
97 };
98 typedef struct {
99     Tcl_Interp *interp;
100     Tcl_Obj *cmdObj;
101     int multiple;
102 } FilePanelCallbackInfo;
103 
104 static const char *const alertOptionStrings[] = {
105     "-default", "-detail", "-icon", "-message", "-parent", "-title",
106     "-type", "-command", NULL
107 };
108 enum alertOptions {
109     ALERT_DEFAULT, ALERT_DETAIL, ALERT_ICON, ALERT_MESSAGE, ALERT_PARENT,
110     ALERT_TITLE, ALERT_TYPE, ALERT_COMMAND,
111 };
112 typedef struct {
113     Tcl_Interp *interp;
114     Tcl_Obj *cmdObj;
115     int typeIndex;
116 } AlertCallbackInfo;
117 static const char *const alertTypeStrings[] = {
118     "abortretryignore", "ok", "okcancel", "retrycancel", "yesno",
119     "yesnocancel", NULL
120 };
121 enum alertTypeOptions {
122     TYPE_ABORTRETRYIGNORE, TYPE_OK, TYPE_OKCANCEL, TYPE_RETRYCANCEL,
123     TYPE_YESNO, TYPE_YESNOCANCEL
124 };
125 static const char *const alertIconStrings[] = {
126     "error", "info", "question", "warning", NULL
127 };
128 enum alertIconOptions {
129     ICON_ERROR, ICON_INFO, ICON_QUESTION, ICON_WARNING
130 };
131 static const char *const alertButtonStrings[] = {
132     "abort", "retry", "ignore", "ok", "cancel", "no", "yes", NULL
133 };
134 
135 static const NSString *const alertButtonNames[][3] = {
136     [TYPE_ABORTRETRYIGNORE] =   {@"Abort", @"Retry", @"Ignore"},
137     [TYPE_OK] =			{@"OK"},
138     [TYPE_OKCANCEL] =		{@"OK", @"Cancel"},
139     [TYPE_RETRYCANCEL] =	{@"Retry", @"Cancel"},
140     [TYPE_YESNO] =		{@"Yes", @"No"},
141     [TYPE_YESNOCANCEL] =	{@"Yes", @"No", @"Cancel"},
142 };
143 static const NSAlertStyle alertStyles[] = {
144     [ICON_ERROR] =		NSWarningAlertStyle,
145     [ICON_INFO] =		NSInformationalAlertStyle,
146     [ICON_QUESTION] =		NSWarningAlertStyle,
147     [ICON_WARNING] =		NSCriticalAlertStyle,
148 };
149 
150 /*
151  * Need to map from 'alertButtonStrings' and its corresponding integer, index
152  * to the native button index, which is 1, 2, 3, from right to left. This is
153  * necessary to do for each separate '-type' of button sets.
154  */
155 
156 static const short alertButtonIndexAndTypeToNativeButtonIndex[][7] = {
157 			    /*  abort retry ignore ok   cancel yes   no */
158     [TYPE_ABORTRETRYIGNORE] =   {1,    2,    3,    0,    0,    0,    0},
159     [TYPE_OK] =			{0,    0,    0,    1,    0,    0,    0},
160     [TYPE_OKCANCEL] =		{0,    0,    0,    1,    2,    0,    0},
161     [TYPE_RETRYCANCEL] =	{0,    1,    0,    0,    2,    0,    0},
162     [TYPE_YESNO] =		{0,    0,    0,    0,    0,    2,    1},
163     [TYPE_YESNOCANCEL] =	{0,    0,    0,    0,    3,    2,    1},
164 };
165 
166 /*
167  * Need also the inverse mapping, from NSAlertFirstButtonReturn etc to the
168  * descriptive button text string index.
169  */
170 
171 static const short alertNativeButtonIndexAndTypeToButtonIndex[][3] = {
172     [TYPE_ABORTRETRYIGNORE] =   {0, 1, 2},
173     [TYPE_OK] =			{3, 0, 0},
174     [TYPE_OKCANCEL] =		{3, 4, 0},
175     [TYPE_RETRYCANCEL] =	{1, 4, 0},
176     [TYPE_YESNO] =		{6, 5, 0},
177     [TYPE_YESNOCANCEL] =	{6, 5, 4},
178 };
179 
180 /*
181  * Construct a file URL from directory and filename. Either may be nil. If both
182  * are nil, returns nil.
183  */
184 
185 static NSURL *
getFileURL(NSString * directory,NSString * filename)186 getFileURL(
187     NSString *directory,
188     NSString *filename)
189 {
190     NSURL *url = nil;
191     if (directory) {
192 	url = [NSURL fileURLWithPath:directory isDirectory:YES];
193     }
194     if (filename) {
195 	url = [NSURL URLWithString:filename relativeToURL:url];
196     }
197     return url;
198 }
199 
200 #pragma mark TKApplication(TKDialog)
201 
202 @implementation TKApplication(TKDialog)
203 
204 - (BOOL)panel:(id)sender shouldEnableURL:(NSURL *)url {
205 	(void)sender;
206 	(void)url;
207     return YES;
208 }
209 
210 - (void)panel:(id)sender didChangeToDirectoryURL:(NSURL *)url {
211     (void)sender; (void)url;
212 }
213 
214 - (BOOL)panel:(id)sender validateURL:(NSURL *)url error:(NSError **)outError {
215     (void)sender; (void)url;
216     *outError = nil;
217     return YES;
218 }
219 
220 - (void) tkFilePanelDidEnd: (NSSavePanel *) panel
221 		returnCode: (NSModalResponse) returnCode
222 	       contextInfo: (void *) contextInfo
223 {
224     FilePanelCallbackInfo *callbackInfo = (FilePanelCallbackInfo *)contextInfo;
225 
226     if (returnCode == modalOK) {
227 	Tcl_Obj *resultObj;
228 
229 	if (callbackInfo->multiple) {
230 	    resultObj = Tcl_NewListObj(0, NULL);
231 	    for (NSURL *url in [(NSOpenPanel*)panel URLs]) {
232 		Tcl_ListObjAppendElement(callbackInfo->interp, resultObj,
233 			Tcl_NewStringObj([[url path] UTF8String], -1));
234 	    }
235 	} else {
236 	    resultObj = Tcl_NewStringObj([[[panel URL]path] UTF8String], -1);
237 	}
238 	if (callbackInfo->cmdObj) {
239 	    Tcl_Obj **objv, **tmpv;
240 	    int objc, result = Tcl_ListObjGetElements(callbackInfo->interp,
241 		    callbackInfo->cmdObj, &objc, &objv);
242 
243 	    if (result == TCL_OK && objc) {
244 		tmpv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * (objc + 2));
245 		memcpy(tmpv, objv, sizeof(Tcl_Obj *) * objc);
246 		tmpv[objc] = resultObj;
247 		TkBackgroundEvalObjv(callbackInfo->interp, objc + 1, tmpv,
248 			TCL_EVAL_GLOBAL);
249 		ckfree(tmpv);
250 	    }
251 	} else {
252 	    Tcl_SetObjResult(callbackInfo->interp, resultObj);
253 	}
254     } else if (returnCode == modalCancel) {
255 	Tcl_ResetResult(callbackInfo->interp);
256     }
257     if (callbackInfo->cmdObj) {
258 	Tcl_DecrRefCount(callbackInfo->cmdObj);
259     }
260     if (callbackInfo) {
261 	ckfree(callbackInfo);
262     }
263     [NSApp stopModalWithCode:returnCode];
264 }
265 
266 - (void) tkAlertDidEnd: (NSAlert *) alert returnCode: (NSInteger) returnCode
267 	contextInfo: (void *) contextInfo
268 {
269     AlertCallbackInfo *callbackInfo = (AlertCallbackInfo *)contextInfo;
270 
271     if (returnCode >= NSAlertFirstButtonReturn) {
272 	Tcl_Obj *resultObj = Tcl_NewStringObj(alertButtonStrings[
273 		alertNativeButtonIndexAndTypeToButtonIndex[callbackInfo->
274 		typeIndex][returnCode - NSAlertFirstButtonReturn]], -1);
275 
276 	if (callbackInfo->cmdObj) {
277 	    Tcl_Obj **objv, **tmpv;
278 	    int objc, result = Tcl_ListObjGetElements(callbackInfo->interp,
279 		    callbackInfo->cmdObj, &objc, &objv);
280 
281 	    if (result == TCL_OK && objc) {
282 		tmpv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * (objc + 2));
283 		memcpy(tmpv, objv, sizeof(Tcl_Obj *) * objc);
284 		tmpv[objc] = resultObj;
285 		TkBackgroundEvalObjv(callbackInfo->interp, objc + 1, tmpv,
286 			TCL_EVAL_GLOBAL);
287 		ckfree(tmpv);
288 	    }
289 	} else {
290 	    Tcl_SetObjResult(callbackInfo->interp, resultObj);
291 	}
292     }
293     if ([alert window] == [NSApp modalWindow]) {
294 	[NSApp stopModalWithCode:returnCode];
295     }
296     if (callbackInfo->cmdObj) {
297 	Tcl_DecrRefCount(callbackInfo->cmdObj);
298 	ckfree(callbackInfo);
299     }
300 }
301 
302 - (void)selectFormat:(id)sender  {
303     NSPopUpButton *button      = (NSPopUpButton *)sender;
304     filterInfo.fileTypeIndex   = [button indexOfSelectedItem];
305     if ([[filterInfo.fileTypeAllowsAll objectAtIndex:filterInfo.fileTypeIndex] boolValue]) {
306 	[openpanel setAllowsOtherFileTypes:YES];
307 
308 	/*
309 	 * setAllowsOtherFileTypes might have no effect; it's inherited from
310 	 * the NSSavePanel, where it has the effect that it does not append an
311 	 * extension. Setting the allowed file types to nil allows selecting
312 	 * any file.
313 	 */
314 
315 	[openpanel setAllowedFileTypes:nil];
316     } else {
317 	NSMutableArray *allowedtypes =
318 		[filterInfo.fileTypeExtensions objectAtIndex:filterInfo.fileTypeIndex];
319 	[openpanel setAllowedFileTypes:allowedtypes];
320 	[openpanel setAllowsOtherFileTypes:NO];
321     }
322 
323     filterInfo.userHasSelectedFilter = true;
324 }
325 
326 - (void)saveFormat:(id)sender  {
327     NSPopUpButton *button     = (NSPopUpButton *)sender;
328     filterInfo.fileTypeIndex  = [button indexOfSelectedItem];
329 
330     if ([[filterInfo.fileTypeAllowsAll objectAtIndex:filterInfo.fileTypeIndex] boolValue]) {
331 	[savepanel setAllowsOtherFileTypes:YES];
332 	[savepanel setAllowedFileTypes:nil];
333     } else {
334 	NSMutableArray *allowedtypes =
335 		[filterInfo.fileTypeExtensions objectAtIndex:filterInfo.fileTypeIndex];
336 	[savepanel setAllowedFileTypes:allowedtypes];
337 	[savepanel setAllowsOtherFileTypes:NO];
338     }
339 
340     filterInfo.userHasSelectedFilter = true;
341 }
342 
343 @end
344 
345 #pragma mark -
346 
showOpenSavePanel(NSSavePanel * panel,NSWindow * parent,FilePanelCallbackInfo * callbackInfo)347 static NSInteger showOpenSavePanel(
348     NSSavePanel *panel,
349     NSWindow *parent,
350     FilePanelCallbackInfo *callbackInfo)
351 {
352     NSInteger modalReturnCode;
353     int OSVersion = [NSApp macOSVersion];
354 
355     /*
356      * Use a sheet if -parent is specified (unless there is already a sheet).
357      */
358 
359     if (parent && ![parent attachedSheet]) {
360 	if (OSVersion < 101500) {
361 	    [panel beginSheetModalForWindow:parent
362 			  completionHandler:^(NSModalResponse returnCode) {
363 		    [NSApp tkFilePanelDidEnd:panel
364 				  returnCode:returnCode
365 				 contextInfo:callbackInfo ];
366 		}];
367 	    modalReturnCode = [NSApp runModalForWindow:panel];
368 	} else if (OSVersion < 110000) {
369 	    [panel beginSheetModalForWindow:parent
370 			  completionHandler:^(NSModalResponse returnCode) {
371 		    [NSApp tkFilePanelDidEnd:panel
372 				  returnCode:returnCode
373 				 contextInfo:callbackInfo ];
374 		}];
375 	    modalReturnCode = [panel runModal];
376 	} else {
377 	    [parent beginSheet: panel completionHandler:nil];
378 	    modalReturnCode = [panel runModal];
379 	    [NSApp tkFilePanelDidEnd:panel
380 			  returnCode:modalReturnCode
381 			 contextInfo:callbackInfo ];
382 	    [parent endSheet:panel];
383 	}
384     } else {
385 	modalReturnCode = [panel runModal];
386 	[NSApp tkFilePanelDidEnd:panel
387 		      returnCode:modalReturnCode
388 		     contextInfo:callbackInfo ];
389     }
390     return callbackInfo->cmdObj ? modalOther : modalReturnCode;
391 }
392 
393 /*
394  *----------------------------------------------------------------------
395  *
396  * Tk_ChooseColorObjCmd --
397  *
398  *	This procedure implements the color dialog box for the Mac platform.
399  *	See the user documentation for details on what it does.
400  *
401  * Results:
402  *	A standard Tcl result.
403  *
404  * Side effects:
405  *	See the user documentation.
406  *
407  *----------------------------------------------------------------------
408  */
409 
410 int
Tk_ChooseColorObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])411 Tk_ChooseColorObjCmd(
412     ClientData clientData,	/* Main window associated with interpreter. */
413     Tcl_Interp *interp,		/* Current interpreter. */
414     int objc,			/* Number of arguments. */
415     Tcl_Obj *const objv[])	/* Argument objects. */
416 {
417     int result = TCL_ERROR;
418     Tk_Window parent, tkwin = (Tk_Window)clientData;
419     const char *title = NULL;
420     int i;
421     NSColor *color = nil, *initialColor = nil;
422     NSColorPanel *colorPanel;
423     NSInteger returnCode, numberOfComponents = 0;
424 
425     for (i = 1; i < objc; i += 2) {
426 	int index;
427 	const char *value;
428 
429 	if (Tcl_GetIndexFromObjStruct(interp, objv[i], colorOptionStrings,
430 		sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) {
431 	    goto end;
432 	}
433 	if (i + 1 == objc) {
434 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
435 		    "value for \"%s\" missing", Tcl_GetString(objv[i])));
436 	    Tcl_SetErrorCode(interp, "TK", "COLORDIALOG", "VALUE", NULL);
437 	    goto end;
438 	}
439 	value = Tcl_GetString(objv[i + 1]);
440 
441 	switch (index) {
442 	case COLOR_INITIAL: {
443 	    XColor *colorPtr;
444 
445 	    colorPtr = Tk_GetColor(interp, tkwin, value);
446 	    if (colorPtr == NULL) {
447 		goto end;
448 	    }
449 	    initialColor = TkMacOSXGetNSColor(NULL, colorPtr->pixel);
450 	    Tk_FreeColor(colorPtr);
451 	    break;
452 	}
453 	case COLOR_PARENT:
454 	    parent = Tk_NameToWindow(interp, value, tkwin);
455 	    if (parent == NULL) {
456 		goto end;
457 	    }
458 	    break;
459 	case COLOR_TITLE:
460 	    title = value;
461 	    break;
462 	}
463     }
464     colorPanel = [NSColorPanel sharedColorPanel];
465     [colorPanel orderOut:NSApp];
466     [colorPanel setContinuous:NO];
467     [colorPanel setBecomesKeyOnlyIfNeeded:NO];
468     [colorPanel setShowsAlpha: NO];
469     [colorPanel _setUseModalAppearance:YES];
470     if (title) {
471 	NSString *s = [[NSString alloc] initWithUTF8String:title];
472 
473 	[colorPanel setTitle:s];
474 	[s release];
475     }
476     if (initialColor) {
477 	[colorPanel setColor:initialColor];
478     }
479     returnCode = [NSApp runModalForWindow:colorPanel];
480     if (returnCode == modalOK) {
481 	color = [[colorPanel color] colorUsingColorSpace:
482 		[NSColorSpace deviceRGBColorSpace]];
483 	numberOfComponents = [color numberOfComponents];
484     }
485     if (color && numberOfComponents >= 3 && numberOfComponents <= 4) {
486 	CGFloat components[4];
487 	char colorstr[8];
488 
489 	[color getComponents:components];
490 	snprintf(colorstr, 8, "#%02x%02x%02x",
491 		(short)(components[0] * 255),
492 		(short)(components[1] * 255),
493 		(short)(components[2] * 255));
494 	Tcl_SetObjResult(interp, Tcl_NewStringObj(colorstr, 7));
495     } else {
496 	Tcl_ResetResult(interp);
497     }
498     result = TCL_OK;
499 
500 end:
501     return result;
502 }
503 
504 /*
505  * Dissect the -filetype nested lists and store the information in the
506  * filterInfo structure.
507  */
508 
509 static int
parseFileFilters(Tcl_Interp * interp,Tcl_Obj * fileTypesPtr,Tcl_Obj * typeVariablePtr)510 parseFileFilters(
511     Tcl_Interp *interp,
512     Tcl_Obj *fileTypesPtr,
513     Tcl_Obj *typeVariablePtr)
514 {
515 
516     if (!fileTypesPtr) {
517 	filterInfo.doFileTypes = false;
518 	return TCL_OK;
519     }
520 
521     FileFilterList fl;
522 
523     TkInitFileFilters(&fl);
524     if (TkGetFileFilters(interp, &fl, fileTypesPtr, 0) != TCL_OK) {
525 	TkFreeFileFilters(&fl);
526 	return TCL_ERROR;
527     }
528 
529     filterInfo.doFileTypes = (fl.filters != NULL);
530 
531     filterInfo.fileTypeIndex = 0;
532     filterInfo.fileTypeExtensions = [NSMutableArray array];
533     filterInfo.fileTypeNames = [NSMutableArray array];
534     filterInfo.fileTypeLabels = [NSMutableArray array];
535     filterInfo.fileTypeAllowsAll = [NSMutableArray array];
536 
537     filterInfo.allowedExtensions = [NSMutableArray array];
538     filterInfo.allowedExtensionsAllowAll = NO;
539 
540     if (filterInfo.doFileTypes) {
541 	for (FileFilter *filterPtr = fl.filters; filterPtr;
542 		filterPtr = filterPtr->next) {
543 	    NSString *name = [[NSString alloc] initWithUTF8String: filterPtr->name];
544 
545 	    [filterInfo.fileTypeNames addObject:name];
546 	    [name release];
547 	    NSMutableArray *clauseextensions = [NSMutableArray array];
548 	    NSMutableArray *displayextensions = [NSMutableArray array];
549 	    bool allowsAll = NO;
550 
551 	    for (FileFilterClause *clausePtr = filterPtr->clauses; clausePtr;
552 		    clausePtr = clausePtr->next) {
553 
554 		for (GlobPattern *globPtr = clausePtr->patterns; globPtr;
555 			globPtr = globPtr->next) {
556 		    const char *str = globPtr->pattern;
557 		    while (*str && (*str == '*' || *str == '.')) {
558 		    	str++;
559 		    }
560 		    if (*str) {
561 			NSString *extension = [[NSString alloc] initWithUTF8String:str];
562 			if (![filterInfo.allowedExtensions containsObject:extension]) {
563 			    [filterInfo.allowedExtensions addObject:extension];
564 			}
565 
566 			[clauseextensions addObject:extension];
567 			[displayextensions addObject:[@"." stringByAppendingString:extension]];
568 
569 			[extension release];
570 		    } else {
571 			/*
572 			 * It is the all pattern (*, .* or *.*)
573 			 */
574 
575 			allowsAll = YES;
576 			filterInfo.allowedExtensionsAllowAll = YES;
577 			[displayextensions addObject:@"*"];
578 		    }
579 		}
580 	    }
581 	    [filterInfo.fileTypeExtensions addObject:clauseextensions];
582 	    [filterInfo.fileTypeAllowsAll addObject:[NSNumber numberWithBool:allowsAll]];
583 
584 	    NSMutableString *label = [[NSMutableString alloc] initWithString:name];
585 	    [label appendString:@" ("];
586 	    [label appendString:[displayextensions componentsJoinedByString:@", "]];
587 	    [label appendString:@")"];
588 	    [filterInfo.fileTypeLabels addObject:label];
589 	    [label release];
590 	}
591 
592 	/*
593 	 * Check if the typevariable exists and matches one of the names.
594 	 */
595 
596 	filterInfo.preselectFilter = false;
597 	filterInfo.userHasSelectedFilter = false;
598 	if (typeVariablePtr) {
599 	    /*
600 	     * Extract the variable content as a NSString.
601 	     */
602 
603 	    Tcl_Obj *selectedFileTypeObj = Tcl_ObjGetVar2(interp,
604 		    typeVariablePtr, NULL, TCL_GLOBAL_ONLY);
605 
606 	    /*
607 	     * Check that the typevariable exists.
608 	     */
609 
610 	    if (selectedFileTypeObj != NULL) {
611 		const char *selectedFileType =
612 			Tcl_GetString(selectedFileTypeObj);
613 		NSString *selectedFileTypeStr =
614 			[[NSString alloc] initWithUTF8String:selectedFileType];
615 		NSUInteger index =
616 			[filterInfo.fileTypeNames indexOfObject:selectedFileTypeStr];
617 
618 		if (index != NSNotFound) {
619 		    filterInfo.fileTypeIndex = index;
620 		    filterInfo.preselectFilter = true;
621 		}
622 	    }
623 	}
624 
625     }
626 
627     TkFreeFileFilters(&fl);
628     return TCL_OK;
629 }
630 
631 static bool
filterCompatible(NSString * extension,int filterIndex)632 filterCompatible(
633     NSString *extension,
634     int filterIndex)
635 {
636     NSMutableArray *allowedExtensions =
637 	    [filterInfo.fileTypeExtensions objectAtIndex: filterIndex];
638 
639     /*
640      * If this contains the all pattern, accept any extension.
641      */
642 
643     if ([[filterInfo.fileTypeAllowsAll objectAtIndex:filterIndex] boolValue]) {
644 	return true;
645     }
646 
647     return [allowedExtensions containsObject: extension];
648 }
649 
650 /*
651  *----------------------------------------------------------------------
652  *
653  * Tk_GetOpenFileObjCmd --
654  *
655  *	This procedure implements the "open file" dialog box for the Mac
656  *	platform. See the user documentation for details on what it does.
657  *
658  * Results:
659  *	A standard Tcl result.
660  *
661  * Side effects:
662  *	See user documentation.
663  *----------------------------------------------------------------------
664  */
665 
666 int
Tk_GetOpenFileObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])667 Tk_GetOpenFileObjCmd(
668     ClientData clientData,	/* Main window associated with interpreter. */
669     Tcl_Interp *interp,		/* Current interpreter. */
670     int objc,			/* Number of arguments. */
671     Tcl_Obj *const objv[])	/* Argument objects. */
672 {
673     Tk_Window tkwin = (Tk_Window)clientData;
674     char *str;
675     int i, result = TCL_ERROR, haveParentOption = 0;
676     int index, len, multiple = 0;
677     Tcl_Obj *cmdObj = NULL, *typeVariablePtr = NULL, *fileTypesPtr = NULL;
678     FilePanelCallbackInfo callbackInfoStruct;
679     FilePanelCallbackInfo *callbackInfo = &callbackInfoStruct;
680     NSString *directory = nil, *filename = nil;
681     NSString *message = nil, *title = nil;
682     NSWindow *parent;
683     openpanel =  [NSOpenPanel openPanel];
684     NSInteger modalReturnCode = modalError;
685     BOOL parentIsKey = NO;
686 
687     for (i = 1; i < objc; i += 2) {
688 	if (Tcl_GetIndexFromObjStruct(interp, objv[i], openOptionStrings,
689 		sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) {
690 	    goto end;
691 	}
692 	if (i + 1 == objc) {
693 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
694 		    "value for \"%s\" missing", Tcl_GetString(objv[i])));
695 	    Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL);
696 	    goto end;
697 	}
698 	switch (index) {
699 	case OPEN_DEFAULT:
700 	    break;
701 	case OPEN_FILETYPES:
702 	    fileTypesPtr = objv[i + 1];
703 	    break;
704 	case OPEN_INITDIR:
705 	    str = Tcl_GetStringFromObj(objv[i + 1], &len);
706 	    if (len) {
707 		directory = [[[NSString alloc] initWithUTF8String:str]
708 			autorelease];
709 	    }
710 	    break;
711 	case OPEN_INITFILE:
712 	    str = Tcl_GetStringFromObj(objv[i + 1], &len);
713 	    if (len) {
714 		filename = [[[NSString alloc] initWithUTF8String:str]
715 			autorelease];
716 	    }
717 	    break;
718 	case OPEN_MESSAGE:
719 	    message = [[NSString alloc] initWithUTF8String:
720 		    Tcl_GetString(objv[i + 1])];
721 	    break;
722 	case OPEN_MULTIPLE:
723 	    if (Tcl_GetBooleanFromObj(interp, objv[i + 1],
724 		    &multiple) != TCL_OK) {
725 		goto end;
726 	    }
727 	    break;
728 	case OPEN_PARENT:
729 	    str = Tcl_GetStringFromObj(objv[i + 1], &len);
730 	    tkwin = Tk_NameToWindow(interp, str, tkwin);
731 	    if (!tkwin) {
732 		goto end;
733 	    }
734 	    haveParentOption = 1;
735 	    break;
736 	case OPEN_TITLE:
737 	    title = [[NSString alloc] initWithUTF8String:
738 		    Tcl_GetString(objv[i + 1])];
739 	    break;
740 	case OPEN_TYPEVARIABLE:
741 	    typeVariablePtr = objv[i + 1];
742 	    break;
743 	case OPEN_COMMAND:
744 	    cmdObj = objv[i+1];
745 	    break;
746 	}
747     }
748     if (title) {
749 	[openpanel setTitle:title];
750 
751 	/*
752 	 * From OSX 10.11, the title string is silently ignored in the open
753 	 * panel.  Prepend the title to the message in this case.
754 	 */
755 
756 	if ([NSApp macOSVersion] > 101000) {
757 	    if (message) {
758 		NSString *fullmessage =
759 		    [[NSString alloc] initWithFormat:@"%@\n%@", title, message];
760 		[message release];
761 		[title release];
762 		message = fullmessage;
763 	    } else {
764 		message = title;
765 	    }
766 	}
767     }
768 
769     if (message) {
770 	[openpanel setMessage:message];
771 	[message release];
772     }
773 
774     [openpanel setAllowsMultipleSelection:multiple];
775 
776     if (parseFileFilters(interp, fileTypesPtr, typeVariablePtr) != TCL_OK) {
777 	goto end;
778     }
779 
780     if (filterInfo.doFileTypes) {
781 	NSTextField *label = [[NSTextField alloc]
782 		initWithFrame:NSMakeRect(0, 0, 60, 22)];
783 	NSPopUpButton *popupButton = [[NSPopUpButton alloc]
784 		initWithFrame:NSMakeRect(50.0, 2, 240, 22.0) pullsDown:NO];
785 	NSView *accessoryView = [[NSView alloc]
786 		initWithFrame:NSMakeRect(0.0, 0.0, 300, 32.0)];
787 
788 	[label setEditable:NO];
789 	[label setStringValue:@"Filter:"];
790 	[label setBordered:NO];
791 	[label setBezeled:NO];
792 	[label setDrawsBackground:NO];
793 	[popupButton addItemsWithTitles:filterInfo.fileTypeLabels];
794 	[popupButton setTarget:NSApp];
795 	[popupButton setAction:@selector(selectFormat:)];
796 	[accessoryView addSubview:label];
797 	[accessoryView addSubview:popupButton];
798 	if (filterInfo.preselectFilter) {
799 
800 	    /*
801 	     * A specific filter was selected from the typevariable. Select it
802 	     * and open the accessory view.
803 	     */
804 
805 	    [popupButton selectItemAtIndex:filterInfo.fileTypeIndex];
806 
807 	    /*
808 	     * On OSX > 10.11, the options are not visible by default. Ergo
809 	     * allow all file types
810 	    [openpanel setAllowedFileTypes:filterInfo.fileTypeExtensions[filterInfo.fileTypeIndex]];
811 	    */
812 
813 	    [openpanel setAllowedFileTypes:filterInfo.allowedExtensions];
814 	} else {
815 	    [openpanel setAllowedFileTypes:filterInfo.allowedExtensions];
816 	}
817 	if (filterInfo.allowedExtensionsAllowAll) {
818 	    [openpanel setAllowsOtherFileTypes:YES];
819 	} else {
820 	    [openpanel setAllowsOtherFileTypes:NO];
821 	}
822 	[openpanel setAccessoryView:accessoryView];
823     } else {
824 	/*
825 	 * No filters are given. Allow picking all files.
826 	 */
827 
828 	[openpanel setAllowsOtherFileTypes:YES];
829     }
830     if (cmdObj) {
831 	if (Tcl_IsShared(cmdObj)) {
832 	    cmdObj = Tcl_DuplicateObj(cmdObj);
833 	}
834 	Tcl_IncrRefCount(cmdObj);
835     }
836     callbackInfo = (FilePanelCallbackInfo *)ckalloc(sizeof(FilePanelCallbackInfo));
837     callbackInfo->cmdObj = cmdObj;
838     callbackInfo->interp = interp;
839     callbackInfo->multiple = multiple;
840     if (directory || filename) {
841 	NSURL *fileURL = getFileURL(directory, filename);
842 
843 	[openpanel setDirectoryURL:fileURL];
844     }
845     if (haveParentOption) {
846 	parent = TkMacOSXGetNSWindowForDrawable(((TkWindow *)tkwin)->window);
847 	parentIsKey = parent && [parent isKeyWindow];
848     } else {
849 	parent = nil;
850 	parentIsKey = False;
851     }
852     modalReturnCode = showOpenSavePanel(openpanel, parent, callbackInfo);
853     result = (modalReturnCode != modalError) ? TCL_OK : TCL_ERROR;
854     if (parentIsKey) {
855 	[parent makeKeyWindow];
856     }
857     if ((typeVariablePtr && (modalReturnCode == NSOKButton))
858 	    && filterInfo.doFileTypes) {
859 	/*
860 	 * The -typevariable must be set to the selected file type, if the
861 	 * dialog was not cancelled.
862 	 */
863 
864 	NSUInteger selectedFilterIndex = filterInfo.fileTypeIndex;
865 	NSString *selectedFilter = NULL;
866 
867 	if (filterInfo.userHasSelectedFilter) {
868 	    selectedFilterIndex = filterInfo.fileTypeIndex;
869 	    selectedFilter = [filterInfo.fileTypeNames objectAtIndex:selectedFilterIndex];
870 	} else {
871 	    /*
872 	     * Difficult case: the user has not touched the filter settings,
873 	     * but we must return something in the typevariable. First check if
874 	     * the preselected type is compatible with the selected file,
875 	     * otherwise choose the first compatible type from the list,
876 	     * finally fall back to the empty string.
877 	     */
878 
879 	    NSURL *selectedFile;
880 	    NSString *extension;
881 	    if (multiple) {
882 		/*
883 		 * Use the first file in the case of multiple selection.
884 		 * Anyway it is not overly useful here.
885 		 */
886 		selectedFile = [[openpanel URLs] objectAtIndex:0];
887 	    } else {
888 		selectedFile = [openpanel URL];
889 	    }
890 
891 	    extension = [selectedFile pathExtension];
892 
893 	    if (filterInfo.preselectFilter &&
894 		    filterCompatible(extension, filterInfo.fileTypeIndex)) {
895 		selectedFilterIndex = filterInfo.fileTypeIndex;  // The preselection from the typevariable
896 		selectedFilter = [filterInfo.fileTypeNames objectAtIndex:selectedFilterIndex];
897 	    } else {
898 		NSUInteger j;
899 
900 		for (j = 0; j < [filterInfo.fileTypeNames count]; j++) {
901 		    if (filterCompatible(extension, j)) {
902 			selectedFilterIndex = j;
903 			break;
904 		    }
905 		}
906 		if (j == selectedFilterIndex) {
907 		    selectedFilter = [filterInfo.fileTypeNames objectAtIndex:selectedFilterIndex];
908 		} else {
909 		    selectedFilter = @"";
910 		}
911 	    }
912 	}
913 	Tcl_ObjSetVar2(interp, typeVariablePtr, NULL,
914 		Tcl_NewStringObj([selectedFilter UTF8String], -1),
915 		TCL_GLOBAL_ONLY);
916     }
917  end:
918     return result;
919 }
920 
921 /*
922  *----------------------------------------------------------------------
923  *
924  * Tk_GetSaveFileObjCmd --
925  *
926  *	This procedure implements the "save file" dialog box for the Mac
927  *	platform. See the user documentation for details on what it does.
928  *
929  * Results:
930  *	A standard Tcl result.
931  *
932  * Side effects:
933  *	See user documentation.
934  *
935  *----------------------------------------------------------------------
936  */
937 
938 int
Tk_GetSaveFileObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])939 Tk_GetSaveFileObjCmd(
940     ClientData clientData,	/* Main window associated with interpreter. */
941     Tcl_Interp *interp,		/* Current interpreter. */
942     int objc,			/* Number of arguments. */
943     Tcl_Obj *const objv[])	/* Argument objects. */
944 {
945     Tk_Window tkwin = (Tk_Window)clientData;
946     char *str;
947     int i, result = TCL_ERROR, haveParentOption = 0;
948     int confirmOverwrite = 1;
949     int index, len;
950     Tcl_Obj *cmdObj = NULL, *typeVariablePtr = NULL, *fileTypesPtr = NULL;
951     FilePanelCallbackInfo callbackInfoStruct;
952     FilePanelCallbackInfo *callbackInfo = &callbackInfoStruct;
953     NSString *directory = nil, *filename = nil, *defaultType = nil;
954     NSString *message = nil, *title = nil;
955     NSWindow *parent;
956     savepanel = [NSSavePanel savePanel];
957     NSInteger modalReturnCode = modalError;
958     BOOL parentIsKey = NO;
959 
960     for (i = 1; i < objc; i += 2) {
961 	if (Tcl_GetIndexFromObjStruct(interp, objv[i], saveOptionStrings,
962 		sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) {
963 	    goto end;
964 	}
965 	if (i + 1 == objc) {
966 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
967 		    "value for \"%s\" missing", Tcl_GetString(objv[i])));
968 	    Tcl_SetErrorCode(interp, "TK", "FILEDIALOG", "VALUE", NULL);
969 	    goto end;
970 	}
971 	switch (index) {
972 	    case SAVE_DEFAULT:
973 		str = Tcl_GetStringFromObj(objv[i + 1], &len);
974 		while (*str && (*str == '*' || *str == '.')) {
975 		    str++;
976 		}
977 		if (*str) {
978 		    defaultType = [[[NSString alloc] initWithUTF8String:str]
979 			    autorelease];
980 		}
981 		break;
982 	    case SAVE_FILETYPES:
983 		fileTypesPtr = objv[i + 1];
984 		break;
985 	    case SAVE_INITDIR:
986 		str = Tcl_GetStringFromObj(objv[i + 1], &len);
987 		if (len) {
988 		    directory = [[[NSString alloc] initWithUTF8String:str]
989 			    autorelease];
990 		}
991 		break;
992 	    case SAVE_INITFILE:
993 		str = Tcl_GetStringFromObj(objv[i + 1], &len);
994 		if (len) {
995 		    filename = [[[NSString alloc] initWithUTF8String:str]
996 			    autorelease];
997 		    [savepanel setNameFieldStringValue:filename];
998 		}
999 		break;
1000 	    case SAVE_MESSAGE:
1001 		message = [[NSString alloc] initWithUTF8String:
1002 			Tcl_GetString(objv[i + 1])];
1003 		break;
1004 	    case SAVE_PARENT:
1005 		str = Tcl_GetStringFromObj(objv[i + 1], &len);
1006 		tkwin = Tk_NameToWindow(interp, str, tkwin);
1007 		if (!tkwin) {
1008 		    goto end;
1009 		}
1010 		haveParentOption = 1;
1011 		break;
1012 	    case SAVE_TITLE:
1013 		title = [[NSString alloc] initWithUTF8String:
1014 			Tcl_GetString(objv[i + 1])];
1015 		break;
1016 	    case SAVE_TYPEVARIABLE:
1017 		typeVariablePtr = objv[i + 1];
1018 		break;
1019 	    case SAVE_COMMAND:
1020 		cmdObj = objv[i+1];
1021 		break;
1022 	    case SAVE_CONFIRMOW:
1023 		if (Tcl_GetBooleanFromObj(interp, objv[i + 1],
1024 			&confirmOverwrite) != TCL_OK) {
1025 		    goto end;
1026 		}
1027 		break;
1028 	}
1029     }
1030 
1031     if (title) {
1032 	[savepanel setTitle:title];
1033 
1034 	/*
1035 	 * From OSX 10.11, the title string is silently ignored, if the save
1036 	 * panel is a sheet.  Prepend the title to the message in this case.
1037 	 * NOTE: should be conditional on OSX version, but -mmacosx-version-min
1038 	 * does not revert this behaviour.
1039 	 */
1040 
1041 	if (haveParentOption) {
1042 	    if (message) {
1043 		NSString *fullmessage =
1044 		    [[NSString alloc] initWithFormat:@"%@\n%@",title,message];
1045 		[message release];
1046 		[title release];
1047 		message = fullmessage;
1048 	    } else {
1049 		message = title;
1050 	    }
1051 	}
1052     }
1053 
1054     if (message) {
1055 	[savepanel setMessage:message];
1056 	[message release];
1057     }
1058 
1059     if (parseFileFilters(interp, fileTypesPtr, typeVariablePtr) != TCL_OK) {
1060 	goto end;
1061     }
1062 
1063     if (filterInfo.doFileTypes) {
1064 	NSView *accessoryView = [[NSView alloc]
1065 		initWithFrame:NSMakeRect(0.0, 0.0, 300, 32.0)];
1066 	NSTextField *label = [[NSTextField alloc]
1067 		initWithFrame:NSMakeRect(0, 0, 60, 22)];
1068 
1069 	[label setEditable:NO];
1070 	[label setStringValue:NSLocalizedString(@"Format:", nil)];
1071 	[label setBordered:NO];
1072 	[label setBezeled:NO];
1073 	[label setDrawsBackground:NO];
1074 
1075 	NSPopUpButton *popupButton = [[NSPopUpButton alloc]
1076 		initWithFrame:NSMakeRect(50.0, 2, 340, 22.0) pullsDown:NO];
1077 
1078 	[popupButton addItemsWithTitles:filterInfo.fileTypeLabels];
1079 	[popupButton selectItemAtIndex:filterInfo.fileTypeIndex];
1080 	[popupButton setTarget:NSApp];
1081 	[popupButton setAction:@selector(saveFormat:)];
1082 	[accessoryView addSubview:label];
1083 	[accessoryView addSubview:popupButton];
1084 
1085 	[savepanel setAccessoryView:accessoryView];
1086 
1087 	[savepanel setAllowedFileTypes:[filterInfo.fileTypeExtensions objectAtIndex:filterInfo.fileTypeIndex]];
1088 	[savepanel setAllowsOtherFileTypes:filterInfo.allowedExtensionsAllowAll];
1089     } else if (defaultType) {
1090 	/*
1091 	 * If no filetypes are given, defaultextension is an alternative way to
1092 	 * specify the attached extension. Just propose this extension, but
1093 	 * don't display an accessory view.
1094 	 */
1095 
1096 	NSMutableArray *AllowedFileTypes = [NSMutableArray array];
1097 
1098 	[AllowedFileTypes addObject:defaultType];
1099 	[savepanel setAllowedFileTypes:AllowedFileTypes];
1100 	[savepanel setAllowsOtherFileTypes:YES];
1101     }
1102 
1103     [savepanel setCanSelectHiddenExtension:YES];
1104     [savepanel setExtensionHidden:NO];
1105 
1106     if (cmdObj) {
1107 	if (Tcl_IsShared(cmdObj)) {
1108 	    cmdObj = Tcl_DuplicateObj(cmdObj);
1109 	}
1110 	Tcl_IncrRefCount(cmdObj);
1111     }
1112     callbackInfo = (FilePanelCallbackInfo *)ckalloc(sizeof(FilePanelCallbackInfo));
1113     callbackInfo->cmdObj = cmdObj;
1114     callbackInfo->interp = interp;
1115     callbackInfo->multiple = 0;
1116 
1117     if (directory) {
1118 	[savepanel setDirectoryURL:[NSURL fileURLWithPath:directory isDirectory:YES]];
1119     }
1120 
1121     /*
1122      * Check for file name and set to the empty string if nil. This prevents a crash
1123      * with an uncaught exception.
1124      */
1125 
1126     if (filename) {
1127 	[savepanel setNameFieldStringValue:filename];
1128     } else {
1129 	[savepanel setNameFieldStringValue:@""];
1130     }
1131     if (haveParentOption) {
1132 	parent = TkMacOSXGetNSWindowForDrawable(((TkWindow *)tkwin)->window);
1133 	parentIsKey = parent && [parent isKeyWindow];
1134     } else {
1135 	parent = nil;
1136 	parentIsKey = False;
1137     }
1138     modalReturnCode = showOpenSavePanel(savepanel, parent, callbackInfo);
1139     result = (modalReturnCode != modalError) ? TCL_OK : TCL_ERROR;
1140     if (parentIsKey) {
1141 	[parent makeKeyWindow];
1142     }
1143 
1144     if (typeVariablePtr && (modalReturnCode == NSOKButton)
1145 	    && filterInfo.doFileTypes) {
1146 	/*
1147 	 * The -typevariable must be set to the selected file type, if the
1148 	 * dialog was not cancelled.
1149 	 */
1150 
1151 	NSString *selectedFilter =
1152 	    [filterInfo.fileTypeNames objectAtIndex:filterInfo.fileTypeIndex];
1153 	Tcl_ObjSetVar2(interp, typeVariablePtr, NULL,
1154 		Tcl_NewStringObj([selectedFilter UTF8String], -1),
1155 		TCL_GLOBAL_ONLY);
1156     }
1157 
1158   end:
1159     return result;
1160 }
1161 
1162 /*
1163  *----------------------------------------------------------------------
1164  *
1165  * Tk_ChooseDirectoryObjCmd --
1166  *
1167  *	This procedure implements the "tk_chooseDirectory" dialog box for the
1168  *	MacOS X platform. See the user documentation for details on what it
1169  *	does.
1170  *
1171  * Results:
1172  *	See user documentation.
1173  *
1174  * Side effects:
1175  *	A modal dialog window is created.
1176  *
1177  *----------------------------------------------------------------------
1178  */
1179 
1180 int
Tk_ChooseDirectoryObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])1181 Tk_ChooseDirectoryObjCmd(
1182     ClientData clientData,	/* Main window associated with interpreter. */
1183     Tcl_Interp *interp,		/* Current interpreter. */
1184     int objc,			/* Number of arguments. */
1185     Tcl_Obj *const objv[])	/* Argument objects. */
1186 {
1187     Tk_Window tkwin = (Tk_Window)clientData;
1188     char *str;
1189     int i, result = TCL_ERROR, haveParentOption = 0;
1190     int index, len, mustexist = 0;
1191     Tcl_Obj *cmdObj = NULL;
1192     FilePanelCallbackInfo callbackInfoStruct;
1193     FilePanelCallbackInfo *callbackInfo = &callbackInfoStruct;
1194     NSString *directory = nil;
1195     NSString *message, *title;
1196     NSWindow *parent;
1197     NSOpenPanel *panel = [NSOpenPanel openPanel];
1198     NSInteger modalReturnCode = modalError;
1199     BOOL parentIsKey = NO;
1200 
1201     for (i = 1; i < objc; i += 2) {
1202 	if (Tcl_GetIndexFromObjStruct(interp, objv[i], chooseOptionStrings,
1203 		sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) {
1204 	    goto end;
1205 	}
1206 	if (i + 1 == objc) {
1207 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
1208 		    "value for \"%s\" missing", Tcl_GetString(objv[i])));
1209 	    Tcl_SetErrorCode(interp, "TK", "DIRDIALOG", "VALUE", NULL);
1210 	    goto end;
1211 	}
1212 	switch (index) {
1213 	case CHOOSE_INITDIR:
1214 	    str = Tcl_GetStringFromObj(objv[i + 1], &len);
1215 	    if (len) {
1216 		directory = [[[NSString alloc] initWithUTF8String:str]
1217 			autorelease];
1218 	    }
1219 	    break;
1220 	case CHOOSE_MESSAGE:
1221 	    message = [[NSString alloc] initWithUTF8String:
1222 		    Tcl_GetString(objv[i + 1])];
1223 	    [panel setMessage:message];
1224 	    [message release];
1225 	    break;
1226 	case CHOOSE_MUSTEXIST:
1227 	    if (Tcl_GetBooleanFromObj(interp, objv[i + 1],
1228 		    &mustexist) != TCL_OK) {
1229 		goto end;
1230 	    }
1231 	    break;
1232 	case CHOOSE_PARENT:
1233 	    str = Tcl_GetStringFromObj(objv[i + 1], &len);
1234 	    tkwin = Tk_NameToWindow(interp, str, tkwin);
1235 	    if (!tkwin) {
1236 		goto end;
1237 	    }
1238 	    haveParentOption = 1;
1239 	    break;
1240 	case CHOOSE_TITLE:
1241 	    title = [[NSString alloc] initWithUTF8String:
1242 		    Tcl_GetString(objv[i + 1])];
1243 	    [panel setTitle:title];
1244 	    [title release];
1245 	    break;
1246 	case CHOOSE_COMMAND:
1247 	    cmdObj = objv[i+1];
1248 	    break;
1249 	}
1250     }
1251     [panel setPrompt:@"Choose"];
1252     [panel setCanChooseFiles:NO];
1253     [panel setCanChooseDirectories:YES];
1254     [panel setCanCreateDirectories:!mustexist];
1255     if (cmdObj) {
1256 	if (Tcl_IsShared(cmdObj)) {
1257 	    cmdObj = Tcl_DuplicateObj(cmdObj);
1258 	}
1259 	Tcl_IncrRefCount(cmdObj);
1260     }
1261     callbackInfo = (FilePanelCallbackInfo *)ckalloc(sizeof(FilePanelCallbackInfo));
1262     callbackInfo->cmdObj = cmdObj;
1263     callbackInfo->interp = interp;
1264     callbackInfo->multiple = 0;
1265 
1266     /*
1267      * Check for directory value, set to root if not specified; otherwise
1268      * crashes with exception because of nil string parameter.
1269      */
1270 
1271     if (!directory) {
1272 	directory = @"/";
1273     }
1274     parent = TkMacOSXGetNSWindowForDrawable(((TkWindow *)tkwin)->window);
1275     [panel setDirectoryURL:[NSURL fileURLWithPath:directory isDirectory:YES]];
1276     if (haveParentOption) {
1277 	parent = TkMacOSXGetNSWindowForDrawable(((TkWindow *)tkwin)->window);
1278 	parentIsKey = parent && [parent isKeyWindow];
1279     } else {
1280 	parent = nil;
1281 	parentIsKey = False;
1282     }
1283     modalReturnCode = showOpenSavePanel(panel, parent, callbackInfo);
1284     result = (modalReturnCode != modalError) ? TCL_OK : TCL_ERROR;
1285     if (parentIsKey) {
1286 	[parent makeKeyWindow];
1287     }
1288   end:
1289     return result;
1290 }
1291 
1292 /*
1293  *----------------------------------------------------------------------
1294  *
1295  * TkAboutDlg --
1296  *
1297  *	Displays the default Tk About box.
1298  *
1299  * Results:
1300  *	None.
1301  *
1302  * Side effects:
1303  *	None.
1304  *
1305  *----------------------------------------------------------------------
1306  */
1307 
1308 void
TkAboutDlg(void)1309 TkAboutDlg(void)
1310 {
1311     [NSApp orderFrontStandardAboutPanel:nil];
1312 }
1313 
1314 /*
1315  *----------------------------------------------------------------------
1316  *
1317  * TkMacOSXStandardAboutPanelObjCmd --
1318  *
1319  *	Implements the ::tk::mac::standardAboutPanel command.
1320  *
1321  * Results:
1322  *	A standard Tcl result.
1323  *
1324  * Side effects:
1325  *	none
1326  *
1327  *----------------------------------------------------------------------
1328  */
1329 
1330 int
TkMacOSXStandardAboutPanelObjCmd(TCL_UNUSED (void *),Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])1331 TkMacOSXStandardAboutPanelObjCmd(
1332     TCL_UNUSED(void *),
1333     Tcl_Interp *interp,		/* Current interpreter. */
1334     int objc,			/* Number of arguments. */
1335     Tcl_Obj *const objv[])	/* Argument objects. */
1336 {
1337     if (objc > 1) {
1338 	Tcl_WrongNumArgs(interp, 1, objv, NULL);
1339 	return TCL_ERROR;
1340     }
1341     [NSApp orderFrontStandardAboutPanel:nil];
1342     return TCL_OK;
1343 }
1344 
1345 /*
1346  *----------------------------------------------------------------------
1347  *
1348  * Tk_MessageBoxObjCmd --
1349  *
1350  *	Implements the tk_messageBox in native Mac OS X style.
1351  *
1352  * Results:
1353  *	A standard Tcl result.
1354  *
1355  * Side effects:
1356  *	none
1357  *
1358  *----------------------------------------------------------------------
1359  */
1360 
1361 int
Tk_MessageBoxObjCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])1362 Tk_MessageBoxObjCmd(
1363     ClientData clientData,	/* Main window associated with interpreter. */
1364     Tcl_Interp *interp,		/* Current interpreter. */
1365     int objc,			/* Number of arguments. */
1366     Tcl_Obj *const objv[])	/* Argument objects. */
1367 {
1368     Tk_Window tkwin = (Tk_Window)clientData;
1369     char *str;
1370     int i, result = TCL_ERROR, haveParentOption = 0;
1371     int index, typeIndex, iconIndex, indexDefaultOption = 0;
1372     int defaultNativeButtonIndex = 1; /* 1, 2, 3: right to left */
1373     Tcl_Obj *cmdObj = NULL;
1374     AlertCallbackInfo callbackInfoStruct, *callbackInfo = &callbackInfoStruct;
1375     NSString *message, *title;
1376     NSWindow *parent;
1377     NSArray *buttons;
1378     NSAlert *alert = [NSAlert new];
1379     NSInteger modalReturnCode = 1;
1380     BOOL parentIsKey = NO;
1381 
1382     iconIndex = ICON_INFO;
1383     typeIndex = TYPE_OK;
1384     for (i = 1; i < objc; i += 2) {
1385 	if (Tcl_GetIndexFromObjStruct(interp, objv[i], alertOptionStrings,
1386 		sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) {
1387 	    goto end;
1388 	}
1389 	if (i + 1 == objc) {
1390 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
1391 		    "value for \"%s\" missing", Tcl_GetString(objv[i])));
1392 	    Tcl_SetErrorCode(interp, "TK", "MSGBOX", "VALUE", NULL);
1393 	    goto end;
1394 	}
1395 	switch (index) {
1396 	case ALERT_DEFAULT:
1397 	    /*
1398 	     * Need to postpone processing of this option until we are sure to
1399 	     * know the '-type' as well.
1400 	     */
1401 
1402 	    indexDefaultOption = i;
1403 	    break;
1404 
1405 	case ALERT_DETAIL:
1406 	    message = [[NSString alloc] initWithUTF8String:
1407 		    Tcl_GetString(objv[i + 1])];
1408 	    [alert setInformativeText:message];
1409 	    [message release];
1410 	    break;
1411 
1412 	case ALERT_ICON:
1413 	    if (Tcl_GetIndexFromObjStruct(interp, objv[i + 1], alertIconStrings,
1414 		    sizeof(char *), "-icon value", TCL_EXACT, &iconIndex) != TCL_OK) {
1415 		goto end;
1416 	    }
1417 	    break;
1418 
1419 	case ALERT_MESSAGE:
1420 	    message = [[NSString alloc] initWithUTF8String:
1421 		    Tcl_GetString(objv[i + 1])];
1422 	    [alert setMessageText:message];
1423 	    [message release];
1424 	    break;
1425 
1426 	case ALERT_PARENT:
1427 	    str = Tcl_GetString(objv[i + 1]);
1428 	    tkwin = Tk_NameToWindow(interp, str, tkwin);
1429 	    if (!tkwin) {
1430 		goto end;
1431 	    }
1432 	    haveParentOption = 1;
1433 	    break;
1434 
1435 	case ALERT_TITLE:
1436 	    title = [[NSString alloc] initWithUTF8String:
1437 		    Tcl_GetString(objv[i + 1])];
1438 	    [[alert window] setTitle:title];
1439 	    [title release];
1440 	    break;
1441 
1442 	case ALERT_TYPE:
1443 	    if (Tcl_GetIndexFromObjStruct(interp, objv[i + 1], alertTypeStrings,
1444 		    sizeof(char *), "-type value", TCL_EXACT, &typeIndex) != TCL_OK) {
1445 		goto end;
1446 	    }
1447 	    break;
1448 	case ALERT_COMMAND:
1449 	    cmdObj = objv[i+1];
1450 	    break;
1451 	}
1452     }
1453     if (indexDefaultOption) {
1454 	/*
1455 	 * Any '-default' option needs to know the '-type' option, which is
1456 	 * why we do this here.
1457 	 */
1458 
1459 	if (Tcl_GetIndexFromObjStruct(interp, objv[indexDefaultOption + 1],
1460 		alertButtonStrings, sizeof(char *), "-default value",
1461 		TCL_EXACT, &index) != TCL_OK) {
1462 	    goto end;
1463 	}
1464 
1465 	/*
1466 	 * Need to map from "ok" etc. to 1, 2, 3, right to left.
1467 	 */
1468 
1469 	defaultNativeButtonIndex =
1470 		alertButtonIndexAndTypeToNativeButtonIndex[typeIndex][index];
1471 	if (!defaultNativeButtonIndex) {
1472 	    Tcl_SetObjResult(interp,
1473 		    Tcl_NewStringObj("Illegal default option", -1));
1474 	    Tcl_SetErrorCode(interp, "TK", "MSGBOX", "DEFAULT", NULL);
1475 	    goto end;
1476 	}
1477     }
1478     [alert setIcon:[NSApp applicationIconImage]];
1479     [alert setAlertStyle:alertStyles[iconIndex]];
1480     i = 0;
1481     while (i < 3 && alertButtonNames[typeIndex][i]) {
1482 	[alert addButtonWithTitle:(NSString*) alertButtonNames[typeIndex][i++]];
1483     }
1484     buttons = [alert buttons];
1485     for (NSButton *b in buttons) {
1486 	NSString *ke = [b keyEquivalent];
1487 
1488 	if (([ke isEqualToString:@"\r"] || [ke isEqualToString:@"\033"]) &&
1489 		![b keyEquivalentModifierMask]) {
1490 	    [b setKeyEquivalent:@""];
1491 	}
1492     }
1493     [[buttons objectAtIndex: [buttons count]-1] setKeyEquivalent: @"\033"];
1494     [[buttons objectAtIndex: defaultNativeButtonIndex-1]
1495 	    setKeyEquivalent: @"\r"];
1496     if (cmdObj) {
1497 	if (Tcl_IsShared(cmdObj)) {
1498 	    cmdObj = Tcl_DuplicateObj(cmdObj);
1499 	}
1500 	Tcl_IncrRefCount(cmdObj);
1501     }
1502     callbackInfo = (AlertCallbackInfo *)ckalloc(sizeof(AlertCallbackInfo));
1503     callbackInfo->cmdObj = cmdObj;
1504     callbackInfo->interp = interp;
1505     callbackInfo->typeIndex = typeIndex;
1506     parent = TkMacOSXGetNSWindowForDrawable(((TkWindow *)tkwin)->window);
1507     if (haveParentOption && parent && ![parent attachedSheet]) {
1508 	parentIsKey = [parent isKeyWindow];
1509 #if MAC_OS_X_VERSION_MIN_REQUIRED >= 1090
1510  	[alert beginSheetModalForWindow:parent
1511 	       completionHandler:^(NSModalResponse returnCode) {
1512 	    [NSApp tkAlertDidEnd:alert
1513 		    returnCode:returnCode
1514 		    contextInfo:callbackInfo];
1515 	}];
1516 #else
1517 	[alert beginSheetModalForWindow:parent
1518 	       modalDelegate:NSApp
1519 	       didEndSelector:@selector(tkAlertDidEnd:returnCode:contextInfo:)
1520 	       contextInfo:callbackInfo];
1521 #endif
1522 	modalReturnCode = cmdObj ? 0 :
1523 	    [alert runModal];
1524     } else {
1525 	modalReturnCode = [alert runModal];
1526 	[NSApp tkAlertDidEnd:alert returnCode:modalReturnCode
1527 		contextInfo:callbackInfo];
1528     }
1529     result = (modalReturnCode >= NSAlertFirstButtonReturn) ? TCL_OK : TCL_ERROR;
1530   end:
1531     [alert release];
1532     if (parentIsKey) {
1533 	[parent makeKeyWindow];
1534     }
1535     return result;
1536 }
1537 
1538 /*
1539  *----------------------------------------------------------------------
1540  */
1541 #pragma mark [tk fontchooser] implementation (TIP 324)
1542 /*
1543  *----------------------------------------------------------------------
1544  */
1545 
1546 #include "tkMacOSXEvent.h"
1547 #include "tkMacOSXFont.h"
1548 
1549 typedef struct FontchooserData {
1550     Tcl_Obj *titleObj;
1551     Tcl_Obj *cmdObj;
1552     Tk_Window parent;
1553 } FontchooserData;
1554 
1555 enum FontchooserEvent {
1556     FontchooserClosed,
1557     FontchooserSelection
1558 };
1559 
1560 static void		FontchooserEvent(int kind);
1561 static Tcl_Obj *	FontchooserCget(FontchooserData *fcdPtr,
1562 			    int optionIndex);
1563 static int		FontchooserConfigureCmd(ClientData clientData,
1564 			    Tcl_Interp *interp, int objc,
1565 			    Tcl_Obj *const objv[]);
1566 static int		FontchooserShowCmd(ClientData clientData,
1567 			    Tcl_Interp *interp, int objc,
1568 			    Tcl_Obj *const objv[]);
1569 static int		FontchooserHideCmd(ClientData clientData,
1570 			    Tcl_Interp *interp, int objc,
1571 			    Tcl_Obj *const objv[]);
1572 static void		FontchooserParentEventHandler(ClientData clientData,
1573 			    XEvent *eventPtr);
1574 static void		DeleteFontchooserData(ClientData clientData,
1575 			    Tcl_Interp *interp);
1576 
1577 MODULE_SCOPE const TkEnsemble tkFontchooserEnsemble[];
1578 const TkEnsemble tkFontchooserEnsemble[] = {
1579     { "configure", FontchooserConfigureCmd, NULL },
1580     { "show", FontchooserShowCmd, NULL },
1581     { "hide", FontchooserHideCmd, NULL },
1582     { NULL, NULL, NULL }
1583 };
1584 
1585 static Tcl_Interp *fontchooserInterp = NULL;
1586 static NSFont *fontPanelFont = nil;
1587 static NSMutableDictionary *fontPanelFontAttributes = nil;
1588 
1589 static const char *const fontchooserOptionStrings[] = {
1590     "-parent", "-title", "-font", "-command",
1591     "-visible", NULL
1592 };
1593 enum FontchooserOption {
1594     FontchooserParent, FontchooserTitle, FontchooserFont, FontchooserCmd,
1595     FontchooserVisible
1596 };
1597 
1598 @implementation TKApplication(TKFontPanel)
1599 
1600 - (void) changeFont: (id) sender
1601 {
1602     NSFontManager *fm = [NSFontManager sharedFontManager];
1603     (void)sender;
1604 
1605     if ([fm currentFontAction] == NSViaPanelFontAction) {
1606 	NSFont *font = [fm convertFont:fontPanelFont];
1607 
1608 	if (![fontPanelFont isEqual:font]) {
1609 	    [fontPanelFont release];
1610 	    fontPanelFont = [font retain];
1611 	    FontchooserEvent(FontchooserSelection);
1612 	}
1613     }
1614 }
1615 
1616 - (void) changeAttributes: (id) sender
1617 {
1618     NSDictionary *attributes = [sender convertAttributes:
1619 	    fontPanelFontAttributes];
1620 
1621     if (![fontPanelFontAttributes isEqual:attributes]) {
1622 	[fontPanelFontAttributes setDictionary:attributes];
1623 	FontchooserEvent(FontchooserSelection);
1624     }
1625 }
1626 
1627 - (NSUInteger) validModesForFontPanel: (NSFontPanel *)fontPanel
1628 {
1629     (void)fontPanel;
1630 
1631     return (NSFontPanelStandardModesMask & ~NSFontPanelAllEffectsModeMask) |
1632 	    NSFontPanelUnderlineEffectModeMask |
1633 	    NSFontPanelStrikethroughEffectModeMask;
1634 }
1635 
1636 - (void) windowDidOrderOffScreen: (NSNotification *)notification
1637 {
1638 #ifdef TK_MAC_DEBUG_NOTIFICATIONS
1639     TKLog(@"-[%@(%p) %s] %@", [self class], self, _cmd, notification);
1640 #endif
1641     if ([[notification object] isEqual:[[NSFontManager sharedFontManager]
1642 	    fontPanel:NO]]) {
1643 	FontchooserEvent(FontchooserClosed);
1644     }
1645 }
1646 @end
1647 
1648 /*
1649  *----------------------------------------------------------------------
1650  *
1651  * FontchooserEvent --
1652  *
1653  *	This processes events generated by user interaction with the font
1654  *	panel.
1655  *
1656  * Results:
1657  *	None.
1658  *
1659  * Side effects:
1660  *	Additional events may be placed on the Tk event queue.
1661  *
1662  *----------------------------------------------------------------------
1663  */
1664 
1665 static void
FontchooserEvent(int kind)1666 FontchooserEvent(
1667     int kind)
1668 {
1669     FontchooserData *fcdPtr;
1670     Tcl_Obj *fontObj;
1671 
1672     if (!fontchooserInterp) {
1673 	return;
1674     }
1675     fcdPtr = (FontchooserData *)Tcl_GetAssocData(fontchooserInterp, "::tk::fontchooser", NULL);
1676     switch (kind) {
1677     case FontchooserClosed:
1678 	if (fcdPtr->parent != NULL) {
1679 	    TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserVisibility", NULL);
1680 	    fontchooserInterp = NULL;
1681 	}
1682 	break;
1683     case FontchooserSelection:
1684 	fontObj = TkMacOSXFontDescriptionForNSFontAndNSFontAttributes(
1685 		fontPanelFont, fontPanelFontAttributes);
1686 	if (fontObj) {
1687 	    if (fcdPtr->cmdObj) {
1688 		int objc, result;
1689 		Tcl_Obj **objv, **tmpv;
1690 
1691 		result = Tcl_ListObjGetElements(fontchooserInterp,
1692 			fcdPtr->cmdObj, &objc, &objv);
1693 		if (result == TCL_OK) {
1694 		    tmpv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * (objc + 2));
1695 		    memcpy(tmpv, objv, sizeof(Tcl_Obj *) * objc);
1696 		    tmpv[objc] = fontObj;
1697 		    TkBackgroundEvalObjv(fontchooserInterp, objc + 1, tmpv,
1698 			    TCL_EVAL_GLOBAL);
1699 		    ckfree(tmpv);
1700 		}
1701 	    }
1702 	    TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserFontChanged", NULL);
1703 	}
1704 	break;
1705     }
1706 }
1707 
1708 /*
1709  *----------------------------------------------------------------------
1710  *
1711  * FontchooserCget --
1712  *
1713  *	Helper for the FontchooserConfigure command to return the current value
1714  *	of any of the options (which may be NULL in the structure).
1715  *
1716  * Results:
1717  *	Tcl object of option value.
1718  *
1719  * Side effects:
1720  *	None.
1721  *
1722  *----------------------------------------------------------------------
1723  */
1724 
1725 static Tcl_Obj *
FontchooserCget(FontchooserData * fcdPtr,int optionIndex)1726 FontchooserCget(
1727     FontchooserData *fcdPtr,
1728     int optionIndex)
1729 {
1730     Tcl_Obj *resObj = NULL;
1731 
1732     switch(optionIndex) {
1733     case FontchooserParent:
1734 	if (fcdPtr->parent != NULL) {
1735 	    resObj = Tcl_NewStringObj(
1736 		    ((TkWindow *)fcdPtr->parent)->pathName, -1);
1737 	} else {
1738 	    resObj = Tcl_NewStringObj(".", 1);
1739 	}
1740 	break;
1741     case FontchooserTitle:
1742 	if (fcdPtr->titleObj) {
1743 	    resObj = fcdPtr->titleObj;
1744 	} else {
1745 	    resObj = Tcl_NewObj();
1746 	}
1747 	break;
1748     case FontchooserFont:
1749 	resObj = TkMacOSXFontDescriptionForNSFontAndNSFontAttributes(
1750 		fontPanelFont, fontPanelFontAttributes);
1751 	if (!resObj) {
1752 	    resObj = Tcl_NewObj();
1753 	}
1754 	break;
1755     case FontchooserCmd:
1756 	if (fcdPtr->cmdObj) {
1757 	    resObj = fcdPtr->cmdObj;
1758 	} else {
1759 	    resObj = Tcl_NewObj();
1760 	}
1761 	break;
1762     case FontchooserVisible:
1763 	resObj = Tcl_NewBooleanObj([[[NSFontManager sharedFontManager]
1764 		fontPanel:NO] isVisible]);
1765 	break;
1766     default:
1767 	resObj = Tcl_NewObj();
1768     }
1769     return resObj;
1770 }
1771 
1772 /*
1773  * ----------------------------------------------------------------------
1774  *
1775  * FontchooserConfigureCmd --
1776  *
1777  *	Implementation of the 'tk fontchooser configure' ensemble command.  See
1778  *	the user documentation for what it does.
1779  *
1780  * Results:
1781  *	See the user documentation.
1782  *
1783  * Side effects:
1784  *	Per-interp data structure may be modified
1785  *
1786  * ----------------------------------------------------------------------
1787  */
1788 
1789 static int
FontchooserConfigureCmd(ClientData clientData,Tcl_Interp * interp,int objc,Tcl_Obj * const objv[])1790 FontchooserConfigureCmd(
1791     ClientData clientData,	/* Main window */
1792     Tcl_Interp *interp,
1793     int objc,
1794     Tcl_Obj *const objv[])
1795 {
1796     Tk_Window tkwin = (Tk_Window)clientData;
1797     FontchooserData *fcdPtr = (FontchooserData *)Tcl_GetAssocData(interp, "::tk::fontchooser",
1798 	    NULL);
1799     int i, r = TCL_OK;
1800 
1801     /*
1802      * With no arguments we return all the options in a dict
1803      */
1804 
1805     if (objc == 1) {
1806 	Tcl_Obj *keyObj, *valueObj;
1807 	Tcl_Obj *dictObj = Tcl_NewDictObj();
1808 
1809 	for (i = 0; r == TCL_OK && fontchooserOptionStrings[i] != NULL; ++i) {
1810 	    keyObj = Tcl_NewStringObj(fontchooserOptionStrings[i], -1);
1811 	    valueObj = FontchooserCget(fcdPtr, i);
1812 	    r = Tcl_DictObjPut(interp, dictObj, keyObj, valueObj);
1813 	}
1814 	if (r == TCL_OK) {
1815 	    Tcl_SetObjResult(interp, dictObj);
1816 	}
1817 	return r;
1818     }
1819 
1820     for (i = 1; i < objc; i += 2) {
1821 	int optionIndex, len;
1822 
1823 	if (Tcl_GetIndexFromObjStruct(interp, objv[i], fontchooserOptionStrings,
1824 		sizeof(char *), "option", 0, &optionIndex) != TCL_OK) {
1825 	    return TCL_ERROR;
1826 	}
1827 	if (objc == 2) {
1828 	    /*
1829 	     * With one option and no arg, return the current value.
1830 	     */
1831 
1832 	    Tcl_SetObjResult(interp, FontchooserCget(fcdPtr, optionIndex));
1833 	    return TCL_OK;
1834 	}
1835 	if (i + 1 == objc) {
1836 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
1837 		    "value for \"%s\" missing", Tcl_GetString(objv[i])));
1838 	    Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "VALUE", NULL);
1839 	    return TCL_ERROR;
1840 	}
1841 	switch (optionIndex) {
1842 	case FontchooserVisible: {
1843 	    const char *msg = "cannot change read-only option "
1844 		    "\"-visible\": use the show or hide command";
1845 
1846 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
1847 	    Tcl_SetErrorCode(interp, "TK", "FONTDIALOG", "READONLY", NULL);
1848 	    return TCL_ERROR;
1849 	}
1850 	case FontchooserParent: {
1851 	    Tk_Window parent = Tk_NameToWindow(interp,
1852 		    Tcl_GetString(objv[i+1]), tkwin);
1853 
1854 	    if (parent == NULL) {
1855 		return TCL_ERROR;
1856 	    }
1857 	    if (fcdPtr->parent) {
1858 		Tk_DeleteEventHandler(fcdPtr->parent, StructureNotifyMask,
1859 			FontchooserParentEventHandler, fcdPtr);
1860 	    }
1861 	    fcdPtr->parent = parent;
1862 	    Tk_CreateEventHandler(fcdPtr->parent, StructureNotifyMask,
1863 		    FontchooserParentEventHandler, fcdPtr);
1864 	    break;
1865 	}
1866 	case FontchooserTitle:
1867 	    if (fcdPtr->titleObj) {
1868 		Tcl_DecrRefCount(fcdPtr->titleObj);
1869 	    }
1870 	    Tcl_GetStringFromObj(objv[i+1], &len);
1871 	    if (len) {
1872 		fcdPtr->titleObj = objv[i+1];
1873 		if (Tcl_IsShared(fcdPtr->titleObj)) {
1874 		    fcdPtr->titleObj = Tcl_DuplicateObj(fcdPtr->titleObj);
1875 		}
1876 		Tcl_IncrRefCount(fcdPtr->titleObj);
1877 	    } else {
1878 		fcdPtr->titleObj = NULL;
1879 	    }
1880 	    break;
1881 	case FontchooserFont: {
1882 	    Tcl_GetStringFromObj(objv[i+1], &len);
1883 	    if (len) {
1884 		Tk_Font f = Tk_AllocFontFromObj(interp, tkwin, objv[i+1]);
1885 
1886 		if (!f) {
1887 		    return TCL_ERROR;
1888 		}
1889 		[fontPanelFont autorelease];
1890 		fontPanelFont = [TkMacOSXNSFontForFont(f) retain];
1891 		[fontPanelFontAttributes setDictionary:
1892 			TkMacOSXNSFontAttributesForFont(f)];
1893 		[fontPanelFontAttributes removeObjectsForKeys:[NSArray
1894 			arrayWithObjects:NSFontAttributeName,
1895 			NSLigatureAttributeName, NSKernAttributeName, nil]];
1896 		Tk_FreeFont(f);
1897 	    } else {
1898 		[fontPanelFont release];
1899 		fontPanelFont = nil;
1900 		[fontPanelFontAttributes removeAllObjects];
1901 	    }
1902 
1903 	    NSFontManager *fm = [NSFontManager sharedFontManager];
1904 	    NSFontPanel *fp = [fm fontPanel:NO];
1905 
1906 	    [fp setPanelFont:fontPanelFont isMultiple:NO];
1907 	    [fm setSelectedFont:fontPanelFont isMultiple:NO];
1908 	    [fm setSelectedAttributes:fontPanelFontAttributes
1909 		    isMultiple:NO];
1910 	    if ([fp isVisible]) {
1911 		TkSendVirtualEvent(fcdPtr->parent,
1912 			"TkFontchooserFontChanged", NULL);
1913 	    }
1914 	    break;
1915 	}
1916 	case FontchooserCmd:
1917 	    if (fcdPtr->cmdObj) {
1918 		Tcl_DecrRefCount(fcdPtr->cmdObj);
1919 	    }
1920 	    Tcl_GetStringFromObj(objv[i+1], &len);
1921 	    if (len) {
1922 		fcdPtr->cmdObj = objv[i+1];
1923 		if (Tcl_IsShared(fcdPtr->cmdObj)) {
1924 		    fcdPtr->cmdObj = Tcl_DuplicateObj(fcdPtr->cmdObj);
1925 		}
1926 		Tcl_IncrRefCount(fcdPtr->cmdObj);
1927 	    } else {
1928 		fcdPtr->cmdObj = NULL;
1929 	    }
1930 	    break;
1931 	}
1932     }
1933     return TCL_OK;
1934 }
1935 
1936 /*
1937  * ----------------------------------------------------------------------
1938  *
1939  * FontchooserShowCmd --
1940  *
1941  *	Implements the 'tk fontchooser show' ensemble command. The per-interp
1942  *	configuration data for the dialog is held in an interp associated
1943  *	structure.
1944  *
1945  * Results:
1946  *	See the user documentation.
1947  *
1948  * Side effects:
1949  *	Font Panel may be shown.
1950  *
1951  * ----------------------------------------------------------------------
1952  */
1953 
1954 static int
FontchooserShowCmd(ClientData clientData,Tcl_Interp * interp,TCL_UNUSED (int),TCL_UNUSED (Tcl_Obj * const *))1955 FontchooserShowCmd(
1956     ClientData clientData,	/* Main window */
1957     Tcl_Interp *interp,
1958     TCL_UNUSED(int),
1959     TCL_UNUSED(Tcl_Obj *const *))
1960 {
1961     FontchooserData *fcdPtr = (FontchooserData *)Tcl_GetAssocData(interp, "::tk::fontchooser",
1962 	    NULL);
1963 
1964     if (fcdPtr->parent == NULL) {
1965 	fcdPtr->parent = (Tk_Window)clientData;
1966 	Tk_CreateEventHandler(fcdPtr->parent, StructureNotifyMask,
1967 		FontchooserParentEventHandler, fcdPtr);
1968     }
1969 
1970     NSFontManager *fm = [NSFontManager sharedFontManager];
1971     NSFontPanel *fp = [fm fontPanel:YES];
1972 
1973     if ([fp delegate] != NSApp) {
1974 	[fp setDelegate:NSApp];
1975     }
1976     if (![fp isVisible]) {
1977 	[fm orderFrontFontPanel:NSApp];
1978 	TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserVisibility", NULL);
1979     }
1980     fontchooserInterp = interp;
1981 
1982     return TCL_OK;
1983 }
1984 
1985 /*
1986  * ----------------------------------------------------------------------
1987  *
1988  * FontchooserHideCmd --
1989  *
1990  *	Implementation of the 'tk fontchooser hide' ensemble. See the user
1991  *	documentation for details.
1992  *
1993  * Results:
1994  *	See the user documentation.
1995  *
1996  * Side effects:
1997  *	Font Panel may be hidden.
1998  *
1999  * ----------------------------------------------------------------------
2000  */
2001 
2002 static int
FontchooserHideCmd(TCL_UNUSED (void *),TCL_UNUSED (Tcl_Interp *),TCL_UNUSED (int),TCL_UNUSED (Tcl_Obj * const *))2003 FontchooserHideCmd(
2004     TCL_UNUSED(void *),	/* Main window */
2005     TCL_UNUSED(Tcl_Interp *),
2006     TCL_UNUSED(int),
2007     TCL_UNUSED(Tcl_Obj *const *))
2008 {
2009     NSFontPanel *fp = [[NSFontManager sharedFontManager] fontPanel:NO];
2010 
2011     if ([fp isVisible]) {
2012 	[fp orderOut:NSApp];
2013     }
2014     return TCL_OK;
2015 }
2016 
2017 /*
2018  * ----------------------------------------------------------------------
2019  *
2020  * FontchooserParentEventHandler --
2021  *
2022  *	Event handler for StructureNotify events on the font chooser's parent
2023  *	window.
2024  *
2025  * Results:
2026  *	None.
2027  *
2028  * Side effects:
2029  *	Font chooser parent info is cleared and font panel is hidden.
2030  *
2031  * ----------------------------------------------------------------------
2032  */
2033 
2034 static void
FontchooserParentEventHandler(ClientData clientData,XEvent * eventPtr)2035 FontchooserParentEventHandler(
2036     ClientData clientData,
2037     XEvent *eventPtr)
2038 {
2039     FontchooserData *fcdPtr = (FontchooserData *)clientData;
2040 
2041     if (eventPtr->type == DestroyNotify) {
2042 	Tk_DeleteEventHandler(fcdPtr->parent, StructureNotifyMask,
2043 		FontchooserParentEventHandler, fcdPtr);
2044 	fcdPtr->parent = NULL;
2045 	FontchooserHideCmd(NULL, NULL, 0, NULL);
2046     }
2047 }
2048 
2049 /*
2050  * ----------------------------------------------------------------------
2051  *
2052  * DeleteFontchooserData --
2053  *
2054  *	Clean up the font chooser configuration data when the interp is
2055  *	destroyed.
2056  *
2057  * Results:
2058  *	None.
2059  *
2060  * Side effects:
2061  *	per-interp configuration data is destroyed.
2062  *
2063  * ----------------------------------------------------------------------
2064  */
2065 
2066 static void
DeleteFontchooserData(ClientData clientData,Tcl_Interp * interp)2067 DeleteFontchooserData(
2068     ClientData clientData,
2069     Tcl_Interp *interp)
2070 {
2071     FontchooserData *fcdPtr = (FontchooserData *)clientData;
2072 
2073     if (fcdPtr->titleObj) {
2074 	Tcl_DecrRefCount(fcdPtr->titleObj);
2075     }
2076     if (fcdPtr->cmdObj) {
2077 	Tcl_DecrRefCount(fcdPtr->cmdObj);
2078     }
2079     ckfree(fcdPtr);
2080 
2081     if (fontchooserInterp == interp) {
2082 	fontchooserInterp = NULL;
2083     }
2084 }
2085 
2086 /*
2087  * ----------------------------------------------------------------------
2088  *
2089  * TkInitFontchooser --
2090  *
2091  *	Associate the font chooser configuration data with the Tcl interpreter.
2092  *	There is one font chooser per interp.
2093  *
2094  * Results:
2095  *	None.
2096  *
2097  * Side effects:
2098  *	per-interp configuration data is destroyed.
2099  *
2100  * ----------------------------------------------------------------------
2101  */
2102 
2103 MODULE_SCOPE int
TkInitFontchooser(Tcl_Interp * interp,TCL_UNUSED (void *))2104 TkInitFontchooser(
2105     Tcl_Interp *interp,
2106     TCL_UNUSED(void *))
2107 {
2108     FontchooserData *fcdPtr = (FontchooserData *)ckalloc(sizeof(FontchooserData));
2109 
2110     bzero(fcdPtr, sizeof(FontchooserData));
2111     Tcl_SetAssocData(interp, "::tk::fontchooser", DeleteFontchooserData,
2112 	    fcdPtr);
2113     if (!fontPanelFontAttributes) {
2114 	fontPanelFontAttributes = [NSMutableDictionary new];
2115     }
2116     return TCL_OK;
2117 }
2118 
2119 /*
2120  * Local Variables:
2121  * mode: objc
2122  * c-basic-offset: 4
2123  * fill-column: 79
2124  * coding: utf-8
2125  * End:
2126  */
2127