1/*
2 * tkMacOSXHLEvents.c --
3 *
4 *	Implements high level event support for the Macintosh. Currently, the
5 *	only event that really does anything is the Quit event.
6 *
7 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
8 * Copyright 2001-2009, Apple Inc.
9 * Copyright (c) 2006-2009 Daniel A. Steffen <das@users.sourceforge.net>
10 *
11 * See the file "license.terms" for information on usage and redistribution
12 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13 *
14 * RCS: @(#) $Id$
15 */
16
17#include "tkMacOSXPrivate.h"
18
19/*
20 * This is a Tcl_Event structure that the Quit AppleEvent handler uses to
21 * schedule the ReallyKillMe function.
22 */
23
24typedef struct KillEvent {
25    Tcl_Event header;		/* Information that is standard for all
26				 * events. */
27    Tcl_Interp *interp;		/* Interp that was passed to the Quit
28				 * AppleEvent */
29} KillEvent;
30
31/*
32 * Static functions used only in this file.
33 */
34
35static OSErr		QuitHandler(const AppleEvent *event,
36			    AppleEvent *reply, SRefCon handlerRefcon);
37static OSErr		OappHandler(const AppleEvent *event,
38			    AppleEvent *reply, SRefCon handlerRefcon);
39static OSErr		RappHandler(const AppleEvent *event,
40			    AppleEvent *reply, SRefCon handlerRefcon);
41static OSErr		OdocHandler(const AppleEvent *event,
42			    AppleEvent *reply, SRefCon handlerRefcon);
43static OSErr		PrintHandler(const AppleEvent *event,
44			    AppleEvent *reply, SRefCon handlerRefcon);
45static OSErr		ScriptHandler(const AppleEvent *event,
46			    AppleEvent *reply, SRefCon handlerRefcon);
47static OSErr		PrefsHandler(const AppleEvent *event,
48			    AppleEvent *reply, SRefCon handlerRefcon);
49static int		MissedAnyParameters(const AppleEvent *theEvent);
50static int		ReallyKillMe(Tcl_Event *eventPtr, int flags);
51static OSStatus		FSRefToDString(const FSRef *fsref, Tcl_DString *ds);
52
53#pragma mark TKApplication(TKHLEvents)
54
55@implementation TKApplication(TKHLEvents)
56
57- (void)terminate:(id)sender {
58    QuitHandler(NULL, NULL, (SRefCon) _eventInterp);
59}
60
61- (void)preferences:(id)sender {
62    PrefsHandler(NULL, NULL, (SRefCon) _eventInterp);
63}
64
65@end
66
67#pragma mark -
68
69/*
70 *----------------------------------------------------------------------
71 *
72 * TkMacOSXInitAppleEvents --
73 *
74 *	Initilize the Apple Events on the Macintosh. This registers the core
75 *	event handlers.
76 *
77 * Results:
78 *	None.
79 *
80 * Side effects:
81 *	None.
82 *
83 *----------------------------------------------------------------------
84 */
85
86void
87TkMacOSXInitAppleEvents(
88    Tcl_Interp *interp)		/* Interp to handle basic events. */
89{
90    AEEventHandlerUPP OappHandlerUPP, RappHandlerUPP, OdocHandlerUPP;
91    AEEventHandlerUPP PrintHandlerUPP, QuitHandlerUPP, ScriptHandlerUPP;
92    AEEventHandlerUPP PrefsHandlerUPP;
93    static Boolean initialized = FALSE;
94
95    if (!initialized) {
96	initialized = TRUE;
97
98	/*
99	 * Install event handlers for the core apple events.
100	 */
101
102	QuitHandlerUPP = NewAEEventHandlerUPP(QuitHandler);
103	ChkErr(AEInstallEventHandler, kCoreEventClass, kAEQuitApplication,
104		QuitHandlerUPP, (SRefCon) interp, false);
105
106	OappHandlerUPP = NewAEEventHandlerUPP(OappHandler);
107	ChkErr(AEInstallEventHandler, kCoreEventClass, kAEOpenApplication,
108		OappHandlerUPP, (SRefCon) interp, false);
109
110	RappHandlerUPP = NewAEEventHandlerUPP(RappHandler);
111	ChkErr(AEInstallEventHandler, kCoreEventClass, kAEReopenApplication,
112		RappHandlerUPP, (SRefCon) interp, false);
113
114	OdocHandlerUPP = NewAEEventHandlerUPP(OdocHandler);
115	ChkErr(AEInstallEventHandler, kCoreEventClass, kAEOpenDocuments,
116		OdocHandlerUPP, (SRefCon) interp, false);
117
118	PrintHandlerUPP = NewAEEventHandlerUPP(PrintHandler);
119	ChkErr(AEInstallEventHandler, kCoreEventClass, kAEPrintDocuments,
120		PrintHandlerUPP, (SRefCon) interp, false);
121
122	PrefsHandlerUPP = NewAEEventHandlerUPP(PrefsHandler);
123	ChkErr(AEInstallEventHandler, kCoreEventClass, kAEShowPreferences,
124		PrefsHandlerUPP, (SRefCon) interp, false);
125
126	if (interp) {
127	    ScriptHandlerUPP = NewAEEventHandlerUPP(ScriptHandler);
128	    ChkErr(AEInstallEventHandler, kAEMiscStandards, kAEDoScript,
129		    ScriptHandlerUPP, (SRefCon) interp, false);
130	}
131    }
132}
133
134/*
135 *----------------------------------------------------------------------
136 *
137 * TkMacOSXDoHLEvent --
138 *
139 *	Dispatch incomming highlevel events.
140 *
141 * Results:
142 *	None.
143 *
144 * Side effects:
145 *	Depends on the incoming event.
146 *
147 *----------------------------------------------------------------------
148 */
149
150int
151TkMacOSXDoHLEvent(
152    void *theEvent)
153{
154    return AEProcessAppleEvent((EventRecord *)theEvent);
155}
156
157/*
158 *----------------------------------------------------------------------
159 *
160 * QuitHandler --
161 *
162 *	This is the 'quit' core Apple event handler.
163 *
164 * Results:
165 *	None.
166 *
167 * Side effects:
168 *	None.
169 *
170 *----------------------------------------------------------------------
171 */
172
173static OSErr
174QuitHandler(
175    const AppleEvent *event,
176    AppleEvent *reply,
177    SRefCon handlerRefcon)
178{
179    Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
180    KillEvent *eventPtr;
181
182    if (interp) {
183	/*
184	 * Call the exit command from the event loop, since you are not
185	 * supposed to call ExitToShell in an Apple Event Handler. We put this
186	 * at the head of Tcl's event queue because this message usually comes
187	 * when the Mac is shutting down, and we want to kill the shell as
188	 * quickly as possible.
189	 */
190
191	eventPtr = (KillEvent *) ckalloc(sizeof(KillEvent));
192	eventPtr->header.proc = ReallyKillMe;
193	eventPtr->interp = interp;
194
195	Tcl_QueueEvent((Tcl_Event *) eventPtr, TCL_QUEUE_HEAD);
196    }
197    return noErr;
198}
199
200/*
201 *----------------------------------------------------------------------
202 *
203 * OappHandler --
204 *
205 *	This is the 'oapp' core Apple event handler.
206 *
207 * Results:
208 *	None.
209 *
210 * Side effects:
211 *	None.
212 *
213 *----------------------------------------------------------------------
214 */
215
216static OSErr
217OappHandler(
218    const AppleEvent *event,
219    AppleEvent *reply,
220    SRefCon handlerRefcon)
221{
222    Tcl_CmdInfo dummy;
223    Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
224
225    if (interp &&
226	    Tcl_GetCommandInfo(interp, "::tk::mac::OpenApplication", &dummy)){
227	int code = Tcl_GlobalEval(interp, "::tk::mac::OpenApplication");
228	if (code != TCL_OK) {
229	    Tcl_BackgroundError(interp);
230	}
231    }
232    return noErr;
233}
234
235/*
236 *----------------------------------------------------------------------
237 *
238 * RappHandler --
239 *
240 *	This is the 'rapp' core Apple event handler.
241 *
242 * Results:
243 *	None.
244 *
245 * Side effects:
246 *	None.
247 *
248 *----------------------------------------------------------------------
249 */
250
251static OSErr
252RappHandler(
253    const AppleEvent *event,
254    AppleEvent *reply,
255    SRefCon handlerRefcon)
256{
257    Tcl_CmdInfo dummy;
258    Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
259    ProcessSerialNumber thePSN = {0, kCurrentProcess};
260    OSStatus err = ChkErr(SetFrontProcess, &thePSN);
261
262    if (interp && Tcl_GetCommandInfo(interp,
263	    "::tk::mac::ReopenApplication", &dummy)) {
264	int code = Tcl_GlobalEval(interp, "::tk::mac::ReopenApplication");
265	if (code != TCL_OK){
266	    Tcl_BackgroundError(interp);
267	}
268    }
269    return err;
270}
271
272/*
273 *----------------------------------------------------------------------
274 *
275 * PrefsHandler --
276 *
277 *	This is the 'pref' core Apple event handler. Called when the user
278 *	selects 'Preferences...' in MacOS X
279 *
280 * Results:
281 *	None.
282 *
283 * Side effects:
284 *	None.
285 *
286 *----------------------------------------------------------------------
287 */
288
289static OSErr
290PrefsHandler(
291    const AppleEvent *event,
292    AppleEvent *reply,
293    SRefCon handlerRefcon)
294{
295    Tcl_CmdInfo dummy;
296    Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
297
298    if (interp &&
299	    Tcl_GetCommandInfo(interp, "::tk::mac::ShowPreferences", &dummy)){
300	int code = Tcl_GlobalEval(interp, "::tk::mac::ShowPreferences");
301	if (code != TCL_OK) {
302	    Tcl_BackgroundError(interp);
303	}
304    }
305    return noErr;
306}
307
308/*
309 *----------------------------------------------------------------------
310 *
311 * OdocHandler --
312 *
313 *	This is the 'odoc' core Apple event handler.
314 *
315 * Results:
316 *	None.
317 *
318 * Side effects:
319 *	None.
320 *
321 *----------------------------------------------------------------------
322 */
323
324static OSErr
325OdocHandler(
326    const AppleEvent *event,
327    AppleEvent *reply,
328    SRefCon handlerRefcon)
329{
330    Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
331    AEDescList fileSpecList;
332    FSRef file;
333    DescType type;
334    Size actual;
335    long count, index;
336    AEKeyword keyword;
337    Tcl_DString command, pathName;
338    Tcl_CmdInfo dummy;
339    int code;
340
341    /*
342     * Don't bother if we don't have an interp or the open document procedure
343     * doesn't exist.
344     */
345
346    if (!interp ||
347	    !Tcl_GetCommandInfo(interp, "::tk::mac::OpenDocument", &dummy)) {
348	return noErr;
349    }
350
351    /*
352     * If we get any errors while retrieving our parameters we just return with
353     * no error.
354     */
355
356    if (ChkErr(AEGetParamDesc, event, keyDirectObject, typeAEList,
357	    &fileSpecList) != noErr) {
358	return noErr;
359    }
360    if (MissedAnyParameters(event) != noErr) {
361	return noErr;
362    }
363    if (ChkErr(AECountItems, &fileSpecList, &count) != noErr) {
364	return noErr;
365    }
366
367    /*
368     * Convert our parameters into a script to evaluate, skipping things that
369     * we can't handle right.
370     */
371
372    Tcl_DStringInit(&command);
373    Tcl_DStringAppend(&command, "::tk::mac::OpenDocument", -1);
374    for (index = 1; index <= count; index++) {
375	if (ChkErr(AEGetNthPtr, &fileSpecList, index, typeFSRef, &keyword,
376		&type, (Ptr) &file, sizeof(FSRef), &actual) != noErr) {
377	    continue;
378	}
379
380	if (ChkErr(FSRefToDString, &file, &pathName) == noErr) {
381	    Tcl_DStringAppendElement(&command, Tcl_DStringValue(&pathName));
382	    Tcl_DStringFree(&pathName);
383	}
384    }
385
386    /*
387     * Now handle the event by evaluating a script.
388     */
389
390    code = Tcl_EvalEx(interp, Tcl_DStringValue(&command),
391	    Tcl_DStringLength(&command), TCL_EVAL_GLOBAL);
392    if (code != TCL_OK) {
393	Tcl_BackgroundError(interp);
394    }
395    Tcl_DStringFree(&command);
396    return noErr;
397}
398
399/*
400 *----------------------------------------------------------------------
401 *
402 * PrintHandler --
403 *
404 *	This is the 'pdoc' core Apple event handler.
405 *
406 * Results:
407 *	None.
408 *
409 * Side effects:
410 *	None.
411 *
412 *----------------------------------------------------------------------
413 */
414
415static OSErr
416PrintHandler(
417    const AppleEvent * event,
418    AppleEvent * reply,
419    SRefCon handlerRefcon)
420{
421    Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
422    AEDescList fileSpecList;
423    FSRef file;
424    DescType type;
425    Size actual;
426    long count, index;
427    AEKeyword keyword;
428    Tcl_DString command, pathName;
429    Tcl_CmdInfo dummy;
430    int code;
431
432    /*
433     * Don't bother if we don't have an interp or the print document procedure
434     * doesn't exist.
435     */
436
437    if (!interp ||
438	    !Tcl_GetCommandInfo(interp, "::tk::mac::PrintDocument", &dummy)) {
439	return noErr;
440    }
441
442    /*
443     * If we get any errors while retrieving our parameters we just return with
444     * no error.
445     */
446
447    if (ChkErr(AEGetParamDesc, event, keyDirectObject, typeAEList,
448	    &fileSpecList) != noErr) {
449	return noErr;
450    }
451    if (ChkErr(MissedAnyParameters, event) != noErr) {
452	return noErr;
453    }
454    if (ChkErr(AECountItems, &fileSpecList, &count) != noErr) {
455	return noErr;
456    }
457
458    Tcl_DStringInit(&command);
459    Tcl_DStringAppend(&command, "::tk::mac::PrintDocument", -1);
460    for (index = 1; index <= count; index++) {
461	if (ChkErr(AEGetNthPtr, &fileSpecList, index, typeFSRef, &keyword,
462		&type, (Ptr) &file, sizeof(FSRef), &actual) != noErr) {
463	    continue;
464	}
465
466	if (ChkErr(FSRefToDString, &file, &pathName) == noErr) {
467	    Tcl_DStringAppendElement(&command, Tcl_DStringValue(&pathName));
468	    Tcl_DStringFree(&pathName);
469	}
470    }
471
472    /*
473     * Now handle the event by evaluating a script.
474     */
475
476    code = Tcl_EvalEx(interp, Tcl_DStringValue(&command),
477	    Tcl_DStringLength(&command), TCL_EVAL_GLOBAL);
478    if (code != TCL_OK) {
479	Tcl_BackgroundError(interp);
480    }
481    Tcl_DStringFree(&command);
482    return noErr;
483}
484
485/*
486 *----------------------------------------------------------------------
487 *
488 * ScriptHandler --
489 *
490 *	This handler process the script event.
491 *
492 * Results:
493 *	Schedules the given event to be processed.
494 *
495 * Side effects:
496 *	None.
497 *
498 *----------------------------------------------------------------------
499 */
500
501static OSErr
502ScriptHandler(
503    const AppleEvent *event,
504    AppleEvent *reply,
505    SRefCon handlerRefcon)
506{
507    OSStatus theErr;
508    AEDescList theDesc;
509    Size size;
510    int tclErr = -1;
511    Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
512    char errString[128];
513
514    /*
515     * The do script event receives one parameter that should be data or a
516     * file.
517     */
518
519    theErr = AEGetParamDesc(event, keyDirectObject, typeWildCard,
520	    &theDesc);
521    if (theErr != noErr) {
522	sprintf(errString, "AEDoScriptHandler: GetParamDesc error %d",
523		(int)theErr);
524	theErr = AEPutParamPtr(reply, keyErrorString, typeChar, errString,
525		strlen(errString));
526    } else if (MissedAnyParameters(event)) {
527	/*
528	 * Return error if parameter is missing.
529	 */
530
531	sprintf(errString, "AEDoScriptHandler: extra parameters");
532	AEPutParamPtr(reply, keyErrorString, typeChar, errString,
533		strlen(errString));
534	theErr = -1771;
535    } else if (theDesc.descriptorType == (DescType) typeAlias &&
536	    AEGetParamPtr(event, keyDirectObject, typeFSRef, NULL, NULL,
537	    0, &size) == noErr && size == sizeof(FSRef)) {
538	/*
539	 * We've had a file sent to us. Source it.
540	 */
541
542	FSRef file;
543	theErr = AEGetParamPtr(event, keyDirectObject, typeFSRef, NULL, &file,
544		size, NULL);
545	if (theErr == noErr) {
546	    Tcl_DString scriptName;
547
548	    theErr = FSRefToDString(&file, &scriptName);
549	    if (theErr == noErr) {
550		tclErr = Tcl_EvalFile(interp, Tcl_DStringValue(&scriptName));
551		Tcl_DStringFree(&scriptName);
552	    } else {
553		sprintf(errString, "AEDoScriptHandler: file not found");
554		AEPutParamPtr(reply, keyErrorString, typeChar, errString,
555			strlen(errString));
556	    }
557	}
558    } else if (AEGetParamPtr(event, keyDirectObject, typeUTF8Text, NULL, NULL,
559	    0, &size) == noErr && size) {
560	/*
561	 * We've had some data sent to us. Evaluate it.
562	 */
563
564	char *data = ckalloc(size + 1);
565	theErr = AEGetParamPtr(event, keyDirectObject, typeUTF8Text, NULL, data,
566		size, NULL);
567	if (theErr == noErr) {
568	    tclErr = Tcl_EvalEx(interp, data, size, TCL_EVAL_GLOBAL);
569	}
570    } else {
571	/*
572	 * Umm, don't recognize what we've got...
573	 */
574
575	sprintf(errString, "AEDoScriptHandler: invalid script type '%-4.4s', "
576		"must be 'alis' or coercable to 'utf8'",
577		(char*) &theDesc.descriptorType);
578	AEPutParamPtr(reply, keyErrorString, typeChar, errString,
579		strlen(errString));
580	theErr = -1770;
581    }
582
583    /*
584     * If we actually go to run Tcl code - put the result in the reply.
585     */
586
587    if (tclErr >= 0) {
588	int reslen;
589	const char *result =
590		Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &reslen);
591
592	if (tclErr == TCL_OK) {
593	    AEPutParamPtr(reply, keyDirectObject, typeChar, result, reslen);
594	} else {
595	    AEPutParamPtr(reply, keyErrorString, typeChar, result, reslen);
596	    AEPutParamPtr(reply, keyErrorNumber, typeSInt32, (Ptr) &tclErr,
597		    sizeof(int));
598	}
599    }
600
601    AEDisposeDesc(&theDesc);
602    return theErr;
603}
604
605/*
606 *----------------------------------------------------------------------
607 *
608 * ReallyKillMe --
609 *
610 *	This proc tries to kill the shell by running exit, called from an
611 *	event scheduled by the "Quit" AppleEvent handler.
612 *
613 * Results:
614 *	Runs the "exit" command which might kill the shell.
615 *
616 * Side effects:
617 *	None.
618 *
619 *----------------------------------------------------------------------
620 */
621
622static int
623ReallyKillMe(
624    Tcl_Event *eventPtr,
625    int flags)
626{
627    Tcl_Interp *interp = ((KillEvent *) eventPtr)->interp;
628    Tcl_CmdInfo dummy;
629    int quit = Tcl_GetCommandInfo(interp, "::tk::mac::Quit", &dummy);
630    int code = Tcl_GlobalEval(interp, quit ? "::tk::mac::Quit" : "exit");
631
632    if (code != TCL_OK) {
633	/*
634	 * Should be never reached...
635	 */
636
637	Tcl_BackgroundError(interp);
638    }
639    return 1;
640}
641
642/*
643 *----------------------------------------------------------------------
644 *
645 * MissedAnyParameters --
646 *
647 *	Checks to see if parameters are still left in the event.
648 *
649 * Results:
650 *	True or false.
651 *
652 * Side effects:
653 *	None.
654 *
655 *----------------------------------------------------------------------
656 */
657
658static int
659MissedAnyParameters(
660    const AppleEvent *theEvent)
661{
662   DescType returnedType;
663   Size actualSize;
664   OSStatus err;
665
666   err = AEGetAttributePtr(theEvent, keyMissedKeywordAttr,
667	    typeWildCard, &returnedType, NULL, 0, &actualSize);
668
669   return (err != errAEDescNotFound);
670}
671
672/*
673 *----------------------------------------------------------------------
674 *
675 * FSRefToDString --
676 *
677 *	Get a POSIX path from an FSRef.
678 *
679 * Results:
680 *	In the parameter ds.
681 *
682 * Side effects:
683 *	None.
684 *
685 *----------------------------------------------------------------------
686 */
687
688static OSStatus
689FSRefToDString(
690    const FSRef *fsref,
691    Tcl_DString *ds)
692{
693    UInt8 fileName[PATH_MAX+1];
694    OSStatus err;
695
696    err = ChkErr(FSRefMakePath, fsref, fileName, sizeof(fileName));
697    if (err == noErr) {
698	Tcl_ExternalToUtfDString(NULL, (char*) fileName, -1, ds);
699    }
700    return err;
701}
702
703/*
704 * Local Variables:
705 * mode: c
706 * c-basic-offset: 4
707 * fill-column: 79
708 * coding: utf-8
709 * End:
710 */
711