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_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 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
)
1257 Lisp_Object rest
, str
;
1259 AppleEvent apple_event
;
1263 if (GetFrontWindowOfClass (kMovableModalWindowClass
, false))
1264 return dragNotAcceptedErr
;
1267 for (rest
= Vmac_dnd_known_types
; CONSP (rest
); rest
= XCDR (rest
))
1270 if (STRINGP (str
) && SBYTES (str
) == 4)
1274 types
= xmalloc (sizeof (FlavorType
) * num_types
);
1276 for (rest
= Vmac_dnd_known_types
; CONSP (rest
); rest
= XCDR (rest
))
1279 if (STRINGP (str
) && SBYTES (str
) == 4)
1280 types
[i
++] = EndianU32_BtoN (*((UInt32
*) SDATA (str
)));
1283 err
= create_apple_event_from_drag_ref (drag
, num_types
, types
,
1288 err
= GetDragMouse (drag
, &mouse_pos
, NULL
);
1291 GlobalToLocal (&mouse_pos
);
1292 err
= GetDragModifiers (drag
, NULL
, NULL
, &modifiers
);
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 ();
1304 return dragNotAcceptedErr
;
1306 #endif /* TARGET_API_MAC_CARBON */
1309 install_drag_handler (window
)
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
);
1320 err
= InstallTrackingHandler (mac_do_track_dragUPP
, window
, NULL
);
1322 err
= InstallReceiveHandler (mac_do_receive_dragUPP
, window
, NULL
);
1329 remove_drag_handler (window
)
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
);
1343 init_service_handler ()
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
);
1353 extern OSErr mac_store_services_event
P_ ((EventRef
));
1356 copy_scrap_flavor_data (from_scrap
, to_scrap
, flavor_type
)
1357 ScrapRef from_scrap
, to_scrap
;
1358 ScrapFlavorType flavor_type
;
1361 Size size
, size_allocated
;
1364 err
= GetScrapFlavorSize (from_scrap
, flavor_type
, &size
);
1366 buf
= xmalloc (size
);
1369 size_allocated
= size
;
1370 err
= GetScrapFlavorData (from_scrap
, flavor_type
, &size
, buf
);
1376 else if (size_allocated
< size
)
1377 buf
= xrealloc (buf
, size
);
1387 err
= PutScrapFlavor (to_scrap
, flavor_type
, kScrapFlavorMaskNone
,
1397 mac_handle_service_event (call_ref
, event
, data
)
1398 EventHandlerCallRef call_ref
;
1402 OSStatus err
= noErr
;
1403 ScrapRef cur_scrap
, specific_scrap
;
1404 UInt32 event_kind
= GetEventKind (event
);
1405 CFMutableArrayRef copy_types
, paste_types
;
1408 ScrapFlavorType flavor_type
;
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
;
1415 err
= get_scrap_from_symbol (Vmac_services_selection
, 0, &cur_scrap
);
1416 if (!(err
== noErr
&& cur_scrap
))
1417 return eventNotHandledErr
;
1421 case kEventServiceGetTypes
:
1422 /* Set paste types. */
1423 err
= GetEventParameter (event
, kEventParamServicePasteTypes
,
1424 typeCFMutableArrayRef
, NULL
,
1425 sizeof (CFMutableArrayRef
), NULL
,
1430 for (rest
= Vselection_converter_alist
; CONSP (rest
);
1432 if (CONSP (XCAR (rest
)) && SYMBOLP (XCAR (XCAR (rest
)))
1434 get_flavor_type_from_symbol (XCAR (XCAR (rest
)))))
1436 type
= CreateTypeStringWithOSType (flavor_type
);
1439 CFArrayAppendValue (paste_types
, type
);
1444 /* Set copy types. */
1445 err
= GetEventParameter (event
, kEventParamServiceCopyTypes
,
1446 typeCFMutableArrayRef
, NULL
,
1447 sizeof (CFMutableArrayRef
), NULL
,
1452 if (NILP (Fx_selection_owner_p (Vmac_services_selection
)))
1455 goto copy_all_flavors
;
1457 case kEventServiceCopy
:
1458 err
= GetEventParameter (event
, kEventParamScrapRef
,
1460 sizeof (ScrapRef
), NULL
, &specific_scrap
);
1462 || NILP (Fx_selection_owner_p (Vmac_services_selection
)))
1464 err
= eventNotHandledErr
;
1471 ScrapFlavorInfo
*flavor_info
= NULL
;
1472 ScrapFlavorFlags flags
;
1474 err
= GetScrapFlavorCount (cur_scrap
, &count
);
1476 flavor_info
= xmalloc (sizeof (ScrapFlavorInfo
) * count
);
1477 err
= GetScrapFlavorInfoList (cur_scrap
, &count
, flavor_info
);
1480 xfree (flavor_info
);
1483 if (flavor_info
== NULL
)
1486 for (i
= 0; i
< count
; i
++)
1488 flavor_type
= flavor_info
[i
].flavorType
;
1489 err
= GetScrapFlavorFlags (cur_scrap
, flavor_type
, &flags
);
1490 if (err
== noErr
&& !(flags
& kScrapFlavorMaskSenderOnly
))
1492 if (event_kind
== kEventServiceCopy
)
1493 err
= copy_scrap_flavor_data (cur_scrap
, specific_scrap
,
1495 else /* event_kind == kEventServiceGetTypes */
1497 type
= CreateTypeStringWithOSType (flavor_type
);
1500 CFArrayAppendValue (copy_types
, type
);
1506 xfree (flavor_info
);
1510 case kEventServicePaste
:
1511 case kEventServicePerform
:
1513 int data_exists_p
= 0;
1515 err
= GetEventParameter (event
, kEventParamScrapRef
, typeScrapRef
,
1516 NULL
, sizeof (ScrapRef
), NULL
,
1519 err
= clear_scrap (&cur_scrap
);
1521 for (rest
= Vselection_converter_alist
; CONSP (rest
);
1524 if (! (CONSP (XCAR (rest
)) && SYMBOLP (XCAR (XCAR (rest
)))))
1526 flavor_type
= get_flavor_type_from_symbol (XCAR (XCAR (rest
)));
1527 if (flavor_type
== 0)
1529 err
= copy_scrap_flavor_data (specific_scrap
, cur_scrap
,
1535 err
= eventNotHandledErr
;
1537 err
= mac_store_services_event (event
);
1543 err
= eventNotHandledErr
;
1550 syms_of_macselect ()
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
);
1559 Vselection_alist
= Qnil
;
1560 staticpro (&Vselection_alist
);
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').
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
;
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
;
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
;
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
1597 Vnext_selection_coding_system
= Qnil
;
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
;
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"));
1610 Vmac_dnd_known_types
= Fcons (build_string ("furl"), Vmac_dnd_known_types
);
1615 DEFVAR_LISP ("mac-services-selection", &Vmac_services_selection
,
1616 doc
: /* Selection name for communication via Services menu. */);
1617 Vmac_services_selection
= intern ("PRIMARY");
1620 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
1621 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
1622 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
1623 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
1625 Qforeign_selection
= intern ("foreign-selection");
1626 staticpro (&Qforeign_selection
);
1628 Qmac_scrap_name
= intern ("mac-scrap-name");
1629 staticpro (&Qmac_scrap_name
);
1631 Qmac_ostype
= intern ("mac-ostype");
1632 staticpro (&Qmac_ostype
);
1634 Qmac_apple_event_class
= intern ("mac-apple-event-class");
1635 staticpro (&Qmac_apple_event_class
);
1637 Qmac_apple_event_id
= intern ("mac-apple-event-id");
1638 staticpro (&Qmac_apple_event_id
);
1641 /* arch-tag: f3c91ad8-99e0-4bd6-9eef-251b2f848732
1642 (do not change this comment) */