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, Apple Computer, Inc.
8 * Copyright (c) 2006-2007 Daniel A. Steffen <das@users.sourceforge.net>
9 *
10 * See the file "license.terms" for information on usage and redistribution
11 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 *
13 * RCS: @(#) $Id: tkMacOSXDialog.c,v 1.4.2.21 2007/11/09 06:26:55 das Exp $
14 */
15
16#include "tkMacOSXPrivate.h"
17#include "tkFileFilter.h"
18
19#ifndef StrLength
20#define StrLength(s)	(*((unsigned char *) (s)))
21#endif
22#ifndef StrBody
23#define StrBody(s)	((char *) (s) + 1)
24#endif
25
26#define OPEN_POPUP_ITEM 10
27
28#define SAVE_FILE	0
29#define OPEN_FILE	1
30#define CHOOSE_FOLDER	2
31
32#define MATCHED		0
33#define UNMATCHED	1
34
35#define TK_DEFAULT_ABOUT 128
36
37/*
38 * The following structures are used in the GetFileName() function. They store
39 * information about the file dialog and the file filters.
40 */
41typedef struct _OpenFileData {
42    FileFilterList fl;          /* List of file filters.                   */
43    SInt16 curType;             /* The filetype currently being listed.    */
44    short initialType;          /* Type to use initially                   */
45    short popupItem;            /* Item number of the popup in the dialog. */
46    short usePopup;             /* True if we show the popup menu (this    */
47                                /* is an open operation and the            */
48                                /* -filetypes option is set).              */
49} OpenFileData;
50
51typedef struct NavHandlerUserData {
52    OpenFileData *ofdPtr;
53    NavReplyRecord reply;
54    OSStatus err;
55    CFStringRef saveNameRef;
56    int sheet;
57    WindowRef dialogWindow, origUnavailWindow;
58    WindowModality origModality;
59} NavHandlerUserData;
60
61/*
62 * The following structure is used in the tk_messageBox implementation.
63 */
64
65typedef struct {
66    int buttonIndex;
67    WindowRef dialogWindow, origUnavailWindow;
68    WindowModality origModality;
69    EventHandlerRef handlerRef;
70} AlertHandlerUserData;
71
72
73static OSStatus		AlertHandler(EventHandlerCallRef callRef,
74			    EventRef eventRef, void *userData);
75static Boolean		MatchOneType(StringPtr fileNamePtr, OSType fileType,
76			    OpenFileData *myofdPtr, FileFilter *filterPtr);
77static pascal Boolean	OpenFileFilterProc(AEDesc* theItem, void* info,
78			    NavCallBackUserData callBackUD,
79			    NavFilterModes filterMode);
80static pascal void	OpenEventProc(NavEventCallbackMessage callBackSelector,
81			    NavCBRecPtr callBackParms,
82			    NavCallBackUserData callBackUD);
83static void		InitFileDialogs(void);
84static int		NavServicesGetFile(Tcl_Interp *interp,
85			    OpenFileData *ofd, AEDesc *initialDescPtr,
86			    char *initialFile, AEDescList *selectDescPtr,
87			    CFStringRef title, CFStringRef message,
88			    const char *initialType, int multiple, int isOpen,
89			    Tk_Window parent);
90static int		HandleInitialDirectory(Tcl_Interp *interp,
91			    char *initialFile, char *initialDir, FSRef *dirRef,
92			    AEDescList *selectDescPtr, AEDesc *dirDescPtr);
93
94/*
95 * Have we initialized the file dialog subsystem
96 */
97
98static int fileDlgInited = 0;
99
100/*
101 * Filter and hook functions used by the tk_getOpenFile and tk_getSaveFile
102 * commands.
103 */
104
105static NavObjectFilterUPP openFileFilterUPP;
106static NavEventUPP openFileEventUPP;
107
108
109/*
110 *----------------------------------------------------------------------
111 *
112 * Tk_ChooseColorObjCmd --
113 *
114 *	This procedure implements the color dialog box for the Mac
115 *	platform. See the user documentation for details on what it
116 *	does.
117 *
118 * Results:
119 *	A standard Tcl result.
120 *
121 * Side effects:
122 *	See the user documentation.
123 *
124 *----------------------------------------------------------------------
125 */
126
127int
128Tk_ChooseColorObjCmd(
129    ClientData clientData,	/* Main window associated with interpreter. */
130    Tcl_Interp *interp,		/* Current interpreter. */
131    int objc,			/* Number of arguments. */
132    Tcl_Obj *CONST objv[])	/* Argument objects. */
133{
134    OSStatus err;
135    int result = TCL_ERROR;
136    Tk_Window parent, tkwin = (Tk_Window) clientData;
137    const char *title;
138    int i, srcRead, dstWrote;
139    CMError cmerr;
140    CMProfileRef prof;
141    NColorPickerInfo cpinfo;
142    static RGBColor color = {0xffff, 0xffff, 0xffff};
143    static const char *optionStrings[] = {
144	"-initialcolor", "-parent", "-title", NULL
145    };
146    enum options {
147	COLOR_INITIAL, COLOR_PARENT, COLOR_TITLE
148    };
149
150    title = "Choose a color:";
151    bzero(&cpinfo, sizeof(cpinfo));
152    cpinfo.theColor.color.rgb.red   = color.red;
153    cpinfo.theColor.color.rgb.green = color.green;
154    cpinfo.theColor.color.rgb.blue  = color.blue;
155
156    for (i = 1; i < objc; i += 2) {
157	int index;
158	const char *option, *value;
159
160	if (Tcl_GetIndexFromObj(interp, objv[i], optionStrings, "option",
161		TCL_EXACT, &index) != TCL_OK) {
162	    goto end;
163	}
164	if (i + 1 == objc) {
165	    option = Tcl_GetString(objv[i]);
166	    Tcl_AppendResult(interp, "value for \"", option, "\" missing",
167		    NULL);
168	    goto end;
169	}
170	value = Tcl_GetString(objv[i + 1]);
171
172	switch ((enum options) index) {
173	    case COLOR_INITIAL: {
174		XColor *colorPtr;
175
176		colorPtr = Tk_GetColor(interp, tkwin, value);
177		if (colorPtr == NULL) {
178		    goto end;
179		}
180		cpinfo.theColor.color.rgb.red   = colorPtr->red;
181		cpinfo.theColor.color.rgb.green = colorPtr->green;
182		cpinfo.theColor.color.rgb.blue  = colorPtr->blue;
183		Tk_FreeColor(colorPtr);
184		break;
185	    }
186	    case COLOR_PARENT: {
187		parent = Tk_NameToWindow(interp, value, tkwin);
188		if (parent == NULL) {
189		    goto end;
190		}
191		break;
192	    }
193	    case COLOR_TITLE: {
194		title = value;
195		break;
196	    }
197	}
198    }
199
200    cmerr = CMGetDefaultProfileBySpace(cmRGBData, &prof);
201    cpinfo.theColor.profile = prof;
202    cpinfo.dstProfile = prof;
203    cpinfo.flags = kColorPickerDialogIsMoveable | kColorPickerDialogIsModal;
204    cpinfo.placeWhere = kCenterOnMainScreen;
205    /* Currently, this does not actually change the colorpicker title */
206    Tcl_UtfToExternal(NULL, TkMacOSXCarbonEncoding, title, -1, 0, NULL,
207	StrBody(cpinfo.prompt), 255, &srcRead, &dstWrote, NULL);
208    StrLength(cpinfo.prompt) = (unsigned char) dstWrote;
209
210    TkMacOSXTrackingLoop(1);
211    err = ChkErr(NPickColor, &cpinfo);
212    TkMacOSXTrackingLoop(0);
213    cmerr = CMCloseProfile(prof);
214    if ((err == noErr) && (cpinfo.newColorChosen != 0)) {
215	char colorstr[8];
216
217	color.red   = cpinfo.theColor.color.rgb.red;
218	color.green = cpinfo.theColor.color.rgb.green;
219	color.blue  = cpinfo.theColor.color.rgb.blue;
220	snprintf(colorstr, 8, "#%02x%02x%02x", color.red >> 8,
221		color.green >> 8, color.blue >> 8);
222	Tcl_SetObjResult(interp, Tcl_NewStringObj(colorstr, 7));
223    } else {
224	Tcl_ResetResult(interp);
225    }
226    result = TCL_OK;
227
228end:
229    return result;
230}
231
232/*
233 *----------------------------------------------------------------------
234 *
235 * Tk_GetOpenFileObjCmd --
236 *
237 *	This procedure implements the "open file" dialog box for the
238 *	Mac platform. See the user documentation for details on what
239 *	it does.
240 *
241 * Results:
242 *	A standard Tcl result.
243 *
244 * Side effects:
245 *	See user documentation.
246 *----------------------------------------------------------------------
247 */
248
249int
250Tk_GetOpenFileObjCmd(
251    ClientData clientData,	/* Main window associated with interpreter. */
252    Tcl_Interp *interp,		/* Current interpreter. */
253    int objc,			/* Number of arguments. */
254    Tcl_Obj *CONST objv[])	/* Argument objects. */
255{
256    int i, result = TCL_ERROR, multiple = 0;
257    OpenFileData ofd;
258    Tk_Window parent = NULL;
259    CFStringRef message = NULL, title = NULL;
260    AEDesc initialDesc = {typeNull, NULL};
261    FSRef dirRef;
262    AEDesc *initialPtr = NULL;
263    AEDescList selectDesc = {typeNull, NULL};
264    char *initialFile = NULL, *initialDir = NULL;
265#if 0
266    Tcl_Obj *typeVariablePtr = NULL;
267#endif
268    const char *initialtype = NULL;
269    static const char *openOptionStrings[] = {
270	"-defaultextension", "-filetypes", "-initialdir", "-initialfile",
271	"-message", "-multiple", "-parent", "-title",/* "-typevariable",*/ NULL
272    };
273    enum openOptions {
274	OPEN_DEFAULT, OPEN_FILETYPES, OPEN_INITDIR, OPEN_INITFILE,
275	OPEN_MESSAGE, OPEN_MULTIPLE, OPEN_PARENT, OPEN_TITLE,
276	/*OPEN_TYPEVARIABLE,*/
277    };
278
279    if (!fileDlgInited) {
280	InitFileDialogs();
281    }
282    TkInitFileFilters(&ofd.fl);
283    ofd.curType = 0;
284    ofd.initialType = -1;
285    ofd.popupItem = OPEN_POPUP_ITEM;
286    ofd.usePopup = 1;
287
288    for (i = 1; i < objc; i += 2) {
289	char *choice;
290	int index, choiceLen;
291	char *string;
292	char *types;
293
294	if (Tcl_GetIndexFromObj(interp, objv[i], openOptionStrings, "option",
295		TCL_EXACT, &index) != TCL_OK) {
296	    goto end;
297	}
298	if (i + 1 == objc) {
299	    string = Tcl_GetString(objv[i]);
300	    Tcl_AppendResult(interp, "value for \"", string, "\" missing",
301		    NULL);
302	    goto end;
303	}
304
305	switch (index) {
306	    case OPEN_DEFAULT:
307		break;
308	    case OPEN_FILETYPES:
309		types = Tcl_GetString(objv[i + 1]);
310		if (TkGetFileFilters(interp, &ofd.fl, types, 0) != TCL_OK) {
311		    goto end;
312		}
313		break;
314	    case OPEN_INITDIR:
315		initialDir = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
316		/* empty strings should be like no selection given */
317		if (choiceLen == 0) { initialDir = NULL; }
318		break;
319	    case OPEN_INITFILE:
320	    initialFile = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
321		/* empty strings should be like no selection given */
322		if (choiceLen == 0) { initialFile = NULL; }
323		break;
324	    case OPEN_MESSAGE:
325		choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
326		if (message) {
327		    CFRelease(message);
328		}
329		message = CFStringCreateWithBytes(NULL, (unsigned char*)
330			choice, choiceLen, kCFStringEncodingUTF8, false);
331		break;
332	    case OPEN_MULTIPLE:
333		if (Tcl_GetBooleanFromObj(interp, objv[i + 1], &multiple)
334			!= TCL_OK) {
335		    goto end;
336		}
337		break;
338	    case OPEN_PARENT:
339		choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
340		parent = Tk_NameToWindow(interp, choice,
341			(Tk_Window) clientData);
342		if (parent == NULL) {
343		    goto end;
344		}
345		break;
346	    case OPEN_TITLE:
347		choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
348		if (title) {
349		    CFRelease(title);
350		}
351		title = CFStringCreateWithBytes(NULL, (unsigned char*)
352			choice, choiceLen, kCFStringEncodingUTF8, false);
353		break;
354#if 0
355	    case OPEN_TYPEVARIABLE:
356	        typeVariablePtr = objv[i + 1];
357	        break;
358#endif
359	}
360    }
361
362    if (HandleInitialDirectory(interp, initialFile, initialDir, &dirRef,
363	    &selectDesc, &initialDesc) != TCL_OK) {
364	goto end;
365    }
366    if (initialDesc.descriptorType == typeFSRef) {
367	initialPtr = &initialDesc;
368    }
369#if 0
370    if (typeVariablePtr) {
371	initialtype = Tcl_GetVar(interp, Tcl_GetString(typeVariablePtr), 0);
372    }
373#endif
374    result = NavServicesGetFile(interp, &ofd, initialPtr, NULL, &selectDesc,
375	    title, message, initialtype, multiple, OPEN_FILE, parent);
376
377#if 0
378    if (typeVariablePtr) {
379	FileFilter *filterPtr = ofd.fl.filters;
380	int i = ofd.curType;
381
382	while (filterPtr && i-- > 0) {
383	    filterPtr = filterPtr->next;
384	}
385	Tcl_SetVar(interp, Tcl_GetString(typeVariablePtr), filterPtr ?
386		filterPtr->name : "", 0);
387    }
388#endif
389
390end:
391    TkFreeFileFilters(&ofd.fl);
392    if (initialDesc.dataHandle) {
393	ChkErr(AEDisposeDesc, &initialDesc);
394    }
395    if (selectDesc.dataHandle) {
396	ChkErr(AEDisposeDesc, &selectDesc);
397    }
398    if (title) {
399	CFRelease(title);
400    }
401    if (message) {
402	CFRelease(message);
403    }
404    return result;
405}
406
407/*
408 *----------------------------------------------------------------------
409 *
410 * Tk_GetSaveFileObjCmd --
411 *
412 *	Same as Tk_GetOpenFileCmd but opens a "save file" dialog box
413 *	instead
414 *
415 * Results:
416 *	A standard Tcl result.
417 *
418 * Side effects:
419 *	See user documentation.
420 *----------------------------------------------------------------------
421 */
422
423int
424Tk_GetSaveFileObjCmd(
425    ClientData clientData,	/* Main window associated with interpreter. */
426    Tcl_Interp *interp,		/* Current interpreter. */
427    int objc,			/* Number of arguments. */
428    Tcl_Obj *CONST objv[])	/* Argument objects. */
429{
430    int i, result = TCL_ERROR;
431    char *initialFile = NULL;
432    Tk_Window parent = NULL;
433    AEDesc initialDesc = {typeNull, NULL};
434    AEDesc *initialPtr = NULL;
435    FSRef dirRef;
436    CFStringRef title = NULL, message = NULL;
437    OpenFileData ofd;
438    static const char *saveOptionStrings[] = {
439	"-defaultextension", "-filetypes", "-initialdir", "-initialfile",
440	"-message", "-parent", "-title",/* "-typevariable",*/ NULL
441    };
442    enum saveOptions {
443	SAVE_DEFAULT, SAVE_FILETYPES, SAVE_INITDIR, SAVE_INITFILE,
444	SAVE_MESSAGE, SAVE_PARENT, SAVE_TITLE,/* SAVE_TYPEVARIABLE,*/
445    };
446
447    if (!fileDlgInited) {
448	InitFileDialogs();
449    }
450
451    TkInitFileFilters(&ofd.fl);
452    ofd.curType = 0;
453    ofd.usePopup = 0;
454
455    for (i = 1; i < objc; i += 2) {
456	char *choice, *string;
457	int index, choiceLen;
458	char *types;
459
460	if (Tcl_GetIndexFromObj(interp, objv[i], saveOptionStrings, "option",
461		TCL_EXACT, &index) != TCL_OK) {
462	    goto end;
463	}
464	if (i + 1 == objc) {
465	    string = Tcl_GetString(objv[i]);
466	    Tcl_AppendResult(interp, "value for \"", string, "\" missing",
467		    NULL);
468	    goto end;
469	}
470	switch (index) {
471	    case SAVE_DEFAULT:
472		break;
473	    case SAVE_FILETYPES:
474		types = Tcl_GetString(objv[i + 1]);
475		if (TkGetFileFilters(interp, &ofd.fl, types, 0) != TCL_OK) {
476		    goto end;
477		}
478		break;
479	    case SAVE_INITDIR:
480		choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
481		/* empty strings should be like no selection given */
482		if (choiceLen && HandleInitialDirectory(interp, NULL, choice,
483			&dirRef, NULL, &initialDesc) != TCL_OK) {
484		    goto end;
485		}
486		break;
487	    case SAVE_INITFILE:
488		initialFile = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
489		/* empty strings should be like no selection given */
490		if (choiceLen == 0) {
491		    initialFile = NULL;
492		}
493		break;
494	    case SAVE_MESSAGE:
495		choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
496		if (message) {
497		    CFRelease(message);
498		}
499		message = CFStringCreateWithBytes(NULL, (unsigned char*)
500			choice, choiceLen, kCFStringEncodingUTF8, false);
501		break;
502	    case SAVE_PARENT:
503		choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
504		parent = Tk_NameToWindow(interp, choice,
505			(Tk_Window) clientData);
506		if (parent == NULL) {
507		    goto end;
508		}
509		break;
510	    case SAVE_TITLE:
511		choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
512		if (title) {
513		    CFRelease(title);
514		}
515		title = CFStringCreateWithBytes(NULL, (unsigned char*)
516			choice, choiceLen, kCFStringEncodingUTF8, false);
517		break;
518	}
519    }
520
521    if (initialDesc.descriptorType == typeFSRef) {
522	initialPtr = &initialDesc;
523    }
524    result = NavServicesGetFile(interp, &ofd, initialPtr, initialFile, NULL,
525	    title, message, NULL, false, SAVE_FILE, parent);
526    TkFreeFileFilters(&ofd.fl);
527end:
528    if (initialDesc.dataHandle) {
529	ChkErr(AEDisposeDesc, &initialDesc);
530    }
531    if (title) {
532	CFRelease(title);
533    }
534    if (message) {
535	CFRelease(message);
536    }
537    return result;
538}
539
540/*
541 *----------------------------------------------------------------------
542 *
543 * Tk_ChooseDirectoryObjCmd --
544 *
545 *	This procedure implements the "tk_chooseDirectory" dialog box
546 *	for the Windows platform. See the user documentation for details
547 *	on what it does.
548 *
549 * Results:
550 *	See user documentation.
551 *
552 * Side effects:
553 *	A modal dialog window is created.
554 *
555 *----------------------------------------------------------------------
556 */
557
558int
559Tk_ChooseDirectoryObjCmd(clientData, interp, objc, objv)
560    ClientData clientData;	/* Main window associated with interpreter. */
561    Tcl_Interp *interp;		/* Current interpreter. */
562    int objc;			/* Number of arguments. */
563    Tcl_Obj *CONST objv[];	/* Argument objects. */
564{
565    int i, result = TCL_ERROR;
566    Tk_Window parent = NULL;
567    AEDesc initialDesc = {typeNull, NULL}, *initialPtr = NULL;
568    FSRef dirRef;
569    CFStringRef message = NULL, title = NULL;
570    OpenFileData ofd;
571    static const char *chooseOptionStrings[] = {
572	"-initialdir", "-message", "-mustexist", "-parent", "-title", NULL
573    };
574    enum chooseOptions {
575	CHOOSE_INITDIR, CHOOSE_MESSAGE, CHOOSE_MUSTEXIST, CHOOSE_PARENT,
576	CHOOSE_TITLE
577    };
578
579    if (!fileDlgInited) {
580	InitFileDialogs();
581    }
582
583    for (i = 1; i < objc; i += 2) {
584	char *choice;
585	int index, choiceLen;
586	char *string;
587
588	if (Tcl_GetIndexFromObj(interp, objv[i], chooseOptionStrings, "option",
589		TCL_EXACT, &index) != TCL_OK) {
590	    goto end;
591	}
592	if (i + 1 == objc) {
593	    string = Tcl_GetString(objv[i]);
594	    Tcl_AppendResult(interp, "value for \"", string, "\" missing",
595		    NULL);
596	    goto end;
597	}
598	switch (index) {
599	    case CHOOSE_INITDIR:
600		choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
601		if (choiceLen && HandleInitialDirectory(interp, NULL, choice,
602			&dirRef, NULL, &initialDesc) != TCL_OK) {
603		    goto end;
604		}
605		break;
606	    case CHOOSE_MESSAGE:
607		choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
608		if (message) {
609		    CFRelease(message);
610		}
611		message = CFStringCreateWithBytes(NULL, (unsigned char*)
612			choice, choiceLen, kCFStringEncodingUTF8, false);
613		break;
614	    case CHOOSE_PARENT:
615		choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
616		parent = Tk_NameToWindow(interp, choice,
617			(Tk_Window) clientData);
618		if (parent == NULL) {
619		    goto end;
620		}
621		break;
622	    case CHOOSE_TITLE:
623		choice = Tcl_GetStringFromObj(objv[i + 1], &choiceLen);
624		if (title) {
625		    CFRelease(title);
626		}
627		title = CFStringCreateWithBytes(NULL, (unsigned char*) choice,
628			choiceLen, kCFStringEncodingUTF8, false);
629		break;
630	}
631    }
632
633    TkInitFileFilters(&ofd.fl);
634    ofd.usePopup = 0;
635    if (initialDesc.descriptorType == typeFSRef) {
636	initialPtr = &initialDesc;
637    }
638    result = NavServicesGetFile(interp, &ofd, initialPtr, NULL, NULL, title,
639	    message, NULL, false, CHOOSE_FOLDER, parent);
640    TkFreeFileFilters(&ofd.fl);
641end:
642    if (initialDesc.dataHandle) {
643	ChkErr(AEDisposeDesc, &initialDesc);
644    }
645    if (title) {
646	CFRelease(title);
647    }
648    if (message) {
649	CFRelease(message);
650    }
651    return result;
652}
653
654/*
655 *----------------------------------------------------------------------
656 *
657 * HandleInitialDirectory --
658 *
659 *	Helper for -initialdir setup.
660 *
661 * Results:
662 *	Tcl result.
663 *
664 * Side effects:
665 *	None.
666 *
667 *----------------------------------------------------------------------
668 */
669
670int
671HandleInitialDirectory(
672    Tcl_Interp *interp,
673    char *initialFile,
674    char *initialDir,
675    FSRef *dirRef,
676    AEDescList *selectDescPtr,
677    AEDesc *dirDescPtr)
678{
679    Tcl_DString ds;
680    OSStatus err;
681    Boolean isDirectory;
682    char *dirName = NULL;
683    int result = TCL_ERROR;
684
685    if (initialDir) {
686	dirName = Tcl_TranslateFileName(interp, initialDir, &ds);
687	if (dirName == NULL) {
688	    goto end;
689	}
690	err = ChkErr(FSPathMakeRef, (unsigned char*) dirName,
691		dirRef, &isDirectory);
692	if (err != noErr) {
693	    Tcl_AppendResult(interp, "bad directory \"", initialDir, "\"",
694		    NULL);
695	    goto end;
696	}
697	if (!isDirectory) {
698	    Tcl_AppendResult(interp, "-intialdir \"",
699		    initialDir, " is a file, not a directory.\"", NULL);
700	    goto end;
701	}
702	ChkErr(AECreateDesc, typeFSRef, dirRef, sizeof(*dirRef), dirDescPtr);
703    }
704
705    if (initialFile && selectDescPtr) {
706	FSRef fileRef;
707	AEDesc fileDesc;
708	char *namePtr;
709
710	if (initialDir) {
711	    Tcl_DStringAppend(&ds, "/", 1);
712	    Tcl_DStringAppend(&ds, initialFile, -1);
713	    namePtr = Tcl_DStringValue(&ds);
714	} else {
715	    namePtr = initialFile;
716	}
717
718	ChkErr(AECreateList, NULL, 0, false, selectDescPtr);
719
720	err = ChkErr(FSPathMakeRef, (unsigned char*) namePtr, &fileRef,
721		&isDirectory);
722	if (err != noErr) {
723	    Tcl_AppendResult(interp, "bad initialfile \"", initialFile,
724		    "\" file does not exist.", NULL);
725	    goto end;
726	}
727	ChkErr(AECreateDesc, typeFSRef, &fileRef, sizeof(fileRef), &fileDesc);
728	ChkErr(AEPutDesc, selectDescPtr, 1, &fileDesc);
729	ChkErr(AEDisposeDesc, &fileDesc);
730    }
731    result = TCL_OK;
732end:
733    if (dirName) {
734	Tcl_DStringFree(&ds);
735    }
736    return result;
737}
738
739/*
740 *----------------------------------------------------------------------
741 *
742 * InitFileDialogs --
743 *
744 *	Initialize file dialog subsystem.
745 *
746 * Results:
747 *	None.
748 *
749 * Side effects:
750 *	None.
751 *
752 *----------------------------------------------------------------------
753 */
754
755void
756InitFileDialogs(void)
757{
758    fileDlgInited = 1;
759    openFileFilterUPP = NewNavObjectFilterUPP(OpenFileFilterProc);
760    openFileEventUPP = NewNavEventUPP(OpenEventProc);
761}
762
763/*
764 *----------------------------------------------------------------------
765 *
766 * NavServicesGetFile --
767 *
768 *	Common wrapper for NavServices API.
769 *
770 * Results:
771 *	Tcl result.
772 *
773 * Side effects:
774 *	None.
775 *
776 *----------------------------------------------------------------------
777 */
778
779int
780NavServicesGetFile(
781    Tcl_Interp *interp,
782    OpenFileData *ofdPtr,
783    AEDesc *initialDescPtr,
784    char *initialFile,
785    AEDescList *selectDescPtr,
786    CFStringRef title,
787    CFStringRef message,
788    const char *initialtype,
789    int multiple,
790    int isOpen,
791    Tk_Window parent)
792{
793    NavHandlerUserData data;
794    NavDialogCreationOptions options;
795    NavDialogRef dialogRef = NULL;
796    CFStringRef * menuItemNames = NULL;
797    OSStatus err;
798    Tcl_Obj *theResult = NULL;
799    int result = TCL_ERROR;
800
801    bzero(&data, sizeof(data));
802    err = NavGetDefaultDialogCreationOptions(&options);
803    if (err != noErr) {
804	return result;
805    }
806    options.optionFlags = kNavDontAutoTranslate | kNavDontAddTranslateItems
807	    | kNavSupportPackages | kNavAllFilesInPopup;
808    if (multiple) {
809	options.optionFlags |= kNavAllowMultipleFiles;
810    }
811    options.modality = kWindowModalityAppModal;
812    if (parent && ((TkWindow*)parent)->window != None &&
813	    TkMacOSXHostToplevelExists(parent)) {
814	options.parentWindow = TkMacOSXDrawableWindow(Tk_WindowId(parent));
815	TK_IF_HI_TOOLBOX (5,
816	    /*
817	     * Impossible to modify dialog modality with the Cocoa-based
818	     * NavServices implementation.
819	     */
820	) TK_ELSE_HI_TOOLBOX (5,
821	    if (options.parentWindow) {
822		options.modality = kWindowModalityWindowModal;
823		data.sheet = 1;
824	    }
825	) TK_ENDIF
826    }
827
828    /*
829     * Now process the selection list. We have to use the popupExtension
830     * to fill the menu.
831     */
832    if (ofdPtr && ofdPtr->usePopup) {
833	FileFilter *filterPtr;
834
835	filterPtr = ofdPtr->fl.filters;
836	if (filterPtr == NULL) {
837	    ofdPtr->usePopup = 0;
838	}
839    }
840    if (ofdPtr && ofdPtr->usePopup) {
841	FileFilter *filterPtr;
842	int index = 0;
843	ofdPtr->curType = 0;
844
845	menuItemNames = (CFStringRef *) ckalloc(ofdPtr->fl.numFilters
846	    * sizeof(CFStringRef));
847
848	for (filterPtr = ofdPtr->fl.filters; filterPtr != NULL;
849		filterPtr = filterPtr->next, index++) {
850	    menuItemNames[index] = CFStringCreateWithCString(NULL,
851		    filterPtr->name, kCFStringEncodingUTF8);
852	    if (initialtype && strcmp(filterPtr->name, initialtype) == 0) {
853		ofdPtr->initialType = index;
854	    }
855	}
856	options.popupExtension = CFArrayCreate(NULL,
857		(const void **) menuItemNames, ofdPtr->fl.numFilters, NULL);
858    } else {
859	options.optionFlags |= kNavNoTypePopup;
860	options.popupExtension = NULL;
861    }
862    options.clientName = CFSTR("Wish");
863    options.message = message;
864    options.windowTitle = title;
865    if (initialFile) {
866	options.saveFileName = CFStringCreateWithCString(NULL,
867		initialFile, kCFStringEncodingUTF8);
868    } else {
869	options.saveFileName = NULL;
870    }
871    if (isOpen == OPEN_FILE) {
872	data.ofdPtr = ofdPtr;
873	err = ChkErr(NavCreateGetFileDialog, &options, NULL,
874		openFileEventUPP, NULL, openFileFilterUPP, &data, &dialogRef);
875    } else if (isOpen == SAVE_FILE) {
876	err = ChkErr(NavCreatePutFileDialog, &options, 'TEXT', 'WIsH',
877		openFileEventUPP, &data, &dialogRef);
878    } else if (isOpen == CHOOSE_FOLDER) {
879	err = ChkErr(NavCreateChooseFolderDialog, &options,
880		openFileEventUPP, openFileFilterUPP, &data, &dialogRef);
881    }
882    if (err == noErr && dialogRef) {
883	if (initialDescPtr) {
884	    ChkErr(NavCustomControl, dialogRef, kNavCtlSetLocation,
885		initialDescPtr);
886	}
887	if (selectDescPtr && selectDescPtr->descriptorType != typeNull) {
888	    ChkErr(NavCustomControl, dialogRef, kNavCtlSetSelection,
889		    selectDescPtr);
890	}
891	TkMacOSXTrackingLoop(1);
892	err = ChkErr(NavDialogRun, dialogRef);
893	if (err == noErr) {
894	    if (data.sheet) {
895		data.dialogWindow = NavDialogGetWindow(dialogRef);
896		ChkErr(GetWindowModality, data.dialogWindow,
897			&data.origModality, &data.origUnavailWindow);
898		ChkErr(SetWindowModality, data.dialogWindow,
899			kWindowModalityAppModal, NULL);
900		ChkErr(RunAppModalLoopForWindow, data.dialogWindow);
901	    }
902	    err = data.err;
903	}
904	TkMacOSXTrackingLoop(0);
905    }
906
907    /*
908     * Most commands assume that the file dialogs return a single
909     * item, not a list. So only build a list if multiple is true...
910     */
911    if (err == noErr) {
912	if (multiple) {
913	    theResult = Tcl_NewListObj(0, NULL);
914	} else {
915	    theResult = Tcl_NewObj();
916	}
917	if (!theResult) {
918	    err = memFullErr;
919	}
920    }
921    if (err == noErr && data.reply.validRecord) {
922	AEDesc resultDesc;
923	long count;
924	FSRef fsRef;
925	char pathPtr[PATH_MAX + 1];
926
927	err = ChkErr(AECountItems, &data.reply.selection, &count);
928	if (err == noErr) {
929	    long i;
930
931	    for (i = 1; i <= count; i++) {
932		err = ChkErr(AEGetNthDesc, &data.reply.selection, i,
933			typeFSRef, NULL, &resultDesc);
934		if (err == noErr) {
935		    err = ChkErr(AEGetDescData, &resultDesc, &fsRef,
936			    sizeof(fsRef));
937		    if (err == noErr) {
938			err = ChkErr(FSRefMakePath, &fsRef, (unsigned char*)
939				pathPtr, PATH_MAX + 1);
940			if (err == noErr) {
941			    int pathValid = 0;
942
943			    if (isOpen == SAVE_FILE) {
944				if (data.saveNameRef) {
945				    char saveName [PATH_MAX + 1];
946
947				    if (CFStringGetCString(data.saveNameRef,
948					    saveName, PATH_MAX + 1,
949					    kCFStringEncodingUTF8)) {
950					if (strlen(pathPtr) + strlen(saveName)
951						< PATH_MAX) {
952					    strcat(pathPtr, "/");
953					    strcat(pathPtr, saveName);
954					    pathValid = 1;
955					} else {
956					    TkMacOSXDbgMsg("Path name too "
957						    "long");
958					}
959				    } else {
960					TkMacOSXDbgMsg("CFStringGetCString "
961						"failed");
962				    }
963				} else {
964				    TkMacOSXDbgMsg("NavDialogGetSaveFileName "
965					    "failed");
966				}
967			    } else {
968				pathValid = 1;
969			    }
970			    if (pathValid) {
971				if (multiple) {
972				    Tcl_ListObjAppendElement(interp, theResult,
973					Tcl_NewStringObj(pathPtr, -1));
974				} else {
975				    Tcl_SetStringObj(theResult, pathPtr, -1);
976				}
977			    }
978			}
979		    }
980		    ChkErr(AEDisposeDesc, &resultDesc);
981		}
982	    }
983	}
984	Tcl_SetObjResult(interp, theResult);
985	result = TCL_OK;
986    } else if (err == userCanceledErr) {
987	Tcl_ResetResult(interp);
988	result = TCL_OK;
989    }
990
991    /*
992     * Clean up any allocated memory.
993     */
994
995    if (data.reply.validRecord) {
996	ChkErr(NavDisposeReply, &data.reply);
997    }
998    if (data.saveNameRef) {
999	CFRelease(data.saveNameRef);
1000    }
1001    if (options.saveFileName) {
1002	CFRelease(options.saveFileName);
1003    }
1004    if (options.clientName) {
1005	CFRelease(options.clientName);
1006    }
1007    if (menuItemNames) {
1008	int i;
1009	for (i = 0; i < ofdPtr->fl.numFilters; i++) {
1010	    CFRelease(menuItemNames[i]);
1011	}
1012	ckfree((void *)menuItemNames);
1013    }
1014    if (options.popupExtension) {
1015	CFRelease(options.popupExtension);
1016    }
1017    return result;
1018}
1019
1020/*
1021 *----------------------------------------------------------------------
1022 *
1023 * OpenEventProc --
1024 *
1025 *	NavServices event handling callback.
1026 *
1027 * Results:
1028 *	None.
1029 *
1030 * Side effects:
1031 *	None.
1032 *
1033 *----------------------------------------------------------------------
1034 */
1035
1036pascal void
1037OpenEventProc(
1038    NavEventCallbackMessage callBackSelector,
1039    NavCBRecPtr callBackParams,
1040    NavCallBackUserData callBackUD)
1041{
1042    NavHandlerUserData *data = (NavHandlerUserData*) callBackUD;
1043    OpenFileData *ofd = data->ofdPtr;
1044
1045    switch (callBackSelector) {
1046	case kNavCBStart:
1047	    if (ofd && ofd->initialType >= 0) {
1048		/* Select initial filter */
1049		FileFilter *filterPtr = ofd->fl.filters;
1050		int i = ofd->initialType;
1051
1052		while (filterPtr && i-- > 0) {
1053		    filterPtr = filterPtr->next;
1054		}
1055		if (filterPtr) {
1056		    NavMenuItemSpec selectItem;
1057
1058		    selectItem.version = kNavMenuItemSpecVersion;
1059		    selectItem.menuCreator = 0;
1060		    selectItem.menuType = ofd->initialType;
1061		    selectItem.menuItemName[0] = strlen(filterPtr->name);
1062		    strncpy((char*) &selectItem.menuItemName[1],
1063			    filterPtr->name, 255);
1064		    ChkErr(NavCustomControl, callBackParams->context,
1065			    kNavCtlSelectCustomType, &selectItem);
1066		}
1067	    }
1068	    break;
1069	case kNavCBPopupMenuSelect:
1070	    ofd->curType = ((NavMenuItemSpec *)
1071		    callBackParams->eventData.eventDataParms.param)->menuType;
1072	    break;
1073	case kNavCBAccept:
1074	case kNavCBCancel:
1075	    if (data->sheet) {
1076		ChkErr(QuitAppModalLoopForWindow, data->dialogWindow);
1077		ChkErr(SetWindowModality, data->dialogWindow,
1078			data->origModality, data->origUnavailWindow);
1079	    }
1080	    break;
1081	case kNavCBUserAction:
1082	    if (data->reply.validRecord) {
1083		ChkErr(NavDisposeReply, &data->reply);
1084		data->reply.validRecord = 0;
1085	    }
1086	    data->err = NavDialogGetReply(callBackParams->context,
1087		    &data->reply);
1088	    if (callBackParams->userAction == kNavUserActionSaveAs) {
1089		data->saveNameRef = NavDialogGetSaveFileName(
1090			callBackParams->context);
1091		if (data->saveNameRef) {
1092		    CFRetain(data->saveNameRef);
1093		}
1094	    }
1095	    break;
1096	case kNavCBTerminate:
1097	    NavDialogDispose(callBackParams->context);
1098	    break;
1099	case kNavCBEvent:
1100	    TkMacOSXRunTclEventLoop();
1101	    break;
1102    }
1103}
1104
1105/*
1106 *----------------------------------------------------------------------
1107 *
1108 * OpenFileFilterProc --
1109 *
1110 *	NavServices file filter callback.
1111 *
1112 * Results:
1113 *	Whether to use the file in question.
1114 *
1115 * Side effects:
1116 *	None.
1117 *
1118 *----------------------------------------------------------------------
1119 */
1120
1121pascal Boolean
1122OpenFileFilterProc(
1123    AEDesc* theItem, void* info,
1124    NavCallBackUserData callBackUD,
1125    NavFilterModes filterMode)
1126{
1127    OpenFileData *ofdPtr = ((NavHandlerUserData*) callBackUD)->ofdPtr;
1128    int result = MATCHED;
1129
1130    if (ofdPtr && ofdPtr->usePopup) {
1131	if (ofdPtr->fl.numFilters > 0) {
1132	    if ((theItem->descriptorType == typeFSS)
1133		    || (theItem->descriptorType == typeFSRef)) {
1134		NavFileOrFolderInfo* theInfo = (NavFileOrFolderInfo *) info;
1135		char fileName[256];
1136
1137		if (!theInfo->isFolder) {
1138		    OSType fileType;
1139		    StringPtr fileNamePtr = NULL;
1140		    Tcl_DString fileNameDString;
1141		    int i;
1142		    FileFilter *filterPtr;
1143
1144		    fileType =
1145			    theInfo->fileAndFolder.fileInfo.finderInfo.fdType;
1146		    Tcl_DStringInit (&fileNameDString);
1147
1148		    if (theItem->descriptorType == typeFSS) {
1149			int len;
1150			fileNamePtr = ((FSSpec *) *theItem->dataHandle)->name;
1151			len = fileNamePtr[0];
1152			strncpy(fileName, (char*) fileNamePtr + 1, len);
1153			fileName[len] = '\0';
1154			fileNamePtr = (unsigned char*) fileName;
1155		    } else if ((theItem->descriptorType == typeFSRef)) {
1156			OSStatus err;
1157			FSRef *theRef = (FSRef *) *theItem->dataHandle;
1158			HFSUniStr255 uniFileName;
1159			err = ChkErr(FSGetCatalogInfo, theRef, kFSCatInfoNone,
1160				NULL, &uniFileName, NULL, NULL);
1161
1162			if (err == noErr) {
1163			    Tcl_UniCharToUtfDString (
1164				    (Tcl_UniChar *) uniFileName.unicode,
1165				    uniFileName.length, &fileNameDString);
1166			    fileNamePtr = (unsigned char*)
1167				    Tcl_DStringValue(&fileNameDString);
1168			}
1169		    }
1170		    if (ofdPtr->usePopup) {
1171			i = ofdPtr->curType;
1172			for (filterPtr = ofdPtr->fl.filters;
1173				filterPtr && i > 0; i--) {
1174			    filterPtr = filterPtr->next;
1175			}
1176			if (filterPtr) {
1177			    result = MatchOneType(fileNamePtr, fileType,
1178				    ofdPtr, filterPtr);
1179			} else {
1180			    result = UNMATCHED;
1181			}
1182		    } else {
1183			/*
1184			 * We are not using the popup menu. In this case, the
1185			 * file is considered matched if it matches any of
1186			 * the file filters.
1187			 */
1188
1189			result = UNMATCHED;
1190			for (filterPtr = ofdPtr->fl.filters; filterPtr;
1191				filterPtr = filterPtr->next) {
1192			    if (MatchOneType(fileNamePtr, fileType,
1193				    ofdPtr, filterPtr) == MATCHED) {
1194				result = MATCHED;
1195				break;
1196			    }
1197			}
1198		    }
1199		    Tcl_DStringFree (&fileNameDString);
1200		}
1201	    }
1202	}
1203    }
1204    return (result == MATCHED);
1205}
1206
1207/*
1208 *----------------------------------------------------------------------
1209 *
1210 * MatchOneType --
1211 *
1212 *	Match a file with one file type in the list of file types.
1213 *
1214 * Results:
1215 *	Returns MATCHED if the file matches with the file type; returns
1216 *	UNMATCHED otherwise.
1217 *
1218 * Side effects:
1219 *	None
1220 *
1221 *----------------------------------------------------------------------
1222 */
1223
1224Boolean
1225MatchOneType(
1226    StringPtr fileNamePtr,	/* Name of the file */
1227    OSType fileType,		/* Type of the file, 0 means there was no
1228				 * specified type. */
1229    OpenFileData *ofdPtr,	/* Information about this file dialog */
1230    FileFilter *filterPtr)	/* Match the file described by pb against this
1231				 * filter */
1232{
1233    FileFilterClause *clausePtr;
1234
1235    /*
1236     * A file matches with a file type if it matches with at least one
1237     * clause of the type.
1238     *
1239     * If the clause has both glob patterns and ostypes, the file must
1240     * match with at least one pattern AND at least one ostype.
1241     *
1242     * If the clause has glob patterns only, the file must match with at least
1243     * one pattern.
1244     *
1245     * If the clause has mac types only, the file must match with at least
1246     * one mac type.
1247     *
1248     * If the clause has neither glob patterns nor mac types, it's
1249     * considered an error.
1250     */
1251
1252    for (clausePtr = filterPtr->clauses; clausePtr;
1253	    clausePtr = clausePtr->next) {
1254	int macMatched = 0;
1255	int globMatched = 0;
1256	GlobPattern *globPtr;
1257	MacFileType *mfPtr;
1258
1259	if (clausePtr->patterns == NULL) {
1260	    globMatched = 1;
1261	}
1262	if (clausePtr->macTypes == NULL) {
1263	    macMatched = 1;
1264	}
1265
1266	for (globPtr = clausePtr->patterns; globPtr;
1267		globPtr = globPtr->next) {
1268	    char *q, *ext;
1269
1270	    if (fileNamePtr == NULL) {
1271		continue;
1272	    }
1273	    ext = globPtr->pattern;
1274
1275	    if (ext[0] == '\0') {
1276		/*
1277		 * We don't want any extensions: OK if the filename doesn't
1278		 * have "." in it
1279		 */
1280
1281		for (q = (char*) fileNamePtr; *q; q++) {
1282		    if (*q == '.') {
1283			goto glob_unmatched;
1284		    }
1285		}
1286		goto glob_matched;
1287	    }
1288
1289	    if (Tcl_StringMatch((char*) fileNamePtr, ext)) {
1290		goto glob_matched;
1291	    } else {
1292		goto glob_unmatched;
1293	    }
1294
1295	glob_unmatched:
1296	    continue;
1297
1298	glob_matched:
1299	    globMatched = 1;
1300	    break;
1301	}
1302
1303	for (mfPtr = clausePtr->macTypes; mfPtr; mfPtr = mfPtr->next) {
1304	    if (fileType == mfPtr->type) {
1305		macMatched = 1;
1306		break;
1307	    }
1308	}
1309
1310	/*
1311	 * On Mac OS X, it is not uncommon for files to have NO
1312	 * file type. But folks with Tcl code on Classic MacOS pretty
1313	 * much assume that a generic file will have type TEXT. So
1314	 * if we were strict about matching types when the source file
1315	 * had NO type set, they would have to add another rule always
1316	 * with no fileType. To avoid that, we pass the macMatch side
1317	 * of the test if no fileType is set.
1318	 */
1319
1320	if (globMatched && (macMatched || (fileType == 0))) {
1321	    return MATCHED;
1322	}
1323    }
1324
1325    return UNMATCHED;
1326}
1327
1328/*
1329 *----------------------------------------------------------------------
1330 *
1331 * TkAboutDlg --
1332 *
1333 *	Displays the default Tk About box. This code uses Macintosh
1334 *	resources to define the content of the About Box.
1335 *
1336 * Results:
1337 *	None.
1338 *
1339 * Side effects:
1340 *	None.
1341 *
1342 *----------------------------------------------------------------------
1343 */
1344
1345void
1346TkAboutDlg(void)
1347{
1348    DialogPtr aboutDlog;
1349    WindowRef windowRef;
1350    short itemHit = -9;
1351
1352    aboutDlog = GetNewDialog(TK_DEFAULT_ABOUT, NULL, (void *) (-1));
1353    if (!aboutDlog) {
1354	return;
1355    }
1356    windowRef = GetDialogWindow(aboutDlog);
1357    SelectWindow(windowRef);
1358    TkMacOSXTrackingLoop(1);
1359    while (itemHit != 1) {
1360	ModalDialog(NULL, &itemHit);
1361    }
1362    TkMacOSXTrackingLoop(0);
1363    DisposeDialog(aboutDlog);
1364    SelectWindow(ActiveNonFloatingWindow());
1365}
1366
1367/*
1368 *----------------------------------------------------------------------
1369 *
1370 * Tk_MessageBoxObjCmd --
1371 *
1372 *	Implements the tk_messageBox in native Mac OS X style.
1373 *
1374 * Results:
1375 *	A standard Tcl result.
1376 *
1377 * Side effects:
1378 *	none
1379 *
1380 *----------------------------------------------------------------------
1381 */
1382
1383int
1384Tk_MessageBoxObjCmd(
1385    ClientData clientData,	/* Main window associated with interpreter. */
1386    Tcl_Interp *interp,		/* Current interpreter. */
1387    int objc,			/* Number of arguments. */
1388    Tcl_Obj *CONST objv[])	/* Argument objects. */
1389{
1390    Tk_Window tkwin = (Tk_Window) clientData;
1391    AlertStdCFStringAlertParamRec paramCFStringRec;
1392    AlertType alertType;
1393    DialogRef dialogRef;
1394    CFStringRef messageTextCF = NULL, finemessageTextCF = NULL;
1395    OSStatus err;
1396    SInt16 itemHit;
1397    Boolean haveDefaultOption = false, haveParentOption = false;
1398    char *str;
1399    int index, defaultButtonIndex;
1400    int defaultNativeButtonIndex; /* 1, 2, 3: right to left */
1401    int typeIndex, i, indexDefaultOption = 0, result = TCL_ERROR;
1402
1403    static const char *movableAlertStrings[] = {
1404	"-default",/* "-detail",*/ "-icon", "-message", "-parent", "-title",
1405	"-type", NULL
1406    };
1407    static const char *movableTypeStrings[] = {
1408	"abortretryignore", "ok", "okcancel", "retrycancel", "yesno",
1409	"yesnocancel", NULL
1410    };
1411    static const char *movableButtonStrings[] = {
1412	"abort", "retry", "ignore", "ok", "cancel", "yes", "no", NULL
1413    };
1414    static const char *movableIconStrings[] = {
1415	"error", "info", "question", "warning", NULL
1416    };
1417    enum movableAlertOptions {
1418	ALERT_DEFAULT,/* ALERT_DETAIL,*/ ALERT_ICON, ALERT_MESSAGE, ALERT_PARENT,
1419	ALERT_TITLE, ALERT_TYPE
1420    };
1421    enum movableTypeOptions {
1422	TYPE_ABORTRETRYIGNORE, TYPE_OK, TYPE_OKCANCEL, TYPE_RETRYCANCEL,
1423	TYPE_YESNO, TYPE_YESNOCANCEL
1424    };
1425    enum movableButtonOptions {
1426	TEXT_ABORT, TEXT_RETRY, TEXT_IGNORE, TEXT_OK, TEXT_CANCEL, TEXT_YES,
1427	TEXT_NO
1428    };
1429    enum movableIconOptions {
1430	ICON_ERROR, ICON_INFO, ICON_QUESTION, ICON_WARNING
1431    };
1432
1433    /*
1434     * Need to map from 'movableButtonStrings' and its corresponding integer,
1435     * index to the native button index, which is 1, 2, 3, from right to left.
1436     * This is necessary to do for each separate '-type' of button sets.
1437     */
1438
1439    short buttonIndexAndTypeToNativeButtonIndex[][7] = {
1440    /*	abort retry ignore ok	cancel yes   no */
1441	{1,    2,    3,	   0,	 0,    0,    0},	/* abortretryignore */
1442	{0,    0,    0,	   1,	 0,    0,    0},	/* ok */
1443	{0,    0,    0,	   1,	 2,    0,    0},	/* okcancel */
1444	{0,    1,    0,	   0,	 2,    0,    0},	/* retrycancel */
1445	{0,    0,    0,	   0,	 0,    1,    2},	/* yesno */
1446	{0,    0,    0,	   0,	 3,    1,    2},	/* yesnocancel */
1447    };
1448
1449    /*
1450     * Need also the inverse mapping, from native button (1, 2, 3) to the
1451     * descriptive button text string index.
1452     */
1453
1454    short nativeButtonIndexAndTypeToButtonIndex[][4] = {
1455	{-1, 0, 1, 2},	/* abortretryignore */
1456	{-1, 3, 0, 0},	/* ok */
1457	{-1, 3, 4, 0},	/* okcancel */
1458	{-1, 1, 4, 0},	/* retrycancel */
1459	{-1, 5, 6, 0},	/* yesno */
1460	{-1, 5, 6, 4},	/* yesnocancel */
1461    };
1462
1463    alertType = kAlertPlainAlert;
1464    typeIndex = TYPE_OK;
1465
1466    ChkErr(GetStandardAlertDefaultParams, &paramCFStringRec,
1467	    kStdCFStringAlertVersionOne);
1468    paramCFStringRec.movable = true;
1469    paramCFStringRec.helpButton = false;
1470    paramCFStringRec.defaultButton = kAlertStdAlertOKButton;
1471    paramCFStringRec.cancelButton = kAlertStdAlertCancelButton;
1472
1473    for (i = 1; i < objc; i += 2) {
1474	int iconIndex;
1475	char *string;
1476
1477	if (Tcl_GetIndexFromObj(interp, objv[i], movableAlertStrings, "option",
1478		TCL_EXACT, &index) != TCL_OK) {
1479	    goto end;
1480	}
1481	if (i + 1 == objc) {
1482	    string = Tcl_GetString(objv[i]);
1483	    Tcl_AppendResult(interp, "value for \"", string, "\" missing",
1484		    NULL);
1485	    goto end;
1486	}
1487
1488	switch (index) {
1489	    case ALERT_DEFAULT:
1490		/*
1491		 * Need to postpone processing of this option until we are
1492		 * sure to know the '-type' as well.
1493		 */
1494		haveDefaultOption = true;
1495		indexDefaultOption = i;
1496		break;
1497
1498#if 0
1499	    case ALERT_DETAIL:
1500		str = Tcl_GetString(objv[i + 1]);
1501		if (finemessageTextCF) {
1502		    CFRelease(finemessageTextCF);
1503		}
1504		finemessageTextCF = CFStringCreateWithCString(NULL, str,
1505			kCFStringEncodingUTF8);
1506		break;
1507#endif
1508
1509	    case ALERT_ICON:
1510		if (Tcl_GetIndexFromObj(interp, objv[i + 1],
1511			movableIconStrings, "value", TCL_EXACT, &iconIndex)
1512			!= TCL_OK) {
1513		    goto end;
1514		}
1515		switch (iconIndex) {
1516		    case ICON_ERROR:
1517			alertType = kAlertStopAlert;
1518			break;
1519		    case ICON_INFO:
1520			alertType = kAlertNoteAlert;
1521			break;
1522		    case ICON_QUESTION:
1523			alertType = kAlertCautionAlert;
1524			break;
1525		    case ICON_WARNING:
1526			alertType = kAlertCautionAlert;
1527			break;
1528		}
1529		break;
1530
1531	    case ALERT_MESSAGE:
1532		str = Tcl_GetString(objv[i + 1]);
1533		if (messageTextCF) {
1534		    CFRelease(messageTextCF);
1535		}
1536		messageTextCF = CFStringCreateWithCString(NULL, str,
1537			kCFStringEncodingUTF8);
1538		break;
1539
1540	    case ALERT_PARENT:
1541		str = Tcl_GetString(objv[i + 1]);
1542		tkwin = Tk_NameToWindow(interp, str, tkwin);
1543		if (tkwin == NULL) {
1544		    goto end;
1545		}
1546		if (((TkWindow*)tkwin)->window != None &&
1547			TkMacOSXHostToplevelExists(tkwin)) {
1548		    haveParentOption = true;
1549		}
1550		break;
1551
1552	    case ALERT_TITLE:
1553		break;
1554
1555	    case ALERT_TYPE:
1556		if (Tcl_GetIndexFromObj(interp, objv[i + 1],\
1557			movableTypeStrings, "value", TCL_EXACT, &typeIndex)
1558			!= TCL_OK) {
1559		    goto end;
1560		}
1561		switch (typeIndex) {
1562		    case TYPE_ABORTRETRYIGNORE:
1563			paramCFStringRec.defaultText = CFSTR("Abort");
1564			paramCFStringRec.cancelText = CFSTR("Retry");
1565			paramCFStringRec.otherText = CFSTR("Ignore");
1566			paramCFStringRec.cancelButton =
1567				kAlertStdAlertOtherButton;
1568			break;
1569		    case TYPE_OK:
1570			paramCFStringRec.defaultText = CFSTR("OK");
1571			break;
1572		    case TYPE_OKCANCEL:
1573			paramCFStringRec.defaultText = CFSTR("OK");
1574			paramCFStringRec.cancelText = CFSTR("Cancel");
1575			break;
1576		    case TYPE_RETRYCANCEL:
1577			paramCFStringRec.defaultText = CFSTR("Retry");
1578			paramCFStringRec.cancelText = CFSTR("Cancel");
1579			break;
1580		    case TYPE_YESNO:
1581			paramCFStringRec.defaultText = CFSTR("Yes");
1582			paramCFStringRec.cancelText = CFSTR("No");
1583			break;
1584		    case TYPE_YESNOCANCEL:
1585			paramCFStringRec.defaultText = CFSTR("Yes");
1586			paramCFStringRec.cancelText = CFSTR("No");
1587			paramCFStringRec.otherText = CFSTR("Cancel");
1588			paramCFStringRec.cancelButton =
1589				kAlertStdAlertOtherButton;
1590			break;
1591		}
1592		break;
1593	}
1594    }
1595
1596    if (haveDefaultOption) {
1597
1598	/*
1599	 * Any '-default' option needs to know the '-type' option, which is why
1600	 * we do this here.
1601	 */
1602
1603	str = Tcl_GetString(objv[indexDefaultOption + 1]);
1604	if (Tcl_GetIndexFromObj(interp, objv[indexDefaultOption + 1],
1605		movableButtonStrings, "value", TCL_EXACT, &defaultButtonIndex)
1606		!= TCL_OK) {
1607	    goto end;
1608	}
1609
1610	/*
1611	 * Need to map from "ok" etc. to 1, 2, 3, right to left.
1612	 */
1613
1614	defaultNativeButtonIndex =
1615	buttonIndexAndTypeToNativeButtonIndex[typeIndex][defaultButtonIndex];
1616	if (defaultNativeButtonIndex == 0) {
1617	    Tcl_SetObjResult(interp,
1618		    Tcl_NewStringObj("Illegal default option", -1));
1619	    goto end;
1620	}
1621	paramCFStringRec.defaultButton = defaultNativeButtonIndex;
1622	if (paramCFStringRec.cancelButton == defaultNativeButtonIndex) {
1623	    paramCFStringRec.cancelButton = 0;
1624	}
1625    }
1626    ChkErr(SetThemeCursor, kThemeArrowCursor);
1627
1628    if (haveParentOption) {
1629	AlertHandlerUserData data;
1630	static EventHandlerUPP handler = NULL;
1631	WindowRef windowRef;
1632	const EventTypeSpec kEvents[] = {
1633	    {kEventClassCommand, kEventProcessCommand}
1634	};
1635
1636	bzero(&data, sizeof(data));
1637	if (!handler) {
1638	    handler = NewEventHandlerUPP(AlertHandler);
1639	}
1640	windowRef = TkMacOSXDrawableWindow(Tk_WindowId(tkwin));
1641	if (!windowRef) {
1642	    goto end;
1643	}
1644	err = ChkErr(CreateStandardSheet, alertType, messageTextCF,
1645		finemessageTextCF, &paramCFStringRec, NULL, &dialogRef);
1646	if(err != noErr) {
1647	    goto end;
1648	}
1649	data.dialogWindow = GetDialogWindow(dialogRef);
1650	err = ChkErr(ShowSheetWindow, data.dialogWindow, windowRef);
1651	if(err != noErr) {
1652	    DisposeDialog(dialogRef);
1653	    goto end;
1654	}
1655	ChkErr(GetWindowModality, data.dialogWindow, &data.origModality,
1656		&data.origUnavailWindow);
1657	ChkErr(SetWindowModality, data.dialogWindow, kWindowModalityAppModal,
1658		NULL);
1659	ChkErr(InstallEventHandler, GetWindowEventTarget(data.dialogWindow),
1660		handler, GetEventTypeCount(kEvents), kEvents, &data,
1661		&data.handlerRef);
1662	TkMacOSXTrackingLoop(1);
1663	ChkErr(RunAppModalLoopForWindow, data.dialogWindow);
1664	TkMacOSXTrackingLoop(0);
1665	itemHit = data.buttonIndex;
1666    } else {
1667	err = ChkErr(CreateStandardAlert, alertType, messageTextCF,
1668		finemessageTextCF, &paramCFStringRec, &dialogRef);
1669	if(err != noErr) {
1670	    goto end;
1671	}
1672	TkMacOSXTrackingLoop(1);
1673	err = ChkErr(RunStandardAlert, dialogRef, NULL, &itemHit);
1674	TkMacOSXTrackingLoop(0);
1675	if (err != noErr) {
1676	    goto end;
1677	}
1678    }
1679    if (err == noErr) {
1680	int ind;
1681
1682	/*
1683	 * Map 'itemHit' (1, 2, 3) to descriptive text string.
1684	 */
1685
1686	ind = nativeButtonIndexAndTypeToButtonIndex[typeIndex][itemHit];
1687	Tcl_SetObjResult(interp, Tcl_NewStringObj(movableButtonStrings[ind],
1688		-1));
1689	result = TCL_OK;
1690    }
1691
1692end:
1693    if (finemessageTextCF) {
1694	CFRelease(finemessageTextCF);
1695    }
1696    if (messageTextCF) {
1697	CFRelease(messageTextCF);
1698    }
1699    return result;
1700}
1701
1702/*
1703 *----------------------------------------------------------------------
1704 *
1705 * AlertHandler --
1706 *
1707 *	Carbon event handler for the Standard Sheet dialog.
1708 *
1709 * Results:
1710 *	OSStatus if event handled or not.
1711 *
1712 * Side effects:
1713 *	May set userData.
1714 *
1715 *----------------------------------------------------------------------
1716 */
1717
1718OSStatus
1719AlertHandler(
1720    EventHandlerCallRef callRef,
1721    EventRef eventRef,
1722    void *userData)
1723{
1724    AlertHandlerUserData *data = (AlertHandlerUserData *) userData;
1725    HICommand cmd;
1726
1727    ChkErr(GetEventParameter,eventRef, kEventParamDirectObject, typeHICommand,
1728	    NULL, sizeof(cmd), NULL, &cmd);
1729    switch (cmd.commandID) {
1730	case kHICommandOK:
1731	    data->buttonIndex = 1;
1732	    break;
1733	case kHICommandCancel:
1734	    data->buttonIndex = 2;
1735	    break;
1736	case kHICommandOther:
1737	    data->buttonIndex = 3;
1738	    break;
1739    }
1740    if (data->buttonIndex) {
1741	ChkErr(QuitAppModalLoopForWindow, data->dialogWindow);
1742	ChkErr(RemoveEventHandler, data->handlerRef);
1743	ChkErr(SetWindowModality, data->dialogWindow,
1744		data->origModality, data->origUnavailWindow);
1745    }
1746    return eventNotHandledErr;
1747}
1748