1/* NeXT/Open/GNUstep / macOS Cocoa selection processing for emacs.
2   Copyright (C) 1993-1994, 2005-2006, 2008-2021 Free Software
3   Foundation, Inc.
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software: you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation, either version 3 of the License, or (at
10your option) any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
19
20/*
21Originally by Carl Edman
22Updated by Christian Limpach (chris@nice.ch)
23OpenStep/Rhapsody port by Scott Bender (sbender@harmony-ds.com)
24macOS/Aqua port by Christophe de Dinechin (descubes@earthlink.net)
25GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu)
26*/
27
28/* This should be the first include, as it may set up #defines affecting
29   interpretation of even the system includes.  */
30#include <config.h>
31
32#include "lisp.h"
33#include "nsterm.h"
34#include "termhooks.h"
35#include "keyboard.h"
36
37static Lisp_Object Vselection_alist;
38
39/* NSPasteboardNameGeneral is pretty much analogous to X11 CLIPBOARD.  */
40static NSString *NXPrimaryPboard;
41static NSString *NXSecondaryPboard;
42
43
44static NSMutableDictionary *pasteboard_changecount;
45
46/* ==========================================================================
47
48    Internal utility functions
49
50   ========================================================================== */
51
52
53static NSString *
54symbol_to_nsstring (Lisp_Object sym)
55{
56  CHECK_SYMBOL (sym);
57  if (EQ (sym, QCLIPBOARD))   return NSPasteboardNameGeneral;
58  if (EQ (sym, QPRIMARY))     return NXPrimaryPboard;
59  if (EQ (sym, QSECONDARY))   return NXSecondaryPboard;
60  if (EQ (sym, QTEXT))        return NSPasteboardTypeString;
61  return [NSString stringWithUTF8String: SSDATA (SYMBOL_NAME (sym))];
62}
63
64static NSPasteboard *
65ns_symbol_to_pb (Lisp_Object symbol)
66{
67  return [NSPasteboard pasteboardWithName: symbol_to_nsstring (symbol)];
68}
69
70static Lisp_Object
71ns_string_to_symbol (NSString *t)
72{
73  if ([t isEqualToString: NSPasteboardNameGeneral])
74    return QCLIPBOARD;
75  if ([t isEqualToString: NXPrimaryPboard])
76    return QPRIMARY;
77  if ([t isEqualToString: NXSecondaryPboard])
78    return QSECONDARY;
79  if ([t isEqualToString: NSPasteboardTypeString])
80    return QTEXT;
81  if ([t isEqualToString: NSFilenamesPboardType])
82    return QFILE_NAME;
83  if ([t isEqualToString: NSPasteboardTypeTabularText])
84    return QTEXT;
85  return intern ([t UTF8String]);
86}
87
88
89static Lisp_Object
90clean_local_selection_data (Lisp_Object obj)
91{
92  if (CONSP (obj)
93      && FIXNUMP (XCAR (obj))
94      && CONSP (XCDR (obj))
95      && FIXNUMP (XCAR (XCDR (obj)))
96      && NILP (XCDR (XCDR (obj))))
97    obj = Fcons (XCAR (obj), XCDR (obj));
98
99  if (CONSP (obj)
100      && FIXNUMP (XCAR (obj))
101      && FIXNUMP (XCDR (obj)))
102    {
103      if (XFIXNUM (XCAR (obj)) == 0)
104        return XCDR (obj);
105      if (XFIXNUM (XCAR (obj)) == -1)
106        return make_fixnum (- XFIXNUM (XCDR (obj)));
107    }
108
109  if (VECTORP (obj))
110    {
111      ptrdiff_t i;
112      ptrdiff_t size = ASIZE (obj);
113      Lisp_Object copy;
114
115      if (size == 1)
116        return clean_local_selection_data (AREF (obj, 0));
117      copy = make_uninit_vector (size);
118      for (i = 0; i < size; i++)
119        ASET (copy, i, clean_local_selection_data (AREF (obj, i)));
120      return copy;
121    }
122
123  return obj;
124}
125
126
127static void
128ns_declare_pasteboard (id pb)
129{
130  [pb declareTypes: ns_send_types owner: NSApp];
131}
132
133
134static void
135ns_undeclare_pasteboard (id pb)
136{
137  [pb declareTypes: [NSArray array] owner: nil];
138}
139
140static void
141ns_store_pb_change_count (id pb)
142{
143  [pasteboard_changecount
144        setObject: [NSNumber numberWithLong: [pb changeCount]]
145           forKey: [pb name]];
146}
147
148static NSInteger
149ns_get_pb_change_count (Lisp_Object selection)
150{
151  id pb = ns_symbol_to_pb (selection);
152  return pb != nil ? [pb changeCount] : -1;
153}
154
155static NSInteger
156ns_get_our_change_count_for (Lisp_Object selection)
157{
158  NSNumber *num = [pasteboard_changecount
159                    objectForKey: symbol_to_nsstring (selection)];
160  return num != nil ? (NSInteger)[num longValue] : -1;
161}
162
163
164static void
165ns_string_to_pasteboard_internal (id pb, Lisp_Object str, NSString *gtype)
166{
167  if (NILP (str))
168    {
169      [pb declareTypes: [NSArray array] owner: nil];
170    }
171  else
172    {
173      char *utfStr;
174      NSString *type, *nsStr;
175      NSEnumerator *tenum;
176
177      CHECK_STRING (str);
178
179      utfStr = SSDATA (str);
180      nsStr = [[NSString alloc] initWithBytesNoCopy: utfStr
181                                             length: SBYTES (str)
182                                           encoding: NSUTF8StringEncoding
183                                       freeWhenDone: NO];
184      // FIXME: Why those 2 different code paths?
185      if (gtype == nil)
186        {
187	  // Used for ns_string_to_pasteboard
188          [pb declareTypes: ns_send_types owner: nil];
189          tenum = [ns_send_types objectEnumerator];
190          while ( (type = [tenum nextObject]) )
191            [pb setString: nsStr forType: type];
192        }
193      else
194        {
195	  // Used for ns-own-selection-internal.
196	  eassert (gtype == NSPasteboardTypeString);
197          [pb setString: nsStr forType: gtype];
198        }
199      [nsStr release];
200      ns_store_pb_change_count (pb);
201    }
202}
203
204
205Lisp_Object
206ns_get_local_selection (Lisp_Object selection_name,
207                        Lisp_Object target_type)
208{
209  Lisp_Object local_value;
210  local_value = assq_no_quit (selection_name, Vselection_alist);
211  return local_value;
212}
213
214
215static Lisp_Object
216ns_get_foreign_selection (Lisp_Object symbol, Lisp_Object target)
217{
218  id pb;
219  pb = ns_symbol_to_pb (symbol);
220  return pb != nil ? ns_string_from_pasteboard (pb) : Qnil;
221}
222
223
224
225
226/* ==========================================================================
227
228    Functions used externally
229
230   ========================================================================== */
231
232
233Lisp_Object
234ns_string_from_pasteboard (id pb)
235{
236  NSString *type, *str;
237  const char *utfStr;
238  int length;
239
240  type = [pb availableTypeFromArray: ns_return_types];
241  if (type == nil)
242    {
243      return Qnil;
244    }
245
246  /* get the string */
247  if (! (str = [pb stringForType: type]))
248    {
249      NSData *data = [pb dataForType: type];
250      if (data != nil)
251        str = [[NSString alloc] initWithData: data
252                                    encoding: NSUTF8StringEncoding];
253      if (str != nil)
254        {
255          [str autorelease];
256        }
257      else
258        {
259          return Qnil;
260        }
261    }
262
263  /* assume UTF8 */
264  NS_DURING
265    {
266      /* EOL conversion: PENDING- is this too simple? */
267      NSMutableString *mstr = [[str mutableCopy] autorelease];
268      [mstr replaceOccurrencesOfString: @"\r\n" withString: @"\n"
269            options: NSLiteralSearch range: NSMakeRange (0, [mstr length])];
270      [mstr replaceOccurrencesOfString: @"\r" withString: @"\n"
271            options: NSLiteralSearch range: NSMakeRange (0, [mstr length])];
272
273      utfStr = [mstr UTF8String];
274      length = [mstr lengthOfBytesUsingEncoding: NSUTF8StringEncoding];
275
276#if ! defined (NS_IMPL_COCOA)
277      if (!utfStr)
278        {
279          utfStr = [mstr cString];
280          length = strlen (utfStr);
281        }
282#endif
283    }
284  NS_HANDLER
285    {
286      message1 ("ns_string_from_pasteboard: UTF8String failed\n");
287#if defined (NS_IMPL_COCOA)
288      utfStr = "Conversion failed";
289#else
290      utfStr = [str lossyCString];
291#endif
292      length = strlen (utfStr);
293    }
294  NS_ENDHANDLER
295
296    return make_string (utfStr, length);
297}
298
299
300void
301ns_string_to_pasteboard (id pb, Lisp_Object str)
302{
303  ns_string_to_pasteboard_internal (pb, str, nil);
304}
305
306
307
308/* ==========================================================================
309
310    Lisp Defuns
311
312   ========================================================================== */
313
314
315DEFUN ("ns-own-selection-internal", Fns_own_selection_internal,
316       Sns_own_selection_internal, 2, 2, 0,
317       doc: /* Assert an X selection of type SELECTION and value VALUE.
318SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
319\(Those are literal upper-case symbol names, since that's what X expects.)
320VALUE is typically a string, or a cons of two markers, but may be
321anything that the functions on `selection-converter-alist' know about.  */)
322     (Lisp_Object selection, Lisp_Object value)
323{
324  id pb;
325  NSString *type;
326  Lisp_Object successful_p = Qnil, rest;
327  Lisp_Object target_symbol;
328
329  check_window_system (NULL);
330  CHECK_SYMBOL (selection);
331  if (NILP (value))
332    error ("Selection value may not be nil");
333  pb = ns_symbol_to_pb (selection);
334  if (pb == nil) return Qnil;
335
336  ns_declare_pasteboard (pb);
337  {
338    Lisp_Object old_value = assq_no_quit (selection, Vselection_alist);
339    Lisp_Object new_value = list2 (selection, value);
340
341    if (NILP (old_value))
342      Vselection_alist = Fcons (new_value, Vselection_alist);
343    else
344      Fsetcdr (old_value, Fcdr (new_value));
345  }
346
347  /* We only support copy of text.  */
348  type = NSPasteboardTypeString;
349  target_symbol = ns_string_to_symbol (type);
350  if (STRINGP (value))
351    {
352      ns_string_to_pasteboard_internal (pb, value, type);
353      successful_p = Qt;
354    }
355
356  if (!EQ (Vns_sent_selection_hooks, Qunbound))
357    {
358      /* FIXME: Use run-hook-with-args!  */
359      for (rest = Vns_sent_selection_hooks; CONSP (rest); rest = Fcdr (rest))
360        call3 (Fcar (rest), selection, target_symbol, successful_p);
361    }
362
363  return value;
364}
365
366
367DEFUN ("ns-disown-selection-internal", Fns_disown_selection_internal,
368       Sns_disown_selection_internal, 1, 1, 0,
369       doc: /* If we own the selection SELECTION, disown it.
370Disowning it means there is no such selection.  */)
371  (Lisp_Object selection)
372{
373  id pb;
374  check_window_system (NULL);
375  CHECK_SYMBOL (selection);
376
377  if (ns_get_pb_change_count (selection)
378      != ns_get_our_change_count_for (selection))
379      return Qnil;
380
381  pb = ns_symbol_to_pb (selection);
382  if (pb != nil) ns_undeclare_pasteboard (pb);
383  return Qt;
384}
385
386
387DEFUN ("ns-selection-exists-p", Fns_selection_exists_p, Sns_selection_exists_p,
388       0, 1, 0, doc: /* Whether there is an owner for the given X selection.
389SELECTION should be the name of the selection in question, typically
390one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.  (X expects
391these literal upper-case names.)  The symbol nil is the same as
392`PRIMARY', and t is the same as `SECONDARY'.  */)
393     (Lisp_Object selection)
394{
395  id pb;
396  NSArray *types;
397
398  if (!window_system_available (NULL))
399    return Qnil;
400
401  CHECK_SYMBOL (selection);
402  if (NILP (selection)) selection = QPRIMARY;
403  if (EQ (selection, Qt)) selection = QSECONDARY;
404  pb = ns_symbol_to_pb (selection);
405  if (pb == nil) return Qnil;
406
407  types = [pb types];
408  return ([types count] == 0) ? Qnil : Qt;
409}
410
411
412DEFUN ("ns-selection-owner-p", Fns_selection_owner_p, Sns_selection_owner_p,
413       0, 1, 0,
414       doc: /* Whether the current Emacs process owns the given X Selection.
415The arg should be the name of the selection in question, typically one of
416the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
417\(Those are literal upper-case symbol names, since that's what X expects.)
418For convenience, the symbol nil is the same as `PRIMARY',
419and t is the same as `SECONDARY'.  */)
420     (Lisp_Object selection)
421{
422  check_window_system (NULL);
423  CHECK_SYMBOL (selection);
424  if (NILP (selection)) selection = QPRIMARY;
425  if (EQ (selection, Qt)) selection = QSECONDARY;
426  return ns_get_pb_change_count (selection)
427    == ns_get_our_change_count_for (selection)
428    ? Qt : Qnil;
429}
430
431
432DEFUN ("ns-get-selection", Fns_get_selection,
433       Sns_get_selection, 2, 2, 0,
434       doc: /* Return text selected from some X window.
435SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
436\(Those are literal upper-case symbol names, since that's what X expects.)
437TARGET-TYPE is the type of data desired, typically `STRING'.  */)
438     (Lisp_Object selection_name, Lisp_Object target_type)
439{
440  Lisp_Object val = Qnil;
441
442  check_window_system (NULL);
443  CHECK_SYMBOL (selection_name);
444  CHECK_SYMBOL (target_type);
445
446  if (ns_get_pb_change_count (selection_name)
447      == ns_get_our_change_count_for (selection_name))
448      val = ns_get_local_selection (selection_name, target_type);
449  if (NILP (val))
450    val = ns_get_foreign_selection (selection_name, target_type);
451  if (CONSP (val) && SYMBOLP (Fcar (val)))
452    {
453      val = Fcdr (val);
454      if (CONSP (val) && NILP (Fcdr (val)))
455        val = Fcar (val);
456    }
457  val = clean_local_selection_data (val);
458  return val;
459}
460
461
462void
463nxatoms_of_nsselect (void)
464{
465  NXPrimaryPboard = @"Selection";
466  NXSecondaryPboard = @"Secondary";
467
468  // This is a memory loss, never released.
469  pasteboard_changecount
470    = [[NSMutableDictionary
471	 dictionaryWithObjectsAndKeys:
472	     [NSNumber numberWithLong:0], NSPasteboardNameGeneral,
473	     [NSNumber numberWithLong:0], NXPrimaryPboard,
474	     [NSNumber numberWithLong:0], NXSecondaryPboard,
475	     [NSNumber numberWithLong:0], NSPasteboardTypeString,
476	     [NSNumber numberWithLong:0], NSFilenamesPboardType,
477	     [NSNumber numberWithLong:0], NSPasteboardTypeTabularText,
478	 nil] retain];
479}
480
481void
482syms_of_nsselect (void)
483{
484  DEFSYM (QCLIPBOARD, "CLIPBOARD");
485  DEFSYM (QSECONDARY, "SECONDARY");
486  DEFSYM (QTEXT, "TEXT");
487  DEFSYM (QFILE_NAME, "FILE_NAME");
488
489  defsubr (&Sns_disown_selection_internal);
490  defsubr (&Sns_get_selection);
491  defsubr (&Sns_own_selection_internal);
492  defsubr (&Sns_selection_exists_p);
493  defsubr (&Sns_selection_owner_p);
494
495  Vselection_alist = Qnil;
496  staticpro (&Vselection_alist);
497
498  DEFVAR_LISP ("ns-sent-selection-hooks", Vns_sent_selection_hooks,
499               "A list of functions to be called when Emacs answers a selection request.\n\
500The functions are called with four arguments:\n\
501  - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
502  - the selection-type which Emacs was asked to convert the\n\
503    selection into before sending (for example, `STRING' or `LENGTH');\n\
504  - a flag indicating success or failure for responding to the request.\n\
505We might have failed (and declined the request) for any number of reasons,\n\
506including being asked for a selection that we no longer own, or being asked\n\
507to convert into a type that we don't know about or that is inappropriate.\n\
508This hook doesn't let you change the behavior of Emacs's selection replies,\n\
509it merely informs you that they have happened.");
510  Vns_sent_selection_hooks = Qnil;
511}
512