/* Selection processing for Emacs on Mac OS.
- Copyright (C) 2005, 2006 Free Software Foundation, Inc.
+ Copyright (C) 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
+the Free Software Foundation; either version 3, or (at your option)
any later version.
GNU Emacs is distributed in the hope that it will be useful,
#include "blockinput.h"
#include "keymap.h"
-#if !TARGET_API_MAC_CARBON
+#if TARGET_API_MAC_CARBON
+typedef ScrapRef Selection;
+#else /* !TARGET_API_MAC_CARBON */
+#include <Scrap.h>
#include <Endian.h>
-typedef int ScrapRef;
-typedef ResType ScrapFlavorType;
+typedef int Selection;
#endif /* !TARGET_API_MAC_CARBON */
-static OSErr 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 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 Lisp_Object get_scrap_target_type_list P_ ((ScrapRef));
+static OSStatus mac_get_selection_from_symbol P_ ((Lisp_Object, int,
+ Selection *));
+static ScrapFlavorType get_flavor_type_from_symbol P_ ((Lisp_Object,
+ Selection));
+static int mac_valid_selection_target_p P_ ((Lisp_Object));
+static OSStatus mac_clear_selection P_ ((Selection *));
+static Lisp_Object mac_get_selection_ownership_info P_ ((Selection));
+static int mac_valid_selection_value_p P_ ((Lisp_Object, Lisp_Object));
+static OSStatus mac_put_selection_value P_ ((Selection, Lisp_Object,
+ Lisp_Object));
+static int mac_selection_has_target_p P_ ((Selection, Lisp_Object));
+static Lisp_Object mac_get_selection_value P_ ((Selection, Lisp_Object));
+static Lisp_Object mac_get_selection_target_list P_ ((Selection));
static void x_own_selection P_ ((Lisp_Object, Lisp_Object));
static Lisp_Object x_get_local_selection P_ ((Lisp_Object, Lisp_Object, int));
static Lisp_Object x_get_foreign_selection P_ ((Lisp_Object,
Lisp_Object QPRIMARY, QSECONDARY, QTIMESTAMP, QTARGETS;
static Lisp_Object Vx_lost_selection_functions;
-/* Coding system for communicating with other programs via scrap. */
+/* Coding system for communicating with other programs via selections. */
static Lisp_Object Vselection_coding_system;
/* Coding system for the next communicating with other programs. */
extern unsigned long last_event_timestamp;
/* This is an association list whose elements are of the form
- ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
+ ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME OWNERSHIP-INFO)
SELECTION-NAME is a lisp symbol.
SELECTION-VALUE is the value that emacs owns for that selection.
It may be any kind of Lisp object.
SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
as a cons of two 16-bit numbers (making a 32 bit time.)
FRAME is the frame for which we made the selection.
- If there is an entry in this alist, and the data for the flavor
- type SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP in the corresponding scrap
- (if exists) coincides with SELECTION-TIMESTAMP, then it can be
- assumed that Emacs owns that selection.
+ OWNERSHIP-INFO is a value saved when emacs owns for that selection.
+ If another application takes the ownership of that selection
+ later, then newly examined ownership info value should be
+ different from the saved one.
+ If there is an entry in this alist, the current ownership info for
+ the selection coincides with OWNERSHIP-INFO, then it can be
+ assumed that Emacs owns that selection.
The only (eq) parts of this list that are visible from Lisp are the
selection-values. */
static Lisp_Object Vselection_alist;
-#define SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP 'Etsp'
-
/* This is an alist whose CARs are selection-types and whose CDRs are
the names of Lisp functions to call to convert the given Emacs
selection value to a string representing the given selection type.
#ifdef MAC_OSX
/* Selection name for communication via Services menu. */
-static Lisp_Object Vmac_services_selection;
+static Lisp_Object Vmac_service_selection;
#endif
\f
-/* 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. */
+/* Get a reference to the selection corresponding to the symbol SYM.
+ The reference is set to *SEL, and it becomes NULL if there's no
+ corresponding selection. Clear the selection if CLEAR_P is
+ non-zero. */
-static OSErr
-get_scrap_from_symbol (sym, clear_p, scrap)
+static OSStatus
+mac_get_selection_from_symbol (sym, clear_p, sel)
Lisp_Object sym;
int clear_p;
- ScrapRef *scrap;
+ Selection *sel;
{
- OSErr err = noErr;
+ OSStatus err = noErr;
Lisp_Object str = Fget (sym, Qmac_scrap_name);
if (!STRINGP (str))
- *scrap = NULL;
+ *sel = NULL;
else
{
#if TARGET_API_MAC_CARBON
OptionBits options = (clear_p ? kScrapClearNamedScrap
: kScrapGetNamedScrap);
- err = GetScrapByName (scrap_name, options, scrap);
+ err = GetScrapByName (scrap_name, options, sel);
CFRelease (scrap_name);
#else /* !MAC_OSX */
if (clear_p)
err = ClearCurrentScrap ();
if (err == noErr)
- err = GetCurrentScrap (scrap);
+ err = GetCurrentScrap (sel);
#endif /* !MAC_OSX */
#else /* !TARGET_API_MAC_CARBON */
if (clear_p)
err = ZeroScrap ();
if (err == noErr)
- *scrap = 1;
+ *sel = 1;
#endif /* !TARGET_API_MAC_CARBON */
}
}
/* Get a scrap flavor type from the symbol SYM. Return 0 if no
- corresponding flavor type. */
+ corresponding flavor type. If SEL is non-zero, the return value is
+ non-zero only when the SEL has the flavor type. */
static ScrapFlavorType
-get_flavor_type_from_symbol (sym)
+get_flavor_type_from_symbol (sym, sel)
Lisp_Object sym;
+ Selection sel;
{
Lisp_Object str = Fget (sym, Qmac_ostype);
+ ScrapFlavorType flavor_type;
if (STRINGP (str) && SBYTES (str) == 4)
- return EndianU32_BtoN (*((UInt32 *) SDATA (str)));
+ flavor_type = EndianU32_BtoN (*((UInt32 *) SDATA (str)));
+ else
+ flavor_type = 0;
+
+ if (flavor_type && sel)
+ {
+#if TARGET_API_MAC_CARBON
+ OSStatus err;
+ ScrapFlavorFlags flags;
+
+ err = GetScrapFlavorFlags (sel, flavor_type, &flags);
+ if (err != noErr)
+ flavor_type = 0;
+#else /* !TARGET_API_MAC_CARBON */
+ SInt32 size, offset;
- return 0;
+ size = GetScrap (NULL, flavor_type, &offset);
+ if (size < 0)
+ flavor_type = 0;
+#endif /* !TARGET_API_MAC_CARBON */
+ }
+
+ return flavor_type;
}
-/* Check if the symbol SYM has a corresponding scrap flavor type. */
+/* Check if the symbol SYM has a corresponding selection target type. */
static int
-valid_scrap_target_type_p (sym)
+mac_valid_selection_target_p (sym)
Lisp_Object sym;
{
- return get_flavor_type_from_symbol (sym) != 0;
+ return get_flavor_type_from_symbol (sym, 0) != 0;
}
-/* Clear the scrap whose reference is *SCRAP. */
+/* Clear the selection whose reference is *SEL. */
-static INLINE OSErr
-clear_scrap (scrap)
- ScrapRef *scrap;
+static OSStatus
+mac_clear_selection (sel)
+ Selection *sel;
{
#if TARGET_API_MAC_CARBON
#ifdef MAC_OSX
- return ClearScrap (scrap);
+ return ClearScrap (sel);
#else
- return ClearCurrentScrap ();
+ OSStatus err;
+
+ err = ClearCurrentScrap ();
+ if (err == noErr)
+ err = GetCurrentScrap (sel);
+ return err;
#endif
#else /* !TARGET_API_MAC_CARBON */
return ZeroScrap ();
#endif /* !TARGET_API_MAC_CARBON */
}
-/* Put Lisp String STR to the scrap SCRAP. The target type is
- specified by TYPE. */
+/* Get ownership information for SEL. Emacs can detect a change of
+ the ownership by comparing saved and current values of the
+ ownership information. */
-static OSErr
-put_scrap_string (scrap, type, str)
- ScrapRef scrap;
- Lisp_Object type, str;
+static Lisp_Object
+mac_get_selection_ownership_info (sel)
+ Selection sel;
{
- ScrapFlavorType flavor_type = get_flavor_type_from_symbol (type);
-
- if (flavor_type == 0)
- return noTypeErr;
-
#if TARGET_API_MAC_CARBON
- return PutScrapFlavor (scrap, flavor_type, kScrapFlavorMaskNone,
- SBYTES (str), SDATA (str));
+ return long_to_cons ((unsigned long) sel);
#else /* !TARGET_API_MAC_CARBON */
- return PutScrap (SBYTES (str), flavor_type, SDATA (str));
+ ScrapStuffPtr scrap_info = InfoScrap ();
+
+ return make_number (scrap_info->scrapCount);
#endif /* !TARGET_API_MAC_CARBON */
}
-/* Put TIMESTAMP to the scrap SCRAP. The timestamp is used for
- checking if the scrap is owned by the process. */
+/* Return non-zero if VALUE is a valid selection value for TARGET. */
-static INLINE OSErr
-put_scrap_private_timestamp (scrap, timestamp)
- ScrapRef scrap;
- unsigned long timestamp;
+static int
+mac_valid_selection_value_p (value, target)
+ Lisp_Object value, target;
{
-#if TARGET_API_MAC_CARBON
- return PutScrapFlavor (scrap, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP,
- kScrapFlavorMaskSenderOnly,
- sizeof (timestamp), ×tamp);
-#else /* !TARGET_API_MAC_CARBON */
- return PutScrap (sizeof (timestamp), SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP,
- ×tamp);
-#endif /* !TARGET_API_MAC_CARBON */
+ return STRINGP (value);
}
-/* Check if data for the target type TYPE is available in SCRAP. */
+/* Put Lisp Object VALUE to the selection SEL. The target type is
+ specified by TARGET. */
-static ScrapFlavorType
-scrap_has_target_type (scrap, type)
- ScrapRef scrap;
- Lisp_Object type;
+static OSStatus
+mac_put_selection_value (sel, target, value)
+ Selection sel;
+ Lisp_Object target, value;
{
- OSErr err;
- ScrapFlavorType flavor_type = get_flavor_type_from_symbol (type);
+ ScrapFlavorType flavor_type = get_flavor_type_from_symbol (target, 0);
- if (flavor_type)
- {
-#if TARGET_API_MAC_CARBON
- ScrapFlavorFlags flags;
+ if (flavor_type == 0 || !STRINGP (value))
+ return noTypeErr;
- err = GetScrapFlavorFlags (scrap, flavor_type, &flags);
- if (err != noErr)
- flavor_type = 0;
+#if TARGET_API_MAC_CARBON
+ return PutScrapFlavor (sel, flavor_type, kScrapFlavorMaskNone,
+ SBYTES (value), SDATA (value));
#else /* !TARGET_API_MAC_CARBON */
- SInt32 size, offset;
-
- size = GetScrap (NULL, flavor_type, &offset);
- if (size < 0)
- flavor_type = 0;
+ return PutScrap (SBYTES (value), flavor_type, SDATA (value));
#endif /* !TARGET_API_MAC_CARBON */
- }
+}
- return flavor_type;
+/* Check if data for the target type TARGET is available in SEL. */
+
+static int
+mac_selection_has_target_p (sel, target)
+ Selection sel;
+ Lisp_Object target;
+{
+ return get_flavor_type_from_symbol (target, sel) != 0;
}
-/* Get data for the target type TYPE from SCRAP and create a Lisp
+/* Get data for the target type TARGET from SEL and create a Lisp
string. Return nil if failed to get data. */
static Lisp_Object
-get_scrap_string (scrap, type)
- ScrapRef scrap;
- Lisp_Object type;
+mac_get_selection_value (sel, target)
+ Selection sel;
+ Lisp_Object target;
{
- OSErr err;
+ OSStatus err;
Lisp_Object result = Qnil;
- ScrapFlavorType flavor_type = get_flavor_type_from_symbol (type);
+ ScrapFlavorType flavor_type = get_flavor_type_from_symbol (target, sel);
#if TARGET_API_MAC_CARBON
Size size;
if (flavor_type)
{
- err = GetScrapFlavorSize (scrap, flavor_type, &size);
+ err = GetScrapFlavorSize (sel, flavor_type, &size);
if (err == noErr)
{
do
{
result = make_uninit_string (size);
- err = GetScrapFlavorData (scrap, flavor_type,
+ err = GetScrapFlavorData (sel, flavor_type,
&size, SDATA (result));
if (err != noErr)
result = Qnil;
return result;
}
-/* Get timestamp from the scrap SCRAP and set to *TIMPSTAMP. */
-
-static OSErr
-get_scrap_private_timestamp (scrap, timestamp)
- ScrapRef scrap;
- unsigned long *timestamp;
-{
- OSErr 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);
-
- 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;
-
- size = GetScrap (NULL, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, &offset);
- if (size == sizeof (*timestamp))
- {
- handle = NewHandle (size);
- HLock (handle);
- size = GetScrap (handle, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, &offset);
- if (size == sizeof (*timestamp))
- *timestamp = *((unsigned long *) *handle);
- DisposeHandle (handle);
- }
- if (size != sizeof (*timestamp))
- err = noTypeErr;
-#endif /* !TARGET_API_MAC_CARBON */
-
- return err;
-}
-
-/* Get the list of target types in SCRAP. The return value is a list
- of target type symbols possibly followed by scrap flavor type
+/* Get the list of target types in SEL. The return value is a list of
+ target type symbols possibly followed by scrap flavor type
strings. */
static Lisp_Object
-get_scrap_target_type_list (scrap)
- ScrapRef scrap;
+mac_get_selection_target_list (sel)
+ Selection sel;
{
- Lisp_Object result = Qnil, rest, target_type;
+ Lisp_Object result = Qnil, rest, target;
#if TARGET_API_MAC_CARBON
- OSErr err;
+ OSStatus err;
UInt32 count, i, type;
ScrapFlavorInfo *flavor_info = NULL;
Lisp_Object strings = Qnil;
- err = GetScrapFlavorCount (scrap, &count);
+ err = GetScrapFlavorCount (sel, &count);
if (err == noErr)
flavor_info = xmalloc (sizeof (ScrapFlavorInfo) * count);
- err = GetScrapFlavorInfoList (scrap, &count, flavor_info);
+ err = GetScrapFlavorInfoList (sel, &count, flavor_info);
if (err != noErr)
{
xfree (flavor_info);
{
ScrapFlavorType flavor_type = 0;
- if (CONSP (XCAR (rest)) && SYMBOLP (target_type = XCAR (XCAR (rest)))
- && (flavor_type = scrap_has_target_type (scrap, target_type)))
+ if (CONSP (XCAR (rest))
+ && (target = XCAR (XCAR (rest)),
+ SYMBOLP (target))
+ && (flavor_type = get_flavor_type_from_symbol (target, sel)))
{
- result = Fcons (target_type, result);
+ result = Fcons (target, result);
#if TARGET_API_MAC_CARBON
for (i = 0; i < count; i++)
if (flavor_info[i].flavorType == flavor_type)
x_own_selection (selection_name, selection_value)
Lisp_Object selection_name, selection_value;
{
- OSErr err;
- ScrapRef scrap;
+ OSStatus err;
+ Selection sel;
struct gcpro gcpro1, gcpro2;
- Lisp_Object rest, handler_fn, value, type;
+ Lisp_Object rest, handler_fn, value, target_type;
int count;
CHECK_SYMBOL (selection_name);
BLOCK_INPUT;
- err = get_scrap_from_symbol (selection_name, 1, &scrap);
- if (err == noErr && scrap)
+ err = mac_get_selection_from_symbol (selection_name, 1, &sel);
+ if (err == noErr && sel)
{
/* Don't allow a quit within the converter.
When the user types C-g, he would be surprised
for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest))
{
if (!(CONSP (XCAR (rest))
- && SYMBOLP (type = XCAR (XCAR (rest)))
- && valid_scrap_target_type_p (type)
- && SYMBOLP (handler_fn = XCDR (XCAR (rest)))))
+ && (target_type = XCAR (XCAR (rest)),
+ SYMBOLP (target_type))
+ && mac_valid_selection_target_p (target_type)
+ && (handler_fn = XCDR (XCAR (rest)),
+ SYMBOLP (handler_fn))))
continue;
if (!NILP (handler_fn))
value = call3 (handler_fn, selection_name,
- type, selection_value);
+ target_type, selection_value);
- if (STRINGP (value))
- err = put_scrap_string (scrap, type, value);
+ if (NILP (value))
+ continue;
+
+ if (mac_valid_selection_value_p (value, target_type))
+ err = mac_put_selection_value (sel, target_type, value);
else if (CONSP (value)
- && EQ (XCAR (value), type)
- && STRINGP (XCDR (value)))
- err = put_scrap_string (scrap, type, XCDR (value));
+ && EQ (XCAR (value), target_type)
+ && mac_valid_selection_value_p (XCDR (value), target_type))
+ err = mac_put_selection_value (sel, target_type, XCDR (value));
}
unbind_to (count, Qnil);
-
- if (err == noErr)
- err = put_scrap_private_timestamp (scrap, last_event_timestamp);
}
UNBLOCK_INPUT;
UNGCPRO;
- if (scrap && err != noErr)
+ if (sel && err != noErr)
error ("Can't set selection");
/* Now update the local cache */
{
Lisp_Object selection_time;
Lisp_Object selection_data;
+ Lisp_Object ownership_info;
Lisp_Object prev_value;
selection_time = long_to_cons (last_event_timestamp);
+ if (sel)
+ ownership_info = mac_get_selection_ownership_info (sel);
+ else
+ ownership_info = Qnil; /* dummy value for local-only selection */
selection_data = Fcons (selection_name,
Fcons (selection_value,
Fcons (selection_time,
- Fcons (selected_frame, Qnil))));
+ Fcons (selected_frame,
+ Fcons (ownership_info,
+ Qnil)))));
prev_value = assq_no_quit (selection_name, Vselection_alist);
Vselection_alist = Fcons (selection_data, Vselection_alist);
if (!NILP (prev_value))
{
Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
- for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
+ for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest))
if (EQ (prev_value, Fcar (XCDR (rest))))
{
XSETCDR (rest, Fcdr (XCDR (rest)));
unbind_to (count, Qnil);
}
+ if (local_request)
+ return value;
+
/* Make sure this value is of a type that we could transmit
- to another X client. */
+ to another application. */
+ type = target_type;
check = value;
if (CONSP (value)
&& SYMBOLP (XCAR (value)))
type = XCAR (value),
check = XCDR (value);
- if (STRINGP (check)
- || VECTORP (check)
- || SYMBOLP (check)
- || INTEGERP (check)
- || NILP (value))
- return value;
- /* Check for a value that cons_to_long could handle. */
- else if (CONSP (check)
- && INTEGERP (XCAR (check))
- && (INTEGERP (XCDR (check))
- ||
- (CONSP (XCDR (check))
- && INTEGERP (XCAR (XCDR (check)))
- && NILP (XCDR (XCDR (check))))))
+ if (NILP (value) || mac_valid_selection_value_p (check, type))
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));
}
\f
}
/* Delete elements after the beginning of Vselection_alist. */
- for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
+ for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest))
if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest))))))))
{
/* Let random Lisp code notice that the selection has been stolen. */
x_get_foreign_selection (selection_symbol, target_type, time_stamp)
Lisp_Object selection_symbol, target_type, time_stamp;
{
- OSErr err;
- ScrapRef scrap;
+ OSStatus err;
+ Selection sel;
Lisp_Object result = Qnil;
BLOCK_INPUT;
- err = get_scrap_from_symbol (selection_symbol, 0, &scrap);
- if (err == noErr && scrap)
+ err = mac_get_selection_from_symbol (selection_symbol, 0, &sel);
+ if (err == noErr && sel)
{
if (EQ (target_type, QTARGETS))
{
- result = get_scrap_target_type_list (scrap);
+ result = mac_get_selection_target_list (sel);
result = Fvconcat (1, &result);
}
else
{
- result = get_scrap_string (scrap, target_type);
+ result = mac_get_selection_value (sel, target_type);
if (STRINGP (result))
Fput_text_property (make_number (0), make_number (SBYTES (result)),
Qforeign_selection, target_type, result);
Lisp_Object selection;
Lisp_Object time;
{
- OSErr err;
- ScrapRef scrap;
+ OSStatus err;
+ Selection sel;
Lisp_Object local_selection_data;
check_mac ();
else
{
Lisp_Object rest;
- for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
+ for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest))
if (EQ (local_selection_data, Fcar (XCDR (rest))))
{
XSETCDR (rest, Fcdr (XCDR (rest)));
BLOCK_INPUT;
- err = get_scrap_from_symbol (selection, 0, &scrap);
- if (err == noErr && scrap)
- clear_scrap (&scrap);
+ err = mac_get_selection_from_symbol (selection, 0, &sel);
+ if (err == noErr && sel)
+ mac_clear_selection (&sel);
UNBLOCK_INPUT;
(selection)
Lisp_Object selection;
{
- OSErr err;
- ScrapRef scrap;
+ OSStatus err;
+ Selection sel;
Lisp_Object result = Qnil, local_selection_data;
check_mac ();
BLOCK_INPUT;
- err = get_scrap_from_symbol (selection, 0, &scrap);
- if (err == noErr && scrap)
+ err = mac_get_selection_from_symbol (selection, 0, &sel);
+ if (err == noErr && sel)
{
- unsigned long timestamp;
+ Lisp_Object ownership_info;
- err = get_scrap_private_timestamp (scrap, ×tamp);
- if (err == noErr
- && (timestamp
- == cons_to_long (XCAR (XCDR (XCDR (local_selection_data))))))
+ ownership_info = XCAR (XCDR (XCDR (XCDR (XCDR (local_selection_data)))));
+ if (!NILP (Fequal (ownership_info,
+ mac_get_selection_ownership_info (sel))))
result = Qt;
}
else
(selection)
Lisp_Object selection;
{
- OSErr err;
- ScrapRef scrap;
+ OSStatus err;
+ Selection sel;
Lisp_Object result = Qnil, rest;
/* It should be safe to call this before we have an Mac frame. */
BLOCK_INPUT;
- err = get_scrap_from_symbol (selection, 0, &scrap);
- if (err == noErr && scrap)
+ err = mac_get_selection_from_symbol (selection, 0, &sel);
+ if (err == noErr && sel)
for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest))
{
if (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest)))
- && scrap_has_target_type (scrap, XCAR (XCAR (rest))))
+ && mac_selection_has_target_p (sel, XCAR (XCAR (rest))))
{
result = Qt;
break;
}
\f
+/***********************************************************************
+ 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 struct
-{
- AppleEvent *buf;
- int size, count;
-} deferred_apple_events;
+static Lisp_Object Qemacs_suspension_id;
extern Lisp_Object Qundefined;
extern void mac_store_apple_event P_ ((Lisp_Object, Lisp_Object,
const AEDesc *));
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;
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);
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)
{
- if (deferred_apple_events.buf == NULL)
- {
- deferred_apple_events.size = 16;
- deferred_apple_events.count = 0;
- deferred_apple_events.buf =
- xmalloc (sizeof (AppleEvent) * deferred_apple_events.size);
- }
- else if (deferred_apple_events.count == deferred_apple_events.size)
+ 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)
{
- deferred_apple_events.size *= 2;
- deferred_apple_events.buf
- = xrealloc (deferred_apple_events.buf,
- sizeof (AppleEvent) * deferred_apple_events.size);
+ /* Emulate keyReplyRequestedAttr in older versions. */
+ reply_requested = reply->descriptorType != typeNull;
+ err = AEPutAttributePtr (&new->apple_event, keyReplyRequestedAttr,
+ typeSInt32, &reply_requested,
+ sizeof (SInt32));
}
}
-
if (err == noErr)
{
- int count = deferred_apple_events.count;
+ SInt32 timeout = 0;
+ struct suspended_ae_info **p;
- AEDuplicateDesc (apple_event, deferred_apple_events.buf + count);
- AEDuplicateDesc (reply, deferred_apple_events.buf + count + 1);
- deferred_apple_events.count += 2;
+ 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;
SInt32 refcon;
{
OSErr err;
+ UInt32 suspension_id;
AEEventClass event_class;
AEEventID event_id;
Lisp_Object class_key, id_key, binding;
- /* We can't handle an Apple event that requests a reply, but this
- seems to be too restrictive. */
-#if 0
- if (reply->descriptorType != typeNull)
- return errAEEventNotHandled;
-#endif
-
if (!mac_ready_for_apple_events)
{
err = defer_apple_events (apple_event, reply);
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)
{
if (INTEGERP (binding))
return XINT (binding);
- mac_store_apple_event (class_key, id_key, apple_event);
- return noErr;
+ err = mac_handle_apple_event_1 (class_key, id_key,
+ apple_event, reply);
}
+ else
+ err = errAEEventNotHandled;
}
- return 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
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. */)
()
{
- Lisp_Object result = Qnil;
- long i;
-
if (mac_ready_for_apple_events)
return Qnil;
BLOCK_INPUT;
mac_ready_for_apple_events = 1;
- if (deferred_apple_events.buf)
+ if (deferred_apple_events)
{
- for (i = 0; i < deferred_apple_events.count; i += 2)
+ 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)
{
- AEResumeTheCurrentEvent (deferred_apple_events.buf + i,
- deferred_apple_events.buf + i + 1,
+ next = tail->next;
+ AEResumeTheCurrentEvent (&tail->apple_event, &tail->reply,
((AEEventHandlerUPP)
kAEUseStandardDispatch), 0);
- AEDisposeDesc (deferred_apple_events.buf + i);
- AEDisposeDesc (deferred_apple_events.buf + i + 1);
+ AEDisposeDesc (&tail->reply);
+ AEDisposeDesc (&tail->apple_event);
+ xfree (tail);
}
- xfree (deferred_apple_events.buf);
- bzero (&deferred_apple_events, sizeof (deferred_apple_events));
+ 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->reply.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;
}
\f
+/***********************************************************************
+ 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,
GlobalToLocal (&mouse_pos);
err = GetDragModifiers (drag, NULL, NULL, &modifiers);
}
+ if (err == noErr)
+ {
+ UInt32 key_modifiers = modifiers;
+
+ err = AEPutParamPtr (&apple_event, kEventParamKeyModifiers,
+ typeUInt32, &key_modifiers, sizeof (UInt32));
+ }
if (err == noErr)
{
- mac_store_drag_event (window, mouse_pos, modifiers, &apple_event);
+ mac_store_drag_event (window, mouse_pos, 0, &apple_event);
AEDisposeDesc (&apple_event);
- /* Post a harmless event so as to wake up from ReceiveNextEvent. */
- mac_post_mouse_moved_event ();
+ mac_wakeup_from_rne ();
return noErr;
}
else
}
\f
+/***********************************************************************
+ Services menu support
+***********************************************************************/
#ifdef MAC_OSX
-void
-init_service_handler ()
+OSStatus
+install_service_handler ()
{
- EventTypeSpec specs[] = {{kEventClassService, kEventServiceGetTypes},
- {kEventClassService, kEventServiceCopy},
- {kEventClassService, kEventServicePaste},
- {kEventClassService, kEventServicePerform}};
- InstallApplicationEventHandler (NewEventHandlerUPP (mac_handle_service_event),
- GetEventTypeCount (specs), specs, NULL, NULL);
+ static const EventTypeSpec specs[] =
+ {{kEventClassService, kEventServiceGetTypes},
+ {kEventClassService, kEventServiceCopy},
+ {kEventClassService, kEventServicePaste},
+ {kEventClassService, kEventServicePerform}};
+
+ return InstallApplicationEventHandler (NewEventHandlerUPP
+ (mac_handle_service_event),
+ GetEventTypeCount (specs),
+ specs, NULL, NULL);
}
-extern OSStatus 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)
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 = mac_get_selection_from_symbol (Vmac_service_selection, 0, &cur_scrap);
if (!(err == noErr && cur_scrap))
return eventNotHandledErr;
rest = XCDR (rest))
if (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest)))
&& (flavor_type =
- get_flavor_type_from_symbol (XCAR (XCAR (rest)))))
+ get_flavor_type_from_symbol (XCAR (XCAR (rest)), 0)))
{
type = CreateTypeStringWithOSType (flavor_type);
if (type)
if (err != noErr)
break;
- if (NILP (Fx_selection_owner_p (Vmac_services_selection)))
+ if (NILP (Fx_selection_owner_p (Vmac_service_selection)))
break;
else
goto copy_all_flavors;
typeScrapRef, NULL,
sizeof (ScrapRef), NULL, &specific_scrap);
if (err != noErr
- || NILP (Fx_selection_owner_p (Vmac_services_selection)))
+ || NILP (Fx_selection_owner_p (Vmac_service_selection)))
{
err = eventNotHandledErr;
break;
NULL, sizeof (ScrapRef), NULL,
&specific_scrap);
if (err == noErr)
- err = clear_scrap (&cur_scrap);
+ err = mac_clear_selection (&cur_scrap);
if (err == noErr)
for (rest = Vselection_converter_alist; CONSP (rest);
rest = XCDR (rest))
{
if (! (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest)))))
continue;
- flavor_type = get_flavor_type_from_symbol (XCAR (XCAR (rest)));
+ flavor_type = get_flavor_type_from_symbol (XCAR (XCAR (rest)),
+ specific_scrap);
if (flavor_type == 0)
continue;
err = copy_scrap_flavor_data (specific_scrap, cur_scrap,
if (!data_exists_p)
err = eventNotHandledErr;
else
- err = mac_store_services_event (event);
+ err = mac_store_service_event (event);
}
break;
}
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);
The function should return the value to send to the Scrap Manager
\(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,
-and there is no meaningful selection value. */);
+means that the conversion could not be done. */);
Vselection_converter_alist = Qnil;
DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions,
#endif
#ifdef MAC_OSX
- DEFVAR_LISP ("mac-services-selection", &Vmac_services_selection,
+ DEFVAR_LISP ("mac-service-selection", &Vmac_service_selection,
doc: /* Selection name for communication via Services menu. */);
- Vmac_services_selection = intern ("PRIMARY");
+ Vmac_service_selection = intern ("PRIMARY");
#endif
QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY);
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
HCoop / bpt / emacs.git / blobdiff