1/* Selection processing for Emacs on Mac OS.
2   Copyright (C) 2005, 2006, 2007 Free Software Foundation, Inc.
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 2, or (at your option)
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING.  If not, write to
18the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
19Boston, MA 02110-1301, USA.  */
20
21#include <config.h>
22
23#include "lisp.h"
24#include "macterm.h"
25#include "blockinput.h"
26#include "keymap.h"
27
28#if !TARGET_API_MAC_CARBON
29#include <Endian.h>
30typedef int ScrapRef;
31typedef ResType ScrapFlavorType;
32#endif /* !TARGET_API_MAC_CARBON */
33
34static OSStatus get_scrap_from_symbol P_ ((Lisp_Object, int, ScrapRef *));
35static ScrapFlavorType get_flavor_type_from_symbol P_ ((Lisp_Object));
36static int valid_scrap_target_type_p P_ ((Lisp_Object));
37static OSStatus clear_scrap P_ ((ScrapRef *));
38static OSStatus put_scrap_string P_ ((ScrapRef, Lisp_Object, Lisp_Object));
39static OSStatus put_scrap_private_timestamp P_ ((ScrapRef, unsigned long));
40static ScrapFlavorType scrap_has_target_type P_ ((ScrapRef, Lisp_Object));
41static Lisp_Object get_scrap_string P_ ((ScrapRef, Lisp_Object));
42static OSStatus get_scrap_private_timestamp P_ ((ScrapRef, unsigned long *));
43static Lisp_Object get_scrap_target_type_list P_ ((ScrapRef));
44static void x_own_selection P_ ((Lisp_Object, Lisp_Object));
45static Lisp_Object x_get_local_selection P_ ((Lisp_Object, Lisp_Object, int));
46static Lisp_Object x_get_foreign_selection P_ ((Lisp_Object,
47                                                Lisp_Object,
48                                                Lisp_Object));
49EXFUN (Fx_selection_owner_p, 1);
50#ifdef MAC_OSX
51static OSStatus mac_handle_service_event P_ ((EventHandlerCallRef,
52					      EventRef, void *));
53void init_service_handler P_ ((void));
54#endif
55
56Lisp_Object QPRIMARY, QSECONDARY, QTIMESTAMP, QTARGETS;
57
58static Lisp_Object Vx_lost_selection_functions;
59/* Coding system for communicating with other programs via scrap.  */
60static Lisp_Object Vselection_coding_system;
61
62/* Coding system for the next communicating with other programs.  */
63static Lisp_Object Vnext_selection_coding_system;
64
65static Lisp_Object Qforeign_selection;
66
67/* The timestamp of the last input event Emacs received from the
68   window server.  */
69/* Defined in keyboard.c.  */
70extern unsigned long last_event_timestamp;
71
72/* This is an association list whose elements are of the form
73     ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
74   SELECTION-NAME is a lisp symbol.
75   SELECTION-VALUE is the value that emacs owns for that selection.
76     It may be any kind of Lisp object.
77   SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
78     as a cons of two 16-bit numbers (making a 32 bit time.)
79   FRAME is the frame for which we made the selection.
80   If there is an entry in this alist, and the data for the flavor
81     type SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP in the corresponding scrap
82     (if exists) coincides with SELECTION-TIMESTAMP, then it can be
83     assumed that Emacs owns that selection.
84   The only (eq) parts of this list that are visible from Lisp are the
85    selection-values.  */
86static Lisp_Object Vselection_alist;
87
88#define SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP 'Etsp'
89
90/* This is an alist whose CARs are selection-types and whose CDRs are
91   the names of Lisp functions to call to convert the given Emacs
92   selection value to a string representing the given selection type.
93   This is for Lisp-level extension of the emacs selection
94   handling.  */
95static Lisp_Object Vselection_converter_alist;
96
97/* A selection name (represented as a Lisp symbol) can be associated
98   with a named scrap via `mac-scrap-name' property.  Likewise for a
99   selection type with a scrap flavor type via `mac-ostype'.  */
100static Lisp_Object Qmac_scrap_name, Qmac_ostype;
101
102#ifdef MAC_OSX
103/* Selection name for communication via Services menu.  */
104static Lisp_Object Vmac_service_selection;
105#endif
106
107/* Get a reference to the scrap corresponding to the symbol SYM.  The
108   reference is set to *SCRAP, and it becomes NULL if there's no
109   corresponding scrap.  Clear the scrap if CLEAR_P is non-zero.  */
110
111static OSStatus
112get_scrap_from_symbol (sym, clear_p, scrap)
113     Lisp_Object sym;
114     int clear_p;
115     ScrapRef *scrap;
116{
117  OSStatus err = noErr;
118  Lisp_Object str = Fget (sym, Qmac_scrap_name);
119
120  if (!STRINGP (str))
121    *scrap = NULL;
122  else
123    {
124#if TARGET_API_MAC_CARBON
125#ifdef MAC_OSX
126      CFStringRef scrap_name = cfstring_create_with_string (str);
127      OptionBits options = (clear_p ? kScrapClearNamedScrap
128			    : kScrapGetNamedScrap);
129
130      err = GetScrapByName (scrap_name, options, scrap);
131      CFRelease (scrap_name);
132#else	/* !MAC_OSX */
133      if (clear_p)
134	err = ClearCurrentScrap ();
135      if (err == noErr)
136	err = GetCurrentScrap (scrap);
137#endif	/* !MAC_OSX */
138#else	/* !TARGET_API_MAC_CARBON */
139      if (clear_p)
140	err = ZeroScrap ();
141      if (err == noErr)
142	*scrap = 1;
143#endif	/* !TARGET_API_MAC_CARBON */
144    }
145
146  return err;
147}
148
149/* Get a scrap flavor type from the symbol SYM.  Return 0 if no
150   corresponding flavor type.  */
151
152static ScrapFlavorType
153get_flavor_type_from_symbol (sym)
154     Lisp_Object sym;
155{
156  Lisp_Object str = Fget (sym, Qmac_ostype);
157
158  if (STRINGP (str) && SBYTES (str) == 4)
159    return EndianU32_BtoN (*((UInt32 *) SDATA (str)));
160
161  return 0;
162}
163
164/* Check if the symbol SYM has a corresponding scrap flavor type.  */
165
166static int
167valid_scrap_target_type_p (sym)
168     Lisp_Object sym;
169{
170  return get_flavor_type_from_symbol (sym) != 0;
171}
172
173/* Clear the scrap whose reference is *SCRAP. */
174
175static INLINE OSStatus
176clear_scrap (scrap)
177     ScrapRef *scrap;
178{
179#if TARGET_API_MAC_CARBON
180#ifdef MAC_OSX
181  return ClearScrap (scrap);
182#else
183  return ClearCurrentScrap ();
184#endif
185#else  /* !TARGET_API_MAC_CARBON */
186  return ZeroScrap ();
187#endif	/* !TARGET_API_MAC_CARBON */
188}
189
190/* Put Lisp String STR to the scrap SCRAP.  The target type is
191   specified by TYPE. */
192
193static OSStatus
194put_scrap_string (scrap, type, str)
195     ScrapRef scrap;
196     Lisp_Object type, str;
197{
198  ScrapFlavorType flavor_type = get_flavor_type_from_symbol (type);
199
200  if (flavor_type == 0)
201    return noTypeErr;
202
203#if TARGET_API_MAC_CARBON
204  return PutScrapFlavor (scrap, flavor_type, kScrapFlavorMaskNone,
205			 SBYTES (str), SDATA (str));
206#else  /* !TARGET_API_MAC_CARBON */
207  return PutScrap (SBYTES (str), flavor_type, SDATA (str));
208#endif	/* !TARGET_API_MAC_CARBON */
209}
210
211/* Put TIMESTAMP to the scrap SCRAP.  The timestamp is used for
212   checking if the scrap is owned by the process.  */
213
214static INLINE OSStatus
215put_scrap_private_timestamp (scrap, timestamp)
216     ScrapRef scrap;
217     unsigned long timestamp;
218{
219#if TARGET_API_MAC_CARBON
220  return PutScrapFlavor (scrap, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP,
221			 kScrapFlavorMaskSenderOnly,
222			 sizeof (timestamp), &timestamp);
223#else  /* !TARGET_API_MAC_CARBON */
224  return PutScrap (sizeof (timestamp), SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP,
225		   &timestamp);
226#endif	/* !TARGET_API_MAC_CARBON */
227}
228
229/* Check if data for the target type TYPE is available in SCRAP.  */
230
231static ScrapFlavorType
232scrap_has_target_type (scrap, type)
233     ScrapRef scrap;
234     Lisp_Object type;
235{
236  OSStatus err;
237  ScrapFlavorType flavor_type = get_flavor_type_from_symbol (type);
238
239  if (flavor_type)
240    {
241#if TARGET_API_MAC_CARBON
242      ScrapFlavorFlags flags;
243
244      err = GetScrapFlavorFlags (scrap, flavor_type, &flags);
245      if (err != noErr)
246	flavor_type = 0;
247#else  /* !TARGET_API_MAC_CARBON */
248      SInt32 size, offset;
249
250      size = GetScrap (NULL, flavor_type, &offset);
251      if (size < 0)
252	flavor_type = 0;
253#endif	/* !TARGET_API_MAC_CARBON */
254    }
255
256  return flavor_type;
257}
258
259/* Get data for the target type TYPE from SCRAP and create a Lisp
260   string.  Return nil if failed to get data.  */
261
262static Lisp_Object
263get_scrap_string (scrap, type)
264     ScrapRef scrap;
265     Lisp_Object type;
266{
267  OSStatus err;
268  Lisp_Object result = Qnil;
269  ScrapFlavorType flavor_type = get_flavor_type_from_symbol (type);
270#if TARGET_API_MAC_CARBON
271  Size size;
272
273  if (flavor_type)
274    {
275      err = GetScrapFlavorSize (scrap, flavor_type, &size);
276      if (err == noErr)
277	{
278	  do
279	    {
280	      result = make_uninit_string (size);
281	      err = GetScrapFlavorData (scrap, flavor_type,
282					&size, SDATA (result));
283	      if (err != noErr)
284		result = Qnil;
285	      else if (size < SBYTES (result))
286		result = make_unibyte_string (SDATA (result), size);
287	    }
288	  while (STRINGP (result) && size > SBYTES (result));
289	}
290    }
291#else
292  Handle handle;
293  SInt32 size, offset;
294
295  if (flavor_type)
296    size = GetScrap (NULL, flavor_type, &offset);
297  if (size >= 0)
298    {
299      handle = NewHandle (size);
300      HLock (handle);
301      size = GetScrap (handle, flavor_type, &offset);
302      if (size >= 0)
303	result = make_unibyte_string (*handle, size);
304      DisposeHandle (handle);
305    }
306#endif
307
308  return result;
309}
310
311/* Get timestamp from the scrap SCRAP and set to *TIMPSTAMP.  */
312
313static OSStatus
314get_scrap_private_timestamp (scrap, timestamp)
315     ScrapRef scrap;
316     unsigned long *timestamp;
317{
318  OSStatus err = noErr;
319#if TARGET_API_MAC_CARBON
320  ScrapFlavorFlags flags;
321
322  err = GetScrapFlavorFlags (scrap, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, &flags);
323  if (err == noErr)
324    {
325      if (!(flags & kScrapFlavorMaskSenderOnly))
326	err = noTypeErr;
327      else
328	{
329	  Size size = sizeof (*timestamp);
330
331	  err = GetScrapFlavorData (scrap, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP,
332				    &size, timestamp);
333	  if (err == noErr && size != sizeof (*timestamp))
334	    err = noTypeErr;
335	}
336    }
337#else  /* !TARGET_API_MAC_CARBON */
338  Handle handle;
339  SInt32 size, offset;
340
341  size = GetScrap (NULL, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, &offset);
342  if (size == sizeof (*timestamp))
343    {
344      handle = NewHandle (size);
345      HLock (handle);
346      size = GetScrap (handle, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, &offset);
347      if (size == sizeof (*timestamp))
348	*timestamp = *((unsigned long *) *handle);
349      DisposeHandle (handle);
350    }
351  if (size != sizeof (*timestamp))
352    err = noTypeErr;
353#endif	/* !TARGET_API_MAC_CARBON */
354
355  return err;
356}
357
358/* Get the list of target types in SCRAP.  The return value is a list
359   of target type symbols possibly followed by scrap flavor type
360   strings.  */
361
362static Lisp_Object
363get_scrap_target_type_list (scrap)
364     ScrapRef scrap;
365{
366  Lisp_Object result = Qnil, rest, target_type;
367#if TARGET_API_MAC_CARBON
368  OSStatus err;
369  UInt32 count, i, type;
370  ScrapFlavorInfo *flavor_info = NULL;
371  Lisp_Object strings = Qnil;
372
373  err = GetScrapFlavorCount (scrap, &count);
374  if (err == noErr)
375    flavor_info = xmalloc (sizeof (ScrapFlavorInfo) * count);
376  err = GetScrapFlavorInfoList (scrap, &count, flavor_info);
377  if (err != noErr)
378    {
379      xfree (flavor_info);
380      flavor_info = NULL;
381    }
382  if (flavor_info == NULL)
383    count = 0;
384#endif
385  for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest))
386    {
387      ScrapFlavorType flavor_type = 0;
388
389      if (CONSP (XCAR (rest))
390	  && (target_type = XCAR (XCAR (rest)),
391	      SYMBOLP (target_type))
392	  && (flavor_type = scrap_has_target_type (scrap, target_type)))
393	{
394	  result = Fcons (target_type, result);
395#if TARGET_API_MAC_CARBON
396	  for (i = 0; i < count; i++)
397	    if (flavor_info[i].flavorType == flavor_type)
398	      {
399		flavor_info[i].flavorType = 0;
400		break;
401	      }
402#endif
403	}
404    }
405#if TARGET_API_MAC_CARBON
406  if (flavor_info)
407    {
408      for (i = 0; i < count; i++)
409	if (flavor_info[i].flavorType)
410	  {
411	    type = EndianU32_NtoB (flavor_info[i].flavorType);
412	    strings = Fcons (make_unibyte_string ((char *) &type, 4), strings);
413	  }
414      result = nconc2 (result, strings);
415      xfree (flavor_info);
416    }
417#endif
418
419  return result;
420}
421
422/* Do protocol to assert ourself as a selection owner.
423   Update the Vselection_alist so that we can reply to later requests for
424   our selection.  */
425
426static void
427x_own_selection (selection_name, selection_value)
428     Lisp_Object selection_name, selection_value;
429{
430  OSStatus err;
431  ScrapRef scrap;
432  struct gcpro gcpro1, gcpro2;
433  Lisp_Object rest, handler_fn, value, type;
434  int count;
435
436  CHECK_SYMBOL (selection_name);
437
438  GCPRO2 (selection_name, selection_value);
439
440  BLOCK_INPUT;
441
442  err = get_scrap_from_symbol (selection_name, 1, &scrap);
443  if (err == noErr && scrap)
444    {
445      /* Don't allow a quit within the converter.
446	 When the user types C-g, he would be surprised
447	 if by luck it came during a converter.  */
448      count = SPECPDL_INDEX ();
449      specbind (Qinhibit_quit, Qt);
450
451      for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest))
452	{
453	  if (!(CONSP (XCAR (rest))
454		&& (type = XCAR (XCAR (rest)),
455		    SYMBOLP (type))
456		&& valid_scrap_target_type_p (type)
457		&& (handler_fn = XCDR (XCAR (rest)),
458		    SYMBOLP (handler_fn))))
459	    continue;
460
461	  if (!NILP (handler_fn))
462	    value = call3 (handler_fn, selection_name,
463			   type, selection_value);
464
465	  if (STRINGP (value))
466	    err = put_scrap_string (scrap, type, value);
467	  else if (CONSP (value)
468		   && EQ (XCAR (value), type)
469		   && STRINGP (XCDR (value)))
470	    err = put_scrap_string (scrap, type, XCDR (value));
471	}
472
473      unbind_to (count, Qnil);
474
475      if (err == noErr)
476	err = put_scrap_private_timestamp (scrap, last_event_timestamp);
477    }
478
479  UNBLOCK_INPUT;
480
481  UNGCPRO;
482
483  if (scrap && err != noErr)
484    error ("Can't set selection");
485
486  /* Now update the local cache */
487  {
488    Lisp_Object selection_time;
489    Lisp_Object selection_data;
490    Lisp_Object prev_value;
491
492    selection_time = long_to_cons (last_event_timestamp);
493    selection_data = Fcons (selection_name,
494			    Fcons (selection_value,
495				   Fcons (selection_time,
496					  Fcons (selected_frame, Qnil))));
497    prev_value = assq_no_quit (selection_name, Vselection_alist);
498
499    Vselection_alist = Fcons (selection_data, Vselection_alist);
500
501    /* If we already owned the selection, remove the old selection data.
502       Perhaps we should destructively modify it instead.
503       Don't use Fdelq as that may QUIT.  */
504    if (!NILP (prev_value))
505      {
506	Lisp_Object rest;	/* we know it's not the CAR, so it's easy.  */
507	for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
508	  if (EQ (prev_value, Fcar (XCDR (rest))))
509	    {
510	      XSETCDR (rest, Fcdr (XCDR (rest)));
511	      break;
512	    }
513      }
514  }
515}
516
517/* Given a selection-name and desired type, look up our local copy of
518   the selection value and convert it to the type.
519   The value is nil or a string.
520   This function is used both for remote requests (LOCAL_REQUEST is zero)
521   and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
522
523   This calls random Lisp code, and may signal or gc.  */
524
525static Lisp_Object
526x_get_local_selection (selection_symbol, target_type, local_request)
527     Lisp_Object selection_symbol, target_type;
528     int local_request;
529{
530  Lisp_Object local_value;
531  Lisp_Object handler_fn, value, type, check;
532  int count;
533
534  if (NILP (Fx_selection_owner_p (selection_symbol)))
535    return Qnil;
536
537  local_value = assq_no_quit (selection_symbol, Vselection_alist);
538
539  /* TIMESTAMP is a special case 'cause that's easiest.  */
540  if (EQ (target_type, QTIMESTAMP))
541    {
542      handler_fn = Qnil;
543      value = XCAR (XCDR (XCDR (local_value)));
544    }
545#if 0
546  else if (EQ (target_type, QDELETE))
547    {
548      handler_fn = Qnil;
549      Fx_disown_selection_internal
550	(selection_symbol,
551	 XCAR (XCDR (XCDR (local_value))));
552      value = QNULL;
553    }
554#endif
555  else
556    {
557      /* Don't allow a quit within the converter.
558	 When the user types C-g, he would be surprised
559	 if by luck it came during a converter.  */
560      count = SPECPDL_INDEX ();
561      specbind (Qinhibit_quit, Qt);
562
563      CHECK_SYMBOL (target_type);
564      handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
565      /* gcpro is not needed here since nothing but HANDLER_FN
566	 is live, and that ought to be a symbol.  */
567
568      if (!NILP (handler_fn))
569	value = call3 (handler_fn,
570		       selection_symbol, (local_request ? Qnil : target_type),
571		       XCAR (XCDR (local_value)));
572      else
573	value = Qnil;
574      unbind_to (count, Qnil);
575    }
576
577  /* Make sure this value is of a type that we could transmit
578     to another X client.  */
579
580  check = value;
581  if (CONSP (value)
582      && SYMBOLP (XCAR (value)))
583    type = XCAR (value),
584    check = XCDR (value);
585
586  if (STRINGP (check)
587      || VECTORP (check)
588      || SYMBOLP (check)
589      || INTEGERP (check)
590      || NILP (value))
591    return value;
592  /* Check for a value that cons_to_long could handle.  */
593  else if (CONSP (check)
594	   && INTEGERP (XCAR (check))
595	   && (INTEGERP (XCDR (check))
596	       ||
597	       (CONSP (XCDR (check))
598		&& INTEGERP (XCAR (XCDR (check)))
599		&& NILP (XCDR (XCDR (check))))))
600    return value;
601
602  signal_error ("Invalid data returned by selection-conversion function",
603		list2 (handler_fn, value));
604}
605
606
607/* Clear all selections that were made from frame F.
608   We do this when about to delete a frame.  */
609
610void
611x_clear_frame_selections (f)
612     FRAME_PTR f;
613{
614  Lisp_Object frame;
615  Lisp_Object rest;
616
617  XSETFRAME (frame, f);
618
619  /* Otherwise, we're really honest and truly being told to drop it.
620     Don't use Fdelq as that may QUIT;.  */
621
622  /* Delete elements from the beginning of Vselection_alist.  */
623  while (!NILP (Vselection_alist)
624	 && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
625    {
626      /* Let random Lisp code notice that the selection has been stolen.  */
627      Lisp_Object hooks, selection_symbol;
628
629      hooks = Vx_lost_selection_functions;
630      selection_symbol = Fcar (Fcar (Vselection_alist));
631
632      if (!EQ (hooks, Qunbound)
633	  && !NILP (Fx_selection_owner_p (selection_symbol)))
634	{
635	  for (; CONSP (hooks); hooks = Fcdr (hooks))
636	    call1 (Fcar (hooks), selection_symbol);
637#if 0 /* This can crash when deleting a frame
638	 from x_connection_closed.  Anyway, it seems unnecessary;
639	 something else should cause a redisplay.  */
640	  redisplay_preserve_echo_area (21);
641#endif
642	}
643
644      Vselection_alist = Fcdr (Vselection_alist);
645    }
646
647  /* Delete elements after the beginning of Vselection_alist.  */
648  for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
649    if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest))))))))
650      {
651	/* Let random Lisp code notice that the selection has been stolen.  */
652	Lisp_Object hooks, selection_symbol;
653
654	hooks = Vx_lost_selection_functions;
655	selection_symbol = Fcar (Fcar (XCDR (rest)));
656
657	if (!EQ (hooks, Qunbound)
658	  && !NILP (Fx_selection_owner_p (selection_symbol)))
659	  {
660	    for (; CONSP (hooks); hooks = Fcdr (hooks))
661	      call1 (Fcar (hooks), selection_symbol);
662#if 0 /* See above */
663	    redisplay_preserve_echo_area (22);
664#endif
665	  }
666	XSETCDR (rest, Fcdr (XCDR (rest)));
667	break;
668      }
669}
670
671/* Do protocol to read selection-data from the server.
672   Converts this to Lisp data and returns it.  */
673
674static Lisp_Object
675x_get_foreign_selection (selection_symbol, target_type, time_stamp)
676     Lisp_Object selection_symbol, target_type, time_stamp;
677{
678  OSStatus err;
679  ScrapRef scrap;
680  Lisp_Object result = Qnil;
681
682  BLOCK_INPUT;
683
684  err = get_scrap_from_symbol (selection_symbol, 0, &scrap);
685  if (err == noErr && scrap)
686    {
687      if (EQ (target_type, QTARGETS))
688	{
689	  result = get_scrap_target_type_list (scrap);
690	  result = Fvconcat (1, &result);
691	}
692      else
693	{
694	  result = get_scrap_string (scrap, target_type);
695	  if (STRINGP (result))
696	    Fput_text_property (make_number (0), make_number (SBYTES (result)),
697				Qforeign_selection, target_type, result);
698	}
699    }
700
701  UNBLOCK_INPUT;
702
703  return result;
704}
705
706
707DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
708       Sx_own_selection_internal, 2, 2, 0,
709       doc: /* Assert a selection of the given TYPE with the given VALUE.
710TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
711VALUE is typically a string, or a cons of two markers, but may be
712anything that the functions on `selection-converter-alist' know about.  */)
713     (selection_name, selection_value)
714     Lisp_Object selection_name, selection_value;
715{
716  check_mac ();
717  CHECK_SYMBOL (selection_name);
718  if (NILP (selection_value)) error ("SELECTION-VALUE may not be nil");
719  x_own_selection (selection_name, selection_value);
720  return selection_value;
721}
722
723
724/* Request the selection value from the owner.  If we are the owner,
725   simply return our selection value.  If we are not the owner, this
726   will block until all of the data has arrived.  */
727
728DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
729       Sx_get_selection_internal, 2, 3, 0,
730       doc: /* Return text selected from some Mac application.
731SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
732TYPE is the type of data desired, typically `STRING'.
733TIME_STAMP is ignored on Mac.  */)
734     (selection_symbol, target_type, time_stamp)
735     Lisp_Object selection_symbol, target_type, time_stamp;
736{
737  Lisp_Object val = Qnil;
738  struct gcpro gcpro1, gcpro2;
739  GCPRO2 (target_type, val); /* we store newly consed data into these */
740  check_mac ();
741  CHECK_SYMBOL (selection_symbol);
742  CHECK_SYMBOL (target_type);
743
744  val = x_get_local_selection (selection_symbol, target_type, 1);
745
746  if (NILP (val))
747    {
748      val = x_get_foreign_selection (selection_symbol, target_type, time_stamp);
749      goto DONE;
750    }
751
752  if (CONSP (val)
753      && SYMBOLP (XCAR (val)))
754    {
755      val = XCDR (val);
756      if (CONSP (val) && NILP (XCDR (val)))
757	val = XCAR (val);
758    }
759 DONE:
760  UNGCPRO;
761  return val;
762}
763
764DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
765       Sx_disown_selection_internal, 1, 2, 0,
766       doc: /* If we own the selection SELECTION, disown it.
767Disowning it means there is no such selection.  */)
768     (selection, time)
769     Lisp_Object selection;
770     Lisp_Object time;
771{
772  OSStatus err;
773  ScrapRef scrap;
774  Lisp_Object local_selection_data;
775
776  check_mac ();
777  CHECK_SYMBOL (selection);
778
779  if (NILP (Fx_selection_owner_p (selection)))
780    return Qnil;  /* Don't disown the selection when we're not the owner.  */
781
782  local_selection_data = assq_no_quit (selection, Vselection_alist);
783
784  /* Don't use Fdelq as that may QUIT;.  */
785
786  if (EQ (local_selection_data, Fcar (Vselection_alist)))
787    Vselection_alist = Fcdr (Vselection_alist);
788  else
789    {
790      Lisp_Object rest;
791      for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
792	if (EQ (local_selection_data, Fcar (XCDR (rest))))
793	  {
794	    XSETCDR (rest, Fcdr (XCDR (rest)));
795	    break;
796	  }
797    }
798
799  /* Let random lisp code notice that the selection has been stolen.  */
800
801  {
802    Lisp_Object rest;
803    rest = Vx_lost_selection_functions;
804    if (!EQ (rest, Qunbound))
805      {
806	for (; CONSP (rest); rest = Fcdr (rest))
807	  call1 (Fcar (rest), selection);
808	prepare_menu_bars ();
809	redisplay_preserve_echo_area (20);
810      }
811  }
812
813  BLOCK_INPUT;
814
815  err = get_scrap_from_symbol (selection, 0, &scrap);
816  if (err == noErr && scrap)
817    clear_scrap (&scrap);
818
819  UNBLOCK_INPUT;
820
821  return Qt;
822}
823
824
825DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
826       0, 1, 0,
827       doc: /* Whether the current Emacs process owns the given SELECTION.
828The arg should be the name of the selection in question, typically one of
829the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
830For convenience, the symbol nil is the same as `PRIMARY',
831and t is the same as `SECONDARY'.  */)
832     (selection)
833     Lisp_Object selection;
834{
835  OSStatus err;
836  ScrapRef scrap;
837  Lisp_Object result = Qnil, local_selection_data;
838
839  check_mac ();
840  CHECK_SYMBOL (selection);
841  if (EQ (selection, Qnil)) selection = QPRIMARY;
842  if (EQ (selection, Qt)) selection = QSECONDARY;
843
844  local_selection_data = assq_no_quit (selection, Vselection_alist);
845
846  if (NILP (local_selection_data))
847    return Qnil;
848
849  BLOCK_INPUT;
850
851  err = get_scrap_from_symbol (selection, 0, &scrap);
852  if (err == noErr && scrap)
853    {
854      unsigned long timestamp;
855
856      err = get_scrap_private_timestamp (scrap, &timestamp);
857      if (err == noErr
858	  && (timestamp
859	      == cons_to_long (XCAR (XCDR (XCDR (local_selection_data))))))
860	result = Qt;
861    }
862  else
863    result = Qt;
864
865  UNBLOCK_INPUT;
866
867  return result;
868}
869
870DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
871       0, 1, 0,
872       doc: /* Whether there is an owner for the given SELECTION.
873The arg should be the name of the selection in question, typically one of
874the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
875For convenience, the symbol nil is the same as `PRIMARY',
876and t is the same as `SECONDARY'.  */)
877     (selection)
878     Lisp_Object selection;
879{
880  OSStatus err;
881  ScrapRef scrap;
882  Lisp_Object result = Qnil, rest;
883
884  /* It should be safe to call this before we have an Mac frame.  */
885  if (! FRAME_MAC_P (SELECTED_FRAME ()))
886    return Qnil;
887
888  CHECK_SYMBOL (selection);
889  if (!NILP (Fx_selection_owner_p (selection)))
890    return Qt;
891  if (EQ (selection, Qnil)) selection = QPRIMARY;
892  if (EQ (selection, Qt)) selection = QSECONDARY;
893
894  BLOCK_INPUT;
895
896  err = get_scrap_from_symbol (selection, 0, &scrap);
897  if (err == noErr && scrap)
898    for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest))
899      {
900	if (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest)))
901	    && scrap_has_target_type (scrap, XCAR (XCAR (rest))))
902	  {
903	    result = Qt;
904	    break;
905	  }
906      }
907
908  UNBLOCK_INPUT;
909
910  return result;
911}
912
913
914/***********************************************************************
915			 Apple event support
916***********************************************************************/
917int mac_ready_for_apple_events = 0;
918static Lisp_Object Vmac_apple_event_map;
919static Lisp_Object Qmac_apple_event_class, Qmac_apple_event_id;
920static Lisp_Object Qemacs_suspension_id;
921extern Lisp_Object Qundefined;
922extern void mac_store_apple_event P_ ((Lisp_Object, Lisp_Object,
923				       const AEDesc *));
924
925struct apple_event_binding
926{
927  UInt32 code;			/* Apple event class or ID.  */
928  Lisp_Object key, binding;
929};
930
931struct suspended_ae_info
932{
933  UInt32 expiration_tick, suspension_id;
934  AppleEvent apple_event, reply;
935  struct suspended_ae_info *next;
936};
937
938/* List of apple events deferred at the startup time.  */
939static struct suspended_ae_info *deferred_apple_events = NULL;
940
941/* List of suspended apple events, in order of expiration_tick.  */
942static struct suspended_ae_info *suspended_apple_events = NULL;
943
944static void
945find_event_binding_fun (key, binding, args, data)
946     Lisp_Object key, binding, args;
947     void *data;
948{
949  struct apple_event_binding *event_binding =
950    (struct apple_event_binding *)data;
951  Lisp_Object code_string;
952
953  if (!SYMBOLP (key))
954    return;
955  code_string = Fget (key, args);
956  if (STRINGP (code_string) && SBYTES (code_string) == 4
957      && (EndianU32_BtoN (*((UInt32 *) SDATA (code_string)))
958	  == event_binding->code))
959    {
960      event_binding->key = key;
961      event_binding->binding = binding;
962    }
963}
964
965static void
966find_event_binding (keymap, event_binding, class_p)
967     Lisp_Object keymap;
968     struct apple_event_binding *event_binding;
969     int class_p;
970{
971  if (event_binding->code == 0)
972    event_binding->binding =
973      access_keymap (keymap, event_binding->key, 0, 1, 0);
974  else
975    {
976      event_binding->binding = Qnil;
977      map_keymap (keymap, find_event_binding_fun,
978		  class_p ? Qmac_apple_event_class : Qmac_apple_event_id,
979		  event_binding, 0);
980    }
981}
982
983void
984mac_find_apple_event_spec (class, id, class_key, id_key, binding)
985     AEEventClass class;
986     AEEventID id;
987     Lisp_Object *class_key, *id_key, *binding;
988{
989  struct apple_event_binding event_binding;
990  Lisp_Object keymap;
991
992  *binding = Qnil;
993
994  keymap = get_keymap (Vmac_apple_event_map, 0, 0);
995  if (NILP (keymap))
996    return;
997
998  event_binding.code = class;
999  event_binding.key = *class_key;
1000  event_binding.binding = Qnil;
1001  find_event_binding (keymap, &event_binding, 1);
1002  *class_key = event_binding.key;
1003  keymap = get_keymap (event_binding.binding, 0, 0);
1004  if (NILP (keymap))
1005    return;
1006
1007  event_binding.code = id;
1008  event_binding.key = *id_key;
1009  event_binding.binding = Qnil;
1010  find_event_binding (keymap, &event_binding, 0);
1011  *id_key = event_binding.key;
1012  *binding = event_binding.binding;
1013}
1014
1015static OSErr
1016defer_apple_events (apple_event, reply)
1017     const AppleEvent *apple_event, *reply;
1018{
1019  OSErr err;
1020  struct suspended_ae_info *new;
1021
1022  new = xmalloc (sizeof (struct suspended_ae_info));
1023  bzero (new, sizeof (struct suspended_ae_info));
1024  new->apple_event.descriptorType = typeNull;
1025  new->reply.descriptorType = typeNull;
1026
1027  err = AESuspendTheCurrentEvent (apple_event);
1028
1029  /* Mac OS 10.3 Xcode manual says AESuspendTheCurrentEvent makes
1030     copies of the Apple event and the reply, but Mac OS 10.4 Xcode
1031     manual says it doesn't.  Anyway we create copies of them and save
1032     them in `deferred_apple_events'.  */
1033  if (err == noErr)
1034    err = AEDuplicateDesc (apple_event, &new->apple_event);
1035  if (err == noErr)
1036    err = AEDuplicateDesc (reply, &new->reply);
1037  if (err == noErr)
1038    {
1039      new->next = deferred_apple_events;
1040      deferred_apple_events = new;
1041    }
1042  else
1043    {
1044      AEDisposeDesc (&new->apple_event);
1045      AEDisposeDesc (&new->reply);
1046      xfree (new);
1047    }
1048
1049  return err;
1050}
1051
1052static OSErr
1053mac_handle_apple_event_1 (class, id, apple_event, reply)
1054     Lisp_Object class, id;
1055     const AppleEvent *apple_event;
1056     AppleEvent *reply;
1057{
1058  OSErr err;
1059  static UInt32 suspension_id = 0;
1060  struct suspended_ae_info *new;
1061
1062  new = xmalloc (sizeof (struct suspended_ae_info));
1063  bzero (new, sizeof (struct suspended_ae_info));
1064  new->apple_event.descriptorType = typeNull;
1065  new->reply.descriptorType = typeNull;
1066
1067  err = AESuspendTheCurrentEvent (apple_event);
1068  if (err == noErr)
1069    err = AEDuplicateDesc (apple_event, &new->apple_event);
1070  if (err == noErr)
1071    err = AEDuplicateDesc (reply, &new->reply);
1072  if (err == noErr)
1073    err = AEPutAttributePtr (&new->apple_event, KEY_EMACS_SUSPENSION_ID_ATTR,
1074			     typeUInt32, &suspension_id, sizeof (UInt32));
1075  if (err == noErr)
1076    {
1077      OSErr err1;
1078      SInt32 reply_requested;
1079
1080      err1 = AEGetAttributePtr (&new->apple_event, keyReplyRequestedAttr,
1081				typeSInt32, NULL, &reply_requested,
1082				sizeof (SInt32), NULL);
1083      if (err1 != noErr)
1084	{
1085	  /* Emulate keyReplyRequestedAttr in older versions.  */
1086	  reply_requested = reply->descriptorType != typeNull;
1087	  err = AEPutAttributePtr (&new->apple_event, keyReplyRequestedAttr,
1088				   typeSInt32, &reply_requested,
1089				   sizeof (SInt32));
1090	}
1091    }
1092  if (err == noErr)
1093    {
1094      SInt32 timeout = 0;
1095      struct suspended_ae_info **p;
1096
1097      new->suspension_id = suspension_id;
1098      suspension_id++;
1099      err = AEGetAttributePtr (apple_event, keyTimeoutAttr, typeSInt32,
1100			       NULL, &timeout, sizeof (SInt32), NULL);
1101      new->expiration_tick = TickCount () + timeout;
1102
1103      for (p = &suspended_apple_events; *p; p = &(*p)->next)
1104	if ((*p)->expiration_tick >= new->expiration_tick)
1105	  break;
1106      new->next = *p;
1107      *p = new;
1108
1109      mac_store_apple_event (class, id, &new->apple_event);
1110    }
1111  else
1112    {
1113      AEDisposeDesc (&new->reply);
1114      AEDisposeDesc (&new->apple_event);
1115      xfree (new);
1116    }
1117
1118  return err;
1119}
1120
1121static pascal OSErr
1122mac_handle_apple_event (apple_event, reply, refcon)
1123     const AppleEvent *apple_event;
1124     AppleEvent *reply;
1125     SInt32 refcon;
1126{
1127  OSErr err;
1128  UInt32 suspension_id;
1129  AEEventClass event_class;
1130  AEEventID event_id;
1131  Lisp_Object class_key, id_key, binding;
1132
1133  if (!mac_ready_for_apple_events)
1134    {
1135      err = defer_apple_events (apple_event, reply);
1136      if (err != noErr)
1137	return errAEEventNotHandled;
1138      return noErr;
1139    }
1140
1141  err = AEGetAttributePtr (apple_event, KEY_EMACS_SUSPENSION_ID_ATTR,
1142			   typeUInt32, NULL,
1143			   &suspension_id, sizeof (UInt32), NULL);
1144  if (err == noErr)
1145    /* Previously suspended event.  Pass it to the next handler.  */
1146    return errAEEventNotHandled;
1147
1148  err = AEGetAttributePtr (apple_event, keyEventClassAttr, typeType, NULL,
1149			   &event_class, sizeof (AEEventClass), NULL);
1150  if (err == noErr)
1151    err = AEGetAttributePtr (apple_event, keyEventIDAttr, typeType, NULL,
1152			     &event_id, sizeof (AEEventID), NULL);
1153  if (err == noErr)
1154    {
1155      mac_find_apple_event_spec (event_class, event_id,
1156				 &class_key, &id_key, &binding);
1157      if (!NILP (binding) && !EQ (binding, Qundefined))
1158	{
1159	  if (INTEGERP (binding))
1160	    return XINT (binding);
1161	  err = mac_handle_apple_event_1 (class_key, id_key,
1162					  apple_event, reply);
1163	}
1164      else
1165	err = errAEEventNotHandled;
1166    }
1167  if (err == noErr)
1168    return noErr;
1169  else
1170    return errAEEventNotHandled;
1171}
1172
1173static int
1174cleanup_suspended_apple_events (head, all_p)
1175     struct suspended_ae_info **head;
1176     int all_p;
1177{
1178  UInt32 current_tick = TickCount (), nresumed = 0;
1179  struct suspended_ae_info *p, *next;
1180
1181  for (p = *head; p; p = next)
1182    {
1183      if (!all_p && p->expiration_tick > current_tick)
1184	break;
1185      AESetTheCurrentEvent (&p->apple_event);
1186      AEResumeTheCurrentEvent (&p->apple_event, &p->reply,
1187			       (AEEventHandlerUPP) kAENoDispatch, 0);
1188      AEDisposeDesc (&p->reply);
1189      AEDisposeDesc (&p->apple_event);
1190      nresumed++;
1191      next = p->next;
1192      xfree (p);
1193    }
1194  *head = p;
1195
1196  return nresumed;
1197}
1198
1199static void
1200cleanup_all_suspended_apple_events ()
1201{
1202  cleanup_suspended_apple_events (&deferred_apple_events, 1);
1203  cleanup_suspended_apple_events (&suspended_apple_events, 1);
1204}
1205
1206void
1207init_apple_event_handler ()
1208{
1209  OSErr err;
1210  long result;
1211
1212  /* Make sure we have Apple events before starting.  */
1213  err = Gestalt (gestaltAppleEventsAttr, &result);
1214  if (err != noErr)
1215    abort ();
1216
1217  if (!(result & (1 << gestaltAppleEventsPresent)))
1218    abort ();
1219
1220  err = AEInstallEventHandler (typeWildCard, typeWildCard,
1221#if TARGET_API_MAC_CARBON
1222			       NewAEEventHandlerUPP (mac_handle_apple_event),
1223#else
1224			       NewAEEventHandlerProc (mac_handle_apple_event),
1225#endif
1226			       0L, false);
1227  if (err != noErr)
1228    abort ();
1229
1230  atexit (cleanup_all_suspended_apple_events);
1231}
1232
1233static UInt32
1234get_suspension_id (apple_event)
1235     Lisp_Object apple_event;
1236{
1237  Lisp_Object tem;
1238
1239  CHECK_CONS (apple_event);
1240  CHECK_STRING_CAR (apple_event);
1241  if (SBYTES (XCAR (apple_event)) != 4
1242      || strcmp (SDATA (XCAR (apple_event)), "aevt") != 0)
1243    error ("Not an apple event");
1244
1245  tem = assq_no_quit (Qemacs_suspension_id, XCDR (apple_event));
1246  if (NILP (tem))
1247    error ("Suspension ID not available");
1248
1249  tem = XCDR (tem);
1250  if (!(CONSP (tem)
1251	&& STRINGP (XCAR (tem)) && SBYTES (XCAR (tem)) == 4
1252	&& strcmp (SDATA (XCAR (tem)), "magn") == 0
1253	&& STRINGP (XCDR (tem)) && SBYTES (XCDR (tem)) == 4))
1254    error ("Bad suspension ID format");
1255
1256  return *((UInt32 *) SDATA (XCDR (tem)));
1257}
1258
1259
1260DEFUN ("mac-process-deferred-apple-events", Fmac_process_deferred_apple_events, Smac_process_deferred_apple_events, 0, 0, 0,
1261       doc: /* Process Apple events that are deferred at the startup time.  */)
1262  ()
1263{
1264  if (mac_ready_for_apple_events)
1265    return Qnil;
1266
1267  BLOCK_INPUT;
1268  mac_ready_for_apple_events = 1;
1269  if (deferred_apple_events)
1270    {
1271      struct suspended_ae_info *prev, *tail, *next;
1272
1273      /* `nreverse' deferred_apple_events.  */
1274      prev = NULL;
1275      for (tail = deferred_apple_events; tail; tail = next)
1276	{
1277	  next = tail->next;
1278	  tail->next = prev;
1279	  prev = tail;
1280	}
1281
1282      /* Now `prev' points to the first cell.  */
1283      for (tail = prev; tail; tail = next)
1284	{
1285	  next = tail->next;
1286	  AEResumeTheCurrentEvent (&tail->apple_event, &tail->reply,
1287				   ((AEEventHandlerUPP)
1288				    kAEUseStandardDispatch), 0);
1289	  AEDisposeDesc (&tail->reply);
1290	  AEDisposeDesc (&tail->apple_event);
1291	  xfree (tail);
1292	}
1293
1294      deferred_apple_events = NULL;
1295    }
1296  UNBLOCK_INPUT;
1297
1298  return Qt;
1299}
1300
1301DEFUN ("mac-cleanup-expired-apple-events", Fmac_cleanup_expired_apple_events, Smac_cleanup_expired_apple_events, 0, 0, 0,
1302       doc: /* Clean up expired Apple events.
1303Return the number of expired events.   */)
1304     ()
1305{
1306  int nexpired;
1307
1308  BLOCK_INPUT;
1309  nexpired = cleanup_suspended_apple_events (&suspended_apple_events, 0);
1310  UNBLOCK_INPUT;
1311
1312  return make_number (nexpired);
1313}
1314
1315DEFUN ("mac-ae-set-reply-parameter", Fmac_ae_set_reply_parameter, Smac_ae_set_reply_parameter, 3, 3, 0,
1316       doc: /* Set parameter KEYWORD to DESCRIPTOR on reply of APPLE-EVENT.
1317KEYWORD is a 4-byte string.  DESCRIPTOR is a Lisp representation of an
1318Apple event descriptor.  It has the form of (TYPE . DATA), where TYPE
1319is a 4-byte string.  Valid format of DATA is as follows:
1320
1321  * If TYPE is "null", then DATA is nil.
1322  * If TYPE is "list", then DATA is a list (DESCRIPTOR1 ... DESCRIPTORn).
1323  * If TYPE is "reco", then DATA is a list ((KEYWORD1 . DESCRIPTOR1)
1324    ... (KEYWORDn . DESCRIPTORn)).
1325  * If TYPE is "aevt", then DATA is ignored and the descriptor is
1326    treated as null.
1327  * Otherwise, DATA is a string.
1328
1329If a (sub-)descriptor is in an invalid format, it is silently treated
1330as null.
1331
1332Return t if the parameter is successfully set.  Otherwise return nil.  */)
1333     (apple_event, keyword, descriptor)
1334     Lisp_Object apple_event, keyword, descriptor;
1335{
1336  Lisp_Object result = Qnil;
1337  UInt32 suspension_id;
1338  struct suspended_ae_info *p;
1339
1340  suspension_id = get_suspension_id (apple_event);
1341
1342  CHECK_STRING (keyword);
1343  if (SBYTES (keyword) != 4)
1344    error ("Apple event keyword must be a 4-byte string: %s",
1345	   SDATA (keyword));
1346
1347  BLOCK_INPUT;
1348  for (p = suspended_apple_events; p; p = p->next)
1349    if (p->suspension_id == suspension_id)
1350      break;
1351  if (p && p->reply.descriptorType != typeNull)
1352    {
1353      OSErr err;
1354
1355      err = mac_ae_put_lisp (&p->reply,
1356			     EndianU32_BtoN (*((UInt32 *) SDATA (keyword))),
1357			     descriptor);
1358      if (err == noErr)
1359	result = Qt;
1360    }
1361  UNBLOCK_INPUT;
1362
1363  return result;
1364}
1365
1366DEFUN ("mac-resume-apple-event", Fmac_resume_apple_event, Smac_resume_apple_event, 1, 2, 0,
1367       doc: /* Resume handling of APPLE-EVENT.
1368Every Apple event handled by the Lisp interpreter is suspended first.
1369This function resumes such a suspended event either to complete Apple
1370event handling to give a reply, or to redispatch it to other handlers.
1371
1372If optional ERROR-CODE is an integer, it specifies the error number
1373that is set in the reply.  If ERROR-CODE is t, the resumed event is
1374handled with the standard dispatching mechanism, but it is not handled
1375by Emacs again, thus it is redispatched to other handlers.
1376
1377Return t if APPLE-EVENT is successfully resumed.  Otherwise return
1378nil, which means the event is already resumed or expired.  */)
1379     (apple_event, error_code)
1380     Lisp_Object apple_event, error_code;
1381{
1382  Lisp_Object result = Qnil;
1383  UInt32 suspension_id;
1384  struct suspended_ae_info **p, *ae;
1385
1386  suspension_id = get_suspension_id (apple_event);
1387
1388  BLOCK_INPUT;
1389  for (p = &suspended_apple_events; *p; p = &(*p)->next)
1390    if ((*p)->suspension_id == suspension_id)
1391      break;
1392  if (*p)
1393    {
1394      ae = *p;
1395      *p = (*p)->next;
1396      if (INTEGERP (error_code)
1397	  && ae->reply.descriptorType != typeNull)
1398	{
1399	  SInt32 errn = XINT (error_code);
1400
1401	  AEPutParamPtr (&ae->reply, keyErrorNumber, typeSInt32,
1402			 &errn, sizeof (SInt32));
1403	}
1404      AESetTheCurrentEvent (&ae->apple_event);
1405      AEResumeTheCurrentEvent (&ae->apple_event, &ae->reply,
1406			       ((AEEventHandlerUPP)
1407				(EQ (error_code, Qt) ?
1408				 kAEUseStandardDispatch : kAENoDispatch)),
1409			       0);
1410      AEDisposeDesc (&ae->reply);
1411      AEDisposeDesc (&ae->apple_event);
1412      xfree (ae);
1413      result = Qt;
1414    }
1415  UNBLOCK_INPUT;
1416
1417  return result;
1418}
1419
1420
1421/***********************************************************************
1422                      Drag and drop support
1423***********************************************************************/
1424#if TARGET_API_MAC_CARBON
1425static Lisp_Object Vmac_dnd_known_types;
1426static pascal OSErr mac_do_track_drag P_ ((DragTrackingMessage, WindowRef,
1427					   void *, DragRef));
1428static pascal OSErr mac_do_receive_drag P_ ((WindowRef, void *, DragRef));
1429static DragTrackingHandlerUPP mac_do_track_dragUPP = NULL;
1430static DragReceiveHandlerUPP mac_do_receive_dragUPP = NULL;
1431
1432extern void mac_store_drag_event P_ ((WindowRef, Point, SInt16,
1433				      const AEDesc *));
1434
1435static pascal OSErr
1436mac_do_track_drag (message, window, refcon, drag)
1437     DragTrackingMessage message;
1438     WindowRef window;
1439     void *refcon;
1440     DragRef drag;
1441{
1442  OSErr err = noErr;
1443  static int can_accept;
1444  UInt16 num_items, index;
1445
1446  if (GetFrontWindowOfClass (kMovableModalWindowClass, false))
1447    return dragNotAcceptedErr;
1448
1449  switch (message)
1450    {
1451    case kDragTrackingEnterHandler:
1452      err = CountDragItems (drag, &num_items);
1453      if (err != noErr)
1454	break;
1455      can_accept = 0;
1456      for (index = 1; index <= num_items; index++)
1457	{
1458	  ItemReference item;
1459	  FlavorFlags flags;
1460	  Lisp_Object rest;
1461
1462	  err = GetDragItemReferenceNumber (drag, index, &item);
1463	  if (err != noErr)
1464	    continue;
1465	  for (rest = Vmac_dnd_known_types; CONSP (rest); rest = XCDR (rest))
1466	    {
1467	      Lisp_Object str;
1468	      FlavorType type;
1469
1470	      str = XCAR (rest);
1471	      if (!(STRINGP (str) && SBYTES (str) == 4))
1472		continue;
1473	      type = EndianU32_BtoN (*((UInt32 *) SDATA (str)));
1474
1475	      err = GetFlavorFlags (drag, item, type, &flags);
1476	      if (err == noErr)
1477		{
1478		  can_accept = 1;
1479		  break;
1480		}
1481	    }
1482	}
1483      break;
1484
1485    case kDragTrackingEnterWindow:
1486      if (can_accept)
1487	{
1488	  RgnHandle hilite_rgn = NewRgn ();
1489
1490	  if (hilite_rgn)
1491	    {
1492	      Rect r;
1493
1494	      GetWindowPortBounds (window, &r);
1495	      OffsetRect (&r, -r.left, -r.top);
1496	      RectRgn (hilite_rgn, &r);
1497	      ShowDragHilite (drag, hilite_rgn, true);
1498	      DisposeRgn (hilite_rgn);
1499	    }
1500	  SetThemeCursor (kThemeCopyArrowCursor);
1501	}
1502      break;
1503
1504    case kDragTrackingInWindow:
1505      break;
1506
1507    case kDragTrackingLeaveWindow:
1508      if (can_accept)
1509	{
1510	  HideDragHilite (drag);
1511	  SetThemeCursor (kThemeArrowCursor);
1512	}
1513      break;
1514
1515    case kDragTrackingLeaveHandler:
1516      break;
1517    }
1518
1519  if (err != noErr)
1520    return dragNotAcceptedErr;
1521  return noErr;
1522}
1523
1524static pascal OSErr
1525mac_do_receive_drag (window, refcon, drag)
1526     WindowRef window;
1527     void *refcon;
1528     DragRef drag;
1529{
1530  OSErr err;
1531  int num_types, i;
1532  Lisp_Object rest, str;
1533  FlavorType *types;
1534  AppleEvent apple_event;
1535  Point mouse_pos;
1536  SInt16 modifiers;
1537
1538  if (GetFrontWindowOfClass (kMovableModalWindowClass, false))
1539    return dragNotAcceptedErr;
1540
1541  num_types = 0;
1542  for (rest = Vmac_dnd_known_types; CONSP (rest); rest = XCDR (rest))
1543    {
1544      str = XCAR (rest);
1545      if (STRINGP (str) && SBYTES (str) == 4)
1546	num_types++;
1547    }
1548
1549  types = xmalloc (sizeof (FlavorType) * num_types);
1550  i = 0;
1551  for (rest = Vmac_dnd_known_types; CONSP (rest); rest = XCDR (rest))
1552    {
1553      str = XCAR (rest);
1554      if (STRINGP (str) && SBYTES (str) == 4)
1555	types[i++] = EndianU32_BtoN (*((UInt32 *) SDATA (str)));
1556    }
1557
1558  err = create_apple_event_from_drag_ref (drag, num_types, types,
1559					  &apple_event);
1560  xfree (types);
1561
1562  if (err == noErr)
1563    err = GetDragMouse (drag, &mouse_pos, NULL);
1564  if (err == noErr)
1565    {
1566      GlobalToLocal (&mouse_pos);
1567      err = GetDragModifiers (drag, NULL, NULL, &modifiers);
1568    }
1569  if (err == noErr)
1570    {
1571      UInt32 key_modifiers = modifiers;
1572
1573      err = AEPutParamPtr (&apple_event, kEventParamKeyModifiers,
1574			   typeUInt32, &key_modifiers, sizeof (UInt32));
1575    }
1576
1577  if (err == noErr)
1578    {
1579      mac_store_drag_event (window, mouse_pos, 0, &apple_event);
1580      AEDisposeDesc (&apple_event);
1581      mac_wakeup_from_rne ();
1582      return noErr;
1583    }
1584  else
1585    return dragNotAcceptedErr;
1586}
1587#endif	/* TARGET_API_MAC_CARBON */
1588
1589OSErr
1590install_drag_handler (window)
1591     WindowRef window;
1592{
1593  OSErr err = noErr;
1594
1595#if TARGET_API_MAC_CARBON
1596  if (mac_do_track_dragUPP == NULL)
1597    mac_do_track_dragUPP = NewDragTrackingHandlerUPP (mac_do_track_drag);
1598  if (mac_do_receive_dragUPP == NULL)
1599    mac_do_receive_dragUPP = NewDragReceiveHandlerUPP (mac_do_receive_drag);
1600
1601  err = InstallTrackingHandler (mac_do_track_dragUPP, window, NULL);
1602  if (err == noErr)
1603    err = InstallReceiveHandler (mac_do_receive_dragUPP, window, NULL);
1604#endif
1605
1606  return err;
1607}
1608
1609void
1610remove_drag_handler (window)
1611     WindowRef window;
1612{
1613#if TARGET_API_MAC_CARBON
1614  if (mac_do_track_dragUPP)
1615    RemoveTrackingHandler (mac_do_track_dragUPP, window);
1616  if (mac_do_receive_dragUPP)
1617    RemoveReceiveHandler (mac_do_receive_dragUPP, window);
1618#endif
1619}
1620
1621
1622/***********************************************************************
1623			Services menu support
1624***********************************************************************/
1625#ifdef MAC_OSX
1626void
1627init_service_handler ()
1628{
1629  static const EventTypeSpec specs[] =
1630    {{kEventClassService, kEventServiceGetTypes},
1631     {kEventClassService, kEventServiceCopy},
1632     {kEventClassService, kEventServicePaste},
1633     {kEventClassService, kEventServicePerform}};
1634  InstallApplicationEventHandler (NewEventHandlerUPP (mac_handle_service_event),
1635				  GetEventTypeCount (specs), specs, NULL, NULL);
1636}
1637
1638extern OSStatus mac_store_service_event P_ ((EventRef));
1639
1640static OSStatus
1641copy_scrap_flavor_data (from_scrap, to_scrap, flavor_type)
1642     ScrapRef from_scrap, to_scrap;
1643     ScrapFlavorType flavor_type;
1644{
1645  OSStatus err;
1646  Size size, size_allocated;
1647  char *buf = NULL;
1648
1649  err = GetScrapFlavorSize (from_scrap, flavor_type, &size);
1650  if (err == noErr)
1651    buf = xmalloc (size);
1652  while (buf)
1653    {
1654      size_allocated = size;
1655      err = GetScrapFlavorData (from_scrap, flavor_type, &size, buf);
1656      if (err != noErr)
1657	{
1658	  xfree (buf);
1659	  buf = NULL;
1660	}
1661      else if (size_allocated < size)
1662	buf = xrealloc (buf, size);
1663      else
1664	break;
1665    }
1666  if (err == noErr)
1667    {
1668      if (buf == NULL)
1669	err = memFullErr;
1670      else
1671	{
1672	  err = PutScrapFlavor (to_scrap, flavor_type, kScrapFlavorMaskNone,
1673				size, buf);
1674	  xfree (buf);
1675	}
1676    }
1677
1678  return err;
1679}
1680
1681static OSStatus
1682mac_handle_service_event (call_ref, event, data)
1683     EventHandlerCallRef call_ref;
1684     EventRef event;
1685     void *data;
1686{
1687  OSStatus err = noErr;
1688  ScrapRef cur_scrap, specific_scrap;
1689  UInt32 event_kind = GetEventKind (event);
1690  CFMutableArrayRef copy_types, paste_types;
1691  CFStringRef type;
1692  Lisp_Object rest;
1693  ScrapFlavorType flavor_type;
1694
1695  /* Check if Vmac_service_selection is a valid selection that has a
1696     corresponding scrap.  */
1697  if (!SYMBOLP (Vmac_service_selection))
1698    err = eventNotHandledErr;
1699  else
1700    err = get_scrap_from_symbol (Vmac_service_selection, 0, &cur_scrap);
1701  if (!(err == noErr && cur_scrap))
1702    return eventNotHandledErr;
1703
1704  switch (event_kind)
1705    {
1706    case kEventServiceGetTypes:
1707      /* Set paste types. */
1708      err = GetEventParameter (event, kEventParamServicePasteTypes,
1709			       typeCFMutableArrayRef, NULL,
1710			       sizeof (CFMutableArrayRef), NULL,
1711			       &paste_types);
1712      if (err != noErr)
1713	break;
1714
1715      for (rest = Vselection_converter_alist; CONSP (rest);
1716	   rest = XCDR (rest))
1717	if (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest)))
1718	    && (flavor_type =
1719		get_flavor_type_from_symbol (XCAR (XCAR (rest)))))
1720	  {
1721	    type = CreateTypeStringWithOSType (flavor_type);
1722	    if (type)
1723	      {
1724		CFArrayAppendValue (paste_types, type);
1725		CFRelease (type);
1726	      }
1727	  }
1728
1729      /* Set copy types.  */
1730      err = GetEventParameter (event, kEventParamServiceCopyTypes,
1731			       typeCFMutableArrayRef, NULL,
1732			       sizeof (CFMutableArrayRef), NULL,
1733			       &copy_types);
1734      if (err != noErr)
1735	break;
1736
1737      if (NILP (Fx_selection_owner_p (Vmac_service_selection)))
1738	break;
1739      else
1740	goto copy_all_flavors;
1741
1742    case kEventServiceCopy:
1743      err = GetEventParameter (event, kEventParamScrapRef,
1744			       typeScrapRef, NULL,
1745			       sizeof (ScrapRef), NULL, &specific_scrap);
1746      if (err != noErr
1747	  || NILP (Fx_selection_owner_p (Vmac_service_selection)))
1748	{
1749	  err = eventNotHandledErr;
1750	  break;
1751	}
1752
1753    copy_all_flavors:
1754      {
1755	UInt32 count, i;
1756	ScrapFlavorInfo *flavor_info = NULL;
1757	ScrapFlavorFlags flags;
1758
1759	err = GetScrapFlavorCount (cur_scrap, &count);
1760	if (err == noErr)
1761	  flavor_info = xmalloc (sizeof (ScrapFlavorInfo) * count);
1762	err = GetScrapFlavorInfoList (cur_scrap, &count, flavor_info);
1763	if (err != noErr)
1764	  {
1765	    xfree (flavor_info);
1766	    flavor_info = NULL;
1767	  }
1768	if (flavor_info == NULL)
1769	  break;
1770
1771	for (i = 0; i < count; i++)
1772	  {
1773	    flavor_type = flavor_info[i].flavorType;
1774	    err = GetScrapFlavorFlags (cur_scrap, flavor_type, &flags);
1775	    if (err == noErr && !(flags & kScrapFlavorMaskSenderOnly))
1776	      {
1777		if (event_kind == kEventServiceCopy)
1778		  err = copy_scrap_flavor_data (cur_scrap, specific_scrap,
1779						flavor_type);
1780		else	     /* event_kind == kEventServiceGetTypes */
1781		  {
1782		    type = CreateTypeStringWithOSType (flavor_type);
1783		    if (type)
1784		      {
1785			CFArrayAppendValue (copy_types, type);
1786			CFRelease (type);
1787		      }
1788		  }
1789	      }
1790	  }
1791	xfree (flavor_info);
1792      }
1793      break;
1794
1795    case kEventServicePaste:
1796    case kEventServicePerform:
1797      {
1798	int data_exists_p = 0;
1799
1800        err = GetEventParameter (event, kEventParamScrapRef, typeScrapRef,
1801				 NULL, sizeof (ScrapRef), NULL,
1802				 &specific_scrap);
1803	if (err == noErr)
1804	  err = clear_scrap (&cur_scrap);
1805	if (err == noErr)
1806	  for (rest = Vselection_converter_alist; CONSP (rest);
1807	       rest = XCDR (rest))
1808	    {
1809	      if (! (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest)))))
1810		continue;
1811	      flavor_type = get_flavor_type_from_symbol (XCAR (XCAR (rest)));
1812	      if (flavor_type == 0)
1813		continue;
1814	      err = copy_scrap_flavor_data (specific_scrap, cur_scrap,
1815					    flavor_type);
1816	      if (err == noErr)
1817		data_exists_p = 1;
1818	    }
1819	if (!data_exists_p)
1820	  err = eventNotHandledErr;
1821	else
1822	  err = mac_store_service_event (event);
1823      }
1824      break;
1825    }
1826
1827  if (err != noErr)
1828    err = eventNotHandledErr;
1829  return err;
1830}
1831#endif
1832
1833
1834void
1835syms_of_macselect ()
1836{
1837  defsubr (&Sx_get_selection_internal);
1838  defsubr (&Sx_own_selection_internal);
1839  defsubr (&Sx_disown_selection_internal);
1840  defsubr (&Sx_selection_owner_p);
1841  defsubr (&Sx_selection_exists_p);
1842  defsubr (&Smac_process_deferred_apple_events);
1843  defsubr (&Smac_cleanup_expired_apple_events);
1844  defsubr (&Smac_resume_apple_event);
1845  defsubr (&Smac_ae_set_reply_parameter);
1846
1847  Vselection_alist = Qnil;
1848  staticpro (&Vselection_alist);
1849
1850  DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
1851	       doc: /* An alist associating selection-types with functions.
1852These functions are called to convert the selection, with three args:
1853the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
1854a desired type to which the selection should be converted;
1855and the local selection value (whatever was given to `x-own-selection').
1856
1857The function should return the value to send to the Scrap Manager
1858\(must be a string).  A return value of nil
1859means that the conversion could not be done.  */);
1860  Vselection_converter_alist = Qnil;
1861
1862  DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions,
1863	       doc: /* A list of functions to be called when Emacs loses a selection.
1864\(This happens when a Lisp program explicitly clears the selection.)
1865The functions are called with one argument, the selection type
1866\(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD').  */);
1867  Vx_lost_selection_functions = Qnil;
1868
1869  DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
1870	       doc: /* Coding system for communicating with other programs.
1871When sending or receiving text via cut_buffer, selection, and clipboard,
1872the text is encoded or decoded by this coding system.
1873The default value is determined by the system script code.  */);
1874  Vselection_coding_system = Qnil;
1875
1876  DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
1877	       doc: /* Coding system for the next communication with other programs.
1878Usually, `selection-coding-system' is used for communicating with
1879other programs.  But, if this variable is set, it is used for the
1880next communication only.  After the communication, this variable is
1881set to nil.  */);
1882  Vnext_selection_coding_system = Qnil;
1883
1884  DEFVAR_LISP ("mac-apple-event-map", &Vmac_apple_event_map,
1885	       doc: /* Keymap for Apple events handled by Emacs.  */);
1886  Vmac_apple_event_map = Qnil;
1887
1888#if TARGET_API_MAC_CARBON
1889  DEFVAR_LISP ("mac-dnd-known-types", &Vmac_dnd_known_types,
1890	       doc: /* The types accepted by default for dropped data.
1891The types are chosen in the order they appear in the list.  */);
1892  Vmac_dnd_known_types = list4 (build_string ("hfs "), build_string ("utxt"),
1893				build_string ("TEXT"), build_string ("TIFF"));
1894#ifdef MAC_OSX
1895  Vmac_dnd_known_types = Fcons (build_string ("furl"), Vmac_dnd_known_types);
1896#endif
1897#endif
1898
1899#ifdef MAC_OSX
1900  DEFVAR_LISP ("mac-service-selection", &Vmac_service_selection,
1901	       doc: /* Selection name for communication via Services menu.  */);
1902  Vmac_service_selection = intern ("PRIMARY");
1903#endif
1904
1905  QPRIMARY   = intern ("PRIMARY");	staticpro (&QPRIMARY);
1906  QSECONDARY = intern ("SECONDARY");	staticpro (&QSECONDARY);
1907  QTIMESTAMP = intern ("TIMESTAMP");	staticpro (&QTIMESTAMP);
1908  QTARGETS   = intern ("TARGETS");	staticpro (&QTARGETS);
1909
1910  Qforeign_selection = intern ("foreign-selection");
1911  staticpro (&Qforeign_selection);
1912
1913  Qmac_scrap_name = intern ("mac-scrap-name");
1914  staticpro (&Qmac_scrap_name);
1915
1916  Qmac_ostype = intern ("mac-ostype");
1917  staticpro (&Qmac_ostype);
1918
1919  Qmac_apple_event_class = intern ("mac-apple-event-class");
1920  staticpro (&Qmac_apple_event_class);
1921
1922  Qmac_apple_event_id = intern ("mac-apple-event-id");
1923  staticpro (&Qmac_apple_event_id);
1924
1925  Qemacs_suspension_id = intern ("emacs-suspension-id");
1926  staticpro (&Qemacs_suspension_id);
1927}
1928
1929/* arch-tag: f3c91ad8-99e0-4bd6-9eef-251b2f848732
1930   (do not change this comment) */
1931