src/nsselect.m

   1 /* NeXT/Open/GNUstep / MacOSX Cocoa selection processing for emacs.
   2    Copyright (C) 1993-1994, 2005-2006, 2008-2015 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 static Lisp_Object Vselection_alist;
  38
  39 /* NSGeneralPboard is pretty much analogous to X11 CLIPBOARD */
  40 static NSString *NXPrimaryPboard;
  41 static NSString *NXSecondaryPboard;
  42
  43
  44 static NSMutableDictionary *pasteboard_changecount;
  45
  46 /* ==========================================================================
  47
  48     Internal utility functions
  49
  50    ========================================================================== */
  51
  52
  53 static NSString *
  54 symbol_to_nsstring (Lisp_Object sym)
  55 {
  56   CHECK_SYMBOL (sym);
  57   if (EQ (sym, QCLIPBOARD))   return NSGeneralPboard;
  58   if (EQ (sym, QPRIMARY))     return NXPrimaryPboard;
  59   if (EQ (sym, QSECONDARY))   return NXSecondaryPboard;
  60   if (EQ (sym, QTEXT))        return NSStringPboardType;
  61   return [NSString stringWithUTF8String: SSDATA (SYMBOL_NAME (sym))];
  62 }
  63
  64 static NSPasteboard *
  65 ns_symbol_to_pb (Lisp_Object symbol)
  66 {
  67   return [NSPasteboard pasteboardWithName: symbol_to_nsstring (symbol)];
  68 }
  69
  70 static Lisp_Object
  71 ns_string_to_symbol (NSString *t)
  72 {
  73   if ([t isEqualToString: NSGeneralPboard])
  74     return QCLIPBOARD;
  75   if ([t isEqualToString: NXPrimaryPboard])
  76     return QPRIMARY;
  77   if ([t isEqualToString: NXSecondaryPboard])
  78     return QSECONDARY;
  79   if ([t isEqualToString: NSStringPboardType])
  80     return QTEXT;
  81   if ([t isEqualToString: NSFilenamesPboardType])
  82     return QFILE_NAME;
  83   if ([t isEqualToString: NSTabularTextPboardType])
  84     return QTEXT;
  85   return intern ([t UTF8String]);
  86 }
  87
  88
  89 static Lisp_Object
  90 clean_local_selection_data (Lisp_Object obj)
  91 {
  92   if (CONSP (obj)
  93       && INTEGERP (XCAR (obj))
  94       && CONSP (XCDR (obj))
  95       && INTEGERP (XCAR (XCDR (obj)))
  96       && NILP (XCDR (XCDR (obj))))
  97     obj = Fcons (XCAR (obj), XCDR (obj));
  98
  99   if (CONSP (obj)
 100       && INTEGERP (XCAR (obj))
 101       && INTEGERP (XCDR (obj)))
 102     {
 103       if (XINT (XCAR (obj)) == 0)
 104         return XCDR (obj);
 105       if (XINT (XCAR (obj)) == -1)
 106         return make_number (- XINT (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
 127 static void
 128 ns_declare_pasteboard (id pb)
 129 {
 130   [pb declareTypes: ns_send_types owner: NSApp];
 131 }
 132
 133
 134 static void
 135 ns_undeclare_pasteboard (id pb)
 136 {
 137   [pb declareTypes: [NSArray array] owner: nil];
 138 }
 139
 140 static void
 141 ns_store_pb_change_count (id pb)
 142 {
 143   [pasteboard_changecount
 144         setObject: [NSNumber numberWithLong: [pb changeCount]]
 145            forKey: [pb name]];
 146 }
 147
 148 static NSInteger
 149 ns_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
 155 static NSInteger
 156 ns_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
 164 static void
 165 ns_string_to_pasteboard_internal (id pb, Lisp_Object str, NSString *gtype)
 166 {
 167   if (EQ (str, Qnil))
 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 == NSStringPboardType);
 197           [pb setString: nsStr forType: gtype];
 198         }
 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   Lisp_Object local_value;
 210   local_value = assq_no_quit (selection_name, Vselection_alist);
 211   return local_value;
 212 }
 213
 214
 215 static Lisp_Object
 216 ns_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
 233 Lisp_Object
 234 ns_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
 300 void
 301 ns_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
 315 DEFUN ("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.
 318 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 anything 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 = NSStringPboardType;
 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
 367 DEFUN ("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.
 370 Disowning 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
 387 DEFUN ("ns-selection-exists-p", Fns_selection_exists_p, Sns_selection_exists_p,
 388        0, 2, 0, doc: /* Whether there is an owner for the given X selection.
 389 SELECTION should be the name of the selection in question, typically
 390 one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.  (X expects
 391 these literal upper-case names.)  The symbol nil is the same as
 392 `PRIMARY', and t is the same as `SECONDARY'.
 393
 394 TERMINAL should be a terminal object or a frame specifying the X
 395 server to query.  If omitted or nil, that stands for the selected
 396 frame's display, or the first available X display.
 397
 398 On Nextstep, TERMINAL is unused.  */)
 399      (Lisp_Object selection, Lisp_Object terminal)
 400 {
 401   id pb;
 402   NSArray *types;
 403
 404   if (!window_system_available (NULL))
 405     return Qnil;
 406
 407   CHECK_SYMBOL (selection);
 408   if (EQ (selection, Qnil)) selection = QPRIMARY;
 409   if (EQ (selection, Qt)) selection = QSECONDARY;
 410   pb = ns_symbol_to_pb (selection);
 411   if (pb == nil) return Qnil;
 412
 413   types = [pb types];
 414   return ([types count] == 0) ? Qnil : Qt;
 415 }
 416
 417
 418 DEFUN ("ns-selection-owner-p", Fns_selection_owner_p, Sns_selection_owner_p,
 419        0, 2, 0,
 420        doc: /* Whether the current Emacs process owns the given X Selection.
 421 The arg should be the name of the selection in question, typically one of
 422 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
 423 \(Those are literal upper-case symbol names, since that's what X expects.)
 424 For convenience, the symbol nil is the same as `PRIMARY',
 425 and t is the same as `SECONDARY'.
 426
 427 TERMINAL should be a terminal object or a frame specifying the X
 428 server to query.  If omitted or nil, that stands for the selected
 429 frame's display, or the first available X display.
 430
 431 On Nextstep, TERMINAL is unused.  */)
 432      (Lisp_Object selection, Lisp_Object terminal)
 433 {
 434   check_window_system (NULL);
 435   CHECK_SYMBOL (selection);
 436   if (EQ (selection, Qnil)) selection = QPRIMARY;
 437   if (EQ (selection, Qt)) selection = QSECONDARY;
 438   return ns_get_pb_change_count (selection)
 439     == ns_get_our_change_count_for (selection)
 440     ? Qt : Qnil;
 441 }
 442
 443
 444 DEFUN ("ns-get-selection", Fns_get_selection,
 445        Sns_get_selection, 2, 4, 0,
 446        doc: /* Return text selected from some X window.
 447 SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
 448 \(Those are literal upper-case symbol names, since that's what X expects.)
 449 TARGET-TYPE is the type of data desired, typically `STRING'.
 450
 451 TIME-STAMP is the time to use in the XConvertSelection call for foreign
 452 selections.  If omitted, defaults to the time for the last event.
 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, TIME-STAMP and TERMINAL are unused.  */)
 459      (Lisp_Object selection_name, Lisp_Object target_type,
 460       Lisp_Object time_stamp, Lisp_Object terminal)
 461 {
 462   Lisp_Object val = Qnil;
 463
 464   check_window_system (NULL);
 465   CHECK_SYMBOL (selection_name);
 466   CHECK_SYMBOL (target_type);
 467
 468   if (ns_get_pb_change_count (selection_name)
 469       == ns_get_our_change_count_for (selection_name))
 470       val = ns_get_local_selection (selection_name, target_type);
 471   if (NILP (val))
 472     val = ns_get_foreign_selection (selection_name, target_type);
 473   if (CONSP (val) && SYMBOLP (Fcar (val)))
 474     {
 475       val = Fcdr (val);
 476       if (CONSP (val) && NILP (Fcdr (val)))
 477         val = Fcar (val);
 478     }
 479   val = clean_local_selection_data (val);
 480   return val;
 481 }
 482
 483
 484 void
 485 nxatoms_of_nsselect (void)
 486 {
 487   NXPrimaryPboard = @"Selection";
 488   NXSecondaryPboard = @"Secondary";
 489
 490   // This is a memory loss, never released.
 491   pasteboard_changecount =
 492     [[NSMutableDictionary
 493        dictionaryWithObjectsAndKeys:
 494             [NSNumber numberWithLong:0], NSGeneralPboard,
 495             [NSNumber numberWithLong:0], NXPrimaryPboard,
 496             [NSNumber numberWithLong:0], NXSecondaryPboard,
 497             [NSNumber numberWithLong:0], NSStringPboardType,
 498             [NSNumber numberWithLong:0], NSFilenamesPboardType,
 499             [NSNumber numberWithLong:0], NSTabularTextPboardType,
 500        nil] retain];
 501 }
 502
 503 void
 504 syms_of_nsselect (void)
 505 {
 506   DEFSYM (QCLIPBOARD, "CLIPBOARD");
 507   DEFSYM (QSECONDARY, "SECONDARY");
 508   DEFSYM (QTEXT, "TEXT");
 509   DEFSYM (QFILE_NAME, "FILE_NAME");
 510
 511   defsubr (&Sns_disown_selection_internal);
 512   defsubr (&Sns_get_selection);
 513   defsubr (&Sns_own_selection_internal);
 514   defsubr (&Sns_selection_exists_p);
 515   defsubr (&Sns_selection_owner_p);
 516
 517   Vselection_alist = Qnil;
 518   staticpro (&Vselection_alist);
 519
 520   DEFVAR_LISP ("ns-sent-selection-hooks", Vns_sent_selection_hooks,
 521                "A list of functions to be called when Emacs answers a selection request.\n\
 522 The functions are called with four arguments:\n\
 523   - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
 524   - the selection-type which Emacs was asked to convert the\n\
 525     selection into before sending (for example, `STRING' or `LENGTH');\n\
 526   - a flag indicating success or failure for responding to the request.\n\
 527 We might have failed (and declined the request) for any number of reasons,\n\
 528 including being asked for a selection that we no longer own, or being asked\n\
 529 to convert into a type that we don't know about or that is inappropriate.\n\
 530 This hook doesn't let you change the behavior of Emacs's selection replies,\n\
 531 it merely informs you that they have happened.");
 532   Vns_sent_selection_hooks = Qnil;
 533 }