#include <config.h>
#include "lisp.h"
#include "macterm.h"
#include "blockinput.h"
#include "keymap.h"
#if !TARGET_API_MAC_CARBON
#include <Endian.h>
typedef int ScrapRef;
typedef ResType ScrapFlavorType;
#endif
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 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 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));
static Lisp_Object x_get_foreign_selection P_ ((Lisp_Object,
Lisp_Object,
Lisp_Object));
EXFUN (Fx_selection_owner_p, 1);
#ifdef MAC_OSX
static OSStatus mac_handle_service_event P_ ((EventHandlerCallRef,
EventRef, void *));
void init_service_handler P_ ((void));
#endif
Lisp_Object QPRIMARY, QSECONDARY, QTIMESTAMP, QTARGETS;
static Lisp_Object Vx_lost_selection_functions;
static Lisp_Object Vselection_coding_system;
static Lisp_Object Vnext_selection_coding_system;
static Lisp_Object Qforeign_selection;
extern unsigned long last_event_timestamp;
static Lisp_Object Vselection_alist;
#define SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP 'Etsp'
static Lisp_Object Vselection_converter_alist;
static Lisp_Object Qmac_scrap_name, Qmac_ostype;
#ifdef MAC_OSX
static Lisp_Object Vmac_service_selection;
#endif
static OSStatus
get_scrap_from_symbol (sym, clear_p, scrap)
Lisp_Object sym;
int clear_p;
ScrapRef *scrap;
{
OSStatus err = noErr;
Lisp_Object str = Fget (sym, Qmac_scrap_name);
if (!STRINGP (str))
*scrap = NULL;
else
{
#if TARGET_API_MAC_CARBON
#ifdef MAC_OSX
CFStringRef scrap_name = cfstring_create_with_string (str);
OptionBits options = (clear_p ? kScrapClearNamedScrap
: kScrapGetNamedScrap);
err = GetScrapByName (scrap_name, options, scrap);
CFRelease (scrap_name);
#else
if (clear_p)
err = ClearCurrentScrap ();
if (err == noErr)
err = GetCurrentScrap (scrap);
#endif
#else
if (clear_p)
err = ZeroScrap ();
if (err == noErr)
*scrap = 1;
#endif
}
return err;
}
static ScrapFlavorType
get_flavor_type_from_symbol (sym)
Lisp_Object sym;
{
Lisp_Object str = Fget (sym, Qmac_ostype);
if (STRINGP (str) && SBYTES (str) == 4)
return EndianU32_BtoN (*((UInt32 *) SDATA (str)));
return 0;
}
static int
valid_scrap_target_type_p (sym)
Lisp_Object sym;
{
return get_flavor_type_from_symbol (sym) != 0;
}
static INLINE OSStatus
clear_scrap (scrap)
ScrapRef *scrap;
{
#if TARGET_API_MAC_CARBON
#ifdef MAC_OSX
return ClearScrap (scrap);
#else
return ClearCurrentScrap ();
#endif
#else
return ZeroScrap ();
#endif
}
static OSStatus
put_scrap_string (scrap, type, str)
ScrapRef scrap;
Lisp_Object type, str;
{
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));
#else
return PutScrap (SBYTES (str), flavor_type, SDATA (str));
#endif
}
static INLINE OSStatus
put_scrap_private_timestamp (scrap, timestamp)
ScrapRef scrap;
unsigned long timestamp;
{
#if TARGET_API_MAC_CARBON
return PutScrapFlavor (scrap, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP,
kScrapFlavorMaskSenderOnly,
sizeof (timestamp), ×tamp);
#else
return PutScrap (sizeof (timestamp), SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP,
×tamp);
#endif
}
static ScrapFlavorType
scrap_has_target_type (scrap, type)
ScrapRef scrap;
Lisp_Object type;
{
OSStatus err;
ScrapFlavorType flavor_type = get_flavor_type_from_symbol (type);
if (flavor_type)
{
#if TARGET_API_MAC_CARBON
ScrapFlavorFlags flags;
err = GetScrapFlavorFlags (scrap, flavor_type, &flags);
if (err != noErr)
flavor_type = 0;
#else
SInt32 size, offset;
size = GetScrap (NULL, flavor_type, &offset);
if (size < 0)
flavor_type = 0;
#endif
}
return flavor_type;
}
static Lisp_Object
get_scrap_string (scrap, type)
ScrapRef scrap;
Lisp_Object type;
{
OSStatus err;
Lisp_Object result = Qnil;
ScrapFlavorType flavor_type = get_flavor_type_from_symbol (type);
#if TARGET_API_MAC_CARBON
Size size;
if (flavor_type)
{
err = GetScrapFlavorSize (scrap, flavor_type, &size);
if (err == noErr)
{
do
{
result = make_uninit_string (size);
err = GetScrapFlavorData (scrap, flavor_type,
&size, SDATA (result));
if (err != noErr)
result = Qnil;
else if (size < SBYTES (result))
result = make_unibyte_string (SDATA (result), size);
}
while (STRINGP (result) && size > SBYTES (result));
}
}
#else
Handle handle;
SInt32 size, offset;
if (flavor_type)
size = GetScrap (NULL, flavor_type, &offset);
if (size >= 0)
{
handle = NewHandle (size);
HLock (handle);
size = GetScrap (handle, flavor_type, &offset);
if (size >= 0)
result = make_unibyte_string (*handle, size);
DisposeHandle (handle);
}
#endif
return result;
}
static OSStatus
get_scrap_private_timestamp (scrap, timestamp)
ScrapRef scrap;
unsigned long *timestamp;
{
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);
err = GetScrapFlavorData (scrap, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP,
&size, timestamp);
if (err == noErr && size != sizeof (*timestamp))
err = noTypeErr;
}
}
#else
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
return err;
}
static Lisp_Object
get_scrap_target_type_list (scrap)
ScrapRef scrap;
{
Lisp_Object result = Qnil, rest, target_type;
#if TARGET_API_MAC_CARBON
OSStatus err;
UInt32 count, i, type;
ScrapFlavorInfo *flavor_info = NULL;
Lisp_Object strings = Qnil;
err = GetScrapFlavorCount (scrap, &count);
if (err == noErr)
flavor_info = xmalloc (sizeof (ScrapFlavorInfo) * count);
err = GetScrapFlavorInfoList (scrap, &count, flavor_info);
if (err != noErr)
{
xfree (flavor_info);
flavor_info = NULL;
}
if (flavor_info == NULL)
count = 0;
#endif
for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest))
{
ScrapFlavorType flavor_type = 0;
if (CONSP (XCAR (rest))
&& (target_type = XCAR (XCAR (rest)),
SYMBOLP (target_type))
&& (flavor_type = scrap_has_target_type (scrap, target_type)))
{
result = Fcons (target_type, result);
#if TARGET_API_MAC_CARBON
for (i = 0; i < count; i++)
if (flavor_info[i].flavorType == flavor_type)
{
flavor_info[i].flavorType = 0;
break;
}
#endif
}
}
#if TARGET_API_MAC_CARBON
if (flavor_info)
{
for (i = 0; i < count; i++)
if (flavor_info[i].flavorType)
{
type = EndianU32_NtoB (flavor_info[i].flavorType);
strings = Fcons (make_unibyte_string ((char *) &type, 4), strings);
}
result = nconc2 (result, strings);
xfree (flavor_info);
}
#endif
return result;
}
static void
x_own_selection (selection_name, selection_value)
Lisp_Object selection_name, selection_value;
{
OSStatus err;
ScrapRef scrap;
struct gcpro gcpro1, gcpro2;
Lisp_Object rest, handler_fn, value, type;
int count;
CHECK_SYMBOL (selection_name);
GCPRO2 (selection_name, selection_value);
BLOCK_INPUT;
err = get_scrap_from_symbol (selection_name, 1, &scrap);
if (err == noErr && scrap)
{
count = SPECPDL_INDEX ();
specbind (Qinhibit_quit, Qt);
for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest))
{
if (!(CONSP (XCAR (rest))
&& (type = XCAR (XCAR (rest)),
SYMBOLP (type))
&& valid_scrap_target_type_p (type)
&& (handler_fn = XCDR (XCAR (rest)),
SYMBOLP (handler_fn))))
continue;
if (!NILP (handler_fn))
value = call3 (handler_fn, selection_name,
type, selection_value);
if (STRINGP (value))
err = put_scrap_string (scrap, type, value);
else if (CONSP (value)
&& EQ (XCAR (value), type)
&& STRINGP (XCDR (value)))
err = put_scrap_string (scrap, 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)
error ("Can't set selection");
{
Lisp_Object selection_time;
Lisp_Object selection_data;
Lisp_Object prev_value;
selection_time = long_to_cons (last_event_timestamp);
selection_data = Fcons (selection_name,
Fcons (selection_value,
Fcons (selection_time,
Fcons (selected_frame, Qnil))));
prev_value = assq_no_quit (selection_name, Vselection_alist);
Vselection_alist = Fcons (selection_data, Vselection_alist);
if (!NILP (prev_value))
{
Lisp_Object rest;
for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
if (EQ (prev_value, Fcar (XCDR (rest))))
{
XSETCDR (rest, Fcdr (XCDR (rest)));
break;
}
}
}
}
static Lisp_Object
x_get_local_selection (selection_symbol, target_type, local_request)
Lisp_Object selection_symbol, target_type;
int local_request;
{
Lisp_Object local_value;
Lisp_Object handler_fn, value, type, check;
int count;
if (NILP (Fx_selection_owner_p (selection_symbol)))
return Qnil;
local_value = assq_no_quit (selection_symbol, Vselection_alist);
if (EQ (target_type, QTIMESTAMP))
{
handler_fn = Qnil;
value = XCAR (XCDR (XCDR (local_value)));
}
#if 0
else if (EQ (target_type, QDELETE))
{
handler_fn = Qnil;
Fx_disown_selection_internal
(selection_symbol,
XCAR (XCDR (XCDR (local_value))));
value = QNULL;
}
#endif
else
{
count = SPECPDL_INDEX ();
specbind (Qinhibit_quit, Qt);
CHECK_SYMBOL (target_type);
handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
if (!NILP (handler_fn))
value = call3 (handler_fn,
selection_symbol, (local_request ? Qnil : target_type),
XCAR (XCDR (local_value)));
else
value = Qnil;
unbind_to (count, Qnil);
}
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;
else if (CONSP (check)
&& INTEGERP (XCAR (check))
&& (INTEGERP (XCDR (check))
||
(CONSP (XCDR (check))
&& INTEGERP (XCAR (XCDR (check)))
&& NILP (XCDR (XCDR (check))))))
return value;
signal_error ("Invalid data returned by selection-conversion function",
list2 (handler_fn, value));
}
void
x_clear_frame_selections (f)
FRAME_PTR f;
{
Lisp_Object frame;
Lisp_Object rest;
XSETFRAME (frame, f);
while (!NILP (Vselection_alist)
&& EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
{
Lisp_Object hooks, selection_symbol;
hooks = Vx_lost_selection_functions;
selection_symbol = Fcar (Fcar (Vselection_alist));
if (!EQ (hooks, Qunbound)
&& !NILP (Fx_selection_owner_p (selection_symbol)))
{
for (; CONSP (hooks); hooks = Fcdr (hooks))
call1 (Fcar (hooks), selection_symbol);
#if 0
redisplay_preserve_echo_area (21);
#endif
}
Vselection_alist = Fcdr (Vselection_alist);
}
for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest))))))))
{
Lisp_Object hooks, selection_symbol;
hooks = Vx_lost_selection_functions;
selection_symbol = Fcar (Fcar (XCDR (rest)));
if (!EQ (hooks, Qunbound)
&& !NILP (Fx_selection_owner_p (selection_symbol)))
{
for (; CONSP (hooks); hooks = Fcdr (hooks))
call1 (Fcar (hooks), selection_symbol);
#if 0
redisplay_preserve_echo_area (22);
#endif
}
XSETCDR (rest, Fcdr (XCDR (rest)));
break;
}
}
static Lisp_Object
x_get_foreign_selection (selection_symbol, target_type, time_stamp)
Lisp_Object selection_symbol, target_type, time_stamp;
{
OSStatus err;
ScrapRef scrap;
Lisp_Object result = Qnil;
BLOCK_INPUT;
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);
}
}
UNBLOCK_INPUT;
return result;
}
DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
Sx_own_selection_internal, 2, 2, 0,
doc: )
(selection_name, selection_value)
Lisp_Object selection_name, selection_value;
{
check_mac ();
CHECK_SYMBOL (selection_name);
if (NILP (selection_value)) error ("SELECTION-VALUE may not be nil");
x_own_selection (selection_name, selection_value);
return selection_value;
}
DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
Sx_get_selection_internal, 2, 3, 0,
doc: )
(selection_symbol, target_type, time_stamp)
Lisp_Object selection_symbol, target_type, time_stamp;
{
Lisp_Object val = Qnil;
struct gcpro gcpro1, gcpro2;
GCPRO2 (target_type, val);
check_mac ();
CHECK_SYMBOL (selection_symbol);
CHECK_SYMBOL (target_type);
val = x_get_local_selection (selection_symbol, target_type, 1);
if (NILP (val))
{
val = x_get_foreign_selection (selection_symbol, target_type, time_stamp);
goto DONE;
}
if (CONSP (val)
&& SYMBOLP (XCAR (val)))
{
val = XCDR (val);
if (CONSP (val) && NILP (XCDR (val)))
val = XCAR (val);
}
DONE:
UNGCPRO;
return val;
}
DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
Sx_disown_selection_internal, 1, 2, 0,
doc: )
(selection, time)
Lisp_Object selection;
Lisp_Object time;
{
OSStatus err;
ScrapRef scrap;
Lisp_Object local_selection_data;
check_mac ();
CHECK_SYMBOL (selection);
if (NILP (Fx_selection_owner_p (selection)))
return Qnil;
local_selection_data = assq_no_quit (selection, Vselection_alist);
if (EQ (local_selection_data, Fcar (Vselection_alist)))
Vselection_alist = Fcdr (Vselection_alist);
else
{
Lisp_Object rest;
for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
if (EQ (local_selection_data, Fcar (XCDR (rest))))
{
XSETCDR (rest, Fcdr (XCDR (rest)));
break;
}
}
{
Lisp_Object rest;
rest = Vx_lost_selection_functions;
if (!EQ (rest, Qunbound))
{
for (; CONSP (rest); rest = Fcdr (rest))
call1 (Fcar (rest), selection);
prepare_menu_bars ();
redisplay_preserve_echo_area (20);
}
}
BLOCK_INPUT;
err = get_scrap_from_symbol (selection, 0, &scrap);
if (err == noErr && scrap)
clear_scrap (&scrap);
UNBLOCK_INPUT;
return Qt;
}
DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
0, 1, 0,
doc: )
(selection)
Lisp_Object selection;
{
OSStatus err;
ScrapRef scrap;
Lisp_Object result = Qnil, local_selection_data;
check_mac ();
CHECK_SYMBOL (selection);
if (EQ (selection, Qnil)) selection = QPRIMARY;
if (EQ (selection, Qt)) selection = QSECONDARY;
local_selection_data = assq_no_quit (selection, Vselection_alist);
if (NILP (local_selection_data))
return Qnil;
BLOCK_INPUT;
err = get_scrap_from_symbol (selection, 0, &scrap);
if (err == noErr && scrap)
{
unsigned long timestamp;
err = get_scrap_private_timestamp (scrap, ×tamp);
if (err == noErr
&& (timestamp
== cons_to_long (XCAR (XCDR (XCDR (local_selection_data))))))
result = Qt;
}
else
result = Qt;
UNBLOCK_INPUT;
return result;
}
DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
0, 1, 0,
doc: )
(selection)
Lisp_Object selection;
{
OSStatus err;
ScrapRef scrap;
Lisp_Object result = Qnil, rest;
if (! FRAME_MAC_P (SELECTED_FRAME ()))
return Qnil;
CHECK_SYMBOL (selection);
if (!NILP (Fx_selection_owner_p (selection)))
return Qt;
if (EQ (selection, Qnil)) selection = QPRIMARY;
if (EQ (selection, Qt)) selection = QSECONDARY;
BLOCK_INPUT;
err = get_scrap_from_symbol (selection, 0, &scrap);
if (err == noErr && scrap)
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))))
{
result = Qt;
break;
}
}
UNBLOCK_INPUT;
return result;
}
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;
Lisp_Object key, binding;
};
struct suspended_ae_info
{
UInt32 expiration_tick, suspension_id;
AppleEvent apple_event, reply;
struct suspended_ae_info *next;
};
static struct suspended_ae_info *deferred_apple_events = NULL;
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);
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)
{
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)
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;
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: )
()
{
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;
prev = NULL;
for (tail = deferred_apple_events; tail; tail = next)
{
next = tail->next;
tail->next = prev;
prev = tail;
}
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: )
()
{
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: )
(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: )
(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;
return result;
}
#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)
{
UInt32 key_modifiers = modifiers;
err = AEPutParamPtr (&apple_event, kEventParamKeyModifiers,
typeUInt32, &key_modifiers, sizeof (UInt32));
}
if (err == noErr)
{
mac_store_drag_event (window, mouse_pos, 0, &apple_event);
AEDisposeDesc (&apple_event);
mac_wakeup_from_rne ();
return noErr;
}
else
return dragNotAcceptedErr;
}
#endif
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
}
#ifdef MAC_OSX
void
init_service_handler ()
{
static const EventTypeSpec specs[] =
{{kEventClassService, kEventServiceGetTypes},
{kEventClassService, kEventServiceCopy},
{kEventClassService, kEventServicePaste},
{kEventClassService, kEventServicePerform}};
InstallApplicationEventHandler (NewEventHandlerUPP (mac_handle_service_event),
GetEventTypeCount (specs), specs, NULL, NULL);
}
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)
EventHandlerCallRef call_ref;
EventRef event;
void *data;
{
OSStatus err = noErr;
ScrapRef cur_scrap, specific_scrap;
UInt32 event_kind = GetEventKind (event);
CFMutableArrayRef copy_types, paste_types;
CFStringRef type;
Lisp_Object rest;
ScrapFlavorType flavor_type;
if (!SYMBOLP (Vmac_service_selection))
err = eventNotHandledErr;
else
err = get_scrap_from_symbol (Vmac_service_selection, 0, &cur_scrap);
if (!(err == noErr && cur_scrap))
return eventNotHandledErr;
switch (event_kind)
{
case kEventServiceGetTypes:
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)
{
CFArrayAppendValue (paste_types, type);
CFRelease (type);
}
}
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:
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
{
type = CreateTypeStringWithOSType (flavor_type);
if (type)
{
CFArrayAppendValue (copy_types, type);
CFRelease (type);
}
}
}
}
xfree (flavor_info);
}
break;
case kEventServicePaste:
case kEventServicePerform:
{
int data_exists_p = 0;
err = GetEventParameter (event, kEventParamScrapRef, typeScrapRef,
NULL, sizeof (ScrapRef), NULL,
&specific_scrap);
if (err == noErr)
err = clear_scrap (&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)));
if (flavor_type == 0)
continue;
err = copy_scrap_flavor_data (specific_scrap, cur_scrap,
flavor_type);
if (err == noErr)
data_exists_p = 1;
}
if (!data_exists_p)
err = eventNotHandledErr;
else
err = mac_store_service_event (event);
}
break;
}
if (err != noErr)
err = eventNotHandledErr;
return err;
}
#endif
void
syms_of_macselect ()
{
defsubr (&Sx_get_selection_internal);
defsubr (&Sx_own_selection_internal);
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);
DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
doc: );
Vselection_converter_alist = Qnil;
DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions,
doc: );
Vx_lost_selection_functions = Qnil;
DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
doc: );
Vselection_coding_system = Qnil;
DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
doc: );
Vnext_selection_coding_system = Qnil;
DEFVAR_LISP ("mac-apple-event-map", &Vmac_apple_event_map,
doc: );
Vmac_apple_event_map = Qnil;
#if TARGET_API_MAC_CARBON
DEFVAR_LISP ("mac-dnd-known-types", &Vmac_dnd_known_types,
doc: );
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: );
Vmac_service_selection = intern ("PRIMARY");
#endif
QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY);
QSECONDARY = intern ("SECONDARY"); staticpro (&QSECONDARY);
QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
QTARGETS = intern ("TARGETS"); staticpro (&QTARGETS);
Qforeign_selection = intern ("foreign-selection");
staticpro (&Qforeign_selection);
Qmac_scrap_name = intern ("mac-scrap-name");
staticpro (&Qmac_scrap_name);
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);
}