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  * Copyright (c) 2015 Marc Culler
11  *
12  * See the file "license.terms" for information on usage and redistribution
13  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14  */
15 
16 #include "tkMacOSXPrivate.h"
17 #include <sys/param.h>
18 #define URL_MAX_LENGTH (17 + MAXPATHLEN)
19 
20 /*
21  * This is a Tcl_Event structure that the Quit AppleEvent handler uses to
22  * schedule the ReallyKillMe function.
23  */
24 
25 typedef struct KillEvent {
26     Tcl_Event header;		/* Information that is standard for all
27 				 * events. */
28     Tcl_Interp *interp;		/* Interp that was passed to the Quit
29 				 * AppleEvent */
30 } KillEvent;
31 
32 /*
33  * Static functions used only in this file.
34  */
35 
36 static void tkMacOSXProcessFiles(NSAppleEventDescriptor* event,
37 				 NSAppleEventDescriptor* replyEvent,
38 				 Tcl_Interp *interp,
39 				 char* procedure);
40 static int  MissedAnyParameters(const AppleEvent *theEvent);
41 static int  ReallyKillMe(Tcl_Event *eventPtr, int flags);
42 
43 #pragma mark TKApplication(TKHLEvents)
44 
45 @implementation TKApplication(TKHLEvents)
46 - (void) terminate: (id) sender
47 {
48     [self handleQuitApplicationEvent:Nil withReplyEvent:Nil];
49 }
50 
51 - (void) preferences: (id) sender
52 {
53     [self handleShowPreferencesEvent:Nil withReplyEvent:Nil];
54 }
55 
56 - (void) handleQuitApplicationEvent: (NSAppleEventDescriptor *)event
57     withReplyEvent: (NSAppleEventDescriptor *)replyEvent
58 {
59     KillEvent *eventPtr;
60 
61     if (_eventInterp) {
62 	/*
63 	 * Call the exit command from the event loop, since you are not
64 	 * supposed to call ExitToShell in an Apple Event Handler. We put this
65 	 * at the head of Tcl's event queue because this message usually comes
66 	 * when the Mac is shutting down, and we want to kill the shell as
67 	 * quickly as possible.
68 	 */
69 
70 	eventPtr = (KillEvent*)ckalloc(sizeof(KillEvent));
71 	eventPtr->header.proc = ReallyKillMe;
72 	eventPtr->interp = _eventInterp;
73 
74 	Tcl_QueueEvent((Tcl_Event *) eventPtr, TCL_QUEUE_HEAD);
75     }
76 }
77 
78 - (void) handleOpenApplicationEvent: (NSAppleEventDescriptor *)event
79     withReplyEvent: (NSAppleEventDescriptor *)replyEvent
80 {
81    Tcl_Interp *interp = _eventInterp;
82 
83     if (interp &&
84 	Tcl_FindCommand(_eventInterp, "::tk::mac::OpenApplication", NULL, 0)){
85 	int code = Tcl_EvalEx(_eventInterp, "::tk::mac::OpenApplication",
86 			      -1, TCL_EVAL_GLOBAL);
87 	if (code != TCL_OK) {
88 	    Tcl_BackgroundError(_eventInterp);
89 	}
90     }
91 }
92 
93 - (void) handleReopenApplicationEvent: (NSAppleEventDescriptor *)event
94     withReplyEvent: (NSAppleEventDescriptor *)replyEvent
95 {
96 #if MAC_OS_X_VERSION_MIN_REQUIRED < 1090
97     ProcessSerialNumber thePSN = {0, kCurrentProcess};
98     SetFrontProcess(&thePSN);
99 #else
100     [[NSApplication sharedApplication] activateIgnoringOtherApps: YES];
101 #endif
102     if (_eventInterp && Tcl_FindCommand(_eventInterp,
103 	    "::tk::mac::ReopenApplication", NULL, 0)) {
104 	int code = Tcl_EvalEx(_eventInterp, "::tk::mac::ReopenApplication",
105 			      -1, TCL_EVAL_GLOBAL);
106 	if (code != TCL_OK){
107 	    Tcl_BackgroundError(_eventInterp);
108 	}
109     }
110 }
111 
112 - (void) handleShowPreferencesEvent: (NSAppleEventDescriptor *)event
113     withReplyEvent: (NSAppleEventDescriptor *)replyEvent
114 {
115     if (_eventInterp &&
116 	    Tcl_FindCommand(_eventInterp, "::tk::mac::ShowPreferences", NULL, 0)){
117 	int code = Tcl_EvalEx(_eventInterp, "::tk::mac::ShowPreferences",
118 			      -1, TCL_EVAL_GLOBAL);
119 	if (code != TCL_OK) {
120 	    Tcl_BackgroundError(_eventInterp);
121 	}
122     }
123 }
124 
125 - (void) handleOpenDocumentsEvent: (NSAppleEventDescriptor *)event
126     withReplyEvent: (NSAppleEventDescriptor *)replyEvent
127 {
128     tkMacOSXProcessFiles(event, replyEvent, _eventInterp, "::tk::mac::OpenDocument");
129 }
130 
131 - (void) handlePrintDocumentsEvent: (NSAppleEventDescriptor *)event
132     withReplyEvent: (NSAppleEventDescriptor *)replyEvent
133 {
134     tkMacOSXProcessFiles(event, replyEvent, _eventInterp, "::tk::mac::PrintDocument");
135 }
136 
137 - (void) handleDoScriptEvent: (NSAppleEventDescriptor *)event
138     withReplyEvent: (NSAppleEventDescriptor *)replyEvent
139 {
140     OSStatus err;
141     const AEDesc *theDesc = nil;
142     DescType type = 0, initialType = 0;
143     Size actual;
144     int tclErr = -1;
145     char URLBuffer[1 + URL_MAX_LENGTH];
146     char errString[128];
147     char typeString[5];
148 
149     /*
150      * The DoScript event receives one parameter that should be text data or a
151      * fileURL.
152      */
153 
154     theDesc = [event aeDesc];
155     if (theDesc == nil) {
156 	return;
157     }
158 
159     err = AEGetParamPtr(theDesc, keyDirectObject, typeWildCard, &initialType,
160 			NULL, 0, NULL);
161     if (err != noErr) {
162 	sprintf(errString, "AEDoScriptHandler: GetParamDesc error %d", (int)err);
163 	AEPutParamPtr((AppleEvent*)[replyEvent aeDesc], keyErrorString, typeChar,
164 		      errString, strlen(errString));
165 	return;
166     }
167 
168     if (MissedAnyParameters((AppleEvent*)theDesc)) {
169     	sprintf(errString, "AEDoScriptHandler: extra parameters");
170     	AEPutParamPtr((AppleEvent*)[replyEvent aeDesc], keyErrorString, typeChar,
171     		      errString, strlen(errString));
172     	return;
173     }
174 
175     if (initialType == typeFileURL || initialType == typeAlias) {
176 	/*
177 	 * The descriptor can be coerced to a file url.  Source the file, or
178 	 * pass the path as a string argument to ::tk::mac::DoScriptFile if
179 	 * that procedure exists.
180 	 */
181 	err = AEGetParamPtr(theDesc, keyDirectObject, typeFileURL, &type,
182 			    (Ptr) URLBuffer, URL_MAX_LENGTH, &actual);
183 	if (err == noErr && actual > 0){
184 	    URLBuffer[actual] = '\0';
185 	    NSString *urlString = [NSString stringWithUTF8String:(char*)URLBuffer];
186 	    NSURL *fileURL = [NSURL URLWithString:urlString];
187 	    Tcl_DString command;
188 	    Tcl_DStringInit(&command);
189 	    if (Tcl_FindCommand(_eventInterp, "::tk::mac::DoScriptFile", NULL, 0)){
190 		Tcl_DStringAppend(&command, "::tk::mac::DoScriptFile", -1);
191 	    } else {
192 		Tcl_DStringAppend(&command, "source", -1);
193 	    }
194 	    Tcl_DStringAppendElement(&command, [[fileURL path] UTF8String]);
195 	    tclErr = Tcl_EvalEx(_eventInterp, Tcl_DStringValue(&command),
196 				 Tcl_DStringLength(&command), TCL_EVAL_GLOBAL);
197 	}
198     } else if (noErr == AEGetParamPtr(theDesc, keyDirectObject, typeUTF8Text, &type,
199 			   NULL, 0, &actual)) {
200 	if (actual > 0) {
201 	    /*
202 	     * The descriptor can be coerced to UTF8 text.  Evaluate as Tcl, or
203 	     * or pass the text as a string argument to ::tk::mac::DoScriptText
204 	     * if that procedure exists.
205 	     */
206 	    char *data = ckalloc(actual + 1);
207 	    if (noErr == AEGetParamPtr(theDesc, keyDirectObject, typeUTF8Text, &type,
208 			    data, actual, NULL)) {
209 		if (Tcl_FindCommand(_eventInterp, "::tk::mac::DoScriptText", NULL, 0)){
210 		    Tcl_DString command;
211 		    Tcl_DStringInit(&command);
212 		    Tcl_DStringAppend(&command, "::tk::mac::DoScriptText", -1);
213 		    Tcl_DStringAppendElement(&command, data);
214 		    tclErr = Tcl_EvalEx(_eventInterp, Tcl_DStringValue(&command),
215 				 Tcl_DStringLength(&command), TCL_EVAL_GLOBAL);
216 		} else {
217 		    tclErr = Tcl_EvalEx(_eventInterp, data, actual, TCL_EVAL_GLOBAL);
218 		}
219 	    }
220 	    ckfree(data);
221 	}
222     } else {
223 	/*
224 	 * The descriptor can not be coerced to a fileURL or UTF8 text.
225 	 */
226 	for (int i = 0; i < 4; i++) {
227 	    typeString[i] = ((char*)&initialType)[3-i];
228 	}
229 	typeString[4] = '\0';
230 	sprintf(errString, "AEDoScriptHandler: invalid script type '%s', "
231 		"must be coercable to 'furl' or 'utf8'", typeString);
232 	AEPutParamPtr((AppleEvent*)[replyEvent aeDesc], keyErrorString, typeChar, errString,
233 		      strlen(errString));
234     }
235     /*
236      * If we ran some Tcl code, put the result in the reply.
237      */
238     if (tclErr >= 0) {
239 	int reslen;
240 	const char *result =
241 	    Tcl_GetStringFromObj(Tcl_GetObjResult(_eventInterp), &reslen);
242 	if (tclErr == TCL_OK) {
243 	    AEPutParamPtr((AppleEvent*)[replyEvent aeDesc], keyDirectObject, typeChar,
244 			  result, reslen);
245 	} else {
246 	    AEPutParamPtr((AppleEvent*)[replyEvent aeDesc], keyErrorString, typeChar,
247 			  result, reslen);
248 	    AEPutParamPtr((AppleEvent*)[replyEvent aeDesc], keyErrorNumber, typeSInt32,
249 			  (Ptr) &tclErr,sizeof(int));
250 	}
251     }
252     return;
253 }
254 @end
255 
256 #pragma mark -
257 
258 /*
259  *----------------------------------------------------------------------
260  *
261  * TkMacOSXProcessFiles --
262  *
263  *	Extract a list of fileURLs from an AppleEvent and call the specified
264  *      procedure with the file paths as arguments.
265  *
266  * Results:
267  *	None.
268  *
269  * Side effects:
270  *	The event is handled by running the procedure.
271  *
272  *----------------------------------------------------------------------
273  */
274 
275 static void
tkMacOSXProcessFiles(NSAppleEventDescriptor * event,NSAppleEventDescriptor * replyEvent,Tcl_Interp * interp,char * procedure)276 tkMacOSXProcessFiles(
277     NSAppleEventDescriptor* event,
278     NSAppleEventDescriptor* replyEvent,
279     Tcl_Interp *interp,
280     char* procedure)
281 {
282     Tcl_Encoding utf8 = Tcl_GetEncoding(NULL, "utf-8");
283     const AEDesc *fileSpecDesc = nil;
284     AEDesc contents;
285     char URLString[1 + URL_MAX_LENGTH];
286     NSURL *fileURL;
287     DescType type;
288     Size actual;
289     long count, index;
290     AEKeyword keyword;
291     Tcl_DString command, pathName;
292     int code;
293 
294     /*
295      * Do nothing if we don't have an interpreter or the procedure doesn't exist.
296      */
297 
298     if (!interp || !Tcl_FindCommand(interp, procedure, NULL, 0)) {
299 	return;
300     }
301 
302     fileSpecDesc = [event aeDesc];
303     if (fileSpecDesc == nil ) {
304     	return;
305     }
306 
307     /*
308      * The AppleEvent's descriptor should either contain a value of
309      * typeObjectSpecifier or typeAEList.  In the first case, the descriptor
310      * can be treated as a list of size 1 containing a value which can be
311      * coerced into a fileURL. In the second case we want to work with the list
312      * itself.  Values in the list will be coerced into fileURL's if possible;
313      * otherwise they will be ignored.
314      */
315 
316     /* Get a copy of the AppleEvent's descriptor. */
317     AEGetParamDesc(fileSpecDesc, keyDirectObject, typeWildCard, &contents);
318     if (contents.descriptorType == typeAEList) {
319     	fileSpecDesc = &contents;
320     }
321 
322     if (AECountItems(fileSpecDesc, &count) != noErr) {
323 	AEDisposeDesc(&contents);
324     	return;
325     }
326 
327     /*
328      * Construct a Tcl command which calls the procedure, passing the
329      * paths contained in the AppleEvent as arguments.
330      */
331 
332     Tcl_DStringInit(&command);
333     Tcl_DStringAppend(&command, procedure, -1);
334 
335     for (index = 1; index <= count; index++) {
336 	if (noErr != AEGetNthPtr(fileSpecDesc, index, typeFileURL, &keyword,
337 				 &type, (Ptr) URLString, URL_MAX_LENGTH, &actual)) {
338 	    continue;
339 	}
340 	if (type != typeFileURL) {
341 	    continue;
342 	}
343 	URLString[actual] = '\0';
344 	fileURL = [NSURL URLWithString:[NSString stringWithUTF8String:(char*)URLString]];
345 	if (fileURL == nil) {
346 	    continue;
347 	}
348 	Tcl_ExternalToUtfDString(utf8, [[fileURL path] UTF8String], -1, &pathName);
349 	Tcl_DStringAppendElement(&command, Tcl_DStringValue(&pathName));
350 	Tcl_DStringFree(&pathName);
351     }
352     AEDisposeDesc(&contents);
353 
354     /*
355      * Handle the event by evaluating the Tcl expression we constructed.
356      */
357 
358     code = Tcl_EvalEx(interp, Tcl_DStringValue(&command),
359 	    Tcl_DStringLength(&command), TCL_EVAL_GLOBAL);
360     if (code != TCL_OK) {
361 	Tcl_BackgroundError(interp);
362     }
363     Tcl_DStringFree(&command);
364     return;
365 }
366 
367 /*
368  *----------------------------------------------------------------------
369  *
370  * TkMacOSXInitAppleEvents --
371  *
372  *	Register AppleEvent handlers with the NSAppleEventManager for
373  *      this NSApplication.
374  *
375  * Results:
376  *	None.
377  *
378  * Side effects:
379  *	None.
380  *
381  *----------------------------------------------------------------------
382  */
383 
384 void
TkMacOSXInitAppleEvents(Tcl_Interp * interp)385 TkMacOSXInitAppleEvents(
386     Tcl_Interp *interp)   /* not used */
387 {
388     NSAppleEventManager *aeManager = [NSAppleEventManager sharedAppleEventManager];
389     static Boolean initialized = FALSE;
390 
391     if (!initialized) {
392 	initialized = TRUE;
393 
394 	[aeManager setEventHandler:NSApp
395 	    andSelector:@selector(handleQuitApplicationEvent:withReplyEvent:)
396 	    forEventClass:kCoreEventClass andEventID:kAEQuitApplication];
397 
398 	[aeManager setEventHandler:NSApp
399 	    andSelector:@selector(handleOpenApplicationEvent:withReplyEvent:)
400 	    forEventClass:kCoreEventClass andEventID:kAEOpenApplication];
401 
402 	[aeManager setEventHandler:NSApp
403 	    andSelector:@selector(handleReopenApplicationEvent:withReplyEvent:)
404 	    forEventClass:kCoreEventClass andEventID:kAEReopenApplication];
405 
406 	[aeManager setEventHandler:NSApp
407 	    andSelector:@selector(handleShowPreferencesEvent:withReplyEvent:)
408 	    forEventClass:kCoreEventClass andEventID:kAEShowPreferences];
409 
410 	[aeManager setEventHandler:NSApp
411 	    andSelector:@selector(handleOpenDocumentsEvent:withReplyEvent:)
412 	    forEventClass:kCoreEventClass andEventID:kAEOpenDocuments];
413 
414 	[aeManager setEventHandler:NSApp
415 	    andSelector:@selector(handleOpenDocumentsEvent:withReplyEvent:)
416 	    forEventClass:kCoreEventClass andEventID:kAEPrintDocuments];
417 
418 	[aeManager setEventHandler:NSApp
419 	    andSelector:@selector(handleDoScriptEvent:withReplyEvent:)
420 	    forEventClass:kAEMiscStandards andEventID:kAEDoScript];
421     }
422 }
423 
424 /*
425  *----------------------------------------------------------------------
426  *
427  * TkMacOSXDoHLEvent --
428  *
429  *	Dispatch an AppleEvent.
430  *
431  * Results:
432  *	None.
433  *
434  * Side effects:
435  *	Depend on the AppleEvent.
436  *
437  *----------------------------------------------------------------------
438  */
439 
440 int
TkMacOSXDoHLEvent(void * theEvent)441 TkMacOSXDoHLEvent(
442     void *theEvent)
443 {
444     /* According to the NSAppleEventManager reference:
445      *   "The theReply parameter always specifies a reply Apple event, never
446      *   nil.  However, the handler should not fill out the reply if the
447      *   descriptor type for the reply event is typeNull, indicating the sender
448      *   does not want a reply."
449      * The specified way to build such a non-nil descriptor is used here.  But
450      * on OSX 10.11, the compiler nonetheless generates a warning.  I am
451      * supressing the warning here -- maybe the warnings will stop in a future
452      * compiler release.
453      */
454 #ifdef __clang__
455 #pragma clang diagnostic push
456 #pragma clang diagnostic ignored "-Wnonnull"
457 #endif
458 
459     NSAppleEventDescriptor* theReply = [NSAppleEventDescriptor nullDescriptor];
460     NSAppleEventManager *aeManager = [NSAppleEventManager sharedAppleEventManager];
461 
462     return [aeManager dispatchRawAppleEvent:(const AppleEvent*)theEvent
463 		      withRawReply: (AppleEvent *)theReply
464 		      handlerRefCon: (SRefCon)0];
465 
466 #ifdef __clang__
467 #pragma clang diagnostic pop
468 #endif
469 }
470 
471 /*
472  *----------------------------------------------------------------------
473  *
474  * ReallyKillMe --
475  *
476  *	This proc tries to kill the shell by running exit, called from an
477  *	event scheduled by the "Quit" AppleEvent handler.
478  *
479  * Results:
480  *	Runs the "exit" command which might kill the shell.
481  *
482  * Side effects:
483  *	None.
484  *
485  *----------------------------------------------------------------------
486  */
487 static int
ReallyKillMe(Tcl_Event * eventPtr,int flags)488 ReallyKillMe(
489     Tcl_Event *eventPtr,
490     int flags)
491 {
492     Tcl_Interp *interp = ((KillEvent *) eventPtr)->interp;
493     Tcl_CmdInfo dummy;
494     int quit = Tcl_GetCommandInfo(interp, "::tk::mac::Quit", &dummy);
495     int code = Tcl_EvalEx(interp, quit ? "::tk::mac::Quit" : "exit", -1, TCL_EVAL_GLOBAL);
496 
497     if (code != TCL_OK) {
498 	/*
499 	 * Should be never reached...
500 	 */
501 
502 	Tcl_BackgroundError(interp);
503     }
504     return 1;
505 }
506 
507 /*
508  *----------------------------------------------------------------------
509  *
510  * MissedAnyParameters --
511  *
512  *	Checks to see if parameters are still left in the event.
513  *
514  * Results:
515  *	True or false.
516  *
517  * Side effects:
518  *	None.
519  *
520  *----------------------------------------------------------------------
521  */
522 
523 static int
MissedAnyParameters(const AppleEvent * theEvent)524 MissedAnyParameters(
525     const AppleEvent *theEvent)
526 {
527    DescType returnedType;
528    Size actualSize;
529    OSStatus err;
530 
531    err = AEGetAttributePtr(theEvent, keyMissedKeywordAttr,
532 	    typeWildCard, &returnedType, NULL, 0, &actualSize);
533 
534    return (err != errAEDescNotFound);
535 }
536 
537 /*
538  * Local Variables:
539  * mode: objc
540  * c-basic-offset: 4
541  * fill-column: 79
542  * coding: utf-8
543  * End:
544  */
545