X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/956c0f10b5eb31886aaa0a2c69e209f02d4f249a..7147863a1cadafc27dcab1d3f28ccab2224a6316:/src/macselect.c diff --git a/src/macselect.c b/src/macselect.c index a115c9b322..fd72bd3cb1 100644 --- a/src/macselect.c +++ b/src/macselect.c @@ -1,5 +1,5 @@ /* Selection processing for Emacs on Mac OS. - Copyright (C) 2005 Free Software Foundation, Inc. + Copyright (C) 2005, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -15,14 +15,15 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ #include #include "lisp.h" #include "macterm.h" #include "blockinput.h" +#include "keymap.h" #if !TARGET_API_MAC_CARBON #include @@ -30,15 +31,15 @@ typedef int ScrapRef; typedef ResType ScrapFlavorType; #endif /* !TARGET_API_MAC_CARBON */ -static OSErr get_scrap_from_symbol P_ ((Lisp_Object, int, ScrapRef *)); +static OSStatus get_scrap_from_symbol P_ ((Lisp_Object, int, ScrapRef *)); static ScrapFlavorType get_flavor_type_from_symbol P_ ((Lisp_Object)); static int valid_scrap_target_type_p P_ ((Lisp_Object)); -static OSErr clear_scrap P_ ((ScrapRef *)); -static OSErr put_scrap_string P_ ((ScrapRef, Lisp_Object, Lisp_Object)); -static OSErr put_scrap_private_timestamp P_ ((ScrapRef, unsigned long)); +static OSStatus clear_scrap P_ ((ScrapRef *)); +static OSStatus put_scrap_string P_ ((ScrapRef, Lisp_Object, Lisp_Object)); +static OSStatus put_scrap_private_timestamp P_ ((ScrapRef, unsigned long)); static ScrapFlavorType scrap_has_target_type P_ ((ScrapRef, Lisp_Object)); static Lisp_Object get_scrap_string P_ ((ScrapRef, Lisp_Object)); -static OSErr get_scrap_private_timestamp P_ ((ScrapRef, unsigned long *)); +static OSStatus get_scrap_private_timestamp P_ ((ScrapRef, unsigned long *)); static Lisp_Object get_scrap_target_type_list P_ ((ScrapRef)); static void x_own_selection P_ ((Lisp_Object, Lisp_Object)); static Lisp_Object x_get_local_selection P_ ((Lisp_Object, Lisp_Object, int)); @@ -100,20 +101,20 @@ static Lisp_Object Qmac_scrap_name, Qmac_ostype; #ifdef MAC_OSX /* Selection name for communication via Services menu. */ -static Lisp_Object Vmac_services_selection; +static Lisp_Object Vmac_service_selection; #endif /* Get a reference to the scrap corresponding to the symbol SYM. The reference is set to *SCRAP, and it becomes NULL if there's no corresponding scrap. Clear the scrap if CLEAR_P is non-zero. */ -static OSErr +static OSStatus get_scrap_from_symbol (sym, clear_p, scrap) Lisp_Object sym; int clear_p; ScrapRef *scrap; { - OSErr err = noErr; + OSStatus err = noErr; Lisp_Object str = Fget (sym, Qmac_scrap_name); if (!STRINGP (str)) @@ -152,7 +153,6 @@ static ScrapFlavorType get_flavor_type_from_symbol (sym) Lisp_Object sym; { - ScrapFlavorType val; Lisp_Object str = Fget (sym, Qmac_ostype); if (STRINGP (str) && SBYTES (str) == 4) @@ -172,7 +172,7 @@ valid_scrap_target_type_p (sym) /* Clear the scrap whose reference is *SCRAP. */ -static INLINE OSErr +static INLINE OSStatus clear_scrap (scrap) ScrapRef *scrap; { @@ -190,7 +190,7 @@ clear_scrap (scrap) /* Put Lisp String STR to the scrap SCRAP. The target type is specified by TYPE. */ -static OSErr +static OSStatus put_scrap_string (scrap, type, str) ScrapRef scrap; Lisp_Object type, str; @@ -211,7 +211,7 @@ put_scrap_string (scrap, type, str) /* Put TIMESTAMP to the scrap SCRAP. The timestamp is used for checking if the scrap is owned by the process. */ -static INLINE OSErr +static INLINE OSStatus put_scrap_private_timestamp (scrap, timestamp) ScrapRef scrap; unsigned long timestamp; @@ -233,7 +233,7 @@ scrap_has_target_type (scrap, type) ScrapRef scrap; Lisp_Object type; { - OSErr err; + OSStatus err; ScrapFlavorType flavor_type = get_flavor_type_from_symbol (type); if (flavor_type) @@ -264,7 +264,7 @@ get_scrap_string (scrap, type) ScrapRef scrap; Lisp_Object type; { - OSErr err; + OSStatus err; Lisp_Object result = Qnil; ScrapFlavorType flavor_type = get_flavor_type_from_symbol (type); #if TARGET_API_MAC_CARBON @@ -310,28 +310,30 @@ get_scrap_string (scrap, type) /* Get timestamp from the scrap SCRAP and set to *TIMPSTAMP. */ -static OSErr +static OSStatus get_scrap_private_timestamp (scrap, timestamp) ScrapRef scrap; unsigned long *timestamp; { - OSErr err = noErr; + OSStatus err = noErr; #if TARGET_API_MAC_CARBON ScrapFlavorFlags flags; err = GetScrapFlavorFlags (scrap, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, &flags); if (err == noErr) - if (!(flags & kScrapFlavorMaskSenderOnly)) - err = noTypeErr; - else - { - Size size = sizeof (*timestamp); + { + if (!(flags & kScrapFlavorMaskSenderOnly)) + err = noTypeErr; + else + { + Size size = sizeof (*timestamp); - err = GetScrapFlavorData (scrap, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, - &size, timestamp); - if (err == noErr && size != sizeof (*timestamp)) - err = noTypeErr; - } + err = GetScrapFlavorData (scrap, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, + &size, timestamp); + if (err == noErr && size != sizeof (*timestamp)) + err = noTypeErr; + } + } #else /* !TARGET_API_MAC_CARBON */ Handle handle; SInt32 size, offset; @@ -363,7 +365,7 @@ get_scrap_target_type_list (scrap) { Lisp_Object result = Qnil, rest, target_type; #if TARGET_API_MAC_CARBON - OSErr err; + OSStatus err; UInt32 count, i, type; ScrapFlavorInfo *flavor_info = NULL; Lisp_Object strings = Qnil; @@ -371,15 +373,14 @@ get_scrap_target_type_list (scrap) err = GetScrapFlavorCount (scrap, &count); if (err == noErr) flavor_info = xmalloc (sizeof (ScrapFlavorInfo) * count); - if (err == noErr && flavor_info) + err = GetScrapFlavorInfoList (scrap, &count, flavor_info); + if (err != noErr) { - err = GetScrapFlavorInfoList (scrap, &count, flavor_info); - if (err != noErr) - { - xfree (flavor_info); - flavor_info = NULL; - } + xfree (flavor_info); + flavor_info = NULL; } + if (flavor_info == NULL) + count = 0; #endif for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest)) { @@ -424,7 +425,7 @@ static void x_own_selection (selection_name, selection_value) Lisp_Object selection_name, selection_value; { - OSErr err; + OSStatus err; ScrapRef scrap; struct gcpro gcpro1, gcpro2; Lisp_Object rest, handler_fn, value, type; @@ -593,11 +594,9 @@ x_get_local_selection (selection_symbol, target_type, local_request) && INTEGERP (XCAR (XCDR (check))) && NILP (XCDR (XCDR (check)))))) return value; - else - return - Fsignal (Qerror, - Fcons (build_string ("invalid data returned by selection-conversion function"), - Fcons (handler_fn, Fcons (value, Qnil)))); + + signal_error ("Invalid data returned by selection-conversion function", + list2 (handler_fn, value)); } @@ -672,7 +671,7 @@ static Lisp_Object x_get_foreign_selection (selection_symbol, target_type, time_stamp) Lisp_Object selection_symbol, target_type, time_stamp; { - OSErr err; + OSStatus err; ScrapRef scrap; Lisp_Object result = Qnil; @@ -680,18 +679,20 @@ x_get_foreign_selection (selection_symbol, target_type, time_stamp) err = get_scrap_from_symbol (selection_symbol, 0, &scrap); if (err == noErr && scrap) - if (EQ (target_type, QTARGETS)) - { - result = get_scrap_target_type_list (scrap); - result = Fvconcat (1, &result); - } - else - { - result = get_scrap_string (scrap, target_type); - if (STRINGP (result)) - Fput_text_property (make_number (0), make_number (SBYTES (result)), - Qforeign_selection, target_type, result); - } + { + if (EQ (target_type, QTARGETS)) + { + result = get_scrap_target_type_list (scrap); + result = Fvconcat (1, &result); + } + else + { + result = get_scrap_string (scrap, target_type); + if (STRINGP (result)) + Fput_text_property (make_number (0), make_number (SBYTES (result)), + Qforeign_selection, target_type, result); + } + } UNBLOCK_INPUT; @@ -710,7 +711,7 @@ anything that the functions on `selection-converter-alist' know about. */) { check_mac (); CHECK_SYMBOL (selection_name); - if (NILP (selection_value)) error ("selection-value may not be nil"); + if (NILP (selection_value)) error ("SELECTION-VALUE may not be nil"); x_own_selection (selection_name, selection_value); return selection_value; } @@ -722,11 +723,11 @@ anything that the functions on `selection-converter-alist' know about. */) DEFUN ("x-get-selection-internal", Fx_get_selection_internal, Sx_get_selection_internal, 2, 3, 0, - doc: /* Return text selected from some Mac window. + doc: /* Return text selected from some Mac application. SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. TYPE is the type of data desired, typically `STRING'. TIME_STAMP is ignored on Mac. */) - (selection_symbol, target_type, time_stamp) + (selection_symbol, target_type, time_stamp) Lisp_Object selection_symbol, target_type, time_stamp; { Lisp_Object val = Qnil; @@ -764,7 +765,7 @@ Disowning it means there is no such selection. */) Lisp_Object selection; Lisp_Object time; { - OSErr err; + OSStatus err; ScrapRef scrap; Lisp_Object local_selection_data; @@ -819,7 +820,7 @@ Disowning it means there is no such selection. */) DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p, 0, 1, 0, - doc: /* Whether the current Emacs process owns the given Selection. + doc: /* Whether the current Emacs process owns the given SELECTION. The arg should be the name of the selection in question, typically one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. For convenience, the symbol nil is the same as `PRIMARY', @@ -827,7 +828,7 @@ and t is the same as `SECONDARY'. */) (selection) Lisp_Object selection; { - OSErr err; + OSStatus err; ScrapRef scrap; Lisp_Object result = Qnil, local_selection_data; @@ -864,7 +865,7 @@ and t is the same as `SECONDARY'. */) DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p, 0, 1, 0, - doc: /* Whether there is an owner for the given Selection. + doc: /* Whether there is an owner for the given SELECTION. The arg should be the name of the selection in question, typically one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. For convenience, the symbol nil is the same as `PRIMARY', @@ -872,7 +873,7 @@ and t is the same as `SECONDARY'. */) (selection) Lisp_Object selection; { - OSErr err; + OSStatus err; ScrapRef scrap; Lisp_Object result = Qnil, rest; @@ -906,6 +907,711 @@ and t is the same as `SECONDARY'. */) } +/*********************************************************************** + Apple event support +***********************************************************************/ +int mac_ready_for_apple_events = 0; +static Lisp_Object Vmac_apple_event_map; +static Lisp_Object Qmac_apple_event_class, Qmac_apple_event_id; +static Lisp_Object Qemacs_suspension_id; +extern Lisp_Object Qundefined; +extern void mac_store_apple_event P_ ((Lisp_Object, Lisp_Object, + const AEDesc *)); + +struct apple_event_binding +{ + UInt32 code; /* Apple event class or ID. */ + Lisp_Object key, binding; +}; + +struct suspended_ae_info +{ + UInt32 expiration_tick, suspension_id; + AppleEvent apple_event, reply; + struct suspended_ae_info *next; +}; + +/* List of apple events deferred at the startup time. */ +static struct suspended_ae_info *deferred_apple_events = NULL; + +/* List of suspended apple events, in order of expiration_tick. */ +static struct suspended_ae_info *suspended_apple_events = NULL; + +static void +find_event_binding_fun (key, binding, args, data) + Lisp_Object key, binding, args; + void *data; +{ + struct apple_event_binding *event_binding = + (struct apple_event_binding *)data; + Lisp_Object code_string; + + if (!SYMBOLP (key)) + return; + code_string = Fget (key, args); + if (STRINGP (code_string) && SBYTES (code_string) == 4 + && (EndianU32_BtoN (*((UInt32 *) SDATA (code_string))) + == event_binding->code)) + { + event_binding->key = key; + event_binding->binding = binding; + } +} + +static void +find_event_binding (keymap, event_binding, class_p) + Lisp_Object keymap; + struct apple_event_binding *event_binding; + int class_p; +{ + if (event_binding->code == 0) + event_binding->binding = + access_keymap (keymap, event_binding->key, 0, 1, 0); + else + { + event_binding->binding = Qnil; + map_keymap (keymap, find_event_binding_fun, + class_p ? Qmac_apple_event_class : Qmac_apple_event_id, + event_binding, 0); + } +} + +void +mac_find_apple_event_spec (class, id, class_key, id_key, binding) + AEEventClass class; + AEEventID id; + Lisp_Object *class_key, *id_key, *binding; +{ + struct apple_event_binding event_binding; + Lisp_Object keymap; + + *binding = Qnil; + + keymap = get_keymap (Vmac_apple_event_map, 0, 0); + if (NILP (keymap)) + return; + + event_binding.code = class; + event_binding.key = *class_key; + event_binding.binding = Qnil; + find_event_binding (keymap, &event_binding, 1); + *class_key = event_binding.key; + keymap = get_keymap (event_binding.binding, 0, 0); + if (NILP (keymap)) + return; + + event_binding.code = id; + event_binding.key = *id_key; + event_binding.binding = Qnil; + find_event_binding (keymap, &event_binding, 0); + *id_key = event_binding.key; + *binding = event_binding.binding; +} + +static OSErr +defer_apple_events (apple_event, reply) + const AppleEvent *apple_event, *reply; +{ + OSErr err; + struct suspended_ae_info *new; + + new = xmalloc (sizeof (struct suspended_ae_info)); + bzero (new, sizeof (struct suspended_ae_info)); + new->apple_event.descriptorType = typeNull; + new->reply.descriptorType = typeNull; + + err = AESuspendTheCurrentEvent (apple_event); + + /* Mac OS 10.3 Xcode manual says AESuspendTheCurrentEvent makes + copies of the Apple event and the reply, but Mac OS 10.4 Xcode + manual says it doesn't. Anyway we create copies of them and save + them in `deferred_apple_events'. */ + if (err == noErr) + err = AEDuplicateDesc (apple_event, &new->apple_event); + if (err == noErr) + err = AEDuplicateDesc (reply, &new->reply); + if (err == noErr) + { + new->next = deferred_apple_events; + deferred_apple_events = new; + } + else + { + AEDisposeDesc (&new->apple_event); + AEDisposeDesc (&new->reply); + xfree (new); + } + + return err; +} + +static OSErr +mac_handle_apple_event_1 (class, id, apple_event, reply) + Lisp_Object class, id; + const AppleEvent *apple_event; + AppleEvent *reply; +{ + OSErr err; + static UInt32 suspension_id = 0; + struct suspended_ae_info *new; + + new = xmalloc (sizeof (struct suspended_ae_info)); + bzero (new, sizeof (struct suspended_ae_info)); + new->apple_event.descriptorType = typeNull; + new->reply.descriptorType = typeNull; + + err = AESuspendTheCurrentEvent (apple_event); + if (err == noErr) + err = AEDuplicateDesc (apple_event, &new->apple_event); + if (err == noErr) + err = AEDuplicateDesc (reply, &new->reply); + if (err == noErr) + err = AEPutAttributePtr (&new->apple_event, KEY_EMACS_SUSPENSION_ID_ATTR, + typeUInt32, &suspension_id, sizeof (UInt32)); + if (err == noErr) + { + OSErr err1; + SInt32 reply_requested; + + err1 = AEGetAttributePtr (&new->apple_event, keyReplyRequestedAttr, + typeSInt32, NULL, &reply_requested, + sizeof (SInt32), NULL); + if (err1 != noErr) + { + /* Emulate keyReplyRequestedAttr in older versions. */ + reply_requested = reply->descriptorType != typeNull; + err = AEPutAttributePtr (&new->apple_event, keyReplyRequestedAttr, + typeSInt32, &reply_requested, + sizeof (SInt32)); + } + } + if (err == noErr) + { + SInt32 timeout = 0; + struct suspended_ae_info **p; + + new->suspension_id = suspension_id; + suspension_id++; + err = AEGetAttributePtr (apple_event, keyTimeoutAttr, typeSInt32, + NULL, &timeout, sizeof (SInt32), NULL); + new->expiration_tick = TickCount () + timeout; + + for (p = &suspended_apple_events; *p; p = &(*p)->next) + if ((*p)->expiration_tick >= new->expiration_tick) + break; + new->next = *p; + *p = new; + + mac_store_apple_event (class, id, &new->apple_event); + } + else + { + AEDisposeDesc (&new->reply); + AEDisposeDesc (&new->apple_event); + xfree (new); + } + + return err; +} + +static pascal OSErr +mac_handle_apple_event (apple_event, reply, refcon) + const AppleEvent *apple_event; + AppleEvent *reply; + SInt32 refcon; +{ + OSErr err; + UInt32 suspension_id; + AEEventClass event_class; + AEEventID event_id; + Lisp_Object class_key, id_key, binding; + + if (!mac_ready_for_apple_events) + { + err = defer_apple_events (apple_event, reply); + if (err != noErr) + return errAEEventNotHandled; + return noErr; + } + + err = AEGetAttributePtr (apple_event, KEY_EMACS_SUSPENSION_ID_ATTR, + typeUInt32, NULL, + &suspension_id, sizeof (UInt32), NULL); + if (err == noErr) + /* Previously suspended event. Pass it to the next handler. */ + return errAEEventNotHandled; + + err = AEGetAttributePtr (apple_event, keyEventClassAttr, typeType, NULL, + &event_class, sizeof (AEEventClass), NULL); + if (err == noErr) + err = AEGetAttributePtr (apple_event, keyEventIDAttr, typeType, NULL, + &event_id, sizeof (AEEventID), NULL); + if (err == noErr) + { + mac_find_apple_event_spec (event_class, event_id, + &class_key, &id_key, &binding); + if (!NILP (binding) && !EQ (binding, Qundefined)) + { + if (INTEGERP (binding)) + return XINT (binding); + err = mac_handle_apple_event_1 (class_key, id_key, + apple_event, reply); + } + else + err = errAEEventNotHandled; + } + if (err == noErr) + return noErr; + else + return errAEEventNotHandled; +} + +static int +cleanup_suspended_apple_events (head, all_p) + struct suspended_ae_info **head; + int all_p; +{ + UInt32 current_tick = TickCount (), nresumed = 0; + struct suspended_ae_info *p, *next; + + for (p = *head; p; p = next) + { + if (!all_p && p->expiration_tick > current_tick) + break; + AESetTheCurrentEvent (&p->apple_event); + AEResumeTheCurrentEvent (&p->apple_event, &p->reply, + (AEEventHandlerUPP) kAENoDispatch, 0); + AEDisposeDesc (&p->reply); + AEDisposeDesc (&p->apple_event); + nresumed++; + next = p->next; + xfree (p); + } + *head = p; + + return nresumed; +} + +static void +cleanup_all_suspended_apple_events () +{ + cleanup_suspended_apple_events (&deferred_apple_events, 1); + cleanup_suspended_apple_events (&suspended_apple_events, 1); +} + +void +init_apple_event_handler () +{ + OSErr err; + long result; + + /* Make sure we have Apple events before starting. */ + err = Gestalt (gestaltAppleEventsAttr, &result); + if (err != noErr) + abort (); + + if (!(result & (1 << gestaltAppleEventsPresent))) + abort (); + + err = AEInstallEventHandler (typeWildCard, typeWildCard, +#if TARGET_API_MAC_CARBON + NewAEEventHandlerUPP (mac_handle_apple_event), +#else + NewAEEventHandlerProc (mac_handle_apple_event), +#endif + 0L, false); + if (err != noErr) + abort (); + + atexit (cleanup_all_suspended_apple_events); +} + +static UInt32 +get_suspension_id (apple_event) + Lisp_Object apple_event; +{ + Lisp_Object tem; + + CHECK_CONS (apple_event); + CHECK_STRING_CAR (apple_event); + if (SBYTES (XCAR (apple_event)) != 4 + || strcmp (SDATA (XCAR (apple_event)), "aevt") != 0) + error ("Not an apple event"); + + tem = assq_no_quit (Qemacs_suspension_id, XCDR (apple_event)); + if (NILP (tem)) + error ("Suspension ID not available"); + + tem = XCDR (tem); + if (!(CONSP (tem) + && STRINGP (XCAR (tem)) && SBYTES (XCAR (tem)) == 4 + && strcmp (SDATA (XCAR (tem)), "magn") == 0 + && STRINGP (XCDR (tem)) && SBYTES (XCDR (tem)) == 4)) + error ("Bad suspension ID format"); + + return *((UInt32 *) SDATA (XCDR (tem))); +} + + +DEFUN ("mac-process-deferred-apple-events", Fmac_process_deferred_apple_events, Smac_process_deferred_apple_events, 0, 0, 0, + doc: /* Process Apple events that are deferred at the startup time. */) + () +{ + if (mac_ready_for_apple_events) + return Qnil; + + BLOCK_INPUT; + mac_ready_for_apple_events = 1; + if (deferred_apple_events) + { + struct suspended_ae_info *prev, *tail, *next; + + /* `nreverse' deferred_apple_events. */ + prev = NULL; + for (tail = deferred_apple_events; tail; tail = next) + { + next = tail->next; + tail->next = prev; + prev = tail; + } + + /* Now `prev' points to the first cell. */ + for (tail = prev; tail; tail = next) + { + next = tail->next; + AEResumeTheCurrentEvent (&tail->apple_event, &tail->reply, + ((AEEventHandlerUPP) + kAEUseStandardDispatch), 0); + AEDisposeDesc (&tail->reply); + AEDisposeDesc (&tail->apple_event); + xfree (tail); + } + + deferred_apple_events = NULL; + } + UNBLOCK_INPUT; + + return Qt; +} + +DEFUN ("mac-cleanup-expired-apple-events", Fmac_cleanup_expired_apple_events, Smac_cleanup_expired_apple_events, 0, 0, 0, + doc: /* Clean up expired Apple events. +Return the number of expired events. */) + () +{ + int nexpired; + + BLOCK_INPUT; + nexpired = cleanup_suspended_apple_events (&suspended_apple_events, 0); + UNBLOCK_INPUT; + + return make_number (nexpired); +} + +DEFUN ("mac-ae-set-reply-parameter", Fmac_ae_set_reply_parameter, Smac_ae_set_reply_parameter, 3, 3, 0, + doc: /* Set parameter KEYWORD to DESCRIPTOR on reply of APPLE-EVENT. +KEYWORD is a 4-byte string. DESCRIPTOR is a Lisp representation of an +Apple event descriptor. It has the form of (TYPE . DATA), where TYPE +is a 4-byte string. Valid format of DATA is as follows: + + * If TYPE is "null", then DATA is nil. + * If TYPE is "list", then DATA is a list (DESCRIPTOR1 ... DESCRIPTORn). + * If TYPE is "reco", then DATA is a list ((KEYWORD1 . DESCRIPTOR1) + ... (KEYWORDn . DESCRIPTORn)). + * If TYPE is "aevt", then DATA is ignored and the descriptor is + treated as null. + * Otherwise, DATA is a string. + +If a (sub-)descriptor is in an invalid format, it is silently treated +as null. + +Return t if the parameter is successfully set. Otherwise return nil. */) + (apple_event, keyword, descriptor) + Lisp_Object apple_event, keyword, descriptor; +{ + Lisp_Object result = Qnil; + UInt32 suspension_id; + struct suspended_ae_info *p; + + suspension_id = get_suspension_id (apple_event); + + CHECK_STRING (keyword); + if (SBYTES (keyword) != 4) + error ("Apple event keyword must be a 4-byte string: %s", + SDATA (keyword)); + + BLOCK_INPUT; + for (p = suspended_apple_events; p; p = p->next) + if (p->suspension_id == suspension_id) + break; + if (p && p->reply.descriptorType != typeNull) + { + OSErr err; + + err = mac_ae_put_lisp (&p->reply, + EndianU32_BtoN (*((UInt32 *) SDATA (keyword))), + descriptor); + if (err == noErr) + result = Qt; + } + UNBLOCK_INPUT; + + return result; +} + +DEFUN ("mac-resume-apple-event", Fmac_resume_apple_event, Smac_resume_apple_event, 1, 2, 0, + doc: /* Resume handling of APPLE-EVENT. +Every Apple event handled by the Lisp interpreter is suspended first. +This function resumes such a suspended event either to complete Apple +event handling to give a reply, or to redispatch it to other handlers. + +If optional ERROR-CODE is an integer, it specifies the error number +that is set in the reply. If ERROR-CODE is t, the resumed event is +handled with the standard dispatching mechanism, but it is not handled +by Emacs again, thus it is redispatched to other handlers. + +Return t if APPLE-EVENT is successfully resumed. Otherwise return +nil, which means the event is already resumed or expired. */) + (apple_event, error_code) + Lisp_Object apple_event, error_code; +{ + Lisp_Object result = Qnil; + UInt32 suspension_id; + struct suspended_ae_info **p, *ae; + + suspension_id = get_suspension_id (apple_event); + + BLOCK_INPUT; + for (p = &suspended_apple_events; *p; p = &(*p)->next) + if ((*p)->suspension_id == suspension_id) + break; + if (*p) + { + ae = *p; + *p = (*p)->next; + if (INTEGERP (error_code) + && ae->apple_event.descriptorType != typeNull) + { + SInt32 errn = XINT (error_code); + + AEPutParamPtr (&ae->reply, keyErrorNumber, typeSInt32, + &errn, sizeof (SInt32)); + } + AESetTheCurrentEvent (&ae->apple_event); + AEResumeTheCurrentEvent (&ae->apple_event, &ae->reply, + ((AEEventHandlerUPP) + (EQ (error_code, Qt) ? + kAEUseStandardDispatch : kAENoDispatch)), + 0); + AEDisposeDesc (&ae->reply); + AEDisposeDesc (&ae->apple_event); + xfree (ae); + result = Qt; + } + UNBLOCK_INPUT; + + return result; +} + + +/*********************************************************************** + Drag and drop support +***********************************************************************/ +#if TARGET_API_MAC_CARBON +static Lisp_Object Vmac_dnd_known_types; +static pascal OSErr mac_do_track_drag P_ ((DragTrackingMessage, WindowRef, + void *, DragRef)); +static pascal OSErr mac_do_receive_drag P_ ((WindowRef, void *, DragRef)); +static DragTrackingHandlerUPP mac_do_track_dragUPP = NULL; +static DragReceiveHandlerUPP mac_do_receive_dragUPP = NULL; + +extern void mac_store_drag_event P_ ((WindowRef, Point, SInt16, + const AEDesc *)); + +static pascal OSErr +mac_do_track_drag (message, window, refcon, drag) + DragTrackingMessage message; + WindowRef window; + void *refcon; + DragRef drag; +{ + OSErr err = noErr; + static int can_accept; + UInt16 num_items, index; + + if (GetFrontWindowOfClass (kMovableModalWindowClass, false)) + return dragNotAcceptedErr; + + switch (message) + { + case kDragTrackingEnterHandler: + err = CountDragItems (drag, &num_items); + if (err != noErr) + break; + can_accept = 0; + for (index = 1; index <= num_items; index++) + { + ItemReference item; + FlavorFlags flags; + Lisp_Object rest; + + err = GetDragItemReferenceNumber (drag, index, &item); + if (err != noErr) + continue; + for (rest = Vmac_dnd_known_types; CONSP (rest); rest = XCDR (rest)) + { + Lisp_Object str; + FlavorType type; + + str = XCAR (rest); + if (!(STRINGP (str) && SBYTES (str) == 4)) + continue; + type = EndianU32_BtoN (*((UInt32 *) SDATA (str))); + + err = GetFlavorFlags (drag, item, type, &flags); + if (err == noErr) + { + can_accept = 1; + break; + } + } + } + break; + + case kDragTrackingEnterWindow: + if (can_accept) + { + RgnHandle hilite_rgn = NewRgn (); + + if (hilite_rgn) + { + Rect r; + + GetWindowPortBounds (window, &r); + OffsetRect (&r, -r.left, -r.top); + RectRgn (hilite_rgn, &r); + ShowDragHilite (drag, hilite_rgn, true); + DisposeRgn (hilite_rgn); + } + SetThemeCursor (kThemeCopyArrowCursor); + } + break; + + case kDragTrackingInWindow: + break; + + case kDragTrackingLeaveWindow: + if (can_accept) + { + HideDragHilite (drag); + SetThemeCursor (kThemeArrowCursor); + } + break; + + case kDragTrackingLeaveHandler: + break; + } + + if (err != noErr) + return dragNotAcceptedErr; + return noErr; +} + +static pascal OSErr +mac_do_receive_drag (window, refcon, drag) + WindowRef window; + void *refcon; + DragRef drag; +{ + OSErr err; + int num_types, i; + Lisp_Object rest, str; + FlavorType *types; + AppleEvent apple_event; + Point mouse_pos; + SInt16 modifiers; + + if (GetFrontWindowOfClass (kMovableModalWindowClass, false)) + return dragNotAcceptedErr; + + num_types = 0; + for (rest = Vmac_dnd_known_types; CONSP (rest); rest = XCDR (rest)) + { + str = XCAR (rest); + if (STRINGP (str) && SBYTES (str) == 4) + num_types++; + } + + types = xmalloc (sizeof (FlavorType) * num_types); + i = 0; + for (rest = Vmac_dnd_known_types; CONSP (rest); rest = XCDR (rest)) + { + str = XCAR (rest); + if (STRINGP (str) && SBYTES (str) == 4) + types[i++] = EndianU32_BtoN (*((UInt32 *) SDATA (str))); + } + + err = create_apple_event_from_drag_ref (drag, num_types, types, + &apple_event); + xfree (types); + + if (err == noErr) + err = GetDragMouse (drag, &mouse_pos, NULL); + if (err == noErr) + { + GlobalToLocal (&mouse_pos); + err = GetDragModifiers (drag, NULL, NULL, &modifiers); + } + + if (err == noErr) + { + mac_store_drag_event (window, mouse_pos, modifiers, &apple_event); + AEDisposeDesc (&apple_event); + /* Post a harmless event so as to wake up from ReceiveNextEvent. */ + mac_post_mouse_moved_event (); + return noErr; + } + else + return dragNotAcceptedErr; +} +#endif /* TARGET_API_MAC_CARBON */ + +OSErr +install_drag_handler (window) + WindowRef window; +{ + OSErr err = noErr; + +#if TARGET_API_MAC_CARBON + if (mac_do_track_dragUPP == NULL) + mac_do_track_dragUPP = NewDragTrackingHandlerUPP (mac_do_track_drag); + if (mac_do_receive_dragUPP == NULL) + mac_do_receive_dragUPP = NewDragReceiveHandlerUPP (mac_do_receive_drag); + + err = InstallTrackingHandler (mac_do_track_dragUPP, window, NULL); + if (err == noErr) + err = InstallReceiveHandler (mac_do_receive_dragUPP, window, NULL); +#endif + + return err; +} + +void +remove_drag_handler (window) + WindowRef window; +{ +#if TARGET_API_MAC_CARBON + if (mac_do_track_dragUPP) + RemoveTrackingHandler (mac_do_track_dragUPP, window); + if (mac_do_receive_dragUPP) + RemoveReceiveHandler (mac_do_receive_dragUPP, window); +#endif +} + + +/*********************************************************************** + Services menu support +***********************************************************************/ #ifdef MAC_OSX void init_service_handler () @@ -918,7 +1624,48 @@ init_service_handler () GetEventTypeCount (specs), specs, NULL, NULL); } -extern void mac_store_services_event P_ ((EventRef)); +extern OSStatus mac_store_service_event P_ ((EventRef)); + +static OSStatus +copy_scrap_flavor_data (from_scrap, to_scrap, flavor_type) + ScrapRef from_scrap, to_scrap; + ScrapFlavorType flavor_type; +{ + OSStatus err; + Size size, size_allocated; + char *buf = NULL; + + err = GetScrapFlavorSize (from_scrap, flavor_type, &size); + if (err == noErr) + buf = xmalloc (size); + while (buf) + { + size_allocated = size; + err = GetScrapFlavorData (from_scrap, flavor_type, &size, buf); + if (err != noErr) + { + xfree (buf); + buf = NULL; + } + else if (size_allocated < size) + buf = xrealloc (buf, size); + else + break; + } + if (err == noErr) + { + if (buf == NULL) + err = memFullErr; + else + { + err = PutScrapFlavor (to_scrap, flavor_type, kScrapFlavorMaskNone, + size, buf); + xfree (buf); + } + } + + return err; +} static OSStatus mac_handle_service_event (call_ref, event, data) @@ -927,97 +1674,116 @@ mac_handle_service_event (call_ref, event, data) void *data; { OSStatus err = noErr; - ScrapRef cur_scrap; + ScrapRef cur_scrap, specific_scrap; + UInt32 event_kind = GetEventKind (event); + CFMutableArrayRef copy_types, paste_types; + CFStringRef type; + Lisp_Object rest; + ScrapFlavorType flavor_type; - /* Check if Vmac_services_selection is a valid selection that has a + /* Check if Vmac_service_selection is a valid selection that has a corresponding scrap. */ - if (!SYMBOLP (Vmac_services_selection)) + if (!SYMBOLP (Vmac_service_selection)) err = eventNotHandledErr; else - err = get_scrap_from_symbol (Vmac_services_selection, 0, &cur_scrap); + err = get_scrap_from_symbol (Vmac_service_selection, 0, &cur_scrap); if (!(err == noErr && cur_scrap)) return eventNotHandledErr; - switch (GetEventKind (event)) + switch (event_kind) { case kEventServiceGetTypes: - { - CFMutableArrayRef copy_types, paste_types; - CFStringRef type; - Lisp_Object rest; - ScrapFlavorType flavor_type; - - /* Set paste types. */ - err = GetEventParameter (event, kEventParamServicePasteTypes, - typeCFMutableArrayRef, NULL, - sizeof (CFMutableArrayRef), NULL, - &paste_types); - if (err == noErr) - for (rest = Vselection_converter_alist; CONSP (rest); - rest = XCDR (rest)) - if (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest))) - && (flavor_type = - get_flavor_type_from_symbol (XCAR (XCAR (rest))))) + /* Set paste types. */ + err = GetEventParameter (event, kEventParamServicePasteTypes, + typeCFMutableArrayRef, NULL, + sizeof (CFMutableArrayRef), NULL, + &paste_types); + if (err != noErr) + break; + + for (rest = Vselection_converter_alist; CONSP (rest); + rest = XCDR (rest)) + if (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest))) + && (flavor_type = + get_flavor_type_from_symbol (XCAR (XCAR (rest))))) + { + type = CreateTypeStringWithOSType (flavor_type); + if (type) { - type = CreateTypeStringWithOSType (flavor_type); - if (type) - { - CFArrayAppendValue (paste_types, type); - CFRelease (type); - } + CFArrayAppendValue (paste_types, type); + CFRelease (type); } + } - /* Set copy types. */ - err = GetEventParameter (event, kEventParamServiceCopyTypes, - typeCFMutableArrayRef, NULL, - sizeof (CFMutableArrayRef), NULL, - ©_types); - if (err == noErr - && !NILP (Fx_selection_owner_p (Vmac_services_selection))) - for (rest = get_scrap_target_type_list (cur_scrap); - CONSP (rest) && SYMBOLP (XCAR (rest)); rest = XCDR (rest)) - { - flavor_type = get_flavor_type_from_symbol (XCAR (rest)); - if (flavor_type) - { - type = CreateTypeStringWithOSType (flavor_type); - if (type) - { - CFArrayAppendValue (copy_types, type); - CFRelease (type); - } - } - } - } - break; + /* Set copy types. */ + err = GetEventParameter (event, kEventParamServiceCopyTypes, + typeCFMutableArrayRef, NULL, + sizeof (CFMutableArrayRef), NULL, + ©_types); + if (err != noErr) + break; + + if (NILP (Fx_selection_owner_p (Vmac_service_selection))) + break; + else + goto copy_all_flavors; case kEventServiceCopy: - { - ScrapRef specific_scrap; - Lisp_Object rest, data; - - err = GetEventParameter (event, kEventParamScrapRef, - typeScrapRef, NULL, - sizeof (ScrapRef), NULL, &specific_scrap); - if (err == noErr - && !NILP (Fx_selection_owner_p (Vmac_services_selection))) - for (rest = get_scrap_target_type_list (cur_scrap); - CONSP (rest) && SYMBOLP (XCAR (rest)); rest = XCDR (rest)) - { - data = get_scrap_string (cur_scrap, XCAR (rest)); - if (STRINGP (data)) - err = put_scrap_string (specific_scrap, XCAR (rest), data); - } - else + err = GetEventParameter (event, kEventParamScrapRef, + typeScrapRef, NULL, + sizeof (ScrapRef), NULL, &specific_scrap); + if (err != noErr + || NILP (Fx_selection_owner_p (Vmac_service_selection))) + { err = eventNotHandledErr; + break; + } + + copy_all_flavors: + { + UInt32 count, i; + ScrapFlavorInfo *flavor_info = NULL; + ScrapFlavorFlags flags; + + err = GetScrapFlavorCount (cur_scrap, &count); + if (err == noErr) + flavor_info = xmalloc (sizeof (ScrapFlavorInfo) * count); + err = GetScrapFlavorInfoList (cur_scrap, &count, flavor_info); + if (err != noErr) + { + xfree (flavor_info); + flavor_info = NULL; + } + if (flavor_info == NULL) + break; + + for (i = 0; i < count; i++) + { + flavor_type = flavor_info[i].flavorType; + err = GetScrapFlavorFlags (cur_scrap, flavor_type, &flags); + if (err == noErr && !(flags & kScrapFlavorMaskSenderOnly)) + { + if (event_kind == kEventServiceCopy) + err = copy_scrap_flavor_data (cur_scrap, specific_scrap, + flavor_type); + else /* event_kind == kEventServiceGetTypes */ + { + type = CreateTypeStringWithOSType (flavor_type); + if (type) + { + CFArrayAppendValue (copy_types, type); + CFRelease (type); + } + } + } + } + xfree (flavor_info); } break; case kEventServicePaste: case kEventServicePerform: { - ScrapRef specific_scrap; - Lisp_Object rest, data; int data_exists_p = 0; err = GetEventParameter (event, kEventParamScrapRef, typeScrapRef, @@ -1031,25 +1797,24 @@ mac_handle_service_event (call_ref, event, data) { if (! (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest))))) continue; - data = get_scrap_string (specific_scrap, XCAR (XCAR (rest))); - if (STRINGP (data)) - { - err = put_scrap_string (cur_scrap, XCAR (XCAR (rest)), - data); - if (err != noErr) - break; - data_exists_p = 1; - } + flavor_type = get_flavor_type_from_symbol (XCAR (XCAR (rest))); + if (flavor_type == 0) + continue; + err = copy_scrap_flavor_data (specific_scrap, cur_scrap, + flavor_type); + if (err == noErr) + data_exists_p = 1; } - if (err == noErr) - if (data_exists_p) - mac_store_application_menu_event (event); - else - err = eventNotHandledErr; + if (!data_exists_p) + err = eventNotHandledErr; + else + err = mac_store_service_event (event); } break; } + if (err != noErr) + err = eventNotHandledErr; return err; } #endif @@ -1063,6 +1828,10 @@ syms_of_macselect () defsubr (&Sx_disown_selection_internal); defsubr (&Sx_selection_owner_p); defsubr (&Sx_selection_exists_p); + defsubr (&Smac_process_deferred_apple_events); + defsubr (&Smac_cleanup_expired_apple_events); + defsubr (&Smac_resume_apple_event); + defsubr (&Smac_ae_set_reply_parameter); Vselection_alist = Qnil; staticpro (&Vselection_alist); @@ -1075,7 +1844,7 @@ a desired type to which the selection should be converted; and the local selection value (whatever was given to `x-own-selection'). The function should return the value to send to the Scrap Manager -\(a string). A return value of nil +\(must be a string). A return value of nil means that the conversion could not be done. A return value which is the symbol `NULL' means that a side-effect was executed, @@ -1104,9 +1873,26 @@ next communication only. After the communication, this variable is set to nil. */); Vnext_selection_coding_system = Qnil; - DEFVAR_LISP ("mac-services-selection", &Vmac_services_selection, + DEFVAR_LISP ("mac-apple-event-map", &Vmac_apple_event_map, + doc: /* Keymap for Apple events handled by Emacs. */); + Vmac_apple_event_map = Qnil; + +#if TARGET_API_MAC_CARBON + DEFVAR_LISP ("mac-dnd-known-types", &Vmac_dnd_known_types, + doc: /* The types accepted by default for dropped data. +The types are chosen in the order they appear in the list. */); + Vmac_dnd_known_types = list4 (build_string ("hfs "), build_string ("utxt"), + build_string ("TEXT"), build_string ("TIFF")); +#ifdef MAC_OSX + Vmac_dnd_known_types = Fcons (build_string ("furl"), Vmac_dnd_known_types); +#endif +#endif + +#ifdef MAC_OSX + DEFVAR_LISP ("mac-service-selection", &Vmac_service_selection, doc: /* Selection name for communication via Services menu. */); - Vmac_services_selection = intern ("CLIPBOARD"); + Vmac_service_selection = intern ("PRIMARY"); +#endif QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY); QSECONDARY = intern ("SECONDARY"); staticpro (&QSECONDARY); @@ -1121,6 +1907,15 @@ set to nil. */); Qmac_ostype = intern ("mac-ostype"); staticpro (&Qmac_ostype); + + Qmac_apple_event_class = intern ("mac-apple-event-class"); + staticpro (&Qmac_apple_event_class); + + Qmac_apple_event_id = intern ("mac-apple-event-id"); + staticpro (&Qmac_apple_event_id); + + Qemacs_suspension_id = intern ("emacs-suspension-id"); + staticpro (&Qemacs_suspension_id); } /* arch-tag: f3c91ad8-99e0-4bd6-9eef-251b2f848732