1 /* Selection processing for Emacs on Mac OS.
2 Copyright (C) 2005, 2006 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_service_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 void 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 mac_store_apple_event (class_key
, id_key
, apple_event
);
1086 return errAEEventNotHandled
;
1090 init_apple_event_handler ()
1095 /* Make sure we have Apple events before starting. */
1096 err
= Gestalt (gestaltAppleEventsAttr
, &result
);
1100 if (!(result
& (1 << gestaltAppleEventsPresent
)))
1103 err
= AEInstallEventHandler (typeWildCard
, typeWildCard
,
1104 #if TARGET_API_MAC_CARBON
1105 NewAEEventHandlerUPP (mac_handle_apple_event
),
1107 NewAEEventHandlerProc (mac_handle_apple_event
),
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. */)
1118 Lisp_Object result
= Qnil
;
1121 if (mac_ready_for_apple_events
)
1125 mac_ready_for_apple_events
= 1;
1126 if (deferred_apple_events
.buf
)
1128 for (i
= 0; i
< deferred_apple_events
.count
; i
+= 2)
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);
1137 xfree (deferred_apple_events
.buf
);
1138 bzero (&deferred_apple_events
, sizeof (deferred_apple_events
));
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
,
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
;
1156 extern void mac_store_drag_event
P_ ((WindowRef
, Point
, SInt16
,
1160 mac_do_track_drag (message
, window
, refcon
, drag
)
1161 DragTrackingMessage message
;
1167 static int can_accept
;
1168 UInt16 num_items
, index
;
1170 if (GetFrontWindowOfClass (kMovableModalWindowClass
, false))
1171 return dragNotAcceptedErr
;
1175 case kDragTrackingEnterHandler
:
1176 err
= CountDragItems (drag
, &num_items
);
1180 for (index
= 1; index
<= num_items
; index
++)
1186 err
= GetDragItemReferenceNumber (drag
, index
, &item
);
1189 for (rest
= Vmac_dnd_known_types
; CONSP (rest
); rest
= XCDR (rest
))
1195 if (!(STRINGP (str
) && SBYTES (str
) == 4))
1197 type
= EndianU32_BtoN (*((UInt32
*) SDATA (str
)));
1199 err
= GetFlavorFlags (drag
, item
, type
, &flags
);
1209 case kDragTrackingEnterWindow
:
1212 RgnHandle hilite_rgn
= NewRgn ();
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
);
1224 SetThemeCursor (kThemeCopyArrowCursor
);
1228 case kDragTrackingInWindow
:
1231 case kDragTrackingLeaveWindow
:
1234 HideDragHilite (drag
);
1235 SetThemeCursor (kThemeArrowCursor
);
1239 case kDragTrackingLeaveHandler
:
1244 return dragNotAcceptedErr
;
1249 mac_do_receive_drag (window
, refcon
, drag
)
1256 Lisp_Object rest
, str
;
1258 AppleEvent apple_event
;
1262 if (GetFrontWindowOfClass (kMovableModalWindowClass
, false))
1263 return dragNotAcceptedErr
;
1266 for (rest
= Vmac_dnd_known_types
; CONSP (rest
); rest
= XCDR (rest
))
1269 if (STRINGP (str
) && SBYTES (str
) == 4)
1273 types
= xmalloc (sizeof (FlavorType
) * num_types
);
1275 for (rest
= Vmac_dnd_known_types
; CONSP (rest
); rest
= XCDR (rest
))
1278 if (STRINGP (str
) && SBYTES (str
) == 4)
1279 types
[i
++] = EndianU32_BtoN (*((UInt32
*) SDATA (str
)));
1282 err
= create_apple_event_from_drag_ref (drag
, num_types
, types
,
1287 err
= GetDragMouse (drag
, &mouse_pos
, NULL
);
1290 GlobalToLocal (&mouse_pos
);
1291 err
= GetDragModifiers (drag
, NULL
, NULL
, &modifiers
);
1296 mac_store_drag_event (window
, mouse_pos
, modifiers
, &apple_event
);
1297 AEDisposeDesc (&apple_event
);
1298 /* Post a harmless event so as to wake up from ReceiveNextEvent. */
1299 mac_post_mouse_moved_event ();
1303 return dragNotAcceptedErr
;
1305 #endif /* TARGET_API_MAC_CARBON */
1308 install_drag_handler (window
)
1313 #if TARGET_API_MAC_CARBON
1314 if (mac_do_track_dragUPP
== NULL
)
1315 mac_do_track_dragUPP
= NewDragTrackingHandlerUPP (mac_do_track_drag
);
1316 if (mac_do_receive_dragUPP
== NULL
)
1317 mac_do_receive_dragUPP
= NewDragReceiveHandlerUPP (mac_do_receive_drag
);
1319 err
= InstallTrackingHandler (mac_do_track_dragUPP
, window
, NULL
);
1321 err
= InstallReceiveHandler (mac_do_receive_dragUPP
, window
, NULL
);
1328 remove_drag_handler (window
)
1331 #if TARGET_API_MAC_CARBON
1332 if (mac_do_track_dragUPP
)
1333 RemoveTrackingHandler (mac_do_track_dragUPP
, window
);
1334 if (mac_do_receive_dragUPP
)
1335 RemoveReceiveHandler (mac_do_receive_dragUPP
, window
);
1342 init_service_handler ()
1344 EventTypeSpec specs
[] = {{kEventClassService
, kEventServiceGetTypes
},
1345 {kEventClassService
, kEventServiceCopy
},
1346 {kEventClassService
, kEventServicePaste
},
1347 {kEventClassService
, kEventServicePerform
}};
1348 InstallApplicationEventHandler (NewEventHandlerUPP (mac_handle_service_event
),
1349 GetEventTypeCount (specs
), specs
, NULL
, NULL
);
1352 extern OSStatus mac_store_service_event
P_ ((EventRef
));
1355 copy_scrap_flavor_data (from_scrap
, to_scrap
, flavor_type
)
1356 ScrapRef from_scrap
, to_scrap
;
1357 ScrapFlavorType flavor_type
;
1360 Size size
, size_allocated
;
1363 err
= GetScrapFlavorSize (from_scrap
, flavor_type
, &size
);
1365 buf
= xmalloc (size
);
1368 size_allocated
= size
;
1369 err
= GetScrapFlavorData (from_scrap
, flavor_type
, &size
, buf
);
1375 else if (size_allocated
< size
)
1376 buf
= xrealloc (buf
, size
);
1386 err
= PutScrapFlavor (to_scrap
, flavor_type
, kScrapFlavorMaskNone
,
1396 mac_handle_service_event (call_ref
, event
, data
)
1397 EventHandlerCallRef call_ref
;
1401 OSStatus err
= noErr
;
1402 ScrapRef cur_scrap
, specific_scrap
;
1403 UInt32 event_kind
= GetEventKind (event
);
1404 CFMutableArrayRef copy_types
, paste_types
;
1407 ScrapFlavorType flavor_type
;
1409 /* Check if Vmac_service_selection is a valid selection that has a
1410 corresponding scrap. */
1411 if (!SYMBOLP (Vmac_service_selection
))
1412 err
= eventNotHandledErr
;
1414 err
= get_scrap_from_symbol (Vmac_service_selection
, 0, &cur_scrap
);
1415 if (!(err
== noErr
&& cur_scrap
))
1416 return eventNotHandledErr
;
1420 case kEventServiceGetTypes
:
1421 /* Set paste types. */
1422 err
= GetEventParameter (event
, kEventParamServicePasteTypes
,
1423 typeCFMutableArrayRef
, NULL
,
1424 sizeof (CFMutableArrayRef
), NULL
,
1429 for (rest
= Vselection_converter_alist
; CONSP (rest
);
1431 if (CONSP (XCAR (rest
)) && SYMBOLP (XCAR (XCAR (rest
)))
1433 get_flavor_type_from_symbol (XCAR (XCAR (rest
)))))
1435 type
= CreateTypeStringWithOSType (flavor_type
);
1438 CFArrayAppendValue (paste_types
, type
);
1443 /* Set copy types. */
1444 err
= GetEventParameter (event
, kEventParamServiceCopyTypes
,
1445 typeCFMutableArrayRef
, NULL
,
1446 sizeof (CFMutableArrayRef
), NULL
,
1451 if (NILP (Fx_selection_owner_p (Vmac_service_selection
)))
1454 goto copy_all_flavors
;
1456 case kEventServiceCopy
:
1457 err
= GetEventParameter (event
, kEventParamScrapRef
,
1459 sizeof (ScrapRef
), NULL
, &specific_scrap
);
1461 || NILP (Fx_selection_owner_p (Vmac_service_selection
)))
1463 err
= eventNotHandledErr
;
1470 ScrapFlavorInfo
*flavor_info
= NULL
;
1471 ScrapFlavorFlags flags
;
1473 err
= GetScrapFlavorCount (cur_scrap
, &count
);
1475 flavor_info
= xmalloc (sizeof (ScrapFlavorInfo
) * count
);
1476 err
= GetScrapFlavorInfoList (cur_scrap
, &count
, flavor_info
);
1479 xfree (flavor_info
);
1482 if (flavor_info
== NULL
)
1485 for (i
= 0; i
< count
; i
++)
1487 flavor_type
= flavor_info
[i
].flavorType
;
1488 err
= GetScrapFlavorFlags (cur_scrap
, flavor_type
, &flags
);
1489 if (err
== noErr
&& !(flags
& kScrapFlavorMaskSenderOnly
))
1491 if (event_kind
== kEventServiceCopy
)
1492 err
= copy_scrap_flavor_data (cur_scrap
, specific_scrap
,
1494 else /* event_kind == kEventServiceGetTypes */
1496 type
= CreateTypeStringWithOSType (flavor_type
);
1499 CFArrayAppendValue (copy_types
, type
);
1505 xfree (flavor_info
);
1509 case kEventServicePaste
:
1510 case kEventServicePerform
:
1512 int data_exists_p
= 0;
1514 err
= GetEventParameter (event
, kEventParamScrapRef
, typeScrapRef
,
1515 NULL
, sizeof (ScrapRef
), NULL
,
1518 err
= clear_scrap (&cur_scrap
);
1520 for (rest
= Vselection_converter_alist
; CONSP (rest
);
1523 if (! (CONSP (XCAR (rest
)) && SYMBOLP (XCAR (XCAR (rest
)))))
1525 flavor_type
= get_flavor_type_from_symbol (XCAR (XCAR (rest
)));
1526 if (flavor_type
== 0)
1528 err
= copy_scrap_flavor_data (specific_scrap
, cur_scrap
,
1534 err
= eventNotHandledErr
;
1536 err
= mac_store_service_event (event
);
1542 err
= eventNotHandledErr
;
1549 syms_of_macselect ()
1551 defsubr (&Sx_get_selection_internal
);
1552 defsubr (&Sx_own_selection_internal
);
1553 defsubr (&Sx_disown_selection_internal
);
1554 defsubr (&Sx_selection_owner_p
);
1555 defsubr (&Sx_selection_exists_p
);
1556 defsubr (&Smac_process_deferred_apple_events
);
1558 Vselection_alist
= Qnil
;
1559 staticpro (&Vselection_alist
);
1561 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist
,
1562 doc
: /* An alist associating selection-types with functions.
1563 These functions are called to convert the selection, with three args:
1564 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
1565 a desired type to which the selection should be converted;
1566 and the local selection value (whatever was given to `x-own-selection').
1568 The function should return the value to send to the Scrap Manager
1569 \(must be a string). A return value of nil
1570 means that the conversion could not be done.
1571 A return value which is the symbol `NULL'
1572 means that a side-effect was executed,
1573 and there is no meaningful selection value. */);
1574 Vselection_converter_alist
= Qnil
;
1576 DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions
,
1577 doc
: /* A list of functions to be called when Emacs loses a selection.
1578 \(This happens when a Lisp program explicitly clears the selection.)
1579 The functions are called with one argument, the selection type
1580 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
1581 Vx_lost_selection_functions
= Qnil
;
1583 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system
,
1584 doc
: /* Coding system for communicating with other programs.
1585 When sending or receiving text via cut_buffer, selection, and clipboard,
1586 the text is encoded or decoded by this coding system.
1587 The default value is determined by the system script code. */);
1588 Vselection_coding_system
= Qnil
;
1590 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system
,
1591 doc
: /* Coding system for the next communication with other programs.
1592 Usually, `selection-coding-system' is used for communicating with
1593 other programs. But, if this variable is set, it is used for the
1594 next communication only. After the communication, this variable is
1596 Vnext_selection_coding_system
= Qnil
;
1598 DEFVAR_LISP ("mac-apple-event-map", &Vmac_apple_event_map
,
1599 doc
: /* Keymap for Apple events handled by Emacs. */);
1600 Vmac_apple_event_map
= Qnil
;
1602 #if TARGET_API_MAC_CARBON
1603 DEFVAR_LISP ("mac-dnd-known-types", &Vmac_dnd_known_types
,
1604 doc
: /* The types accepted by default for dropped data.
1605 The types are chosen in the order they appear in the list. */);
1606 Vmac_dnd_known_types
= list4 (build_string ("hfs "), build_string ("utxt"),
1607 build_string ("TEXT"), build_string ("TIFF"));
1609 Vmac_dnd_known_types
= Fcons (build_string ("furl"), Vmac_dnd_known_types
);
1614 DEFVAR_LISP ("mac-service-selection", &Vmac_service_selection
,
1615 doc
: /* Selection name for communication via Services menu. */);
1616 Vmac_service_selection
= intern ("PRIMARY");
1619 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
1620 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
1621 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
1622 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
1624 Qforeign_selection
= intern ("foreign-selection");
1625 staticpro (&Qforeign_selection
);
1627 Qmac_scrap_name
= intern ("mac-scrap-name");
1628 staticpro (&Qmac_scrap_name
);
1630 Qmac_ostype
= intern ("mac-ostype");
1631 staticpro (&Qmac_ostype
);
1633 Qmac_apple_event_class
= intern ("mac-apple-event-class");
1634 staticpro (&Qmac_apple_event_class
);
1636 Qmac_apple_event_id
= intern ("mac-apple-event-id");
1637 staticpro (&Qmac_apple_event_id
);
1640 /* arch-tag: f3c91ad8-99e0-4bd6-9eef-251b2f848732
1641 (do not change this comment) */