]> code.delx.au - gnu-emacs/blob - src/macselect.c
(lgrep, rgrep): Use add-to-history.
[gnu-emacs] / src / macselect.c
1 /* Selection processing for Emacs on Mac OS.
2 Copyright (C) 2005, 2006 Free Software Foundation, Inc.
3
4 This file is part of GNU Emacs.
5
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
10
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
19 Boston, 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>
30 typedef int ScrapRef;
31 typedef ResType ScrapFlavorType;
32 #endif /* !TARGET_API_MAC_CARBON */
33
34 static OSErr get_scrap_from_symbol P_ ((Lisp_Object, int, ScrapRef *));
35 static ScrapFlavorType get_flavor_type_from_symbol P_ ((Lisp_Object));
36 static int valid_scrap_target_type_p P_ ((Lisp_Object));
37 static OSErr clear_scrap P_ ((ScrapRef *));
38 static OSErr put_scrap_string P_ ((ScrapRef, Lisp_Object, Lisp_Object));
39 static OSErr put_scrap_private_timestamp P_ ((ScrapRef, unsigned long));
40 static ScrapFlavorType scrap_has_target_type P_ ((ScrapRef, Lisp_Object));
41 static Lisp_Object get_scrap_string P_ ((ScrapRef, Lisp_Object));
42 static OSErr get_scrap_private_timestamp P_ ((ScrapRef, unsigned long *));
43 static Lisp_Object get_scrap_target_type_list P_ ((ScrapRef));
44 static void x_own_selection P_ ((Lisp_Object, Lisp_Object));
45 static Lisp_Object x_get_local_selection P_ ((Lisp_Object, Lisp_Object, int));
46 static Lisp_Object x_get_foreign_selection P_ ((Lisp_Object,
47 Lisp_Object,
48 Lisp_Object));
49 EXFUN (Fx_selection_owner_p, 1);
50 #ifdef MAC_OSX
51 static OSStatus mac_handle_service_event P_ ((EventHandlerCallRef,
52 EventRef, void *));
53 void init_service_handler P_ ((void));
54 #endif
55
56 Lisp_Object QPRIMARY, QSECONDARY, QTIMESTAMP, QTARGETS;
57
58 static Lisp_Object Vx_lost_selection_functions;
59 /* Coding system for communicating with other programs via scrap. */
60 static Lisp_Object Vselection_coding_system;
61
62 /* Coding system for the next communicating with other programs. */
63 static Lisp_Object Vnext_selection_coding_system;
64
65 static 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. */
70 extern 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. */
86 static 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. */
95 static 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'. */
100 static Lisp_Object Qmac_scrap_name, Qmac_ostype;
101
102 #ifdef MAC_OSX
103 /* Selection name for communication via Services menu. */
104 static Lisp_Object Vmac_services_selection;
105 #endif
106 \f
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
111 static OSErr
112 get_scrap_from_symbol (sym, clear_p, scrap)
113 Lisp_Object sym;
114 int clear_p;
115 ScrapRef *scrap;
116 {
117 OSErr 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
152 static ScrapFlavorType
153 get_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
166 static int
167 valid_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
175 static INLINE OSErr
176 clear_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
193 static OSErr
194 put_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
214 static INLINE OSErr
215 put_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
231 static ScrapFlavorType
232 scrap_has_target_type (scrap, type)
233 ScrapRef scrap;
234 Lisp_Object type;
235 {
236 OSErr 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
262 static Lisp_Object
263 get_scrap_string (scrap, type)
264 ScrapRef scrap;
265 Lisp_Object type;
266 {
267 OSErr 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
313 static OSErr
314 get_scrap_private_timestamp (scrap, timestamp)
315 ScrapRef scrap;
316 unsigned long *timestamp;
317 {
318 OSErr 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
362 static Lisp_Object
363 get_scrap_target_type_list (scrap)
364 ScrapRef scrap;
365 {
366 Lisp_Object result = Qnil, rest, target_type;
367 #if TARGET_API_MAC_CARBON
368 OSErr 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)) && SYMBOLP (target_type = XCAR (XCAR (rest)))
390 && (flavor_type = scrap_has_target_type (scrap, target_type)))
391 {
392 result = Fcons (target_type, result);
393 #if TARGET_API_MAC_CARBON
394 for (i = 0; i < count; i++)
395 if (flavor_info[i].flavorType == flavor_type)
396 {
397 flavor_info[i].flavorType = 0;
398 break;
399 }
400 #endif
401 }
402 }
403 #if TARGET_API_MAC_CARBON
404 if (flavor_info)
405 {
406 for (i = 0; i < count; i++)
407 if (flavor_info[i].flavorType)
408 {
409 type = EndianU32_NtoB (flavor_info[i].flavorType);
410 strings = Fcons (make_unibyte_string ((char *) &type, 4), strings);
411 }
412 result = nconc2 (result, strings);
413 xfree (flavor_info);
414 }
415 #endif
416
417 return result;
418 }
419 \f
420 /* Do protocol to assert ourself as a selection owner.
421 Update the Vselection_alist so that we can reply to later requests for
422 our selection. */
423
424 static void
425 x_own_selection (selection_name, selection_value)
426 Lisp_Object selection_name, selection_value;
427 {
428 OSErr err;
429 ScrapRef scrap;
430 struct gcpro gcpro1, gcpro2;
431 Lisp_Object rest, handler_fn, value, type;
432 int count;
433
434 CHECK_SYMBOL (selection_name);
435
436 GCPRO2 (selection_name, selection_value);
437
438 BLOCK_INPUT;
439
440 err = get_scrap_from_symbol (selection_name, 1, &scrap);
441 if (err == noErr && scrap)
442 {
443 /* Don't allow a quit within the converter.
444 When the user types C-g, he would be surprised
445 if by luck it came during a converter. */
446 count = SPECPDL_INDEX ();
447 specbind (Qinhibit_quit, Qt);
448
449 for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest))
450 {
451 if (!(CONSP (XCAR (rest))
452 && SYMBOLP (type = XCAR (XCAR (rest)))
453 && valid_scrap_target_type_p (type)
454 && SYMBOLP (handler_fn = XCDR (XCAR (rest)))))
455 continue;
456
457 if (!NILP (handler_fn))
458 value = call3 (handler_fn, selection_name,
459 type, selection_value);
460
461 if (STRINGP (value))
462 err = put_scrap_string (scrap, type, value);
463 else if (CONSP (value)
464 && EQ (XCAR (value), type)
465 && STRINGP (XCDR (value)))
466 err = put_scrap_string (scrap, type, XCDR (value));
467 }
468
469 unbind_to (count, Qnil);
470
471 if (err == noErr)
472 err = put_scrap_private_timestamp (scrap, last_event_timestamp);
473 }
474
475 UNBLOCK_INPUT;
476
477 UNGCPRO;
478
479 if (scrap && err != noErr)
480 error ("Can't set selection");
481
482 /* Now update the local cache */
483 {
484 Lisp_Object selection_time;
485 Lisp_Object selection_data;
486 Lisp_Object prev_value;
487
488 selection_time = long_to_cons (last_event_timestamp);
489 selection_data = Fcons (selection_name,
490 Fcons (selection_value,
491 Fcons (selection_time,
492 Fcons (selected_frame, Qnil))));
493 prev_value = assq_no_quit (selection_name, Vselection_alist);
494
495 Vselection_alist = Fcons (selection_data, Vselection_alist);
496
497 /* If we already owned the selection, remove the old selection data.
498 Perhaps we should destructively modify it instead.
499 Don't use Fdelq as that may QUIT. */
500 if (!NILP (prev_value))
501 {
502 Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
503 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
504 if (EQ (prev_value, Fcar (XCDR (rest))))
505 {
506 XSETCDR (rest, Fcdr (XCDR (rest)));
507 break;
508 }
509 }
510 }
511 }
512 \f
513 /* Given a selection-name and desired type, look up our local copy of
514 the selection value and convert it to the type.
515 The value is nil or a string.
516 This function is used both for remote requests (LOCAL_REQUEST is zero)
517 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
518
519 This calls random Lisp code, and may signal or gc. */
520
521 static Lisp_Object
522 x_get_local_selection (selection_symbol, target_type, local_request)
523 Lisp_Object selection_symbol, target_type;
524 int local_request;
525 {
526 Lisp_Object local_value;
527 Lisp_Object handler_fn, value, type, check;
528 int count;
529
530 if (NILP (Fx_selection_owner_p (selection_symbol)))
531 return Qnil;
532
533 local_value = assq_no_quit (selection_symbol, Vselection_alist);
534
535 /* TIMESTAMP is a special case 'cause that's easiest. */
536 if (EQ (target_type, QTIMESTAMP))
537 {
538 handler_fn = Qnil;
539 value = XCAR (XCDR (XCDR (local_value)));
540 }
541 #if 0
542 else if (EQ (target_type, QDELETE))
543 {
544 handler_fn = Qnil;
545 Fx_disown_selection_internal
546 (selection_symbol,
547 XCAR (XCDR (XCDR (local_value))));
548 value = QNULL;
549 }
550 #endif
551 else
552 {
553 /* Don't allow a quit within the converter.
554 When the user types C-g, he would be surprised
555 if by luck it came during a converter. */
556 count = SPECPDL_INDEX ();
557 specbind (Qinhibit_quit, Qt);
558
559 CHECK_SYMBOL (target_type);
560 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
561 /* gcpro is not needed here since nothing but HANDLER_FN
562 is live, and that ought to be a symbol. */
563
564 if (!NILP (handler_fn))
565 value = call3 (handler_fn,
566 selection_symbol, (local_request ? Qnil : target_type),
567 XCAR (XCDR (local_value)));
568 else
569 value = Qnil;
570 unbind_to (count, Qnil);
571 }
572
573 /* Make sure this value is of a type that we could transmit
574 to another X client. */
575
576 check = value;
577 if (CONSP (value)
578 && SYMBOLP (XCAR (value)))
579 type = XCAR (value),
580 check = XCDR (value);
581
582 if (STRINGP (check)
583 || VECTORP (check)
584 || SYMBOLP (check)
585 || INTEGERP (check)
586 || NILP (value))
587 return value;
588 /* Check for a value that cons_to_long could handle. */
589 else if (CONSP (check)
590 && INTEGERP (XCAR (check))
591 && (INTEGERP (XCDR (check))
592 ||
593 (CONSP (XCDR (check))
594 && INTEGERP (XCAR (XCDR (check)))
595 && NILP (XCDR (XCDR (check))))))
596 return value;
597 else
598 return
599 Fsignal (Qerror,
600 Fcons (build_string ("invalid data returned by selection-conversion function"),
601 Fcons (handler_fn, Fcons (value, Qnil))));
602 }
603
604 \f
605 /* Clear all selections that were made from frame F.
606 We do this when about to delete a frame. */
607
608 void
609 x_clear_frame_selections (f)
610 FRAME_PTR f;
611 {
612 Lisp_Object frame;
613 Lisp_Object rest;
614
615 XSETFRAME (frame, f);
616
617 /* Otherwise, we're really honest and truly being told to drop it.
618 Don't use Fdelq as that may QUIT;. */
619
620 /* Delete elements from the beginning of Vselection_alist. */
621 while (!NILP (Vselection_alist)
622 && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
623 {
624 /* Let random Lisp code notice that the selection has been stolen. */
625 Lisp_Object hooks, selection_symbol;
626
627 hooks = Vx_lost_selection_functions;
628 selection_symbol = Fcar (Fcar (Vselection_alist));
629
630 if (!EQ (hooks, Qunbound)
631 && !NILP (Fx_selection_owner_p (selection_symbol)))
632 {
633 for (; CONSP (hooks); hooks = Fcdr (hooks))
634 call1 (Fcar (hooks), selection_symbol);
635 #if 0 /* This can crash when deleting a frame
636 from x_connection_closed. Anyway, it seems unnecessary;
637 something else should cause a redisplay. */
638 redisplay_preserve_echo_area (21);
639 #endif
640 }
641
642 Vselection_alist = Fcdr (Vselection_alist);
643 }
644
645 /* Delete elements after the beginning of Vselection_alist. */
646 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
647 if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest))))))))
648 {
649 /* Let random Lisp code notice that the selection has been stolen. */
650 Lisp_Object hooks, selection_symbol;
651
652 hooks = Vx_lost_selection_functions;
653 selection_symbol = Fcar (Fcar (XCDR (rest)));
654
655 if (!EQ (hooks, Qunbound)
656 && !NILP (Fx_selection_owner_p (selection_symbol)))
657 {
658 for (; CONSP (hooks); hooks = Fcdr (hooks))
659 call1 (Fcar (hooks), selection_symbol);
660 #if 0 /* See above */
661 redisplay_preserve_echo_area (22);
662 #endif
663 }
664 XSETCDR (rest, Fcdr (XCDR (rest)));
665 break;
666 }
667 }
668 \f
669 /* Do protocol to read selection-data from the server.
670 Converts this to Lisp data and returns it. */
671
672 static Lisp_Object
673 x_get_foreign_selection (selection_symbol, target_type, time_stamp)
674 Lisp_Object selection_symbol, target_type, time_stamp;
675 {
676 OSErr err;
677 ScrapRef scrap;
678 Lisp_Object result = Qnil;
679
680 BLOCK_INPUT;
681
682 err = get_scrap_from_symbol (selection_symbol, 0, &scrap);
683 if (err == noErr && scrap)
684 {
685 if (EQ (target_type, QTARGETS))
686 {
687 result = get_scrap_target_type_list (scrap);
688 result = Fvconcat (1, &result);
689 }
690 else
691 {
692 result = get_scrap_string (scrap, target_type);
693 if (STRINGP (result))
694 Fput_text_property (make_number (0), make_number (SBYTES (result)),
695 Qforeign_selection, target_type, result);
696 }
697 }
698
699 UNBLOCK_INPUT;
700
701 return result;
702 }
703
704
705 DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
706 Sx_own_selection_internal, 2, 2, 0,
707 doc: /* Assert a selection of the given TYPE with the given VALUE.
708 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
709 VALUE is typically a string, or a cons of two markers, but may be
710 anything that the functions on `selection-converter-alist' know about. */)
711 (selection_name, selection_value)
712 Lisp_Object selection_name, selection_value;
713 {
714 check_mac ();
715 CHECK_SYMBOL (selection_name);
716 if (NILP (selection_value)) error ("SELECTION-VALUE may not be nil");
717 x_own_selection (selection_name, selection_value);
718 return selection_value;
719 }
720
721
722 /* Request the selection value from the owner. If we are the owner,
723 simply return our selection value. If we are not the owner, this
724 will block until all of the data has arrived. */
725
726 DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
727 Sx_get_selection_internal, 2, 3, 0,
728 doc: /* Return text selected from some Mac application.
729 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
730 TYPE is the type of data desired, typically `STRING'.
731 TIME_STAMP is ignored on Mac. */)
732 (selection_symbol, target_type, time_stamp)
733 Lisp_Object selection_symbol, target_type, time_stamp;
734 {
735 Lisp_Object val = Qnil;
736 struct gcpro gcpro1, gcpro2;
737 GCPRO2 (target_type, val); /* we store newly consed data into these */
738 check_mac ();
739 CHECK_SYMBOL (selection_symbol);
740 CHECK_SYMBOL (target_type);
741
742 val = x_get_local_selection (selection_symbol, target_type, 1);
743
744 if (NILP (val))
745 {
746 val = x_get_foreign_selection (selection_symbol, target_type, time_stamp);
747 goto DONE;
748 }
749
750 if (CONSP (val)
751 && SYMBOLP (XCAR (val)))
752 {
753 val = XCDR (val);
754 if (CONSP (val) && NILP (XCDR (val)))
755 val = XCAR (val);
756 }
757 DONE:
758 UNGCPRO;
759 return val;
760 }
761
762 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
763 Sx_disown_selection_internal, 1, 2, 0,
764 doc: /* If we own the selection SELECTION, disown it.
765 Disowning it means there is no such selection. */)
766 (selection, time)
767 Lisp_Object selection;
768 Lisp_Object time;
769 {
770 OSErr err;
771 ScrapRef scrap;
772 Lisp_Object local_selection_data;
773
774 check_mac ();
775 CHECK_SYMBOL (selection);
776
777 if (NILP (Fx_selection_owner_p (selection)))
778 return Qnil; /* Don't disown the selection when we're not the owner. */
779
780 local_selection_data = assq_no_quit (selection, Vselection_alist);
781
782 /* Don't use Fdelq as that may QUIT;. */
783
784 if (EQ (local_selection_data, Fcar (Vselection_alist)))
785 Vselection_alist = Fcdr (Vselection_alist);
786 else
787 {
788 Lisp_Object rest;
789 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
790 if (EQ (local_selection_data, Fcar (XCDR (rest))))
791 {
792 XSETCDR (rest, Fcdr (XCDR (rest)));
793 break;
794 }
795 }
796
797 /* Let random lisp code notice that the selection has been stolen. */
798
799 {
800 Lisp_Object rest;
801 rest = Vx_lost_selection_functions;
802 if (!EQ (rest, Qunbound))
803 {
804 for (; CONSP (rest); rest = Fcdr (rest))
805 call1 (Fcar (rest), selection);
806 prepare_menu_bars ();
807 redisplay_preserve_echo_area (20);
808 }
809 }
810
811 BLOCK_INPUT;
812
813 err = get_scrap_from_symbol (selection, 0, &scrap);
814 if (err == noErr && scrap)
815 clear_scrap (&scrap);
816
817 UNBLOCK_INPUT;
818
819 return Qt;
820 }
821
822
823 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
824 0, 1, 0,
825 doc: /* Whether the current Emacs process owns the given SELECTION.
826 The arg should be the name of the selection in question, typically one of
827 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
828 For convenience, the symbol nil is the same as `PRIMARY',
829 and t is the same as `SECONDARY'. */)
830 (selection)
831 Lisp_Object selection;
832 {
833 OSErr err;
834 ScrapRef scrap;
835 Lisp_Object result = Qnil, local_selection_data;
836
837 check_mac ();
838 CHECK_SYMBOL (selection);
839 if (EQ (selection, Qnil)) selection = QPRIMARY;
840 if (EQ (selection, Qt)) selection = QSECONDARY;
841
842 local_selection_data = assq_no_quit (selection, Vselection_alist);
843
844 if (NILP (local_selection_data))
845 return Qnil;
846
847 BLOCK_INPUT;
848
849 err = get_scrap_from_symbol (selection, 0, &scrap);
850 if (err == noErr && scrap)
851 {
852 unsigned long timestamp;
853
854 err = get_scrap_private_timestamp (scrap, &timestamp);
855 if (err == noErr
856 && (timestamp
857 == cons_to_long (XCAR (XCDR (XCDR (local_selection_data))))))
858 result = Qt;
859 }
860 else
861 result = Qt;
862
863 UNBLOCK_INPUT;
864
865 return result;
866 }
867
868 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
869 0, 1, 0,
870 doc: /* Whether there is an owner for the given SELECTION.
871 The arg should be the name of the selection in question, typically one of
872 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
873 For convenience, the symbol nil is the same as `PRIMARY',
874 and t is the same as `SECONDARY'. */)
875 (selection)
876 Lisp_Object selection;
877 {
878 OSErr err;
879 ScrapRef scrap;
880 Lisp_Object result = Qnil, rest;
881
882 /* It should be safe to call this before we have an Mac frame. */
883 if (! FRAME_MAC_P (SELECTED_FRAME ()))
884 return Qnil;
885
886 CHECK_SYMBOL (selection);
887 if (!NILP (Fx_selection_owner_p (selection)))
888 return Qt;
889 if (EQ (selection, Qnil)) selection = QPRIMARY;
890 if (EQ (selection, Qt)) selection = QSECONDARY;
891
892 BLOCK_INPUT;
893
894 err = get_scrap_from_symbol (selection, 0, &scrap);
895 if (err == noErr && scrap)
896 for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest))
897 {
898 if (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest)))
899 && scrap_has_target_type (scrap, XCAR (XCAR (rest))))
900 {
901 result = Qt;
902 break;
903 }
904 }
905
906 UNBLOCK_INPUT;
907
908 return result;
909 }
910
911 \f
912 int mac_ready_for_apple_events = 0;
913 static Lisp_Object Vmac_apple_event_map;
914 static Lisp_Object Qmac_apple_event_class, Qmac_apple_event_id;
915 static struct
916 {
917 AppleEvent *buf;
918 int size, count;
919 } deferred_apple_events;
920 extern Lisp_Object Qundefined;
921 extern void mac_store_apple_event P_ ((Lisp_Object, Lisp_Object,
922 const AEDesc *));
923
924 struct apple_event_binding
925 {
926 UInt32 code; /* Apple event class or ID. */
927 Lisp_Object key, binding;
928 };
929
930 static void
931 find_event_binding_fun (key, binding, args, data)
932 Lisp_Object key, binding, args;
933 void *data;
934 {
935 struct apple_event_binding *event_binding =
936 (struct apple_event_binding *)data;
937 Lisp_Object code_string;
938
939 if (!SYMBOLP (key))
940 return;
941 code_string = Fget (key, args);
942 if (STRINGP (code_string) && SBYTES (code_string) == 4
943 && (EndianU32_BtoN (*((UInt32 *) SDATA (code_string)))
944 == event_binding->code))
945 {
946 event_binding->key = key;
947 event_binding->binding = binding;
948 }
949 }
950
951 static void
952 find_event_binding (keymap, event_binding, class_p)
953 Lisp_Object keymap;
954 struct apple_event_binding *event_binding;
955 int class_p;
956 {
957 if (event_binding->code == 0)
958 event_binding->binding =
959 access_keymap (keymap, event_binding->key, 0, 1, 0);
960 else
961 {
962 event_binding->binding = Qnil;
963 map_keymap (keymap, find_event_binding_fun,
964 class_p ? Qmac_apple_event_class : Qmac_apple_event_id,
965 event_binding, 0);
966 }
967 }
968
969 void
970 mac_find_apple_event_spec (class, id, class_key, id_key, binding)
971 AEEventClass class;
972 AEEventID id;
973 Lisp_Object *class_key, *id_key, *binding;
974 {
975 struct apple_event_binding event_binding;
976 Lisp_Object keymap;
977
978 *binding = Qnil;
979
980 keymap = get_keymap (Vmac_apple_event_map, 0, 0);
981 if (NILP (keymap))
982 return;
983
984 event_binding.code = class;
985 event_binding.key = *class_key;
986 event_binding.binding = Qnil;
987 find_event_binding (keymap, &event_binding, 1);
988 *class_key = event_binding.key;
989 keymap = get_keymap (event_binding.binding, 0, 0);
990 if (NILP (keymap))
991 return;
992
993 event_binding.code = id;
994 event_binding.key = *id_key;
995 event_binding.binding = Qnil;
996 find_event_binding (keymap, &event_binding, 0);
997 *id_key = event_binding.key;
998 *binding = event_binding.binding;
999 }
1000
1001 static OSErr
1002 defer_apple_events (apple_event, reply)
1003 const AppleEvent *apple_event, *reply;
1004 {
1005 OSErr err;
1006
1007 err = AESuspendTheCurrentEvent (apple_event);
1008
1009 /* Mac OS 10.3 Xcode manual says AESuspendTheCurrentEvent makes
1010 copies of the Apple event and the reply, but Mac OS 10.4 Xcode
1011 manual says it doesn't. Anyway we create copies of them and save
1012 them in `deferred_apple_events'. */
1013 if (err == noErr)
1014 {
1015 if (deferred_apple_events.buf == NULL)
1016 {
1017 deferred_apple_events.size = 16;
1018 deferred_apple_events.count = 0;
1019 deferred_apple_events.buf =
1020 xmalloc (sizeof (AppleEvent) * deferred_apple_events.size);
1021 }
1022 else if (deferred_apple_events.count == deferred_apple_events.size)
1023 {
1024 deferred_apple_events.size *= 2;
1025 deferred_apple_events.buf
1026 = xrealloc (deferred_apple_events.buf,
1027 sizeof (AppleEvent) * deferred_apple_events.size);
1028 }
1029 }
1030
1031 if (err == noErr)
1032 {
1033 int count = deferred_apple_events.count;
1034
1035 AEDuplicateDesc (apple_event, deferred_apple_events.buf + count);
1036 AEDuplicateDesc (reply, deferred_apple_events.buf + count + 1);
1037 deferred_apple_events.count += 2;
1038 }
1039
1040 return err;
1041 }
1042
1043 static pascal OSErr
1044 mac_handle_apple_event (apple_event, reply, refcon)
1045 const AppleEvent *apple_event;
1046 AppleEvent *reply;
1047 SInt32 refcon;
1048 {
1049 OSErr err;
1050 AEEventClass event_class;
1051 AEEventID event_id;
1052 Lisp_Object class_key, id_key, binding;
1053
1054 /* We can't handle an Apple event that requests a reply, but this
1055 seems to be too restrictive. */
1056 #if 0
1057 if (reply->descriptorType != typeNull)
1058 return errAEEventNotHandled;
1059 #endif
1060
1061 if (!mac_ready_for_apple_events)
1062 {
1063 err = defer_apple_events (apple_event, reply);
1064 if (err != noErr)
1065 return errAEEventNotHandled;
1066 return noErr;
1067 }
1068
1069 err = AEGetAttributePtr (apple_event, keyEventClassAttr, typeType, NULL,
1070 &event_class, sizeof (AEEventClass), NULL);
1071 if (err == noErr)
1072 err = AEGetAttributePtr (apple_event, keyEventIDAttr, typeType, NULL,
1073 &event_id, sizeof (AEEventID), NULL);
1074 if (err == noErr)
1075 {
1076 mac_find_apple_event_spec (event_class, event_id,
1077 &class_key, &id_key, &binding);
1078 if (!NILP (binding) && !EQ (binding, Qundefined))
1079 {
1080 if (INTEGERP (binding))
1081 return XINT (binding);
1082 mac_store_apple_event (class_key, id_key, apple_event);
1083 return noErr;
1084 }
1085 }
1086 return errAEEventNotHandled;
1087 }
1088
1089 void
1090 init_apple_event_handler ()
1091 {
1092 OSErr err;
1093 long result;
1094
1095 /* Make sure we have Apple events before starting. */
1096 err = Gestalt (gestaltAppleEventsAttr, &result);
1097 if (err != noErr)
1098 abort ();
1099
1100 if (!(result & (1 << gestaltAppleEventsPresent)))
1101 abort ();
1102
1103 err = AEInstallEventHandler (typeWildCard, typeWildCard,
1104 #if TARGET_API_MAC_CARBON
1105 NewAEEventHandlerUPP (mac_handle_apple_event),
1106 #else
1107 NewAEEventHandlerProc (mac_handle_apple_event),
1108 #endif
1109 0L, false);
1110 if (err != noErr)
1111 abort ();
1112 }
1113
1114 DEFUN ("mac-process-deferred-apple-events", Fmac_process_deferred_apple_events, Smac_process_deferred_apple_events, 0, 0, 0,
1115 doc: /* Process Apple events that are deferred at the startup time. */)
1116 ()
1117 {
1118 Lisp_Object result = Qnil;
1119 long i;
1120
1121 if (mac_ready_for_apple_events)
1122 return Qnil;
1123
1124 BLOCK_INPUT;
1125 mac_ready_for_apple_events = 1;
1126 if (deferred_apple_events.buf)
1127 {
1128 for (i = 0; i < deferred_apple_events.count; i += 2)
1129 {
1130 AEResumeTheCurrentEvent (deferred_apple_events.buf + i,
1131 deferred_apple_events.buf + i + 1,
1132 ((AEEventHandlerUPP)
1133 kAEUseStandardDispatch), 0);
1134 AEDisposeDesc (deferred_apple_events.buf + i);
1135 AEDisposeDesc (deferred_apple_events.buf + i + 1);
1136 }
1137 xfree (deferred_apple_events.buf);
1138 bzero (&deferred_apple_events, sizeof (deferred_apple_events));
1139
1140 result = Qt;
1141 }
1142 UNBLOCK_INPUT;
1143
1144 return result;
1145 }
1146
1147 \f
1148 #if TARGET_API_MAC_CARBON
1149 static Lisp_Object Vmac_dnd_known_types;
1150 static pascal OSErr mac_do_track_drag P_ ((DragTrackingMessage, WindowRef,
1151 void *, DragRef));
1152 static pascal OSErr mac_do_receive_drag P_ ((WindowRef, void *, DragRef));
1153 static DragTrackingHandlerUPP mac_do_track_dragUPP = NULL;
1154 static DragReceiveHandlerUPP mac_do_receive_dragUPP = NULL;
1155
1156 extern void mac_store_drag_event P_ ((WindowRef, Point, SInt16,
1157 const AEDesc *));
1158
1159 static pascal OSErr
1160 mac_do_track_drag (message, window, refcon, drag)
1161 DragTrackingMessage message;
1162 WindowRef window;
1163 void *refcon;
1164 DragRef drag;
1165 {
1166 OSErr err = noErr;
1167 static int can_accept;
1168 UInt16 num_items, index;
1169
1170 if (GetFrontWindowOfClass (kMovableModalWindowClass, false))
1171 return dragNotAcceptedErr;
1172
1173 switch (message)
1174 {
1175 case kDragTrackingEnterHandler:
1176 err = CountDragItems (drag, &num_items);
1177 if (err != noErr)
1178 break;
1179 can_accept = 0;
1180 for (index = 1; index <= num_items; index++)
1181 {
1182 ItemReference item;
1183 FlavorFlags flags;
1184 Lisp_Object rest;
1185
1186 err = GetDragItemReferenceNumber (drag, index, &item);
1187 if (err != noErr)
1188 continue;
1189 for (rest = Vmac_dnd_known_types; CONSP (rest); rest = XCDR (rest))
1190 {
1191 Lisp_Object str;
1192 FlavorType type;
1193
1194 str = XCAR (rest);
1195 if (!(STRINGP (str) && SBYTES (str) == 4))
1196 continue;
1197 type = EndianU32_BtoN (*((UInt32 *) SDATA (str)));
1198
1199 err = GetFlavorFlags (drag, item, type, &flags);
1200 if (err == noErr)
1201 {
1202 can_accept = 1;
1203 break;
1204 }
1205 }
1206 }
1207 break;
1208
1209 case kDragTrackingEnterWindow:
1210 if (can_accept)
1211 {
1212 RgnHandle hilite_rgn = NewRgn ();
1213
1214 if (hilite_rgn)
1215 {
1216 Rect r;
1217
1218 GetWindowPortBounds (window, &r);
1219 OffsetRect (&r, -r.left, -r.top);
1220 RectRgn (hilite_rgn, &r);
1221 ShowDragHilite (drag, hilite_rgn, true);
1222 DisposeRgn (hilite_rgn);
1223 }
1224 SetThemeCursor (kThemeCopyArrowCursor);
1225 }
1226 break;
1227
1228 case kDragTrackingInWindow:
1229 break;
1230
1231 case kDragTrackingLeaveWindow:
1232 if (can_accept)
1233 {
1234 HideDragHilite (drag);
1235 SetThemeCursor (kThemeArrowCursor);
1236 }
1237 break;
1238
1239 case kDragTrackingLeaveHandler:
1240 break;
1241 }
1242
1243 if (err != noErr)
1244 return dragNotAcceptedErr;
1245 return noErr;
1246 }
1247
1248 static pascal OSErr
1249 mac_do_receive_drag (window, refcon, drag)
1250 WindowRef window;
1251 void *refcon;
1252 DragRef drag;
1253 {
1254 OSErr err;
1255 UInt16 index;
1256 int num_types, i;
1257 Lisp_Object rest, str;
1258 FlavorType *types;
1259 AppleEvent apple_event;
1260 Point mouse_pos;
1261 SInt16 modifiers;
1262
1263 if (GetFrontWindowOfClass (kMovableModalWindowClass, false))
1264 return dragNotAcceptedErr;
1265
1266 num_types = 0;
1267 for (rest = Vmac_dnd_known_types; CONSP (rest); rest = XCDR (rest))
1268 {
1269 str = XCAR (rest);
1270 if (STRINGP (str) && SBYTES (str) == 4)
1271 num_types++;
1272 }
1273
1274 types = xmalloc (sizeof (FlavorType) * num_types);
1275 i = 0;
1276 for (rest = Vmac_dnd_known_types; CONSP (rest); rest = XCDR (rest))
1277 {
1278 str = XCAR (rest);
1279 if (STRINGP (str) && SBYTES (str) == 4)
1280 types[i++] = EndianU32_BtoN (*((UInt32 *) SDATA (str)));
1281 }
1282
1283 err = create_apple_event_from_drag_ref (drag, num_types, types,
1284 &apple_event);
1285 xfree (types);
1286
1287 if (err == noErr)
1288 err = GetDragMouse (drag, &mouse_pos, NULL);
1289 if (err == noErr)
1290 {
1291 GlobalToLocal (&mouse_pos);
1292 err = GetDragModifiers (drag, NULL, NULL, &modifiers);
1293 }
1294
1295 if (err == noErr)
1296 {
1297 mac_store_drag_event (window, mouse_pos, modifiers, &apple_event);
1298 AEDisposeDesc (&apple_event);
1299 /* Post a harmless event so as to wake up from ReceiveNextEvent. */
1300 mac_post_mouse_moved_event ();
1301 return noErr;
1302 }
1303 else
1304 return dragNotAcceptedErr;
1305 }
1306 #endif /* TARGET_API_MAC_CARBON */
1307
1308 OSErr
1309 install_drag_handler (window)
1310 WindowRef window;
1311 {
1312 OSErr err = noErr;
1313
1314 #if TARGET_API_MAC_CARBON
1315 if (mac_do_track_dragUPP == NULL)
1316 mac_do_track_dragUPP = NewDragTrackingHandlerUPP (mac_do_track_drag);
1317 if (mac_do_receive_dragUPP == NULL)
1318 mac_do_receive_dragUPP = NewDragReceiveHandlerUPP (mac_do_receive_drag);
1319
1320 err = InstallTrackingHandler (mac_do_track_dragUPP, window, NULL);
1321 if (err == noErr)
1322 err = InstallReceiveHandler (mac_do_receive_dragUPP, window, NULL);
1323 #endif
1324
1325 return err;
1326 }
1327
1328 void
1329 remove_drag_handler (window)
1330 WindowRef window;
1331 {
1332 #if TARGET_API_MAC_CARBON
1333 if (mac_do_track_dragUPP)
1334 RemoveTrackingHandler (mac_do_track_dragUPP, window);
1335 if (mac_do_receive_dragUPP)
1336 RemoveReceiveHandler (mac_do_receive_dragUPP, window);
1337 #endif
1338 }
1339
1340 \f
1341 #ifdef MAC_OSX
1342 void
1343 init_service_handler ()
1344 {
1345 EventTypeSpec specs[] = {{kEventClassService, kEventServiceGetTypes},
1346 {kEventClassService, kEventServiceCopy},
1347 {kEventClassService, kEventServicePaste},
1348 {kEventClassService, kEventServicePerform}};
1349 InstallApplicationEventHandler (NewEventHandlerUPP (mac_handle_service_event),
1350 GetEventTypeCount (specs), specs, NULL, NULL);
1351 }
1352
1353 extern OSErr mac_store_services_event P_ ((EventRef));
1354
1355 static OSStatus
1356 copy_scrap_flavor_data (from_scrap, to_scrap, flavor_type)
1357 ScrapRef from_scrap, to_scrap;
1358 ScrapFlavorType flavor_type;
1359 {
1360 OSStatus err;
1361 Size size, size_allocated;
1362 char *buf = NULL;
1363
1364 err = GetScrapFlavorSize (from_scrap, flavor_type, &size);
1365 if (err == noErr)
1366 buf = xmalloc (size);
1367 while (buf)
1368 {
1369 size_allocated = size;
1370 err = GetScrapFlavorData (from_scrap, flavor_type, &size, buf);
1371 if (err != noErr)
1372 {
1373 xfree (buf);
1374 buf = NULL;
1375 }
1376 else if (size_allocated < size)
1377 buf = xrealloc (buf, size);
1378 else
1379 break;
1380 }
1381 if (err == noErr)
1382 {
1383 if (buf == NULL)
1384 err = memFullErr;
1385 else
1386 {
1387 err = PutScrapFlavor (to_scrap, flavor_type, kScrapFlavorMaskNone,
1388 size, buf);
1389 xfree (buf);
1390 }
1391 }
1392
1393 return err;
1394 }
1395
1396 static OSStatus
1397 mac_handle_service_event (call_ref, event, data)
1398 EventHandlerCallRef call_ref;
1399 EventRef event;
1400 void *data;
1401 {
1402 OSStatus err = noErr;
1403 ScrapRef cur_scrap, specific_scrap;
1404 UInt32 event_kind = GetEventKind (event);
1405 CFMutableArrayRef copy_types, paste_types;
1406 CFStringRef type;
1407 Lisp_Object rest;
1408 ScrapFlavorType flavor_type;
1409
1410 /* Check if Vmac_services_selection is a valid selection that has a
1411 corresponding scrap. */
1412 if (!SYMBOLP (Vmac_services_selection))
1413 err = eventNotHandledErr;
1414 else
1415 err = get_scrap_from_symbol (Vmac_services_selection, 0, &cur_scrap);
1416 if (!(err == noErr && cur_scrap))
1417 return eventNotHandledErr;
1418
1419 switch (event_kind)
1420 {
1421 case kEventServiceGetTypes:
1422 /* Set paste types. */
1423 err = GetEventParameter (event, kEventParamServicePasteTypes,
1424 typeCFMutableArrayRef, NULL,
1425 sizeof (CFMutableArrayRef), NULL,
1426 &paste_types);
1427 if (err != noErr)
1428 break;
1429
1430 for (rest = Vselection_converter_alist; CONSP (rest);
1431 rest = XCDR (rest))
1432 if (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest)))
1433 && (flavor_type =
1434 get_flavor_type_from_symbol (XCAR (XCAR (rest)))))
1435 {
1436 type = CreateTypeStringWithOSType (flavor_type);
1437 if (type)
1438 {
1439 CFArrayAppendValue (paste_types, type);
1440 CFRelease (type);
1441 }
1442 }
1443
1444 /* Set copy types. */
1445 err = GetEventParameter (event, kEventParamServiceCopyTypes,
1446 typeCFMutableArrayRef, NULL,
1447 sizeof (CFMutableArrayRef), NULL,
1448 &copy_types);
1449 if (err != noErr)
1450 break;
1451
1452 if (NILP (Fx_selection_owner_p (Vmac_services_selection)))
1453 break;
1454 else
1455 goto copy_all_flavors;
1456
1457 case kEventServiceCopy:
1458 err = GetEventParameter (event, kEventParamScrapRef,
1459 typeScrapRef, NULL,
1460 sizeof (ScrapRef), NULL, &specific_scrap);
1461 if (err != noErr
1462 || NILP (Fx_selection_owner_p (Vmac_services_selection)))
1463 {
1464 err = eventNotHandledErr;
1465 break;
1466 }
1467
1468 copy_all_flavors:
1469 {
1470 UInt32 count, i;
1471 ScrapFlavorInfo *flavor_info = NULL;
1472 ScrapFlavorFlags flags;
1473
1474 err = GetScrapFlavorCount (cur_scrap, &count);
1475 if (err == noErr)
1476 flavor_info = xmalloc (sizeof (ScrapFlavorInfo) * count);
1477 err = GetScrapFlavorInfoList (cur_scrap, &count, flavor_info);
1478 if (err != noErr)
1479 {
1480 xfree (flavor_info);
1481 flavor_info = NULL;
1482 }
1483 if (flavor_info == NULL)
1484 break;
1485
1486 for (i = 0; i < count; i++)
1487 {
1488 flavor_type = flavor_info[i].flavorType;
1489 err = GetScrapFlavorFlags (cur_scrap, flavor_type, &flags);
1490 if (err == noErr && !(flags & kScrapFlavorMaskSenderOnly))
1491 {
1492 if (event_kind == kEventServiceCopy)
1493 err = copy_scrap_flavor_data (cur_scrap, specific_scrap,
1494 flavor_type);
1495 else /* event_kind == kEventServiceGetTypes */
1496 {
1497 type = CreateTypeStringWithOSType (flavor_type);
1498 if (type)
1499 {
1500 CFArrayAppendValue (copy_types, type);
1501 CFRelease (type);
1502 }
1503 }
1504 }
1505 }
1506 xfree (flavor_info);
1507 }
1508 break;
1509
1510 case kEventServicePaste:
1511 case kEventServicePerform:
1512 {
1513 int data_exists_p = 0;
1514
1515 err = GetEventParameter (event, kEventParamScrapRef, typeScrapRef,
1516 NULL, sizeof (ScrapRef), NULL,
1517 &specific_scrap);
1518 if (err == noErr)
1519 err = clear_scrap (&cur_scrap);
1520 if (err == noErr)
1521 for (rest = Vselection_converter_alist; CONSP (rest);
1522 rest = XCDR (rest))
1523 {
1524 if (! (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest)))))
1525 continue;
1526 flavor_type = get_flavor_type_from_symbol (XCAR (XCAR (rest)));
1527 if (flavor_type == 0)
1528 continue;
1529 err = copy_scrap_flavor_data (specific_scrap, cur_scrap,
1530 flavor_type);
1531 if (err == noErr)
1532 data_exists_p = 1;
1533 }
1534 if (!data_exists_p)
1535 err = eventNotHandledErr;
1536 else
1537 err = mac_store_services_event (event);
1538 }
1539 break;
1540 }
1541
1542 if (err != noErr)
1543 err = eventNotHandledErr;
1544 return err;
1545 }
1546 #endif
1547
1548
1549 void
1550 syms_of_macselect ()
1551 {
1552 defsubr (&Sx_get_selection_internal);
1553 defsubr (&Sx_own_selection_internal);
1554 defsubr (&Sx_disown_selection_internal);
1555 defsubr (&Sx_selection_owner_p);
1556 defsubr (&Sx_selection_exists_p);
1557 defsubr (&Smac_process_deferred_apple_events);
1558
1559 Vselection_alist = Qnil;
1560 staticpro (&Vselection_alist);
1561
1562 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
1563 doc: /* An alist associating selection-types with functions.
1564 These functions are called to convert the selection, with three args:
1565 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
1566 a desired type to which the selection should be converted;
1567 and the local selection value (whatever was given to `x-own-selection').
1568
1569 The function should return the value to send to the Scrap Manager
1570 \(must be a string). A return value of nil
1571 means that the conversion could not be done.
1572 A return value which is the symbol `NULL'
1573 means that a side-effect was executed,
1574 and there is no meaningful selection value. */);
1575 Vselection_converter_alist = Qnil;
1576
1577 DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions,
1578 doc: /* A list of functions to be called when Emacs loses a selection.
1579 \(This happens when a Lisp program explicitly clears the selection.)
1580 The functions are called with one argument, the selection type
1581 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
1582 Vx_lost_selection_functions = Qnil;
1583
1584 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
1585 doc: /* Coding system for communicating with other programs.
1586 When sending or receiving text via cut_buffer, selection, and clipboard,
1587 the text is encoded or decoded by this coding system.
1588 The default value is determined by the system script code. */);
1589 Vselection_coding_system = Qnil;
1590
1591 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
1592 doc: /* Coding system for the next communication with other programs.
1593 Usually, `selection-coding-system' is used for communicating with
1594 other programs. But, if this variable is set, it is used for the
1595 next communication only. After the communication, this variable is
1596 set to nil. */);
1597 Vnext_selection_coding_system = Qnil;
1598
1599 DEFVAR_LISP ("mac-apple-event-map", &Vmac_apple_event_map,
1600 doc: /* Keymap for Apple events handled by Emacs. */);
1601 Vmac_apple_event_map = Qnil;
1602
1603 #if TARGET_API_MAC_CARBON
1604 DEFVAR_LISP ("mac-dnd-known-types", &Vmac_dnd_known_types,
1605 doc: /* The types accepted by default for dropped data.
1606 The types are chosen in the order they appear in the list. */);
1607 Vmac_dnd_known_types = list4 (build_string ("hfs "), build_string ("utxt"),
1608 build_string ("TEXT"), build_string ("TIFF"));
1609 #ifdef MAC_OSX
1610 Vmac_dnd_known_types = Fcons (build_string ("furl"), Vmac_dnd_known_types);
1611 #endif
1612 #endif
1613
1614 #ifdef MAC_OSX
1615 DEFVAR_LISP ("mac-services-selection", &Vmac_services_selection,
1616 doc: /* Selection name for communication via Services menu. */);
1617 Vmac_services_selection = intern ("PRIMARY");
1618 #endif
1619
1620 QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY);
1621 QSECONDARY = intern ("SECONDARY"); staticpro (&QSECONDARY);
1622 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
1623 QTARGETS = intern ("TARGETS"); staticpro (&QTARGETS);
1624
1625 Qforeign_selection = intern ("foreign-selection");
1626 staticpro (&Qforeign_selection);
1627
1628 Qmac_scrap_name = intern ("mac-scrap-name");
1629 staticpro (&Qmac_scrap_name);
1630
1631 Qmac_ostype = intern ("mac-ostype");
1632 staticpro (&Qmac_ostype);
1633
1634 Qmac_apple_event_class = intern ("mac-apple-event-class");
1635 staticpro (&Qmac_apple_event_class);
1636
1637 Qmac_apple_event_id = intern ("mac-apple-event-id");
1638 staticpro (&Qmac_apple_event_id);
1639 }
1640
1641 /* arch-tag: f3c91ad8-99e0-4bd6-9eef-251b2f848732
1642 (do not change this comment) */