nsselect.m 14.4 KB
Newer Older
1
/* NeXT/Open/GNUstep / macOS Cocoa selection processing for emacs.
Paul Eggert's avatar
Paul Eggert committed
2
   Copyright (C) 1993-1994, 2005-2006, 2008-2019 Free Software
3
   Foundation, Inc.
4 5 6

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 10
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
11 12 13 14 15 16 17

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
18
along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
19

20
/*
21 22 23
Originally by Carl Edman
Updated by Christian Limpach (chris@nice.ch)
OpenStep/Rhapsody port by Scott Bender (sbender@harmony-ds.com)
24
macOS/Aqua port by Christophe de Dinechin (descubes@earthlink.net)
25 26 27
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.  */
Dan Nicolaescu's avatar
Dan Nicolaescu committed
30
#include <config.h>
31

32 33 34
#include "lisp.h"
#include "nsterm.h"
#include "termhooks.h"
35
#include "keyboard.h"
36

Tom Tromey's avatar
Tom Tromey committed
37 38
static Lisp_Object Vselection_alist;

39
/* NSPasteboardNameGeneral is pretty much analogous to X11 CLIPBOARD.  */
40 41
static NSString *NXPrimaryPboard;
static NSString *NXSecondaryPboard;
42 43


44
static NSMutableDictionary *pasteboard_changecount;
45 46 47 48 49 50 51 52 53 54 55 56

/* ==========================================================================

    Internal utility functions

   ========================================================================== */


static NSString *
symbol_to_nsstring (Lisp_Object sym)
{
  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
}

64 65 66 67 68
static NSPasteboard *
ns_symbol_to_pb (Lisp_Object symbol)
{
  return [NSPasteboard pasteboardWithName: symbol_to_nsstring (symbol)];
}
69 70 71 72

static Lisp_Object
ns_string_to_symbol (NSString *t)
{
73
  if ([t isEqualToString: NSPasteboardNameGeneral])
74 75
    return QCLIPBOARD;
  if ([t isEqualToString: NXPrimaryPboard])
76 77 78
    return QPRIMARY;
  if ([t isEqualToString: NXSecondaryPboard])
    return QSECONDARY;
79
  if ([t isEqualToString: NSPasteboardTypeString])
80 81 82
    return QTEXT;
  if ([t isEqualToString: NSFilenamesPboardType])
    return QFILE_NAME;
83
  if ([t isEqualToString: NSPasteboardTypeTabularText])
84 85 86 87 88 89 90 91 92
    return QTEXT;
  return intern ([t UTF8String]);
}


static Lisp_Object
clean_local_selection_data (Lisp_Object obj)
{
  if (CONSP (obj)
93
      && FIXNUMP (XCAR (obj))
94
      && CONSP (XCDR (obj))
95
      && FIXNUMP (XCAR (XCDR (obj)))
96 97 98 99
      && NILP (XCDR (XCDR (obj))))
    obj = Fcons (XCAR (obj), XCDR (obj));

  if (CONSP (obj)
100 101
      && FIXNUMP (XCAR (obj))
      && FIXNUMP (XCDR (obj)))
102
    {
103
      if (XFIXNUM (XCAR (obj)) == 0)
104
        return XCDR (obj);
105 106
      if (XFIXNUM (XCAR (obj)) == -1)
        return make_fixnum (- XFIXNUM (XCDR (obj)));
107 108 109 110
    }

  if (VECTORP (obj))
    {
111 112
      ptrdiff_t i;
      ptrdiff_t size = ASIZE (obj);
113 114 115
      Lisp_Object copy;

      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 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139
      return copy;
    }

  return obj;
}


static void
ns_declare_pasteboard (id pb)
{
  [pb declareTypes: ns_send_types owner: NSApp];
}


static void
ns_undeclare_pasteboard (id pb)
{
  [pb declareTypes: [NSArray array] owner: nil];
}

140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
static void
ns_store_pb_change_count (id pb)
{
  [pasteboard_changecount
        setObject: [NSNumber numberWithLong: [pb changeCount]]
           forKey: [pb name]];
}

static NSInteger
ns_get_pb_change_count (Lisp_Object selection)
{
  id pb = ns_symbol_to_pb (selection);
  return pb != nil ? [pb changeCount] : -1;
}

static NSInteger
ns_get_our_change_count_for (Lisp_Object selection)
{
  NSNumber *num = [pasteboard_changecount
                    objectForKey: symbol_to_nsstring (selection)];
  return num != nil ? (NSInteger)[num longValue] : -1;
}

163 164 165 166

static void
ns_string_to_pasteboard_internal (id pb, Lisp_Object str, NSString *gtype)
{
Paul Eggert's avatar
Paul Eggert committed
167
  if (NILP (str))
168 169 170 171 172 173 174 175 176 177 178
    {
      [pb declareTypes: [NSArray array] owner: nil];
    }
  else
    {
      char *utfStr;
      NSString *type, *nsStr;
      NSEnumerator *tenum;

      CHECK_STRING (str);

179
      utfStr = SSDATA (str);
180 181 182 183
      nsStr = [[NSString alloc] initWithBytesNoCopy: utfStr
                                             length: SBYTES (str)
                                           encoding: NSUTF8StringEncoding
                                       freeWhenDone: NO];
184
      // FIXME: Why those 2 different code paths?
185 186
      if (gtype == nil)
        {
187
	  // Used for ns_string_to_pasteboard
188 189 190 191 192 193 194
          [pb declareTypes: ns_send_types owner: nil];
          tenum = [ns_send_types objectEnumerator];
          while ( (type = [tenum nextObject]) )
            [pb setString: nsStr forType: type];
        }
      else
        {
195
	  // Used for ns-own-selection-internal.
196
	  eassert (gtype == NSPasteboardTypeString);
197 198
          [pb setString: nsStr forType: gtype];
        }
199
      [nsStr release];
200
      ns_store_pb_change_count (pb);
201 202 203 204
    }
}


205
Lisp_Object
206
ns_get_local_selection (Lisp_Object selection_name,
207
                        Lisp_Object target_type)
208 209 210
{
  Lisp_Object local_value;
  local_value = assq_no_quit (selection_name, Vselection_alist);
211
  return local_value;
212 213 214 215 216 217 218
}


static Lisp_Object
ns_get_foreign_selection (Lisp_Object symbol, Lisp_Object target)
{
  id pb;
219 220
  pb = ns_symbol_to_pb (symbol);
  return pb != nil ? ns_string_from_pasteboard (pb) : Qnil;
221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237
}




/* ==========================================================================

    Functions used externally

   ========================================================================== */


Lisp_Object
ns_string_from_pasteboard (id pb)
{
  NSString *type, *str;
  const char *utfStr;
238
  int length;
239 240 241 242

  type = [pb availableTypeFromArray: ns_return_types];
  if (type == nil)
    {
243
      return Qnil;
244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273
    }

  /* get the string */
  if (! (str = [pb stringForType: type]))
    {
      NSData *data = [pb dataForType: type];
      if (data != nil)
        str = [[NSString alloc] initWithData: data
                                    encoding: NSUTF8StringEncoding];
      if (str != nil)
        {
          [str autorelease];
        }
      else
        {
          return Qnil;
        }
    }

  /* assume UTF8 */
  NS_DURING
    {
      /* EOL conversion: PENDING- is this too simple? */
      NSMutableString *mstr = [[str mutableCopy] autorelease];
      [mstr replaceOccurrencesOfString: @"\r\n" withString: @"\n"
            options: NSLiteralSearch range: NSMakeRange (0, [mstr length])];
      [mstr replaceOccurrencesOfString: @"\r" withString: @"\n"
            options: NSLiteralSearch range: NSMakeRange (0, [mstr length])];

      utfStr = [mstr UTF8String];
274 275
      length = [mstr lengthOfBytesUsingEncoding: NSUTF8StringEncoding];

276
#if ! defined (NS_IMPL_COCOA)
277
      if (!utfStr)
278 279 280 281
        {
          utfStr = [mstr cString];
          length = strlen (utfStr);
        }
282
#endif
283 284 285 286
    }
  NS_HANDLER
    {
      message1 ("ns_string_from_pasteboard: UTF8String failed\n");
287
#if defined (NS_IMPL_COCOA)
288 289
      utfStr = "Conversion failed";
#else
290
      utfStr = [str lossyCString];
291
#endif
292
      length = strlen (utfStr);
293 294 295
    }
  NS_ENDHANDLER

296
    return make_string (utfStr, length);
297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314
}


void
ns_string_to_pasteboard (id pb, Lisp_Object str)
{
  ns_string_to_pasteboard_internal (pb, str, nil);
}



/* ==========================================================================

    Lisp Defuns

   ========================================================================== */


315 316
DEFUN ("ns-own-selection-internal", Fns_own_selection_internal,
       Sns_own_selection_internal, 2, 2, 0,
317 318
       doc: /* Assert an X selection of type SELECTION and value VALUE.
SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
319
\(Those are literal upper-case symbol names, since that's what X expects.)
320
VALUE is typically a string, or a cons of two markers, but may be
321 322
anything that the functions on `selection-converter-alist' know about.  */)
     (Lisp_Object selection, Lisp_Object value)
323 324
{
  id pb;
325 326
  NSString *type;
  Lisp_Object successful_p = Qnil, rest;
327
  Lisp_Object target_symbol;
328

329
  check_window_system (NULL);
330 331
  CHECK_SYMBOL (selection);
  if (NILP (value))
332
    error ("Selection value may not be nil");
333
  pb = ns_symbol_to_pb (selection);
334 335
  if (pb == nil) return Qnil;

336
  ns_declare_pasteboard (pb);
337 338 339
  {
    Lisp_Object old_value = assq_no_quit (selection, Vselection_alist);
    Lisp_Object new_value = list2 (selection, value);
340

341 342 343 344 345
    if (NILP (old_value))
      Vselection_alist = Fcons (new_value, Vselection_alist);
    else
      Fsetcdr (old_value, Fcdr (new_value));
  }
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 354 355 356 357
      successful_p = Qt;
    }

  if (!EQ (Vns_sent_selection_hooks, Qunbound))
    {
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
}


367 368
DEFUN ("ns-disown-selection-internal", Fns_disown_selection_internal,
       Sns_disown_selection_internal, 1, 1, 0,
369
       doc: /* If we own the selection SELECTION, disown it.
370 371
Disowning it means there is no such selection.  */)
  (Lisp_Object selection)
372 373
{
  id pb;
374
  check_window_system (NULL);
375
  CHECK_SYMBOL (selection);
376 377 378 379

  if (ns_get_pb_change_count (selection)
      != ns_get_our_change_count_for (selection))
      return Qnil;
380

381
  pb = ns_symbol_to_pb (selection);
382
  if (pb != nil) ns_undeclare_pasteboard (pb);
383 384 385 386
  return Qt;
}


387
DEFUN ("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.
389 390 391
SELECTION should be the name of the selection in question, typically
one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.  (X expects
these literal upper-case names.)  The symbol nil is the same as
392 393
`PRIMARY', and t is the same as `SECONDARY'.  */)
     (Lisp_Object selection)
394 395 396 397
{
  id pb;
  NSArray *types;

398 399 400
  if (!window_system_available (NULL))
    return Qnil;

401
  CHECK_SYMBOL (selection);
Paul Eggert's avatar
Paul Eggert committed
402
  if (NILP (selection)) selection = QPRIMARY;
403
  if (EQ (selection, Qt)) selection = QSECONDARY;
404 405
  pb = ns_symbol_to_pb (selection);
  if (pb == nil) return Qnil;
406

407
  types = [pb types];
408 409 410 411
  return ([types count] == 0) ? Qnil : Qt;
}


412
DEFUN ("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.
415 416
The arg should be the name of the selection in question, typically one of
the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
417
\(Those are literal upper-case symbol names, since that's what X expects.)
418
For convenience, the symbol nil is the same as `PRIMARY',
419 420
and t is the same as `SECONDARY'.  */)
     (Lisp_Object selection)
421
{
422
  check_window_system (NULL);
423
  CHECK_SYMBOL (selection);
Paul Eggert's avatar
Paul Eggert committed
424
  if (NILP (selection)) selection = QPRIMARY;
425
  if (EQ (selection, Qt)) selection = QSECONDARY;
426
  return ns_get_pb_change_count (selection)
Didier Verna's avatar
Didier Verna committed
427 428
    == ns_get_our_change_count_for (selection)
    ? Qt : Qnil;
429 430 431
}


432
DEFUN ("ns-get-selection", Fns_get_selection,
433
       Sns_get_selection, 2, 2, 0,
434 435
       doc: /* Return text selected from some X window.
SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
436
\(Those are literal upper-case symbol names, since that's what X expects.)
437 438
TARGET-TYPE is the type of data desired, typically `STRING'.  */)
     (Lisp_Object selection_name, Lisp_Object target_type)
439
{
440
  Lisp_Object val = Qnil;
441

442
  check_window_system (NULL);
443 444
  CHECK_SYMBOL (selection_name);
  CHECK_SYMBOL (target_type);
445 446 447 448

  if (ns_get_pb_change_count (selection_name)
      == ns_get_our_change_count_for (selection_name))
      val = ns_get_local_selection (selection_name, target_type);
449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464
  if (NILP (val))
    val = ns_get_foreign_selection (selection_name, target_type);
  if (CONSP (val) && SYMBOLP (Fcar (val)))
    {
      val = Fcdr (val);
      if (CONSP (val) && NILP (Fcdr (val)))
        val = Fcar (val);
    }
  val = clean_local_selection_data (val);
  return val;
}


void
nxatoms_of_nsselect (void)
{
465 466
  NXPrimaryPboard = @"Selection";
  NXSecondaryPboard = @"Secondary";
467 468

  // This is a memory loss, never released.
469 470 471
  pasteboard_changecount
    = [[NSMutableDictionary
	 dictionaryWithObjectsAndKeys:
472
	     [NSNumber numberWithLong:0], NSPasteboardNameGeneral,
473 474
	     [NSNumber numberWithLong:0], NXPrimaryPboard,
	     [NSNumber numberWithLong:0], NXSecondaryPboard,
475
	     [NSNumber numberWithLong:0], NSPasteboardTypeString,
476
	     [NSNumber numberWithLong:0], NSFilenamesPboardType,
477
	     [NSNumber numberWithLong:0], NSPasteboardTypeTabularText,
478
	 nil] retain];
479 480 481 482 483
}

void
syms_of_nsselect (void)
{
484 485 486 487
  DEFSYM (QCLIPBOARD, "CLIPBOARD");
  DEFSYM (QSECONDARY, "SECONDARY");
  DEFSYM (QTEXT, "TEXT");
  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 496 497

  Vselection_alist = Qnil;
  staticpro (&Vselection_alist);

498
  DEFVAR_LISP ("ns-sent-selection-hooks", Vns_sent_selection_hooks,
499 500 501 502 503 504 505 506 507 508 509 510 511
               "A list of functions to be called when Emacs answers a selection request.\n\
The functions are called with four arguments:\n\
  - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
  - the selection-type which Emacs was asked to convert the\n\
    selection into before sending (for example, `STRING' or `LENGTH');\n\
  - a flag indicating success or failure for responding to the request.\n\
We might have failed (and declined the request) for any number of reasons,\n\
including being asked for a selection that we no longer own, or being asked\n\
to convert into a type that we don't know about or that is inappropriate.\n\
This hook doesn't let you change the behavior of Emacs's selection replies,\n\
it merely informs you that they have happened.");
  Vns_sent_selection_hooks = Qnil;
}