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