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