src/nsselect.m

   1 /* NeXT/Open/GNUstep / MacOSX Cocoa selection processing for emacs.
   2    Copyright (C) 1993-1994, 2005-2006, 2008-2014 Free Software
   3    Foundation, Inc.
   4
   5 This file is part of GNU Emacs.
   6
   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.
  11
  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.
  16
  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/>.  */
  19
  20 /*
  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)
  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
  37 Lisp_Object QCLIPBOARD, QSECONDARY, QTEXT, QFILE_NAME;
  38
  39 static Lisp_Object Vselection_alist;
  40
  41 static Lisp_Object Qforeign_selection;
  42
  43 /* NSGeneralPboard is pretty much analogous to X11 CLIPBOARD */
  44 NSString *NXPrimaryPboard;
  45 NSString *NXSecondaryPboard;
  46
  47
  48
  49 /* ==========================================================================
  50
  51     Internal utility functions
  52
  53    ========================================================================== */
  54
  55
  56 static NSString *
  57 symbol_to_nsstring (Lisp_Object sym)
  58 {
  59   CHECK_SYMBOL (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))];
  65 }
  66
  67 static NSPasteboard *
  68 ns_symbol_to_pb (Lisp_Object symbol)
  69 {
  70   return [NSPasteboard pasteboardWithName: symbol_to_nsstring (symbol)];
  71 }
  72
  73 static Lisp_Object
  74 ns_string_to_symbol (NSString *t)
  75 {
  76   if ([t isEqualToString: NSGeneralPboard])
  77     return QCLIPBOARD;
  78   if ([t isEqualToString: NXPrimaryPboard])
  79     return QPRIMARY;
  80   if ([t isEqualToString: NXSecondaryPboard])
  81     return QSECONDARY;
  82   if ([t isEqualToString: NSStringPboardType])
  83     return QTEXT;
  84   if ([t isEqualToString: NSFilenamesPboardType])
  85     return QFILE_NAME;
  86   if ([t isEqualToString: NSTabularTextPboardType])
  87     return QTEXT;
  88   return intern ([t UTF8String]);
  89 }
  90
  91
  92 static Lisp_Object
  93 clean_local_selection_data (Lisp_Object obj)
  94 {
  95   if (CONSP (obj)
  96       && INTEGERP (XCAR (obj))
  97       && CONSP (XCDR (obj))
  98       && INTEGERP (XCAR (XCDR (obj)))
  99       && NILP (XCDR (XCDR (obj))))
 100     obj = Fcons (XCAR (obj), XCDR (obj));
 101
 102   if (CONSP (obj)
 103       && INTEGERP (XCAR (obj))
 104       && INTEGERP (XCDR (obj)))
 105     {
 106       if (XINT (XCAR (obj)) == 0)
 107         return XCDR (obj);
 108       if (XINT (XCAR (obj)) == -1)
 109         return make_number (- XINT (XCDR (obj)));
 110     }
 111
 112   if (VECTORP (obj))
 113     {
 114       ptrdiff_t i;
 115       ptrdiff_t size = ASIZE (obj);
 116       Lisp_Object copy;
 117
 118       if (size == 1)
 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)));
 123       return copy;
 124     }
 125
 126   return obj;
 127 }
 128
 129
 130 static void
 131 ns_declare_pasteboard (id pb)
 132 {
 133   [pb declareTypes: ns_send_types owner: NSApp];
 134 }
 135
 136
 137 static void
 138 ns_undeclare_pasteboard (id pb)
 139 {
 140   [pb declareTypes: [NSArray array] owner: nil];
 141 }
 142
 143
 144 static void
 145 ns_string_to_pasteboard_internal (id pb, Lisp_Object str, NSString *gtype)
 146 {
 147   if (EQ (str, Qnil))
 148     {
 149       [pb declareTypes: [NSArray array] owner: nil];
 150     }
 151   else
 152     {
 153       char *utfStr;
 154       NSString *type, *nsStr;
 155       NSEnumerator *tenum;
 156
 157       CHECK_STRING (str);
 158
 159       utfStr = SSDATA (str);
 160       nsStr = [[NSString alloc] initWithBytesNoCopy: utfStr
 161                                              length: SBYTES (str)
 162                                            encoding: NSUTF8StringEncoding
 163                                        freeWhenDone: NO];
 164       if (gtype == nil)
 165         {
 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];
 170         }
 171       else
 172         {
 173           [pb setString: nsStr forType: gtype];
 174         }
 175       [nsStr release];
 176     }
 177 }
 178
 179
 180 Lisp_Object
 181 ns_get_local_selection (Lisp_Object selection_name,
 182                        Lisp_Object target_type)
 183 {
 184   Lisp_Object local_value;
 185   Lisp_Object handler_fn, value, check;
 186
 187   local_value = assq_no_quit (selection_name, Vselection_alist);
 188
 189   if (NILP (local_value)) return Qnil;
 190
 191   dynwind_begin ();
 192   specbind (Qinhibit_quit, Qt);
 193   CHECK_SYMBOL (target_type);
 194   handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
 195   if (!NILP (handler_fn))
 196     value = call3 (handler_fn, selection_name, target_type,
 197                 XCAR (XCDR (local_value)));
 198   else
 199     value = Qnil;
 200   dynwind_end ();
 201
 202   check = value;
 203   if (CONSP (value) && SYMBOLP (XCAR (value)))
 204     {
 205       check = XCDR (value);
 206     }
 207
 208   if (STRINGP (check) || VECTORP (check) || SYMBOLP (check)
 209       || INTEGERP (check) || NILP (value))
 210     return value;
 211
 212   if (CONSP (check)
 213       && INTEGERP (XCAR (check))
 214       && (INTEGERP (XCDR (check))||
 215           (CONSP (XCDR (check))
 216            && INTEGERP (XCAR (XCDR (check)))
 217            && NILP (XCDR (XCDR (check))))))
 218     return value;
 219
 220   // FIXME: Why `quit' rather than `error'?
 221   Fsignal (Qquit,
 222            list3 (build_string ("invalid data returned by"
 223                                 " selection-conversion function"),
 224                   handler_fn, value));
 225   // FIXME: Beware, `quit' can return!!
 226   return Qnil;
 227 }
 228
 229
 230 static Lisp_Object
 231 ns_get_foreign_selection (Lisp_Object symbol, Lisp_Object target)
 232 {
 233   id pb;
 234   pb = ns_symbol_to_pb (symbol);
 235   return pb != nil ? ns_string_from_pasteboard (pb) : Qnil;
 236 }
 237
 238
 239
 240
 241 /* ==========================================================================
 242
 243     Functions used externally
 244
 245    ========================================================================== */
 246
 247
 248 Lisp_Object
 249 ns_string_from_pasteboard (id pb)
 250 {
 251   NSString *type, *str;
 252   const char *utfStr;
 253   int length;
 254
 255   type = [pb availableTypeFromArray: ns_return_types];
 256   if (type == nil)
 257     {
 258       return Qnil;
 259     }
 260
 261   /* get the string */
 262   if (! (str = [pb stringForType: type]))
 263     {
 264       NSData *data = [pb dataForType: type];
 265       if (data != nil)
 266         str = [[NSString alloc] initWithData: data
 267                                     encoding: NSUTF8StringEncoding];
 268       if (str != nil)
 269         {
 270           [str autorelease];
 271         }
 272       else
 273         {
 274           return Qnil;
 275         }
 276     }
 277
 278   /* assume UTF8 */
 279   NS_DURING
 280     {
 281       /* EOL conversion: PENDING- is this too simple? */
 282       NSMutableString *mstr = [[str mutableCopy] autorelease];
 283       [mstr replaceOccurrencesOfString: @"\r\n" withString: @"\n"
 284             options: NSLiteralSearch range: NSMakeRange (0, [mstr length])];
 285       [mstr replaceOccurrencesOfString: @"\r" withString: @"\n"
 286             options: NSLiteralSearch range: NSMakeRange (0, [mstr length])];
 287
 288       utfStr = [mstr UTF8String];
 289       length = [mstr lengthOfBytesUsingEncoding: NSUTF8StringEncoding];
 290
 291 #if ! defined (NS_IMPL_COCOA)
 292       if (!utfStr)
 293         {
 294           utfStr = [mstr cString];
 295           length = strlen (utfStr);
 296         }
 297 #endif
 298     }
 299   NS_HANDLER
 300     {
 301       message1 ("ns_string_from_pasteboard: UTF8String failed\n");
 302 #if defined (NS_IMPL_COCOA)
 303       utfStr = "Conversion failed";
 304 #else
 305       utfStr = [str lossyCString];
 306 #endif
 307       length = strlen (utfStr);
 308     }
 309   NS_ENDHANDLER
 310
 311     return make_string (utfStr, length);
 312 }
 313
 314
 315 void
 316 ns_string_to_pasteboard (id pb, Lisp_Object str)
 317 {
 318   ns_string_to_pasteboard_internal (pb, str, nil);
 319 }
 320
 321
 322
 323 /* ==========================================================================
 324
 325     Lisp Defuns
 326
 327    ========================================================================== */
 328
 329
 330 DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
 331        Sx_own_selection_internal, 2, 3, 0,
 332        doc: /* Assert an X selection of type SELECTION and value VALUE.
 333 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
 334 \(Those are literal upper-case symbol names, since that's what X expects.)
 335 VALUE is typically a string, or a cons of two markers, but may be
 336 anything that the functions on `selection-converter-alist' know about.
 337
 338 FRAME should be a frame that should own the selection.  If omitted or
 339 nil, it defaults to the selected frame.
 340
 341 On Nextstep, FRAME is unused.  */)
 342      (Lisp_Object selection, Lisp_Object value, Lisp_Object frame)
 343 {
 344   id pb;
 345   Lisp_Object old_value, new_value;
 346   NSString *type;
 347   Lisp_Object successful_p = Qnil, rest;
 348   Lisp_Object target_symbol, data;
 349
 350   check_window_system (NULL);
 351   CHECK_SYMBOL (selection);
 352   if (NILP (value))
 353     error ("Selection value may not be nil");
 354   pb = ns_symbol_to_pb (selection);
 355   if (pb == nil) return Qnil;
 356
 357   ns_declare_pasteboard (pb);
 358   old_value = assq_no_quit (selection, Vselection_alist);
 359   new_value = list2 (selection, value);
 360
 361   if (NILP (old_value))
 362     Vselection_alist = Fcons (new_value, Vselection_alist);
 363   else
 364     Fsetcdr (old_value, Fcdr (new_value));
 365
 366   /* We only support copy of text.  */
 367   type = NSStringPboardType;
 368   target_symbol = ns_string_to_symbol (type);
 369   data = ns_get_local_selection (selection, target_symbol);
 370   if (!NILP (data))
 371     {
 372       if (STRINGP (data))
 373         ns_string_to_pasteboard_internal (pb, data, type);
 374       successful_p = Qt;
 375     }
 376
 377   if (!EQ (Vns_sent_selection_hooks, Qunbound))
 378     {
 379       for (rest = Vns_sent_selection_hooks; CONSP (rest); rest = Fcdr (rest))
 380         call3 (Fcar (rest), selection, target_symbol, successful_p);
 381     }
 382
 383   return value;
 384 }
 385
 386
 387 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
 388        Sx_disown_selection_internal, 1, 3, 0,
 389        doc: /* If we own the selection SELECTION, disown it.
 390 Disowning it means there is no such selection.
 391
 392 Sets the last-change time for the selection to TIME-OBJECT (by default
 393 the time of the last event).
 394
 395 TERMINAL should be a terminal object or a frame specifying the X
 396 server to query.  If omitted or nil, that stands for the selected
 397 frame's display, or the first available X display.
 398
 399 On Nextstep, the TIME-OBJECT and TERMINAL arguments are unused.
 400 On MS-DOS, all this does is return non-nil if we own the selection.  */)
 401   (Lisp_Object selection, Lisp_Object time_object, Lisp_Object terminal)
 402 {
 403   id pb;
 404   check_window_system (NULL);
 405   CHECK_SYMBOL (selection);
 406   if (NILP (assq_no_quit (selection, Vselection_alist))) return Qnil;
 407
 408   pb = ns_symbol_to_pb (selection);
 409   if (pb != nil) ns_undeclare_pasteboard (pb);
 410   return Qt;
 411 }
 412
 413
 414 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
 415        0, 2, 0, doc: /* Whether there is an owner for the given X selection.
 416 SELECTION should be the name of the selection in question, typically
 417 one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.  (X expects
 418 these literal upper-case names.)  The symbol nil is the same as
 419 `PRIMARY', and t is the same as `SECONDARY'.
 420
 421 TERMINAL should be a terminal object or a frame specifying the X
 422 server to query.  If omitted or nil, that stands for the selected
 423 frame's display, or the first available X display.
 424
 425 On Nextstep, TERMINAL is unused.  */)
 426      (Lisp_Object selection, Lisp_Object terminal)
 427 {
 428   id pb;
 429   NSArray *types;
 430
 431   if (!window_system_available (NULL))
 432     return Qnil;
 433
 434   CHECK_SYMBOL (selection);
 435   if (EQ (selection, Qnil)) selection = QPRIMARY;
 436   if (EQ (selection, Qt)) selection = QSECONDARY;
 437   pb = ns_symbol_to_pb (selection);
 438   if (pb == nil) return Qnil;
 439
 440   types = [pb types];
 441   return ([types count] == 0) ? Qnil : Qt;
 442 }
 443
 444
 445 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
 446        0, 2, 0,
 447        doc: /* Whether the current Emacs process owns the given X Selection.
 448 The arg should be the name of the selection in question, typically one of
 449 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
 450 \(Those are literal upper-case symbol names, since that's what X expects.)
 451 For convenience, the symbol nil is the same as `PRIMARY',
 452 and t is the same as `SECONDARY'.
 453
 454 TERMINAL should be a terminal object or a frame specifying the X
 455 server to query.  If omitted or nil, that stands for the selected
 456 frame's display, or the first available X display.
 457
 458 On Nextstep, TERMINAL is unused.  */)
 459      (Lisp_Object selection, Lisp_Object terminal)
 460 {
 461   check_window_system (NULL);
 462   CHECK_SYMBOL (selection);
 463   if (EQ (selection, Qnil)) selection = QPRIMARY;
 464   if (EQ (selection, Qt)) selection = QSECONDARY;
 465   return (NILP (Fassq (selection, Vselection_alist))) ? Qnil : Qt;
 466 }
 467
 468
 469 DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
 470        Sx_get_selection_internal, 2, 4, 0,
 471        doc: /* Return text selected from some X window.
 472 SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
 473 \(Those are literal upper-case symbol names, since that's what X expects.)
 474 TARGET-TYPE is the type of data desired, typically `STRING'.
 475
 476 TIME-STAMP is the time to use in the XConvertSelection call for foreign
 477 selections.  If omitted, defaults to the time for the last event.
 478
 479 TERMINAL should be a terminal object or a frame specifying the X
 480 server to query.  If omitted or nil, that stands for the selected
 481 frame's display, or the first available X display.
 482
 483 On Nextstep, TIME-STAMP and TERMINAL are unused.  */)
 484      (Lisp_Object selection_name, Lisp_Object target_type,
 485       Lisp_Object time_stamp, Lisp_Object terminal)
 486 {
 487   Lisp_Object val;
 488
 489   check_window_system (NULL);
 490   CHECK_SYMBOL (selection_name);
 491   CHECK_SYMBOL (target_type);
 492   val = ns_get_local_selection (selection_name, target_type);
 493   if (NILP (val))
 494     val = ns_get_foreign_selection (selection_name, target_type);
 495   if (CONSP (val) && SYMBOLP (Fcar (val)))
 496     {
 497       val = Fcdr (val);
 498       if (CONSP (val) && NILP (Fcdr (val)))
 499         val = Fcar (val);
 500     }
 501   val = clean_local_selection_data (val);
 502   return val;
 503 }
 504
 505
 506 DEFUN ("ns-get-selection-internal", Fns_get_selection_internal,
 507        Sns_get_selection_internal, 1, 1, 0,
 508        doc: /* Returns the value of SELECTION as a string.
 509 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. */)
 510      (Lisp_Object selection)
 511 {
 512   id pb;
 513   check_window_system (NULL);
 514   pb = ns_symbol_to_pb (selection);
 515   return pb != nil ? ns_string_from_pasteboard (pb) : Qnil;
 516 }
 517
 518
 519 DEFUN ("ns-store-selection-internal", Fns_store_selection_internal,
 520        Sns_store_selection_internal, 2, 2, 0,
 521        doc: /* Sets the string value of SELECTION.
 522 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. */)
 523      (Lisp_Object selection, Lisp_Object string)
 524 {
 525   id pb;
 526   check_window_system (NULL);
 527   pb = ns_symbol_to_pb (selection);
 528   if (pb != nil) ns_string_to_pasteboard (pb, string);
 529   return Qnil;
 530 }
 531
 532
 533 void
 534 nxatoms_of_nsselect (void)
 535 {
 536   NXPrimaryPboard = @"Selection";
 537   NXSecondaryPboard = @"Secondary";
 538 }
 539
 540 void
 541 syms_of_nsselect (void)
 542 {
 543 #include "nsselect.x"
 544
 545   QCLIPBOARD = intern_c_string ("CLIPBOARD");   staticpro (&QCLIPBOARD);
 546   QSECONDARY = intern_c_string ("SECONDARY");   staticpro (&QSECONDARY);
 547   QTEXT      = intern_c_string ("TEXT");        staticpro (&QTEXT);
 548   QFILE_NAME = intern_c_string ("FILE_NAME");   staticpro (&QFILE_NAME);
 549
 550   Vselection_alist = Qnil;
 551   staticpro (&Vselection_alist);
 552
 553   DEFVAR_LISP ("ns-sent-selection-hooks", Vns_sent_selection_hooks,
 554                "A list of functions to be called when Emacs answers a selection request.\n\
 555 The functions are called with four arguments:\n\
 556   - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
 557   - the selection-type which Emacs was asked to convert the\n\
 558     selection into before sending (for example, `STRING' or `LENGTH');\n\
 559   - a flag indicating success or failure for responding to the request.\n\
 560 We might have failed (and declined the request) for any number of reasons,\n\
 561 including being asked for a selection that we no longer own, or being asked\n\
 562 to convert into a type that we don't know about or that is inappropriate.\n\
 563 This hook doesn't let you change the behavior of Emacs's selection replies,\n\
 564 it merely informs you that they have happened.");
 565   Vns_sent_selection_hooks = Qnil;
 566
 567   DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist,
 568                "An alist associating X Windows selection-types with functions.\n\
 569 These functions are called to convert the selection, with three args:\n\
 570 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
 571 a desired type to which the selection should be converted;\n\
 572 and the local selection value (whatever was given to `x-own-selection').\n\
 573 \n\
 574 The function should return the value to send to the X server\n\
 575 \(typically a string).  A return value of nil\n\
 576 means that the conversion could not be done.\n\
 577 A return value which is the symbol `NULL'\n\
 578 means that a side-effect was executed,\n\
 579 and there is no meaningful selection value.");
 580   Vselection_converter_alist = Qnil;
 581
 582   DEFVAR_LISP ("ns-lost-selection-hooks", Vns_lost_selection_hooks,
 583                "A list of functions to be called when Emacs loses an X selection.\n\
 584 \(This happens when some other X client makes its own selection\n\
 585 or when a Lisp program explicitly clears the selection.)\n\
 586 The functions are called with one argument, the selection type\n\
 587 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD').");
 588   Vns_lost_selection_hooks = Qnil;
 589
 590   Qforeign_selection = intern_c_string ("foreign-selection");
 591   staticpro (&Qforeign_selection);
 592 }