1/* NeXT/Open/GNUstep / macOS Cocoa selection processing for emacs. 2 Copyright (C) 1993-1994, 2005-2006, 2008-2021 Free Software 3 Foundation, Inc. 4 5This file is part of GNU Emacs. 6 7GNU Emacs is free software: you can redistribute it and/or modify 8it under the terms of the GNU General Public License as published by 9the Free Software Foundation, either version 3 of the License, or (at 10your option) any later version. 11 12GNU Emacs is distributed in the hope that it will be useful, 13but WITHOUT ANY WARRANTY; without even the implied warranty of 14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15GNU General Public License for more details. 16 17You should have received a copy of the GNU General Public License 18along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ 19 20/* 21Originally by Carl Edman 22Updated by Christian Limpach (chris@nice.ch) 23OpenStep/Rhapsody port by Scott Bender (sbender@harmony-ds.com) 24macOS/Aqua port by Christophe de Dinechin (descubes@earthlink.net) 25GNUstep 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 37static Lisp_Object Vselection_alist; 38 39/* NSPasteboardNameGeneral is pretty much analogous to X11 CLIPBOARD. */ 40static NSString *NXPrimaryPboard; 41static NSString *NXSecondaryPboard; 42 43 44static NSMutableDictionary *pasteboard_changecount; 45 46/* ========================================================================== 47 48 Internal utility functions 49 50 ========================================================================== */ 51 52 53static NSString * 54symbol_to_nsstring (Lisp_Object sym) 55{ 56 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 64static NSPasteboard * 65ns_symbol_to_pb (Lisp_Object symbol) 66{ 67 return [NSPasteboard pasteboardWithName: symbol_to_nsstring (symbol)]; 68} 69 70static Lisp_Object 71ns_string_to_symbol (NSString *t) 72{ 73 if ([t isEqualToString: NSPasteboardNameGeneral]) 74 return QCLIPBOARD; 75 if ([t isEqualToString: NXPrimaryPboard]) 76 return QPRIMARY; 77 if ([t isEqualToString: NXSecondaryPboard]) 78 return QSECONDARY; 79 if ([t isEqualToString: NSPasteboardTypeString]) 80 return QTEXT; 81 if ([t isEqualToString: NSFilenamesPboardType]) 82 return QFILE_NAME; 83 if ([t isEqualToString: NSPasteboardTypeTabularText]) 84 return QTEXT; 85 return intern ([t UTF8String]); 86} 87 88 89static Lisp_Object 90clean_local_selection_data (Lisp_Object obj) 91{ 92 if (CONSP (obj) 93 && FIXNUMP (XCAR (obj)) 94 && CONSP (XCDR (obj)) 95 && FIXNUMP (XCAR (XCDR (obj))) 96 && NILP (XCDR (XCDR (obj)))) 97 obj = Fcons (XCAR (obj), XCDR (obj)); 98 99 if (CONSP (obj) 100 && FIXNUMP (XCAR (obj)) 101 && FIXNUMP (XCDR (obj))) 102 { 103 if (XFIXNUM (XCAR (obj)) == 0) 104 return XCDR (obj); 105 if (XFIXNUM (XCAR (obj)) == -1) 106 return make_fixnum (- XFIXNUM (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 127static void 128ns_declare_pasteboard (id pb) 129{ 130 [pb declareTypes: ns_send_types owner: NSApp]; 131} 132 133 134static void 135ns_undeclare_pasteboard (id pb) 136{ 137 [pb declareTypes: [NSArray array] owner: nil]; 138} 139 140static void 141ns_store_pb_change_count (id pb) 142{ 143 [pasteboard_changecount 144 setObject: [NSNumber numberWithLong: [pb changeCount]] 145 forKey: [pb name]]; 146} 147 148static NSInteger 149ns_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 155static NSInteger 156ns_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 164static void 165ns_string_to_pasteboard_internal (id pb, Lisp_Object str, NSString *gtype) 166{ 167 if (NILP (str)) 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 == NSPasteboardTypeString); 197 [pb setString: nsStr forType: gtype]; 198 } 199 [nsStr release]; 200 ns_store_pb_change_count (pb); 201 } 202} 203 204 205Lisp_Object 206ns_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 215static Lisp_Object 216ns_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 233Lisp_Object 234ns_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 300void 301ns_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 315DEFUN ("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. 318SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. 319\(Those are literal upper-case symbol names, since that's what X expects.) 320VALUE is typically a string, or a cons of two markers, but may be 321anything 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 = NSPasteboardTypeString; 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 367DEFUN ("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. 370Disowning 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 387DEFUN ("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. 389SELECTION should be the name of the selection in question, typically 390one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. (X expects 391these literal upper-case names.) The symbol nil is the same as 392`PRIMARY', and t is the same as `SECONDARY'. */) 393 (Lisp_Object selection) 394{ 395 id pb; 396 NSArray *types; 397 398 if (!window_system_available (NULL)) 399 return Qnil; 400 401 CHECK_SYMBOL (selection); 402 if (NILP (selection)) selection = QPRIMARY; 403 if (EQ (selection, Qt)) selection = QSECONDARY; 404 pb = ns_symbol_to_pb (selection); 405 if (pb == nil) return Qnil; 406 407 types = [pb types]; 408 return ([types count] == 0) ? Qnil : Qt; 409} 410 411 412DEFUN ("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. 415The arg should be the name of the selection in question, typically one of 416the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. 417\(Those are literal upper-case symbol names, since that's what X expects.) 418For convenience, the symbol nil is the same as `PRIMARY', 419and t is the same as `SECONDARY'. */) 420 (Lisp_Object selection) 421{ 422 check_window_system (NULL); 423 CHECK_SYMBOL (selection); 424 if (NILP (selection)) selection = QPRIMARY; 425 if (EQ (selection, Qt)) selection = QSECONDARY; 426 return ns_get_pb_change_count (selection) 427 == ns_get_our_change_count_for (selection) 428 ? Qt : Qnil; 429} 430 431 432DEFUN ("ns-get-selection", Fns_get_selection, 433 Sns_get_selection, 2, 2, 0, 434 doc: /* Return text selected from some X window. 435SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. 436\(Those are literal upper-case symbol names, since that's what X expects.) 437TARGET-TYPE is the type of data desired, typically `STRING'. */) 438 (Lisp_Object selection_name, Lisp_Object target_type) 439{ 440 Lisp_Object val = Qnil; 441 442 check_window_system (NULL); 443 CHECK_SYMBOL (selection_name); 444 CHECK_SYMBOL (target_type); 445 446 if (ns_get_pb_change_count (selection_name) 447 == ns_get_our_change_count_for (selection_name)) 448 val = ns_get_local_selection (selection_name, target_type); 449 if (NILP (val)) 450 val = ns_get_foreign_selection (selection_name, target_type); 451 if (CONSP (val) && SYMBOLP (Fcar (val))) 452 { 453 val = Fcdr (val); 454 if (CONSP (val) && NILP (Fcdr (val))) 455 val = Fcar (val); 456 } 457 val = clean_local_selection_data (val); 458 return val; 459} 460 461 462void 463nxatoms_of_nsselect (void) 464{ 465 NXPrimaryPboard = @"Selection"; 466 NXSecondaryPboard = @"Secondary"; 467 468 // This is a memory loss, never released. 469 pasteboard_changecount 470 = [[NSMutableDictionary 471 dictionaryWithObjectsAndKeys: 472 [NSNumber numberWithLong:0], NSPasteboardNameGeneral, 473 [NSNumber numberWithLong:0], NXPrimaryPboard, 474 [NSNumber numberWithLong:0], NXSecondaryPboard, 475 [NSNumber numberWithLong:0], NSPasteboardTypeString, 476 [NSNumber numberWithLong:0], NSFilenamesPboardType, 477 [NSNumber numberWithLong:0], NSPasteboardTypeTabularText, 478 nil] retain]; 479} 480 481void 482syms_of_nsselect (void) 483{ 484 DEFSYM (QCLIPBOARD, "CLIPBOARD"); 485 DEFSYM (QSECONDARY, "SECONDARY"); 486 DEFSYM (QTEXT, "TEXT"); 487 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 Vselection_alist = Qnil; 496 staticpro (&Vselection_alist); 497 498 DEFVAR_LISP ("ns-sent-selection-hooks", Vns_sent_selection_hooks, 499 "A list of functions to be called when Emacs answers a selection request.\n\ 500The functions are called with four arguments:\n\ 501 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\ 502 - the selection-type which Emacs was asked to convert the\n\ 503 selection into before sending (for example, `STRING' or `LENGTH');\n\ 504 - a flag indicating success or failure for responding to the request.\n\ 505We might have failed (and declined the request) for any number of reasons,\n\ 506including being asked for a selection that we no longer own, or being asked\n\ 507to convert into a type that we don't know about or that is inappropriate.\n\ 508This hook doesn't let you change the behavior of Emacs's selection replies,\n\ 509it merely informs you that they have happened."); 510 Vns_sent_selection_hooks = Qnil; 511} 512