1 /* NeXT/Open/GNUstep / MacOSX Cocoa selection processing for emacs.
2 Copyright (C) 1993-1994, 2005-2006, 2008-2011
3 Free Software Foundation, Inc.
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. */
35 #include "termhooks.h"
38 #define CUT_BUFFER_SUPPORT
40 Lisp_Object QCLIPBOARD, QSECONDARY, QTEXT, QFILE_NAME;
42 static Lisp_Object Vselection_alist;
44 static Lisp_Object Qforeign_selection;
46 /* NSGeneralPboard is pretty much analogous to X11 CLIPBOARD */
47 NSString *NXPrimaryPboard;
48 NSString *NXSecondaryPboard;
52 /* ==========================================================================
54 Internal utility functions
56 ========================================================================== */
60 symbol_to_nsstring (Lisp_Object sym)
63 if (EQ (sym, QCLIPBOARD)) return NSGeneralPboard;
64 if (EQ (sym, QPRIMARY)) return NXPrimaryPboard;
65 if (EQ (sym, QSECONDARY)) return NXSecondaryPboard;
66 if (EQ (sym, QTEXT)) return NSStringPboardType;
67 return [NSString stringWithUTF8String: SDATA (XSYMBOL (sym)->xname)];
72 ns_string_to_symbol (NSString *t)
74 if ([t isEqualToString: NSGeneralPboard])
76 if ([t isEqualToString: NXPrimaryPboard])
78 if ([t isEqualToString: NXSecondaryPboard])
80 if ([t isEqualToString: NSStringPboardType])
82 if ([t isEqualToString: NSFilenamesPboardType])
84 if ([t isEqualToString: NSTabularTextPboardType])
86 return intern ([t UTF8String]);
91 clean_local_selection_data (Lisp_Object obj)
94 && INTEGERP (XCAR (obj))
96 && INTEGERP (XCAR (XCDR (obj)))
97 && NILP (XCDR (XCDR (obj))))
98 obj = Fcons (XCAR (obj), XCDR (obj));
101 && INTEGERP (XCAR (obj))
102 && INTEGERP (XCDR (obj)))
104 if (XINT (XCAR (obj)) == 0)
106 if (XINT (XCAR (obj)) == -1)
107 return make_number (- XINT (XCDR (obj)));
113 int size = ASIZE (obj);
117 return clean_local_selection_data (AREF (obj, 0));
118 copy = Fmake_vector (make_number (size), Qnil);
119 for (i = 0; i < size; i++)
120 ASET (copy, i, clean_local_selection_data (AREF (obj, i)));
129 ns_declare_pasteboard (id pb)
131 [pb declareTypes: ns_send_types owner: NSApp];
136 ns_undeclare_pasteboard (id pb)
138 [pb declareTypes: [NSArray array] owner: nil];
143 ns_string_to_pasteboard_internal (id pb, Lisp_Object str, NSString *gtype)
147 [pb declareTypes: [NSArray array] owner: nil];
152 NSString *type, *nsStr;
157 utfStr = SDATA (str);
158 nsStr = [[NSString alloc] initWithBytesNoCopy: utfStr
160 encoding: NSUTF8StringEncoding
164 [pb declareTypes: ns_send_types owner: nil];
165 tenum = [ns_send_types objectEnumerator];
166 while ( (type = [tenum nextObject]) )
167 [pb setString: nsStr forType: type];
171 [pb setString: nsStr forType: gtype];
179 ns_get_local_selection (Lisp_Object selection_name,
180 Lisp_Object target_type)
182 Lisp_Object local_value;
183 Lisp_Object handler_fn, value, type, check;
186 local_value = assq_no_quit (selection_name, Vselection_alist);
188 if (NILP (local_value)) return Qnil;
190 count = specpdl_ptr - specpdl;
191 specbind (Qinhibit_quit, Qt);
192 CHECK_SYMBOL (target_type);
193 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
194 if (!NILP (handler_fn))
195 value = call3 (handler_fn, selection_name, target_type,
196 XCAR (XCDR (local_value)));
199 unbind_to (count, Qnil);
202 if (CONSP (value) && SYMBOLP (XCAR (value)))
205 check = XCDR (value);
208 if (STRINGP (check) || VECTORP (check) || SYMBOLP (check)
209 || INTEGERP (check) || NILP (value))
213 && INTEGERP (XCAR (check))
214 && (INTEGERP (XCDR (check))||
215 (CONSP (XCDR (check))
216 && INTEGERP (XCAR (XCDR (check)))
217 && NILP (XCDR (XCDR (check))))))
220 // FIXME: Why `quit' rather than `error'?
221 Fsignal (Qquit, Fcons (build_string (
222 "invalid data returned by selection-conversion function"),
223 Fcons (handler_fn, Fcons (value, Qnil))));
224 // FIXME: Beware, `quit' can return!!
230 ns_get_foreign_selection (Lisp_Object symbol, Lisp_Object target)
233 pb =[NSPasteboard pasteboardWithName: symbol_to_nsstring (symbol)];
234 return ns_string_from_pasteboard (pb);
239 ns_handle_selection_request (struct input_event *event)
241 // FIXME: BIG UGLY HACK!!!
242 id pb = (id)*(EMACS_INT*)&(event->x);
243 NSString *type = (NSString *)*(EMACS_INT*)&(event->y);
244 Lisp_Object selection_name, selection_data, target_symbol, data;
245 Lisp_Object successful_p, rest;
247 selection_name = ns_string_to_symbol ([(NSPasteboard *)pb name]);
248 target_symbol = ns_string_to_symbol (type);
249 selection_data = assq_no_quit (selection_name, Vselection_alist);
252 if (!NILP (selection_data))
254 data = ns_get_local_selection (selection_name, target_symbol);
258 ns_string_to_pasteboard_internal (pb, data, type);
263 if (!EQ (Vns_sent_selection_hooks, Qunbound))
265 for (rest = Vns_sent_selection_hooks; CONSP (rest); rest = Fcdr (rest))
266 call3 (Fcar (rest), selection_name, target_symbol, successful_p);
272 ns_handle_selection_clear (struct input_event *event)
274 id pb = (id)*(EMACS_INT*)&(event->x);
275 Lisp_Object selection_name, selection_data, rest;
277 selection_name = ns_string_to_symbol ([(NSPasteboard *)pb name]);
278 selection_data = assq_no_quit (selection_name, Vselection_alist);
279 if (NILP (selection_data)) return;
281 if (EQ (selection_data, Fcar (Vselection_alist)))
282 Vselection_alist = Fcdr (Vselection_alist);
285 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
286 if (EQ (selection_data, Fcar (Fcdr (rest))))
287 Fsetcdr (rest, Fcdr (Fcdr (rest)));
290 if (!EQ (Vns_lost_selection_hooks, Qunbound))
292 for (rest = Vns_lost_selection_hooks;CONSP (rest); rest = Fcdr (rest))
293 call1 (Fcar (rest), selection_name);
299 /* ==========================================================================
301 Functions used externally
303 ========================================================================== */
307 ns_string_from_pasteboard (id pb)
309 NSString *type, *str;
313 type = [pb availableTypeFromArray: ns_return_types];
317 Fcons (build_string ("empty or unsupported pasteboard type"),
323 if (! (str = [pb stringForType: type]))
325 NSData *data = [pb dataForType: type];
327 str = [[NSString alloc] initWithData: data
328 encoding: NSUTF8StringEncoding];
336 Fcons (build_string ("pasteboard doesn't contain valid data"),
345 /* EOL conversion: PENDING- is this too simple? */
346 NSMutableString *mstr = [[str mutableCopy] autorelease];
347 [mstr replaceOccurrencesOfString: @"\r\n" withString: @"\n"
348 options: NSLiteralSearch range: NSMakeRange (0, [mstr length])];
349 [mstr replaceOccurrencesOfString: @"\r" withString: @"\n"
350 options: NSLiteralSearch range: NSMakeRange (0, [mstr length])];
352 utfStr = [mstr UTF8String];
353 length = [mstr lengthOfBytesUsingEncoding: NSUTF8StringEncoding];
355 #if ! defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_4
358 utfStr = [mstr cString];
359 length = strlen (utfStr);
365 message1 ("ns_string_from_pasteboard: UTF8String failed\n");
366 #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_4
367 utfStr = "Conversion failed";
369 utfStr = [str lossyCString];
371 length = strlen (utfStr);
375 return make_string (utfStr, length);
380 ns_string_to_pasteboard (id pb, Lisp_Object str)
382 ns_string_to_pasteboard_internal (pb, str, nil);
387 /* ==========================================================================
391 ========================================================================== */
394 DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
395 Sx_own_selection_internal, 2, 2, 0,
396 doc: /* Assert a selection.
397 SELECTION-NAME is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
398 VALUE is typically a string, or a cons of two markers, but may be
399 anything that the functions on `selection-converter-alist' know about. */)
400 (Lisp_Object selection_name, Lisp_Object selection_value)
403 Lisp_Object old_value, new_value;
406 CHECK_SYMBOL (selection_name);
407 if (NILP (selection_value))
408 error ("selection-value may not be nil.");
409 pb =[NSPasteboard pasteboardWithName: symbol_to_nsstring (selection_name)];
410 ns_declare_pasteboard (pb);
411 old_value = assq_no_quit (selection_name, Vselection_alist);
412 new_value = Fcons (selection_name, Fcons (selection_value, Qnil));
413 if (NILP (old_value))
414 Vselection_alist = Fcons (new_value, Vselection_alist);
416 Fsetcdr (old_value, Fcdr (new_value));
417 /* XXX An evil hack, but a necessary one I fear XXX */
419 struct input_event ev;
420 ev.kind = SELECTION_REQUEST_EVENT;
423 *(EMACS_INT*)(&(ev.x)) = (EMACS_INT)pb; // FIXME: BIG UGLY HACK!!
424 *(EMACS_INT*)(&(ev.y)) = (EMACS_INT)NSStringPboardType;
425 ns_handle_selection_request (&ev);
427 return selection_value;
431 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
432 Sx_disown_selection_internal, 1, 2, 0,
433 doc: /* If we own the selection SELECTION, disown it. */)
434 (Lisp_Object selection_name, Lisp_Object time)
438 CHECK_SYMBOL (selection_name);
439 if (NILP (assq_no_quit (selection_name, Vselection_alist))) return Qnil;
441 pb =[NSPasteboard pasteboardWithName: symbol_to_nsstring (selection_name)];
442 ns_undeclare_pasteboard (pb);
447 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
448 0, 1, 0, doc: /* Whether there is an owner for the given selection.
449 The arg should be the name of the selection in question, typically one of
450 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
451 \(Those are literal upper-case symbol names.)
452 For convenience, the symbol nil is the same as `PRIMARY',
453 and t is the same as `SECONDARY'.) */)
454 (Lisp_Object selection)
460 CHECK_SYMBOL (selection);
461 if (EQ (selection, Qnil)) selection = QPRIMARY;
462 if (EQ (selection, Qt)) selection = QSECONDARY;
463 pb =[NSPasteboard pasteboardWithName: symbol_to_nsstring (selection)];
465 return ([types count] == 0) ? Qnil : Qt;
469 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
471 doc: /* Whether the current Emacs process owns the given selection.
472 The arg should be the name of the selection in question, typically one of
473 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
474 \(Those are literal upper-case symbol names.)
475 For convenience, the symbol nil is the same as `PRIMARY',
476 and t is the same as `SECONDARY'.) */)
477 (Lisp_Object selection)
480 CHECK_SYMBOL (selection);
481 if (EQ (selection, Qnil)) selection = QPRIMARY;
482 if (EQ (selection, Qt)) selection = QSECONDARY;
483 return (NILP (Fassq (selection, Vselection_alist))) ? Qnil : Qt;
487 DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
488 Sx_get_selection_internal, 2, 2, 0,
489 doc: /* Return text selected from some pasteboard.
490 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
491 \(Those are literal upper-case symbol names.)
492 TYPE is the type of data desired, typically `STRING'. */)
493 (Lisp_Object selection_name, Lisp_Object target_type)
498 CHECK_SYMBOL (selection_name);
499 CHECK_SYMBOL (target_type);
500 val = ns_get_local_selection (selection_name, target_type);
502 val = ns_get_foreign_selection (selection_name, target_type);
503 if (CONSP (val) && SYMBOLP (Fcar (val)))
506 if (CONSP (val) && NILP (Fcdr (val)))
509 val = clean_local_selection_data (val);
514 #ifdef CUT_BUFFER_SUPPORT
515 DEFUN ("ns-get-cut-buffer-internal", Fns_get_cut_buffer_internal,
516 Sns_get_cut_buffer_internal, 1, 1, 0,
517 doc: /* Returns the value of the named cut buffer. */)
522 pb =[NSPasteboard pasteboardWithName: symbol_to_nsstring (buffer)];
523 return ns_string_from_pasteboard (pb);
527 DEFUN ("ns-rotate-cut-buffers-internal", Fns_rotate_cut_buffers_internal,
528 Sns_rotate_cut_buffers_internal, 1, 1, 0,
529 doc: /* Rotate the values of the cut buffers by N steps.
530 Positive N means move values forward, negative means
531 backward. CURRENTLY NOT IMPLEMENTED UNDER NEXTSTEP. */ )
534 /* XXX This function is unimplemented under NeXTstep XXX */
535 Fsignal (Qquit, Fcons (build_string (
536 "Warning: ns-rotate-cut-buffers-internal not implemented\n"), Qnil));
541 DEFUN ("ns-store-cut-buffer-internal", Fns_store_cut_buffer_internal,
542 Sns_store_cut_buffer_internal, 2, 2, 0,
543 doc: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */)
544 (Lisp_Object buffer, Lisp_Object string)
548 pb =[NSPasteboard pasteboardWithName: symbol_to_nsstring (buffer)];
549 ns_string_to_pasteboard (pb, string);
556 nxatoms_of_nsselect (void)
558 NXPrimaryPboard = @"Selection";
559 NXSecondaryPboard = @"Secondary";
563 syms_of_nsselect (void)
565 QCLIPBOARD = intern_c_string ("CLIPBOARD"); staticpro (&QCLIPBOARD);
566 QSECONDARY = intern_c_string ("SECONDARY"); staticpro (&QSECONDARY);
567 QTEXT = intern_c_string ("TEXT"); staticpro (&QTEXT);
568 QFILE_NAME = intern_c_string ("FILE_NAME"); staticpro (&QFILE_NAME);
570 defsubr (&Sx_disown_selection_internal);
571 defsubr (&Sx_get_selection_internal);
572 defsubr (&Sx_own_selection_internal);
573 defsubr (&Sx_selection_exists_p);
574 defsubr (&Sx_selection_owner_p);
575 #ifdef CUT_BUFFER_SUPPORT
576 defsubr (&Sns_get_cut_buffer_internal);
577 defsubr (&Sns_rotate_cut_buffers_internal);
578 defsubr (&Sns_store_cut_buffer_internal);
581 Vselection_alist = Qnil;
582 staticpro (&Vselection_alist);
584 DEFVAR_LISP ("ns-sent-selection-hooks", Vns_sent_selection_hooks,
585 "A list of functions to be called when Emacs answers a selection request.\n\
586 The functions are called with four arguments:\n\
587 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
588 - the selection-type which Emacs was asked to convert the\n\
589 selection into before sending (for example, `STRING' or `LENGTH');\n\
590 - a flag indicating success or failure for responding to the request.\n\
591 We might have failed (and declined the request) for any number of reasons,\n\
592 including being asked for a selection that we no longer own, or being asked\n\
593 to convert into a type that we don't know about or that is inappropriate.\n\
594 This hook doesn't let you change the behavior of Emacs's selection replies,\n\
595 it merely informs you that they have happened.");
596 Vns_sent_selection_hooks = Qnil;
598 DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist,
599 "An alist associating X Windows selection-types with functions.\n\
600 These functions are called to convert the selection, with three args:\n\
601 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
602 a desired type to which the selection should be converted;\n\
603 and the local selection value (whatever was given to `x-own-selection').\n\
605 The function should return the value to send to the X server\n\
606 \(typically a string). A return value of nil\n\
607 means that the conversion could not be done.\n\
608 A return value which is the symbol `NULL'\n\
609 means that a side-effect was executed,\n\
610 and there is no meaningful selection value.");
611 Vselection_converter_alist = Qnil;
613 DEFVAR_LISP ("ns-lost-selection-hooks", Vns_lost_selection_hooks,
614 "A list of functions to be called when Emacs loses an X selection.\n\
615 \(This happens when some other X client makes its own selection\n\
616 or when a Lisp program explicitly clears the selection.)\n\
617 The functions are called with one argument, the selection type\n\
618 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD').");
619 Vns_lost_selection_hooks = Qnil;
621 Qforeign_selection = intern_c_string ("foreign-selection");
622 staticpro (&Qforeign_selection);