1 /* NeXT/Open/GNUstep / MacOSX Cocoa selection processing for emacs.
2 Copyright (C) 1993, 1994, 2005, 2006, 2008,
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, or (at your option)
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; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA.
22 Originally by Carl Edman
23 Updated by Christian Limpach (chris@nice.ch)
24 OpenStep/Rhapsody port by Scott Bender (sbender@harmony-ds.com)
25 MacOSX/Aqua port by Christophe de Dinechin (descubes@earthlink.net)
26 GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
33 #include "termhooks.h"
35 #define CUT_BUFFER_SUPPORT
37 Lisp_Object QPRIMARY
, QSECONDARY
, QTEXT
, QFILE_NAME
;
39 static Lisp_Object Vns_sent_selection_hooks
;
40 static Lisp_Object Vns_lost_selection_hooks
;
41 static Lisp_Object Vselection_alist
;
42 static Lisp_Object Vselection_converter_alist
;
45 /* Coding system for communicating with other programs. */
46 static Lisp_Object Vselection_coding_system
;
47 /* Coding system for the next communicating with other programs. */
48 static Lisp_Object Vnext_selection_coding_system
;
49 static Lisp_Object Qforeign_selection
;
51 NSString
*NXSecondaryPboard
;
55 /* ==========================================================================
57 Internal utility functions
59 ========================================================================== */
63 symbol_to_nsstring
(Lisp_Object sym
)
66 if (EQ
(sym
, QPRIMARY
)) return NSGeneralPboard
;
67 if (EQ
(sym
, QSECONDARY
)) return NXSecondaryPboard
;
68 if (EQ
(sym
, QTEXT
)) return NSStringPboardType
;
69 return [NSString stringWithUTF8String
: XSTRING
(XSYMBOL
(sym
)->xname
)->data
];
74 ns_string_to_symbol
(NSString
*t
)
76 if ([t isEqualToString
: NSGeneralPboard
])
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 = XVECTOR
(obj
)->size;
117 return clean_local_selection_data
(XVECTOR
(obj
)->contents
[0]);
118 copy
= Fmake_vector
(size, Qnil
);
119 for (i
= 0; i
< size; i
++)
120 XVECTOR
(copy
)->contents
[i
]
121 = clean_local_selection_data
(XVECTOR
(obj
)->contents
[i
]);
130 ns_declare_pasteboard
(id pb
)
132 [pb declareTypes
: ns_send_types owner
: NSApp
];
137 ns_undeclare_pasteboard
(id pb
)
139 [pb declareTypes
: [NSArray array
] owner
: nil
];
144 ns_string_to_pasteboard_internal
(id pb
, Lisp_Object str
, NSString
*gtype
)
148 [pb declareTypes
: [NSArray array
] owner
: nil
];
153 NSString
*type, *nsStr
;
158 utfStr
= XSTRING
(str
)->data
;
159 nsStr
= [NSString stringWithUTF8String
: utfStr
];
163 [pb declareTypes
: ns_send_types owner
: nil
];
164 tenum
= [ns_send_types objectEnumerator
];
165 while ( (type = [tenum nextObject
]) )
166 [pb setString
: nsStr forType
: type];
170 [pb setString
: nsStr forType
: gtype
];
177 ns_get_local_selection
(Lisp_Object selection_name
,
178 Lisp_Object target_type
)
180 Lisp_Object local_value
;
181 Lisp_Object handler_fn
, value
, type, check
;
184 local_value
= assq_no_quit
(selection_name
, Vselection_alist
);
186 if (NILP
(local_value
)) return Qnil
;
188 count
= specpdl_ptr
- specpdl
;
189 specbind
(Qinhibit_quit
, Qt
);
190 CHECK_SYMBOL
(target_type
);
191 handler_fn
= Fcdr
(Fassq
(target_type
, Vselection_converter_alist
));
192 if (!NILP
(handler_fn
))
193 value
=call3
(handler_fn
, selection_name
, target_type
,
194 XCAR
(XCDR
(local_value
)));
197 unbind_to
(count
, Qnil
);
200 if (CONSP
(value
) && SYMBOLP
(XCAR
(value
)))
203 check
= XCDR
(value
);
206 if (STRINGP
(check
) || VECTORP
(check
) || SYMBOLP
(check
)
207 || INTEGERP
(check
) || NILP
(value
))
211 && INTEGERP
(XCAR
(check
))
212 && (INTEGERP
(XCDR
(check
))||
213 (CONSP
(XCDR
(check
))
214 && INTEGERP
(XCAR
(XCDR
(check
)))
215 && NILP
(XCDR
(XCDR
(check
))))))
218 Fsignal
(Qquit
, Fcons
(build_string
(
219 "invalid data returned by selection
-conversion
function"
),
220 Fcons
(handler_fn
, Fcons
(value
, Qnil
))));
225 ns_get_foreign_selection
(Lisp_Object symbol
, Lisp_Object target
)
228 pb
=[NSPasteboard pasteboardWithName
: symbol_to_nsstring
(symbol
)];
229 return ns_string_from_pasteboard
(pb
);
234 ns_handle_selection_request
(struct input_event
*event
)
237 NSString
*type =(NSString
*)event
->y
;
238 Lisp_Object selection_name
, selection_data
, target_symbol
, data
;
239 Lisp_Object successful_p
, rest
;
241 selection_name
=ns_string_to_symbol
([(NSPasteboard
*)pb name
]);
242 target_symbol
=ns_string_to_symbol
(type);
243 selection_data
= assq_no_quit
(selection_name
, Vselection_alist
);
246 if (!NILP
(selection_data
))
248 data
= ns_get_local_selection
(selection_name
, target_symbol
);
252 ns_string_to_pasteboard_internal
(pb
, data
, type);
257 if (!EQ
(Vns_sent_selection_hooks
, Qunbound
))
259 for (rest
=Vns_sent_selection_hooks
;CONSP
(rest
); rest
=Fcdr
(rest
))
260 call3
(Fcar
(rest
), selection_name
, target_symbol
, successful_p
);
266 ns_handle_selection_clear
(struct input_event
*event
)
268 id pb
= (id
)event
->x
;
269 Lisp_Object selection_name
, selection_data
, rest
;
271 selection_name
=ns_string_to_symbol
([(NSPasteboard
*)pb name
]);
272 selection_data
=assq_no_quit
(selection_name
, Vselection_alist
);
273 if (NILP
(selection_data
)) return;
275 if (EQ
(selection_data
, Fcar
(Vselection_alist
)))
276 Vselection_alist
= Fcdr
(Vselection_alist
);
279 for (rest
= Vselection_alist
; !NILP
(rest
); rest
= Fcdr
(rest
))
280 if (EQ
(selection_data
, Fcar
(Fcdr
(rest
))))
281 Fsetcdr
(rest
, Fcdr
(Fcdr
(rest
)));
284 if (!EQ
(Vns_lost_selection_hooks
, Qunbound
))
286 for (rest
=Vns_lost_selection_hooks
;CONSP
(rest
); rest
=Fcdr
(rest
))
287 call1
(Fcar
(rest
), selection_name
);
293 /* ==========================================================================
295 Functions used externally
297 ========================================================================== */
301 ns_string_from_pasteboard
(id pb
)
303 NSString
*type, *str
;
306 type = [pb availableTypeFromArray
: ns_return_types
];
310 Fcons
(build_string
("empty or unsupported pasteboard
type"
),
316 if (! (str
= [pb stringForType
: type]))
318 NSData
*data
= [pb dataForType
: type];
320 str
= [[NSString alloc
] initWithData
: data
321 encoding
: NSUTF8StringEncoding
];
329 Fcons
(build_string
("pasteboard doesn
't contain valid data"),
338 /* EOL conversion: PENDING- is this too simple? */
339 NSMutableString *mstr = [[str mutableCopy] autorelease];
340 [mstr replaceOccurrencesOfString: @"\r\n" withString: @"\n"
341 options: NSLiteralSearch range: NSMakeRange (0, [mstr length])];
342 [mstr replaceOccurrencesOfString: @"\r" withString: @"\n"
343 options: NSLiteralSearch range: NSMakeRange (0, [mstr length])];
345 utfStr = [mstr UTF8String];
347 utfStr = [mstr cString];
351 message1 ("ns_string_from_pasteboard: UTF8String failed\n");
352 utfStr = [str lossyCString];
356 return build_string (utfStr);
361 ns_string_to_pasteboard (id pb, Lisp_Object str)
363 ns_string_to_pasteboard_internal (pb, str, nil);
368 /* ==========================================================================
372 ========================================================================== */
375 DEFUN ("ns-own-selection-internal", Fns_own_selection_internal,
376 Sns_own_selection_internal, 2, 2, 0, "Assert a selection.")
377 (selection_name, selection_value)
378 Lisp_Object selection_name, selection_value;
381 Lisp_Object old_value, new_value;
384 CHECK_SYMBOL (selection_name);
385 if (NILP (selection_value))
386 error ("selection-value may not be nil.");
387 pb =[NSPasteboard pasteboardWithName: symbol_to_nsstring (selection_name)];
388 ns_declare_pasteboard (pb);
389 old_value =assq_no_quit (selection_name, Vselection_alist);
390 new_value = Fcons (selection_name, Fcons (selection_value, Qnil));
391 if (NILP (old_value))
392 Vselection_alist =Fcons (new_value, Vselection_alist);
394 Fsetcdr (old_value, Fcdr (new_value));
395 /* XXX An evil hack, but a necessary one I fear XXX */
397 struct input_event ev;
398 ev.kind = SELECTION_REQUEST_EVENT;
402 ev.y = (int)NSStringPboardType;
403 ns_handle_selection_request (&ev);
405 return selection_value;
409 DEFUN ("ns-disown-selection-internal", Fns_disown_selection_internal,
410 Sns_disown_selection_internal, 1, 2, 0,
411 "If we own the selection SELECTION, disown it.")
412 (selection_name, time)
413 Lisp_Object selection_name, time;
417 CHECK_SYMBOL (selection_name);
418 if (NILP (assq_no_quit (selection_name, Vselection_alist))) return Qnil;
420 pb =[NSPasteboard pasteboardWithName: symbol_to_nsstring (selection_name)];
421 ns_undeclare_pasteboard (pb);
426 DEFUN ("ns-selection-exists-p", Fns_selection_exists_p, Sns_selection_exists_p,
427 0, 1, 0, "Whether there is an owner for the given selection.\n\
428 The arg should be the name of the selection in question, typically one of\n\
429 the symbols `PRIMARY', `SECONDARY
', or `CLIPBOARD'.
\n\
430 \
(Those are literal
upper-case symbol names.
)\n\
431 For convenience
, the symbol nil is the same as `PRIMARY
',\n\
432 and t is the same as `SECONDARY'.
)"
)
434 Lisp_Object selection
;
440 CHECK_SYMBOL
(selection
);
441 if (EQ
(selection
, Qnil
)) selection
= QPRIMARY
;
442 if (EQ
(selection
, Qt
)) selection
= QSECONDARY
;
443 pb
=[NSPasteboard pasteboardWithName
: symbol_to_nsstring
(selection
)];
445 return ([types count
] == 0) ? Qnil
: Qt
;
449 DEFUN
("ns
-selection
-owner
-p"
, Fns_selection_owner_p
, Sns_selection_owner_p
,
451 "Whether the current Emacs process owns the given selection.
\n\
452 The arg should be the name of the selection in question
, typically one of
\n\
453 the symbols `PRIMARY
', `SECONDARY', or `CLIPBOARD
'.\n\
454 \(Those are literal upper-case symbol names.)\n\
455 For convenience, the symbol nil is the same as `PRIMARY',\n\
456 and t is the same as `SECONDARY
'.)")
458 Lisp_Object selection;
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 ("ns-get-selection-internal", Fns_get_selection_internal,
469 Sns_get_selection_internal, 2, 2, 0,
470 "Return text selected from some pasteboard.\n\
471 SELECTION is a symbol, typically `PRIMARY', `SECONDARY
', or `CLIPBOARD'.
\n\
472 \
(Those are literal
upper-case symbol names.
)\n\
473 TYPE is the
type of data desired
, typically `STRING
'.")
474 (selection_name, target_type)
475 Lisp_Object selection_name, target_type;
480 CHECK_SYMBOL (selection_name);
481 CHECK_SYMBOL (target_type);
482 val = ns_get_local_selection (selection_name, target_type);
484 val = ns_get_foreign_selection (selection_name, target_type);
485 if (CONSP (val) && SYMBOLP (Fcar (val)))
488 if (CONSP (val) && NILP (Fcdr (val)))
491 val = clean_local_selection_data (val);
496 #ifdef CUT_BUFFER_SUPPORT
497 DEFUN ("ns-get-cut-buffer-internal", Fns_get_cut_buffer_internal,
498 Sns_get_cut_buffer_internal, 1, 1, 0,
499 "Returns the value of the named cut buffer.")
505 pb =[NSPasteboard pasteboardWithName: symbol_to_nsstring (buffer)];
506 return ns_string_from_pasteboard (pb);
510 DEFUN ("ns-rotate-cut-buffers-internal", Fns_rotate_cut_buffers_internal,
511 Sns_rotate_cut_buffers_internal, 1, 1, 0,
512 "Rotate the values of the cut buffers by the given number of steps;\n\
513 positive means move values forward, negative means backward. CURRENTLY NOT IMPLEMENTED UNDER NeXTstep.")
517 /* XXX This function is unimplemented under NeXTstep XXX */
518 Fsignal (Qquit, Fcons (build_string (
519 "Warning: ns-rotate-cut-buffers-internal not implemented\n"), Qnil));
524 DEFUN ("ns-store-cut-buffer-internal", Fns_store_cut_buffer_internal,
525 Sns_store_cut_buffer_internal, 2, 2, 0,
526 "Sets the value of the named cut buffer (typically CUT_BUFFER0).")
528 Lisp_Object buffer, string;
532 pb =[NSPasteboard pasteboardWithName: symbol_to_nsstring (buffer)];
533 ns_string_to_pasteboard (pb, string);
540 nxatoms_of_nsselect (void)
542 NXSecondaryPboard = @"Selection";
546 syms_of_nsselect (void)
548 QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY);
549 QSECONDARY = intern ("SECONDARY"); staticpro (&QSECONDARY);
550 QTEXT = intern ("TEXT"); staticpro (&QTEXT);
551 QFILE_NAME = intern ("FILE_NAME"); staticpro (&QFILE_NAME);
553 defsubr (&Sns_disown_selection_internal);
554 defsubr (&Sns_get_selection_internal);
555 defsubr (&Sns_own_selection_internal);
556 defsubr (&Sns_selection_exists_p);
557 defsubr (&Sns_selection_owner_p);
558 #ifdef CUT_BUFFER_SUPPORT
559 defsubr (&Sns_get_cut_buffer_internal);
560 defsubr (&Sns_rotate_cut_buffers_internal);
561 defsubr (&Sns_store_cut_buffer_internal);
564 Vselection_alist = Qnil;
565 staticpro (&Vselection_alist);
567 DEFVAR_LISP ("ns-sent-selection-hooks", &Vns_sent_selection_hooks,
568 "A list of functions to be called when Emacs answers a selection request.\n\
569 The functions are called with four arguments:\n\
570 - the selection name (typically `PRIMARY', `SECONDARY
', or `CLIPBOARD');\n\
571 - the selection
-type which Emacs was asked to convert the
\n\
572 selection into before sending
(for example
, `STRING
' or `LENGTH');\n\
573 - a
flag indicating success or failure
for responding to the request.
\n\
574 We might have failed
(and declined the request
) for any number of reasons
,\n\
575 including being asked
for a selection that we no longer own
, or being asked
\n\
576 to convert into a
type that we don
't know about or that is inappropriate.\n\
577 This hook doesn't let you change the behavior of Emacs
's selection replies,\n\
578 it merely informs you that they have happened.");
579 Vns_sent_selection_hooks = Qnil;
581 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
582 "An alist associating X Windows selection-types with functions.\n\
583 These functions are called to convert the selection, with three args:\n\
584 the name of the selection (typically `PRIMARY', `SECONDARY
', or `CLIPBOARD');\n\
585 a desired
type to
which the selection should be converted
;\n\
586 and the local selection value
(whatever was given to `x
-own
-selection
').\n\
588 The function should return the value to send to the X server\n\
589 \(typically a string). A return value of nil\n\
590 means that the conversion could not be done.\n\
591 A return value which is the symbol `NULL'\n\
592 means that a side
-effect was executed
,\n\
593 and there is no meaningful selection value."
);
594 Vselection_converter_alist
= Qnil
;
596 DEFVAR_LISP
("ns
-lost
-selection
-hooks"
, &Vns_lost_selection_hooks
,
597 "A list of functions to be called when Emacs loses an X selection.
\n\
598 \
(This happens when some other X client makes its own selection
\n\
599 or when a Lisp program explicitly clears the selection.
)\n\
600 The functions are called with one argument
, the selection
type\n\
601 \
(a symbol
, typically `PRIMARY
', `SECONDARY', or `CLIPBOARD
').");
602 Vns_lost_selection_hooks = Qnil;
605 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
606 doc: /* Coding system for communicating with other programs.
607 When sending or receiving text via cut_buffer, selection, and clipboard,
608 the text is encoded or decoded by this coding system.
609 The default value is determined by the system script code. */);
610 Vselection_coding_system = Qnil;
612 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
613 doc: /* Coding system for the next communication with other programs.
614 Usually, `selection-coding-system' is used
for communicating with
615 other programs. But
, if this variable is
set, it is used
for the
616 next communication only. After the communication
, this variable is
618 Vnext_selection_coding_system
= Qnil
;
620 Qforeign_selection
= intern
("foreign
-selection"
);
621 staticpro
(&Qforeign_selection
);