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, type, 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)))
207 check = XCDR (value);
210 if (STRINGP (check) || VECTORP (check) || SYMBOLP (check)
211 || INTEGERP (check) || NILP (value))
215 && INTEGERP (XCAR (check))
216 && (INTEGERP (XCDR (check))||
217 (CONSP (XCDR (check))
218 && INTEGERP (XCAR (XCDR (check)))
219 && NILP (XCDR (XCDR (check))))))
222 // FIXME: Why `quit' rather than `error'?
223 Fsignal (Qquit, Fcons (build_string (
224 "invalid data returned by selection-conversion function"),
225 Fcons (handler_fn, Fcons (value, Qnil))));
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];
260 Fcons (build_string ("empty or unsupported pasteboard type"),
266 if (! (str = [pb stringForType: type]))
268 NSData *data = [pb dataForType: type];
270 str = [[NSString alloc] initWithData: data
271 encoding: NSUTF8StringEncoding];
279 Fcons (build_string ("pasteboard doesn't contain valid data"),
288 /* EOL conversion: PENDING- is this too simple? */
289 NSMutableString *mstr = [[str mutableCopy] autorelease];
290 [mstr replaceOccurrencesOfString: @"\r\n" withString: @"\n"
291 options: NSLiteralSearch range: NSMakeRange (0, [mstr length])];
292 [mstr replaceOccurrencesOfString: @"\r" withString: @"\n"
293 options: NSLiteralSearch range: NSMakeRange (0, [mstr length])];
295 utfStr = [mstr UTF8String];
296 length = [mstr lengthOfBytesUsingEncoding: NSUTF8StringEncoding];
298 #if ! defined (NS_IMPL_COCOA)
301 utfStr = [mstr cString];
302 length = strlen (utfStr);
308 message1 ("ns_string_from_pasteboard: UTF8String failed\n");
309 #if defined (NS_IMPL_COCOA)
310 utfStr = "Conversion failed";
312 utfStr = [str lossyCString];
314 length = strlen (utfStr);
318 return make_string (utfStr, length);
323 ns_string_to_pasteboard (id pb, Lisp_Object str)
325 ns_string_to_pasteboard_internal (pb, str, nil);
330 /* ==========================================================================
334 ========================================================================== */
337 DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
338 Sx_own_selection_internal, 2, 3, 0,
339 doc: /* Assert an X selection of type SELECTION and value VALUE.
340 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
341 \(Those are literal upper-case symbol names, since that's what X expects.)
342 VALUE is typically a string, or a cons of two markers, but may be
343 anything that the functions on `selection-converter-alist' know about.
345 FRAME should be a frame that should own the selection. If omitted or
346 nil, it defaults to the selected frame.
348 On Nextstep, FRAME is unused. */)
349 (Lisp_Object selection, Lisp_Object value, Lisp_Object frame)
352 Lisp_Object old_value, new_value;
354 Lisp_Object successful_p = Qnil, rest;
355 Lisp_Object target_symbol, data;
357 check_window_system (NULL);
358 CHECK_SYMBOL (selection);
360 error ("selection value may not be nil.");
361 pb = ns_symbol_to_pb (selection);
362 if (pb == nil) return Qnil;
364 ns_declare_pasteboard (pb);
365 old_value = assq_no_quit (selection, Vselection_alist);
366 new_value = Fcons (selection, Fcons (value, Qnil));
368 if (NILP (old_value))
369 Vselection_alist = Fcons (new_value, Vselection_alist);
371 Fsetcdr (old_value, Fcdr (new_value));
373 /* We only support copy of text. */
374 type = NSStringPboardType;
375 target_symbol = ns_string_to_symbol (type);
376 data = ns_get_local_selection (selection, target_symbol);
380 ns_string_to_pasteboard_internal (pb, data, type);
384 if (!EQ (Vns_sent_selection_hooks, Qunbound))
386 for (rest = Vns_sent_selection_hooks; CONSP (rest); rest = Fcdr (rest))
387 call3 (Fcar (rest), selection, target_symbol, successful_p);
394 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
395 Sx_disown_selection_internal, 1, 3, 0,
396 doc: /* If we own the selection SELECTION, disown it.
397 Disowning it means there is no such selection.
399 Sets the last-change time for the selection to TIME-OBJECT (by default
400 the time of the last event).
402 TERMINAL should be a terminal object or a frame specifying the X
403 server to query. If omitted or nil, that stands for the selected
404 frame's display, or the first available X display.
406 On Nextstep, the TIME-OBJECT and TERMINAL arguments are unused.
407 On MS-DOS, all this does is return non-nil if we own the selection. */)
408 (Lisp_Object selection, Lisp_Object time_object, Lisp_Object terminal)
411 check_window_system (NULL);
412 CHECK_SYMBOL (selection);
413 if (NILP (assq_no_quit (selection, Vselection_alist))) return Qnil;
415 pb = ns_symbol_to_pb (selection);
416 if (pb != nil) ns_undeclare_pasteboard (pb);
421 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
422 0, 2, 0, doc: /* Whether there is an owner for the given X selection.
423 SELECTION should be the name of the selection in question, typically
424 one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. (X expects
425 these literal upper-case names.) The symbol nil is the same as
426 `PRIMARY', and t is the same as `SECONDARY'.
428 TERMINAL should be a terminal object or a frame specifying the X
429 server to query. If omitted or nil, that stands for the selected
430 frame's display, or the first available X display.
432 On Nextstep, TERMINAL is unused. */)
433 (Lisp_Object selection, Lisp_Object terminal)
438 check_window_system (NULL);
439 CHECK_SYMBOL (selection);
440 if (EQ (selection, Qnil)) selection = QPRIMARY;
441 if (EQ (selection, Qt)) selection = QSECONDARY;
442 pb = ns_symbol_to_pb (selection);
443 if (pb == nil) return Qnil;
446 return ([types count] == 0) ? Qnil : Qt;
450 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
452 doc: /* Whether the current Emacs process owns the given X Selection.
453 The arg should be the name of the selection in question, typically one of
454 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
455 \(Those are literal upper-case symbol names, since that's what X expects.)
456 For convenience, the symbol nil is the same as `PRIMARY',
457 and t is the same as `SECONDARY'.
459 TERMINAL should be a terminal object or a frame specifying the X
460 server to query. If omitted or nil, that stands for the selected
461 frame's display, or the first available X display.
463 On Nextstep, TERMINAL is unused. */)
464 (Lisp_Object selection, Lisp_Object terminal)
466 check_window_system (NULL);
467 CHECK_SYMBOL (selection);
468 if (EQ (selection, Qnil)) selection = QPRIMARY;
469 if (EQ (selection, Qt)) selection = QSECONDARY;
470 return (NILP (Fassq (selection, Vselection_alist))) ? Qnil : Qt;
474 DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
475 Sx_get_selection_internal, 2, 4, 0,
476 doc: /* Return text selected from some X window.
477 SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
478 \(Those are literal upper-case symbol names, since that's what X expects.)
479 TARGET-TYPE is the type of data desired, typically `STRING'.
481 TIME-STAMP is the time to use in the XConvertSelection call for foreign
482 selections. If omitted, defaults to the time for the last event.
484 TERMINAL should be a terminal object or a frame specifying the X
485 server to query. If omitted or nil, that stands for the selected
486 frame's display, or the first available X display.
488 On Nextstep, TIME-STAMP and TERMINAL are unused. */)
489 (Lisp_Object selection_name, Lisp_Object target_type,
490 Lisp_Object time_stamp, Lisp_Object terminal)
494 check_window_system (NULL);
495 CHECK_SYMBOL (selection_name);
496 CHECK_SYMBOL (target_type);
497 val = ns_get_local_selection (selection_name, target_type);
499 val = ns_get_foreign_selection (selection_name, target_type);
500 if (CONSP (val) && SYMBOLP (Fcar (val)))
503 if (CONSP (val) && NILP (Fcdr (val)))
506 val = clean_local_selection_data (val);
511 DEFUN ("ns-get-selection-internal", Fns_get_selection_internal,
512 Sns_get_selection_internal, 1, 1, 0,
513 doc: /* Returns the value of SELECTION as a string.
514 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. */)
515 (Lisp_Object selection)
518 check_window_system (NULL);
519 pb = ns_symbol_to_pb (selection);
520 return pb != nil ? ns_string_from_pasteboard (pb) : Qnil;
524 DEFUN ("ns-store-selection-internal", Fns_store_selection_internal,
525 Sns_store_selection_internal, 2, 2, 0,
526 doc: /* Sets the string value of SELECTION.
527 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. */)
528 (Lisp_Object selection, Lisp_Object string)
531 check_window_system (NULL);
532 pb = ns_symbol_to_pb (selection);
533 if (pb != nil) ns_string_to_pasteboard (pb, string);
539 nxatoms_of_nsselect (void)
541 NXPrimaryPboard = @"Selection";
542 NXSecondaryPboard = @"Secondary";
546 syms_of_nsselect (void)
548 QCLIPBOARD = intern_c_string ("CLIPBOARD"); staticpro (&QCLIPBOARD);
549 QSECONDARY = intern_c_string ("SECONDARY"); staticpro (&QSECONDARY);
550 QTEXT = intern_c_string ("TEXT"); staticpro (&QTEXT);
551 QFILE_NAME = intern_c_string ("FILE_NAME"); staticpro (&QFILE_NAME);
553 defsubr (&Sx_disown_selection_internal);
554 defsubr (&Sx_get_selection_internal);
555 defsubr (&Sx_own_selection_internal);
556 defsubr (&Sx_selection_exists_p);
557 defsubr (&Sx_selection_owner_p);
558 defsubr (&Sns_get_selection_internal);
559 defsubr (&Sns_store_selection_internal);
561 Vselection_alist = Qnil;
562 staticpro (&Vselection_alist);
564 DEFVAR_LISP ("ns-sent-selection-hooks", Vns_sent_selection_hooks,
565 "A list of functions to be called when Emacs answers a selection request.\n\
566 The functions are called with four arguments:\n\
567 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
568 - the selection-type which Emacs was asked to convert the\n\
569 selection into before sending (for example, `STRING' or `LENGTH');\n\
570 - a flag indicating success or failure for responding to the request.\n\
571 We might have failed (and declined the request) for any number of reasons,\n\
572 including being asked for a selection that we no longer own, or being asked\n\
573 to convert into a type that we don't know about or that is inappropriate.\n\
574 This hook doesn't let you change the behavior of Emacs's selection replies,\n\
575 it merely informs you that they have happened.");
576 Vns_sent_selection_hooks = Qnil;
578 DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist,
579 "An alist associating X Windows selection-types with functions.\n\
580 These functions are called to convert the selection, with three args:\n\
581 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
582 a desired type to which the selection should be converted;\n\
583 and the local selection value (whatever was given to `x-own-selection').\n\
585 The function should return the value to send to the X server\n\
586 \(typically a string). A return value of nil\n\
587 means that the conversion could not be done.\n\
588 A return value which is the symbol `NULL'\n\
589 means that a side-effect was executed,\n\
590 and there is no meaningful selection value.");
591 Vselection_converter_alist = Qnil;
593 DEFVAR_LISP ("ns-lost-selection-hooks", Vns_lost_selection_hooks,
594 "A list of functions to be called when Emacs loses an X selection.\n\
595 \(This happens when some other X client makes its own selection\n\
596 or when a Lisp program explicitly clears the selection.)\n\
597 The functions are called with one argument, the selection type\n\
598 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD').");
599 Vns_lost_selection_hooks = Qnil;
601 Qforeign_selection = intern_c_string ("foreign-selection");
602 staticpro (&Qforeign_selection);