1 /* Selection processing for Emacs on Mac OS.
2 Copyright (C) 2005 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
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)
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.
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. */
25 #include "blockinput.h"
28 #if !TARGET_API_MAC_CARBON
31 typedef ResType ScrapFlavorType
;
32 #endif /* !TARGET_API_MAC_CARBON */
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
,
49 EXFUN (Fx_selection_owner_p
, 1);
51 static OSStatus mac_handle_service_event
P_ ((EventHandlerCallRef
,
53 void init_service_handler
P_ ((void));
56 Lisp_Object QPRIMARY
, QSECONDARY
, QTIMESTAMP
, QTARGETS
;
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
;
62 /* Coding system for the next communicating with other programs. */
63 static Lisp_Object Vnext_selection_coding_system
;
65 static Lisp_Object Qforeign_selection
;
67 /* The timestamp of the last input event Emacs received from the
69 /* Defined in keyboard.c. */
70 extern unsigned long last_event_timestamp
;
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
86 static Lisp_Object Vselection_alist
;
88 #define SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP 'Etsp'
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
95 static Lisp_Object Vselection_converter_alist
;
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
;
103 /* Selection name for communication via Services menu. */
104 static Lisp_Object Vmac_services_selection
;
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. */
112 get_scrap_from_symbol (sym
, clear_p
, scrap
)
118 Lisp_Object str
= Fget (sym
, Qmac_scrap_name
);
124 #if TARGET_API_MAC_CARBON
126 CFStringRef scrap_name
= cfstring_create_with_string (str
);
127 OptionBits options
= (clear_p
? kScrapClearNamedScrap
128 : kScrapGetNamedScrap
);
130 err
= GetScrapByName (scrap_name
, options
, scrap
);
131 CFRelease (scrap_name
);
134 err
= ClearCurrentScrap ();
136 err
= GetCurrentScrap (scrap
);
137 #endif /* !MAC_OSX */
138 #else /* !TARGET_API_MAC_CARBON */
143 #endif /* !TARGET_API_MAC_CARBON */
149 /* Get a scrap flavor type from the symbol SYM. Return 0 if no
150 corresponding flavor type. */
152 static ScrapFlavorType
153 get_flavor_type_from_symbol (sym
)
156 Lisp_Object str
= Fget (sym
, Qmac_ostype
);
158 if (STRINGP (str
) && SBYTES (str
) == 4)
159 return EndianU32_BtoN (*((UInt32
*) SDATA (str
)));
164 /* Check if the symbol SYM has a corresponding scrap flavor type. */
167 valid_scrap_target_type_p (sym
)
170 return get_flavor_type_from_symbol (sym
) != 0;
173 /* Clear the scrap whose reference is *SCRAP. */
179 #if TARGET_API_MAC_CARBON
181 return ClearScrap (scrap
);
183 return ClearCurrentScrap ();
185 #else /* !TARGET_API_MAC_CARBON */
187 #endif /* !TARGET_API_MAC_CARBON */
190 /* Put Lisp String STR to the scrap SCRAP. The target type is
191 specified by TYPE. */
194 put_scrap_string (scrap
, type
, str
)
196 Lisp_Object type
, str
;
198 ScrapFlavorType flavor_type
= get_flavor_type_from_symbol (type
);
200 if (flavor_type
== 0)
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 */
211 /* Put TIMESTAMP to the scrap SCRAP. The timestamp is used for
212 checking if the scrap is owned by the process. */
215 put_scrap_private_timestamp (scrap
, timestamp
)
217 unsigned long timestamp
;
219 #if TARGET_API_MAC_CARBON
220 return PutScrapFlavor (scrap
, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP
,
221 kScrapFlavorMaskSenderOnly
,
222 sizeof (timestamp
), ×tamp
);
223 #else /* !TARGET_API_MAC_CARBON */
224 return PutScrap (sizeof (timestamp
), SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP
,
226 #endif /* !TARGET_API_MAC_CARBON */
229 /* Check if data for the target type TYPE is available in SCRAP. */
231 static ScrapFlavorType
232 scrap_has_target_type (scrap
, type
)
237 ScrapFlavorType flavor_type
= get_flavor_type_from_symbol (type
);
241 #if TARGET_API_MAC_CARBON
242 ScrapFlavorFlags flags
;
244 err
= GetScrapFlavorFlags (scrap
, flavor_type
, &flags
);
247 #else /* !TARGET_API_MAC_CARBON */
250 size
= GetScrap (NULL
, flavor_type
, &offset
);
253 #endif /* !TARGET_API_MAC_CARBON */
259 /* Get data for the target type TYPE from SCRAP and create a Lisp
260 string. Return nil if failed to get data. */
263 get_scrap_string (scrap
, type
)
268 Lisp_Object result
= Qnil
;
269 ScrapFlavorType flavor_type
= get_flavor_type_from_symbol (type
);
270 #if TARGET_API_MAC_CARBON
275 err
= GetScrapFlavorSize (scrap
, flavor_type
, &size
);
280 result
= make_uninit_string (size
);
281 err
= GetScrapFlavorData (scrap
, flavor_type
,
282 &size
, SDATA (result
));
285 else if (size
< SBYTES (result
))
286 result
= make_unibyte_string (SDATA (result
), size
);
288 while (STRINGP (result
) && size
> SBYTES (result
));
296 size
= GetScrap (NULL
, flavor_type
, &offset
);
299 handle
= NewHandle (size
);
301 size
= GetScrap (handle
, flavor_type
, &offset
);
303 result
= make_unibyte_string (*handle
, size
);
304 DisposeHandle (handle
);
311 /* Get timestamp from the scrap SCRAP and set to *TIMPSTAMP. */
314 get_scrap_private_timestamp (scrap
, timestamp
)
316 unsigned long *timestamp
;
319 #if TARGET_API_MAC_CARBON
320 ScrapFlavorFlags flags
;
322 err
= GetScrapFlavorFlags (scrap
, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP
, &flags
);
325 if (!(flags
& kScrapFlavorMaskSenderOnly
))
329 Size size
= sizeof (*timestamp
);
331 err
= GetScrapFlavorData (scrap
, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP
,
333 if (err
== noErr
&& size
!= sizeof (*timestamp
))
337 #else /* !TARGET_API_MAC_CARBON */
341 size
= GetScrap (NULL
, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP
, &offset
);
342 if (size
== sizeof (*timestamp
))
344 handle
= NewHandle (size
);
346 size
= GetScrap (handle
, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP
, &offset
);
347 if (size
== sizeof (*timestamp
))
348 *timestamp
= *((unsigned long *) *handle
);
349 DisposeHandle (handle
);
351 if (size
!= sizeof (*timestamp
))
353 #endif /* !TARGET_API_MAC_CARBON */
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
363 get_scrap_target_type_list (scrap
)
366 Lisp_Object result
= Qnil
, rest
, target_type
;
367 #if TARGET_API_MAC_CARBON
369 UInt32 count
, i
, type
;
370 ScrapFlavorInfo
*flavor_info
= NULL
;
371 Lisp_Object strings
= Qnil
;
373 err
= GetScrapFlavorCount (scrap
, &count
);
375 flavor_info
= xmalloc (sizeof (ScrapFlavorInfo
) * count
);
376 err
= GetScrapFlavorInfoList (scrap
, &count
, flavor_info
);
382 if (flavor_info
== NULL
)
385 for (rest
= Vselection_converter_alist
; CONSP (rest
); rest
= XCDR (rest
))
387 ScrapFlavorType flavor_type
= 0;
389 if (CONSP (XCAR (rest
)) && SYMBOLP (target_type
= XCAR (XCAR (rest
)))
390 && (flavor_type
= scrap_has_target_type (scrap
, target_type
)))
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
)
397 flavor_info
[i
].flavorType
= 0;
403 #if TARGET_API_MAC_CARBON
406 for (i
= 0; i
< count
; i
++)
407 if (flavor_info
[i
].flavorType
)
409 type
= EndianU32_NtoB (flavor_info
[i
].flavorType
);
410 strings
= Fcons (make_unibyte_string ((char *) &type
, 4), strings
);
412 result
= nconc2 (result
, strings
);
420 /* Do protocol to assert ourself as a selection owner.
421 Update the Vselection_alist so that we can reply to later requests for
425 x_own_selection (selection_name
, selection_value
)
426 Lisp_Object selection_name
, selection_value
;
430 struct gcpro gcpro1
, gcpro2
;
431 Lisp_Object rest
, handler_fn
, value
, type
;
434 CHECK_SYMBOL (selection_name
);
436 GCPRO2 (selection_name
, selection_value
);
440 err
= get_scrap_from_symbol (selection_name
, 1, &scrap
);
441 if (err
== noErr
&& scrap
)
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
);
449 for (rest
= Vselection_converter_alist
; CONSP (rest
); rest
= XCDR (rest
))
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
)))))
457 if (!NILP (handler_fn
))
458 value
= call3 (handler_fn
, selection_name
,
459 type
, selection_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
));
469 unbind_to (count
, Qnil
);
472 err
= put_scrap_private_timestamp (scrap
, last_event_timestamp
);
479 if (scrap
&& err
!= noErr
)
480 error ("Can't set selection");
482 /* Now update the local cache */
484 Lisp_Object selection_time
;
485 Lisp_Object selection_data
;
486 Lisp_Object prev_value
;
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
);
495 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
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
))
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
))))
506 XSETCDR (rest
, Fcdr (XCDR (rest
)));
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).
519 This calls random Lisp code, and may signal or gc. */
522 x_get_local_selection (selection_symbol
, target_type
, local_request
)
523 Lisp_Object selection_symbol
, target_type
;
526 Lisp_Object local_value
;
527 Lisp_Object handler_fn
, value
, type
, check
;
530 if (NILP (Fx_selection_owner_p (selection_symbol
)))
533 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
535 /* TIMESTAMP is a special case 'cause that's easiest. */
536 if (EQ (target_type
, QTIMESTAMP
))
539 value
= XCAR (XCDR (XCDR (local_value
)));
542 else if (EQ (target_type
, QDELETE
))
545 Fx_disown_selection_internal
547 XCAR (XCDR (XCDR (local_value
))));
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
);
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. */
564 if (!NILP (handler_fn
))
565 value
= call3 (handler_fn
,
566 selection_symbol
, (local_request
? Qnil
: target_type
),
567 XCAR (XCDR (local_value
)));
570 unbind_to (count
, Qnil
);
573 /* Make sure this value is of a type that we could transmit
574 to another X client. */
578 && SYMBOLP (XCAR (value
)))
580 check
= XCDR (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
))
593 (CONSP (XCDR (check
))
594 && INTEGERP (XCAR (XCDR (check
)))
595 && NILP (XCDR (XCDR (check
))))))
600 Fcons (build_string ("invalid data returned by selection-conversion function"),
601 Fcons (handler_fn
, Fcons (value
, Qnil
))));
605 /* Clear all selections that were made from frame F.
606 We do this when about to delete a frame. */
609 x_clear_frame_selections (f
)
615 XSETFRAME (frame
, f
);
617 /* Otherwise, we're really honest and truly being told to drop it.
618 Don't use Fdelq as that may QUIT;. */
620 /* Delete elements from the beginning of Vselection_alist. */
621 while (!NILP (Vselection_alist
)
622 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
624 /* Let random Lisp code notice that the selection has been stolen. */
625 Lisp_Object hooks
, selection_symbol
;
627 hooks
= Vx_lost_selection_functions
;
628 selection_symbol
= Fcar (Fcar (Vselection_alist
));
630 if (!EQ (hooks
, Qunbound
)
631 && !NILP (Fx_selection_owner_p (selection_symbol
)))
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);
642 Vselection_alist
= Fcdr (Vselection_alist
);
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
))))))))
649 /* Let random Lisp code notice that the selection has been stolen. */
650 Lisp_Object hooks
, selection_symbol
;
652 hooks
= Vx_lost_selection_functions
;
653 selection_symbol
= Fcar (Fcar (XCDR (rest
)));
655 if (!EQ (hooks
, Qunbound
)
656 && !NILP (Fx_selection_owner_p (selection_symbol
)))
658 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
659 call1 (Fcar (hooks
), selection_symbol
);
660 #if 0 /* See above */
661 redisplay_preserve_echo_area (22);
664 XSETCDR (rest
, Fcdr (XCDR (rest
)));
669 /* Do protocol to read selection-data from the server.
670 Converts this to Lisp data and returns it. */
673 x_get_foreign_selection (selection_symbol
, target_type
, time_stamp
)
674 Lisp_Object selection_symbol
, target_type
, time_stamp
;
678 Lisp_Object result
= Qnil
;
682 err
= get_scrap_from_symbol (selection_symbol
, 0, &scrap
);
683 if (err
== noErr
&& scrap
)
685 if (EQ (target_type
, QTARGETS
))
687 result
= get_scrap_target_type_list (scrap
);
688 result
= Fvconcat (1, &result
);
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
);
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
;
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
;
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. */
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
;
735 Lisp_Object val
= Qnil
;
736 struct gcpro gcpro1
, gcpro2
;
737 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
739 CHECK_SYMBOL (selection_symbol
);
740 CHECK_SYMBOL (target_type
);
742 val
= x_get_local_selection (selection_symbol
, target_type
, 1);
746 val
= x_get_foreign_selection (selection_symbol
, target_type
, time_stamp
);
751 && SYMBOLP (XCAR (val
)))
754 if (CONSP (val
) && NILP (XCDR (val
)))
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. */)
767 Lisp_Object selection
;
772 Lisp_Object local_selection_data
;
775 CHECK_SYMBOL (selection
);
777 if (NILP (Fx_selection_owner_p (selection
)))
778 return Qnil
; /* Don't disown the selection when we're not the owner. */
780 local_selection_data
= assq_no_quit (selection
, Vselection_alist
);
782 /* Don't use Fdelq as that may QUIT;. */
784 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
785 Vselection_alist
= Fcdr (Vselection_alist
);
789 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
790 if (EQ (local_selection_data
, Fcar (XCDR (rest
))))
792 XSETCDR (rest
, Fcdr (XCDR (rest
)));
797 /* Let random lisp code notice that the selection has been stolen. */
801 rest
= Vx_lost_selection_functions
;
802 if (!EQ (rest
, Qunbound
))
804 for (; CONSP (rest
); rest
= Fcdr (rest
))
805 call1 (Fcar (rest
), selection
);
806 prepare_menu_bars ();
807 redisplay_preserve_echo_area (20);
813 err
= get_scrap_from_symbol (selection
, 0, &scrap
);
814 if (err
== noErr
&& scrap
)
815 clear_scrap (&scrap
);
823 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
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'. */)
831 Lisp_Object selection
;
835 Lisp_Object result
= Qnil
, local_selection_data
;
838 CHECK_SYMBOL (selection
);
839 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
840 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
842 local_selection_data
= assq_no_quit (selection
, Vselection_alist
);
844 if (NILP (local_selection_data
))
849 err
= get_scrap_from_symbol (selection
, 0, &scrap
);
850 if (err
== noErr
&& scrap
)
852 unsigned long timestamp
;
854 err
= get_scrap_private_timestamp (scrap
, ×tamp
);
857 == cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))))))
868 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
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'. */)
876 Lisp_Object selection
;
880 Lisp_Object result
= Qnil
, rest
;
882 /* It should be safe to call this before we have an Mac frame. */
883 if (! FRAME_MAC_P (SELECTED_FRAME ()))
886 CHECK_SYMBOL (selection
);
887 if (!NILP (Fx_selection_owner_p (selection
)))
889 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
890 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
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
))
898 if (CONSP (XCAR (rest
)) && SYMBOLP (XCAR (XCAR (rest
)))
899 && scrap_has_target_type (scrap
, XCAR (XCAR (rest
))))
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
;
919 } deferred_apple_events
;
920 extern Lisp_Object Qundefined
;
921 extern OSErr mac_store_apple_event
P_ ((Lisp_Object
, Lisp_Object
,
924 struct apple_event_binding
926 UInt32 code
; /* Apple event class or ID. */
927 Lisp_Object key
, binding
;
931 find_event_binding_fun (key
, binding
, args
, data
)
932 Lisp_Object key
, binding
, args
;
935 struct apple_event_binding
*event_binding
=
936 (struct apple_event_binding
*)data
;
937 Lisp_Object code_string
;
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
))
946 event_binding
->key
= key
;
947 event_binding
->binding
= binding
;
952 find_event_binding (keymap
, event_binding
, class_p
)
954 struct apple_event_binding
*event_binding
;
957 if (event_binding
->code
== 0)
958 event_binding
->binding
=
959 access_keymap (keymap
, event_binding
->key
, 0, 1, 0);
962 event_binding
->binding
= Qnil
;
963 map_keymap (keymap
, find_event_binding_fun
,
964 class_p
? Qmac_apple_event_class
: Qmac_apple_event_id
,
970 mac_find_apple_event_spec (class, id
, class_key
, id_key
, binding
)
973 Lisp_Object
*class_key
, *id_key
, *binding
;
975 struct apple_event_binding event_binding
;
980 keymap
= get_keymap (Vmac_apple_event_map
, 0, 0);
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);
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
;
1002 defer_apple_events (apple_event
, reply
)
1003 const AppleEvent
*apple_event
, *reply
;
1007 err
= AESuspendTheCurrentEvent (apple_event
);
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'. */
1015 if (deferred_apple_events
.buf
== NULL
)
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
);
1022 else if (deferred_apple_events
.count
== deferred_apple_events
.size
)
1024 deferred_apple_events
.size
*= 2;
1025 deferred_apple_events
.buf
1026 = xrealloc (deferred_apple_events
.buf
,
1027 sizeof (AppleEvent
) * deferred_apple_events
.size
);
1033 int count
= deferred_apple_events
.count
;
1035 AEDuplicateDesc (apple_event
, deferred_apple_events
.buf
+ count
);
1036 AEDuplicateDesc (reply
, deferred_apple_events
.buf
+ count
+ 1);
1037 deferred_apple_events
.count
+= 2;
1044 mac_handle_apple_event (apple_event
, reply
, refcon
)
1045 const AppleEvent
*apple_event
;
1050 AEEventClass event_class
;
1052 Lisp_Object class_key
, id_key
, binding
;
1054 /* We can't handle an Apple event that requests a reply, but this
1055 seems to be too restrictive. */
1057 if (reply
->descriptorType
!= typeNull
)
1058 return errAEEventNotHandled
;
1061 if (!mac_ready_for_apple_events
)
1063 err
= defer_apple_events (apple_event
, reply
);
1065 return errAEEventNotHandled
;
1069 err
= AEGetAttributePtr (apple_event
, keyEventClassAttr
, typeType
, NULL
,
1070 &event_class
, sizeof (AEEventClass
), NULL
);
1072 err
= AEGetAttributePtr (apple_event
, keyEventIDAttr
, typeType
, NULL
,
1073 &event_id
, sizeof (AEEventID
), NULL
);
1076 mac_find_apple_event_spec (event_class
, event_id
,
1077 &class_key
, &id_key
, &binding
);
1078 if (!NILP (binding
) && !EQ (binding
, Qundefined
))
1080 if (INTEGERP (binding
))
1081 return XINT (binding
);
1082 err
= mac_store_apple_event (class_key
, id_key
, apple_event
);
1087 return errAEEventNotHandled
;
1091 init_apple_event_handler ()
1096 /* Make sure we have Apple events before starting. */
1097 err
= Gestalt (gestaltAppleEventsAttr
, &result
);
1101 if (!(result
& (1 << gestaltAppleEventsPresent
)))
1104 err
= AEInstallEventHandler (typeWildCard
, typeWildCard
,
1105 #if TARGET_API_MAC_CARBON
1106 NewAEEventHandlerUPP (mac_handle_apple_event
),
1108 NewAEEventHandlerProc (mac_handle_apple_event
),
1115 DEFUN ("mac-process-deferred-apple-events", Fmac_process_deferred_apple_events
, Smac_process_deferred_apple_events
, 0, 0, 0,
1116 doc
: /* Process Apple events that are deferred at the startup time. */)
1119 Lisp_Object result
= Qnil
;
1122 if (mac_ready_for_apple_events
)
1126 mac_ready_for_apple_events
= 1;
1127 if (deferred_apple_events
.buf
)
1129 for (i
= 0; i
< deferred_apple_events
.count
; i
+= 2)
1131 AEResumeTheCurrentEvent (deferred_apple_events
.buf
+ i
,
1132 deferred_apple_events
.buf
+ i
+ 1,
1133 ((AEEventHandlerUPP
)
1134 kAEUseStandardDispatch
), 0);
1135 AEDisposeDesc (deferred_apple_events
.buf
+ i
);
1136 AEDisposeDesc (deferred_apple_events
.buf
+ i
+ 1);
1138 xfree (deferred_apple_events
.buf
);
1139 bzero (&deferred_apple_events
, sizeof (deferred_apple_events
));
1151 init_service_handler ()
1153 EventTypeSpec specs
[] = {{kEventClassService
, kEventServiceGetTypes
},
1154 {kEventClassService
, kEventServiceCopy
},
1155 {kEventClassService
, kEventServicePaste
},
1156 {kEventClassService
, kEventServicePerform
}};
1157 InstallApplicationEventHandler (NewEventHandlerUPP (mac_handle_service_event
),
1158 GetEventTypeCount (specs
), specs
, NULL
, NULL
);
1161 extern OSErr mac_store_services_event
P_ ((EventRef
));
1164 copy_scrap_flavor_data (from_scrap
, to_scrap
, flavor_type
)
1165 ScrapRef from_scrap
, to_scrap
;
1166 ScrapFlavorType flavor_type
;
1169 Size size
, size_allocated
;
1172 err
= GetScrapFlavorSize (from_scrap
, flavor_type
, &size
);
1174 buf
= xmalloc (size
);
1177 size_allocated
= size
;
1178 err
= GetScrapFlavorData (from_scrap
, flavor_type
, &size
, buf
);
1184 else if (size_allocated
< size
)
1185 buf
= xrealloc (buf
, size
);
1195 err
= PutScrapFlavor (to_scrap
, flavor_type
, kScrapFlavorMaskNone
,
1205 mac_handle_service_event (call_ref
, event
, data
)
1206 EventHandlerCallRef call_ref
;
1210 OSStatus err
= noErr
;
1211 ScrapRef cur_scrap
, specific_scrap
;
1212 UInt32 event_kind
= GetEventKind (event
);
1213 CFMutableArrayRef copy_types
, paste_types
;
1216 ScrapFlavorType flavor_type
;
1218 /* Check if Vmac_services_selection is a valid selection that has a
1219 corresponding scrap. */
1220 if (!SYMBOLP (Vmac_services_selection
))
1221 err
= eventNotHandledErr
;
1223 err
= get_scrap_from_symbol (Vmac_services_selection
, 0, &cur_scrap
);
1224 if (!(err
== noErr
&& cur_scrap
))
1225 return eventNotHandledErr
;
1229 case kEventServiceGetTypes
:
1230 /* Set paste types. */
1231 err
= GetEventParameter (event
, kEventParamServicePasteTypes
,
1232 typeCFMutableArrayRef
, NULL
,
1233 sizeof (CFMutableArrayRef
), NULL
,
1238 for (rest
= Vselection_converter_alist
; CONSP (rest
);
1240 if (CONSP (XCAR (rest
)) && SYMBOLP (XCAR (XCAR (rest
)))
1242 get_flavor_type_from_symbol (XCAR (XCAR (rest
)))))
1244 type
= CreateTypeStringWithOSType (flavor_type
);
1247 CFArrayAppendValue (paste_types
, type
);
1252 /* Set copy types. */
1253 err
= GetEventParameter (event
, kEventParamServiceCopyTypes
,
1254 typeCFMutableArrayRef
, NULL
,
1255 sizeof (CFMutableArrayRef
), NULL
,
1260 if (NILP (Fx_selection_owner_p (Vmac_services_selection
)))
1263 goto copy_all_flavors
;
1265 case kEventServiceCopy
:
1266 err
= GetEventParameter (event
, kEventParamScrapRef
,
1268 sizeof (ScrapRef
), NULL
, &specific_scrap
);
1270 || NILP (Fx_selection_owner_p (Vmac_services_selection
)))
1272 err
= eventNotHandledErr
;
1279 ScrapFlavorInfo
*flavor_info
= NULL
;
1280 ScrapFlavorFlags flags
;
1282 err
= GetScrapFlavorCount (cur_scrap
, &count
);
1284 flavor_info
= xmalloc (sizeof (ScrapFlavorInfo
) * count
);
1285 err
= GetScrapFlavorInfoList (cur_scrap
, &count
, flavor_info
);
1288 xfree (flavor_info
);
1291 if (flavor_info
== NULL
)
1294 for (i
= 0; i
< count
; i
++)
1296 flavor_type
= flavor_info
[i
].flavorType
;
1297 err
= GetScrapFlavorFlags (cur_scrap
, flavor_type
, &flags
);
1298 if (err
== noErr
&& !(flags
& kScrapFlavorMaskSenderOnly
))
1300 if (event_kind
== kEventServiceCopy
)
1301 err
= copy_scrap_flavor_data (cur_scrap
, specific_scrap
,
1303 else /* event_kind == kEventServiceGetTypes */
1305 type
= CreateTypeStringWithOSType (flavor_type
);
1308 CFArrayAppendValue (copy_types
, type
);
1314 xfree (flavor_info
);
1318 case kEventServicePaste
:
1319 case kEventServicePerform
:
1321 int data_exists_p
= 0;
1323 err
= GetEventParameter (event
, kEventParamScrapRef
, typeScrapRef
,
1324 NULL
, sizeof (ScrapRef
), NULL
,
1327 err
= clear_scrap (&cur_scrap
);
1329 for (rest
= Vselection_converter_alist
; CONSP (rest
);
1332 if (! (CONSP (XCAR (rest
)) && SYMBOLP (XCAR (XCAR (rest
)))))
1334 flavor_type
= get_flavor_type_from_symbol (XCAR (XCAR (rest
)));
1335 if (flavor_type
== 0)
1337 err
= copy_scrap_flavor_data (specific_scrap
, cur_scrap
,
1343 err
= eventNotHandledErr
;
1345 err
= mac_store_services_event (event
);
1351 err
= eventNotHandledErr
;
1358 syms_of_macselect ()
1360 defsubr (&Sx_get_selection_internal
);
1361 defsubr (&Sx_own_selection_internal
);
1362 defsubr (&Sx_disown_selection_internal
);
1363 defsubr (&Sx_selection_owner_p
);
1364 defsubr (&Sx_selection_exists_p
);
1365 defsubr (&Smac_process_deferred_apple_events
);
1367 Vselection_alist
= Qnil
;
1368 staticpro (&Vselection_alist
);
1370 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist
,
1371 doc
: /* An alist associating selection-types with functions.
1372 These functions are called to convert the selection, with three args:
1373 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
1374 a desired type to which the selection should be converted;
1375 and the local selection value (whatever was given to `x-own-selection').
1377 The function should return the value to send to the Scrap Manager
1378 \(must be a string). A return value of nil
1379 means that the conversion could not be done.
1380 A return value which is the symbol `NULL'
1381 means that a side-effect was executed,
1382 and there is no meaningful selection value. */);
1383 Vselection_converter_alist
= Qnil
;
1385 DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions
,
1386 doc
: /* A list of functions to be called when Emacs loses a selection.
1387 \(This happens when a Lisp program explicitly clears the selection.)
1388 The functions are called with one argument, the selection type
1389 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
1390 Vx_lost_selection_functions
= Qnil
;
1392 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system
,
1393 doc
: /* Coding system for communicating with other programs.
1394 When sending or receiving text via cut_buffer, selection, and clipboard,
1395 the text is encoded or decoded by this coding system.
1396 The default value is determined by the system script code. */);
1397 Vselection_coding_system
= Qnil
;
1399 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system
,
1400 doc
: /* Coding system for the next communication with other programs.
1401 Usually, `selection-coding-system' is used for communicating with
1402 other programs. But, if this variable is set, it is used for the
1403 next communication only. After the communication, this variable is
1405 Vnext_selection_coding_system
= Qnil
;
1407 DEFVAR_LISP ("mac-apple-event-map", &Vmac_apple_event_map
,
1408 doc
: /* Keymap for Apple events handled by Emacs. */);
1409 Vmac_apple_event_map
= Qnil
;
1412 DEFVAR_LISP ("mac-services-selection", &Vmac_services_selection
,
1413 doc
: /* Selection name for communication via Services menu. */);
1414 Vmac_services_selection
= intern ("PRIMARY");
1417 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
1418 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
1419 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
1420 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
1422 Qforeign_selection
= intern ("foreign-selection");
1423 staticpro (&Qforeign_selection
);
1425 Qmac_scrap_name
= intern ("mac-scrap-name");
1426 staticpro (&Qmac_scrap_name
);
1428 Qmac_ostype
= intern ("mac-ostype");
1429 staticpro (&Qmac_ostype
);
1431 Qmac_apple_event_class
= intern ("mac-apple-event-class");
1432 staticpro (&Qmac_apple_event_class
);
1434 Qmac_apple_event_id
= intern ("mac-apple-event-id");
1435 staticpro (&Qmac_apple_event_id
);
1438 /* arch-tag: f3c91ad8-99e0-4bd6-9eef-251b2f848732
1439 (do not change this comment) */