1 /* NeXT/Open/GNUstep / MacOSX Cocoa selection processing for emacs.
2 Copyright (C) 1993-1994, 2005-2006, 2008-2013 Free Software
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
21 Originally by Carl Edman
22 Updated by Christian Limpach (chris@nice.ch)
23 OpenStep/Rhapsody port by Scott Bender (sbender@harmony-ds.com)
24 MacOSX/Aqua port by Christophe de Dinechin (descubes@earthlink.net)
25 GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
28 /* This should be the first include, as it may set up #defines affecting
29 interpretation of even the system includes. */
34 #include "termhooks.h"
37 Lisp_Object QCLIPBOARD, QSECONDARY, QTEXT, QFILE_NAME;
39 static Lisp_Object Vselection_alist;
41 static Lisp_Object Qforeign_selection;
43 /* NSGeneralPboard is pretty much analogous to X11 CLIPBOARD */
44 NSString *NXPrimaryPboard;
45 NSString *NXSecondaryPboard;
49 /* ==========================================================================
51 Internal utility functions
53 ========================================================================== */
57 symbol_to_nsstring (Lisp_Object sym)
60 if (EQ (sym, QCLIPBOARD)) return NSGeneralPboard;
61 if (EQ (sym, QPRIMARY)) return NXPrimaryPboard;
62 if (EQ (sym, QSECONDARY)) return NXSecondaryPboard;
63 if (EQ (sym, QTEXT)) return NSStringPboardType;
64 return [NSString stringWithUTF8String: SSDATA (SYMBOL_NAME (sym))];
68 ns_symbol_to_pb (Lisp_Object symbol)
70 return [NSPasteboard pasteboardWithName: symbol_to_nsstring (symbol)];
74 ns_string_to_symbol (NSString *t)
76 if ([t isEqualToString: NSGeneralPboard])
78 if ([t isEqualToString: NXPrimaryPboard])
80 if ([t isEqualToString: NXSecondaryPboard])
82 if ([t isEqualToString: NSStringPboardType])
84 if ([t isEqualToString: NSFilenamesPboardType])
86 if ([t isEqualToString: NSTabularTextPboardType])
88 return intern ([t UTF8String]);
93 clean_local_selection_data (Lisp_Object obj)
96 && INTEGERP (XCAR (obj))
98 && INTEGERP (XCAR (XCDR (obj)))
99 && NILP (XCDR (XCDR (obj))))
100 obj = Fcons (XCAR (obj), XCDR (obj));
103 && INTEGERP (XCAR (obj))
104 && INTEGERP (XCDR (obj)))
106 if (XINT (XCAR (obj)) == 0)
108 if (XINT (XCAR (obj)) == -1)
109 return make_number (- XINT (XCDR (obj)));
115 ptrdiff_t size = ASIZE (obj);
119 return clean_local_selection_data (AREF (obj, 0));
120 copy = make_uninit_vector (size);
121 for (i = 0; i < size; i++)
122 ASET (copy, i, clean_local_selection_data (AREF (obj, i)));
131 ns_declare_pasteboard (id pb)
133 [pb declareTypes: ns_send_types owner: NSApp];
138 ns_undeclare_pasteboard (id pb)
140 [pb declareTypes: [NSArray array] owner: nil];
145 ns_string_to_pasteboard_internal (id pb, Lisp_Object str, NSString *gtype)
149 [pb declareTypes: [NSArray array] owner: nil];
154 NSString *type, *nsStr;
159 utfStr = SSDATA (str);
160 nsStr = [[NSString alloc] initWithBytesNoCopy: utfStr
162 encoding: NSUTF8StringEncoding
166 [pb declareTypes: ns_send_types owner: nil];
167 tenum = [ns_send_types objectEnumerator];
168 while ( (type = [tenum nextObject]) )
169 [pb setString: nsStr forType: type];
173 [pb setString: nsStr forType: gtype];
181 ns_get_local_selection (Lisp_Object selection_name,
182 Lisp_Object target_type)
184 Lisp_Object local_value;
185 Lisp_Object handler_fn, value, check;
188 local_value = assq_no_quit (selection_name, Vselection_alist);
190 if (NILP (local_value)) return Qnil;
192 count = specpdl_ptr - specpdl;
193 specbind (Qinhibit_quit, Qt);
194 CHECK_SYMBOL (target_type);
195 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
196 if (!NILP (handler_fn))
197 value = call3 (handler_fn, selection_name, target_type,
198 XCAR (XCDR (local_value)));
201 unbind_to (count, Qnil);
204 if (CONSP (value) && SYMBOLP (XCAR (value)))
206 check = XCDR (value);
209 if (STRINGP (check) || VECTORP (check) || SYMBOLP (check)
210 || INTEGERP (check) || NILP (value))
214 && INTEGERP (XCAR (check))
215 && (INTEGERP (XCDR (check))||
216 (CONSP (XCDR (check))
217 && INTEGERP (XCAR (XCDR (check)))
218 && NILP (XCDR (XCDR (check))))))
221 // FIXME: Why `quit' rather than `error'?
223 list3 (build_string ("invalid data returned by"
224 " selection-conversion function"),
226 // FIXME: Beware, `quit' can return!!
232 ns_get_foreign_selection (Lisp_Object symbol, Lisp_Object target)
235 pb = ns_symbol_to_pb (symbol);
236 return pb != nil ? ns_string_from_pasteboard (pb) : Qnil;
242 /* ==========================================================================
244 Functions used externally
246 ========================================================================== */
250 ns_string_from_pasteboard (id pb)
252 NSString *type, *str;
256 type = [pb availableTypeFromArray: ns_return_types];
263 if (! (str = [pb stringForType: type]))
265 NSData *data = [pb dataForType: type];
267 str = [[NSString alloc] initWithData: data
268 encoding: NSUTF8StringEncoding];
282 /* EOL conversion: PENDING- is this too simple? */
283 NSMutableString *mstr = [[str mutableCopy] autorelease];
284 [mstr replaceOccurrencesOfString: @"\r\n" withString: @"\n"
285 options: NSLiteralSearch range: NSMakeRange (0, [mstr length])];
286 [mstr replaceOccurrencesOfString: @"\r" withString: @"\n"
287 options: NSLiteralSearch range: NSMakeRange (0, [mstr length])];
289 utfStr = [mstr UTF8String];
290 length = [mstr lengthOfBytesUsingEncoding: NSUTF8StringEncoding];
292 #if ! defined (NS_IMPL_COCOA)
295 utfStr = [mstr cString];
296 length = strlen (utfStr);
302 message1 ("ns_string_from_pasteboard: UTF8String failed\n");
303 #if defined (NS_IMPL_COCOA)
304 utfStr = "Conversion failed";
306 utfStr = [str lossyCString];
308 length = strlen (utfStr);
312 return make_string (utfStr, length);
317 ns_string_to_pasteboard (id pb, Lisp_Object str)
319 ns_string_to_pasteboard_internal (pb, str, nil);
324 /* ==========================================================================
328 ========================================================================== */
331 DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
332 Sx_own_selection_internal, 2, 3, 0,
333 doc: /* Assert an X selection of type SELECTION and value VALUE.
334 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
335 \(Those are literal upper-case symbol names, since that's what X expects.)
336 VALUE is typically a string, or a cons of two markers, but may be
337 anything that the functions on `selection-converter-alist' know about.
339 FRAME should be a frame that should own the selection. If omitted or
340 nil, it defaults to the selected frame.
342 On Nextstep, FRAME is unused. */)
343 (Lisp_Object selection, Lisp_Object value, Lisp_Object frame)
346 Lisp_Object old_value, new_value;
348 Lisp_Object successful_p = Qnil, rest;
349 Lisp_Object target_symbol, data;
351 check_window_system (NULL);
352 CHECK_SYMBOL (selection);
354 error ("selection value may not be nil.");
355 pb = ns_symbol_to_pb (selection);
356 if (pb == nil) return Qnil;
358 ns_declare_pasteboard (pb);
359 old_value = assq_no_quit (selection, Vselection_alist);
360 new_value = list2 (selection, value);
362 if (NILP (old_value))
363 Vselection_alist = Fcons (new_value, Vselection_alist);
365 Fsetcdr (old_value, Fcdr (new_value));
367 /* We only support copy of text. */
368 type = NSStringPboardType;
369 target_symbol = ns_string_to_symbol (type);
370 data = ns_get_local_selection (selection, target_symbol);
374 ns_string_to_pasteboard_internal (pb, data, type);
378 if (!EQ (Vns_sent_selection_hooks, Qunbound))
380 for (rest = Vns_sent_selection_hooks; CONSP (rest); rest = Fcdr (rest))
381 call3 (Fcar (rest), selection, target_symbol, successful_p);
388 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
389 Sx_disown_selection_internal, 1, 3, 0,
390 doc: /* If we own the selection SELECTION, disown it.
391 Disowning it means there is no such selection.
393 Sets the last-change time for the selection to TIME-OBJECT (by default
394 the time of the last event).
396 TERMINAL should be a terminal object or a frame specifying the X
397 server to query. If omitted or nil, that stands for the selected
398 frame's display, or the first available X display.
400 On Nextstep, the TIME-OBJECT and TERMINAL arguments are unused.
401 On MS-DOS, all this does is return non-nil if we own the selection. */)
402 (Lisp_Object selection, Lisp_Object time_object, Lisp_Object terminal)
405 check_window_system (NULL);
406 CHECK_SYMBOL (selection);
407 if (NILP (assq_no_quit (selection, Vselection_alist))) return Qnil;
409 pb = ns_symbol_to_pb (selection);
410 if (pb != nil) ns_undeclare_pasteboard (pb);
415 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
416 0, 2, 0, doc: /* Whether there is an owner for the given X selection.
417 SELECTION should be the name of the selection in question, typically
418 one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. (X expects
419 these literal upper-case names.) The symbol nil is the same as
420 `PRIMARY', and t is the same as `SECONDARY'.
422 TERMINAL should be a terminal object or a frame specifying the X
423 server to query. If omitted or nil, that stands for the selected
424 frame's display, or the first available X display.
426 On Nextstep, TERMINAL is unused. */)
427 (Lisp_Object selection, Lisp_Object terminal)
432 check_window_system (NULL);
433 CHECK_SYMBOL (selection);
434 if (EQ (selection, Qnil)) selection = QPRIMARY;
435 if (EQ (selection, Qt)) selection = QSECONDARY;
436 pb = ns_symbol_to_pb (selection);
437 if (pb == nil) return Qnil;
440 return ([types count] == 0) ? Qnil : Qt;
444 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
446 doc: /* Whether the current Emacs process owns the given X Selection.
447 The arg should be the name of the selection in question, typically one of
448 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
449 \(Those are literal upper-case symbol names, since that's what X expects.)
450 For convenience, the symbol nil is the same as `PRIMARY',
451 and t is the same as `SECONDARY'.
453 TERMINAL should be a terminal object or a frame specifying the X
454 server to query. If omitted or nil, that stands for the selected
455 frame's display, or the first available X display.
457 On Nextstep, TERMINAL is unused. */)
458 (Lisp_Object selection, Lisp_Object terminal)
460 check_window_system (NULL);
461 CHECK_SYMBOL (selection);
462 if (EQ (selection, Qnil)) selection = QPRIMARY;
463 if (EQ (selection, Qt)) selection = QSECONDARY;
464 return (NILP (Fassq (selection, Vselection_alist))) ? Qnil : Qt;
468 DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
469 Sx_get_selection_internal, 2, 4, 0,
470 doc: /* Return text selected from some X window.
471 SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
472 \(Those are literal upper-case symbol names, since that's what X expects.)
473 TARGET-TYPE is the type of data desired, typically `STRING'.
475 TIME-STAMP is the time to use in the XConvertSelection call for foreign
476 selections. If omitted, defaults to the time for the last event.
478 TERMINAL should be a terminal object or a frame specifying the X
479 server to query. If omitted or nil, that stands for the selected
480 frame's display, or the first available X display.
482 On Nextstep, TIME-STAMP and TERMINAL are unused. */)
483 (Lisp_Object selection_name, Lisp_Object target_type,
484 Lisp_Object time_stamp, Lisp_Object terminal)
488 check_window_system (NULL);
489 CHECK_SYMBOL (selection_name);
490 CHECK_SYMBOL (target_type);
491 val = ns_get_local_selection (selection_name, target_type);
493 val = ns_get_foreign_selection (selection_name, target_type);
494 if (CONSP (val) && SYMBOLP (Fcar (val)))
497 if (CONSP (val) && NILP (Fcdr (val)))
500 val = clean_local_selection_data (val);
505 DEFUN ("ns-get-selection-internal", Fns_get_selection_internal,
506 Sns_get_selection_internal, 1, 1, 0,
507 doc: /* Returns the value of SELECTION as a string.
508 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. */)
509 (Lisp_Object selection)
512 check_window_system (NULL);
513 pb = ns_symbol_to_pb (selection);
514 return pb != nil ? ns_string_from_pasteboard (pb) : Qnil;
518 DEFUN ("ns-store-selection-internal", Fns_store_selection_internal,
519 Sns_store_selection_internal, 2, 2, 0,
520 doc: /* Sets the string value of SELECTION.
521 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. */)
522 (Lisp_Object selection, Lisp_Object string)
525 check_window_system (NULL);
526 pb = ns_symbol_to_pb (selection);
527 if (pb != nil) ns_string_to_pasteboard (pb, string);
533 nxatoms_of_nsselect (void)
535 NXPrimaryPboard = @"Selection";
536 NXSecondaryPboard = @"Secondary";
540 syms_of_nsselect (void)
542 QCLIPBOARD = intern_c_string ("CLIPBOARD"); staticpro (&QCLIPBOARD);
543 QSECONDARY = intern_c_string ("SECONDARY"); staticpro (&QSECONDARY);
544 QTEXT = intern_c_string ("TEXT"); staticpro (&QTEXT);
545 QFILE_NAME = intern_c_string ("FILE_NAME"); staticpro (&QFILE_NAME);
547 defsubr (&Sx_disown_selection_internal);
548 defsubr (&Sx_get_selection_internal);
549 defsubr (&Sx_own_selection_internal);
550 defsubr (&Sx_selection_exists_p);
551 defsubr (&Sx_selection_owner_p);
552 defsubr (&Sns_get_selection_internal);
553 defsubr (&Sns_store_selection_internal);
555 Vselection_alist = Qnil;
556 staticpro (&Vselection_alist);
558 DEFVAR_LISP ("ns-sent-selection-hooks", Vns_sent_selection_hooks,
559 "A list of functions to be called when Emacs answers a selection request.\n\
560 The functions are called with four arguments:\n\
561 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
562 - the selection-type which Emacs was asked to convert the\n\
563 selection into before sending (for example, `STRING' or `LENGTH');\n\
564 - a flag indicating success or failure for responding to the request.\n\
565 We might have failed (and declined the request) for any number of reasons,\n\
566 including being asked for a selection that we no longer own, or being asked\n\
567 to convert into a type that we don't know about or that is inappropriate.\n\
568 This hook doesn't let you change the behavior of Emacs's selection replies,\n\
569 it merely informs you that they have happened.");
570 Vns_sent_selection_hooks = Qnil;
572 DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist,
573 "An alist associating X Windows selection-types with functions.\n\
574 These functions are called to convert the selection, with three args:\n\
575 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
576 a desired type to which the selection should be converted;\n\
577 and the local selection value (whatever was given to `x-own-selection').\n\
579 The function should return the value to send to the X server\n\
580 \(typically a string). A return value of nil\n\
581 means that the conversion could not be done.\n\
582 A return value which is the symbol `NULL'\n\
583 means that a side-effect was executed,\n\
584 and there is no meaningful selection value.");
585 Vselection_converter_alist = Qnil;
587 DEFVAR_LISP ("ns-lost-selection-hooks", Vns_lost_selection_hooks,
588 "A list of functions to be called when Emacs loses an X selection.\n\
589 \(This happens when some other X client makes its own selection\n\
590 or when a Lisp program explicitly clears the selection.)\n\
591 The functions are called with one argument, the selection type\n\
592 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD').");
593 Vns_lost_selection_hooks = Qnil;
595 Qforeign_selection = intern_c_string ("foreign-selection");
596 staticpro (&Qforeign_selection);