1/* Selection processing for Emacs on Mac OS. 2 Copyright (C) 2005, 2006, 2007 Free Software Foundation, Inc. 3 4This file is part of GNU Emacs. 5 6GNU Emacs is free software; you can redistribute it and/or modify 7it under the terms of the GNU General Public License as published by 8the Free Software Foundation; either version 2, or (at your option) 9any later version. 10 11GNU Emacs is distributed in the hope that it will be useful, 12but WITHOUT ANY WARRANTY; without even the implied warranty of 13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14GNU General Public License for more details. 15 16You should have received a copy of the GNU General Public License 17along with GNU Emacs; see the file COPYING. If not, write to 18the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 19Boston, MA 02110-1301, USA. */ 20 21#include <config.h> 22 23#include "lisp.h" 24#include "macterm.h" 25#include "blockinput.h" 26#include "keymap.h" 27 28#if !TARGET_API_MAC_CARBON 29#include <Endian.h> 30typedef int ScrapRef; 31typedef ResType ScrapFlavorType; 32#endif /* !TARGET_API_MAC_CARBON */ 33 34static OSStatus get_scrap_from_symbol P_ ((Lisp_Object, int, ScrapRef *)); 35static ScrapFlavorType get_flavor_type_from_symbol P_ ((Lisp_Object)); 36static int valid_scrap_target_type_p P_ ((Lisp_Object)); 37static OSStatus clear_scrap P_ ((ScrapRef *)); 38static OSStatus put_scrap_string P_ ((ScrapRef, Lisp_Object, Lisp_Object)); 39static OSStatus put_scrap_private_timestamp P_ ((ScrapRef, unsigned long)); 40static ScrapFlavorType scrap_has_target_type P_ ((ScrapRef, Lisp_Object)); 41static Lisp_Object get_scrap_string P_ ((ScrapRef, Lisp_Object)); 42static OSStatus get_scrap_private_timestamp P_ ((ScrapRef, unsigned long *)); 43static Lisp_Object get_scrap_target_type_list P_ ((ScrapRef)); 44static void x_own_selection P_ ((Lisp_Object, Lisp_Object)); 45static Lisp_Object x_get_local_selection P_ ((Lisp_Object, Lisp_Object, int)); 46static Lisp_Object x_get_foreign_selection P_ ((Lisp_Object, 47 Lisp_Object, 48 Lisp_Object)); 49EXFUN (Fx_selection_owner_p, 1); 50#ifdef MAC_OSX 51static OSStatus mac_handle_service_event P_ ((EventHandlerCallRef, 52 EventRef, void *)); 53void init_service_handler P_ ((void)); 54#endif 55 56Lisp_Object QPRIMARY, QSECONDARY, QTIMESTAMP, QTARGETS; 57 58static Lisp_Object Vx_lost_selection_functions; 59/* Coding system for communicating with other programs via scrap. */ 60static Lisp_Object Vselection_coding_system; 61 62/* Coding system for the next communicating with other programs. */ 63static Lisp_Object Vnext_selection_coding_system; 64 65static Lisp_Object Qforeign_selection; 66 67/* The timestamp of the last input event Emacs received from the 68 window server. */ 69/* Defined in keyboard.c. */ 70extern unsigned long last_event_timestamp; 71 72/* This is an association list whose elements are of the form 73 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME) 74 SELECTION-NAME is a lisp symbol. 75 SELECTION-VALUE is the value that emacs owns for that selection. 76 It may be any kind of Lisp object. 77 SELECTION-TIMESTAMP is the time at which emacs began owning this selection, 78 as a cons of two 16-bit numbers (making a 32 bit time.) 79 FRAME is the frame for which we made the selection. 80 If there is an entry in this alist, and the data for the flavor 81 type SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP in the corresponding scrap 82 (if exists) coincides with SELECTION-TIMESTAMP, then it can be 83 assumed that Emacs owns that selection. 84 The only (eq) parts of this list that are visible from Lisp are the 85 selection-values. */ 86static Lisp_Object Vselection_alist; 87 88#define SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP 'Etsp' 89 90/* This is an alist whose CARs are selection-types and whose CDRs are 91 the names of Lisp functions to call to convert the given Emacs 92 selection value to a string representing the given selection type. 93 This is for Lisp-level extension of the emacs selection 94 handling. */ 95static Lisp_Object Vselection_converter_alist; 96 97/* A selection name (represented as a Lisp symbol) can be associated 98 with a named scrap via `mac-scrap-name' property. Likewise for a 99 selection type with a scrap flavor type via `mac-ostype'. */ 100static Lisp_Object Qmac_scrap_name, Qmac_ostype; 101 102#ifdef MAC_OSX 103/* Selection name for communication via Services menu. */ 104static Lisp_Object Vmac_service_selection; 105#endif 106 107/* Get a reference to the scrap corresponding to the symbol SYM. The 108 reference is set to *SCRAP, and it becomes NULL if there's no 109 corresponding scrap. Clear the scrap if CLEAR_P is non-zero. */ 110 111static OSStatus 112get_scrap_from_symbol (sym, clear_p, scrap) 113 Lisp_Object sym; 114 int clear_p; 115 ScrapRef *scrap; 116{ 117 OSStatus err = noErr; 118 Lisp_Object str = Fget (sym, Qmac_scrap_name); 119 120 if (!STRINGP (str)) 121 *scrap = NULL; 122 else 123 { 124#if TARGET_API_MAC_CARBON 125#ifdef MAC_OSX 126 CFStringRef scrap_name = cfstring_create_with_string (str); 127 OptionBits options = (clear_p ? kScrapClearNamedScrap 128 : kScrapGetNamedScrap); 129 130 err = GetScrapByName (scrap_name, options, scrap); 131 CFRelease (scrap_name); 132#else /* !MAC_OSX */ 133 if (clear_p) 134 err = ClearCurrentScrap (); 135 if (err == noErr) 136 err = GetCurrentScrap (scrap); 137#endif /* !MAC_OSX */ 138#else /* !TARGET_API_MAC_CARBON */ 139 if (clear_p) 140 err = ZeroScrap (); 141 if (err == noErr) 142 *scrap = 1; 143#endif /* !TARGET_API_MAC_CARBON */ 144 } 145 146 return err; 147} 148 149/* Get a scrap flavor type from the symbol SYM. Return 0 if no 150 corresponding flavor type. */ 151 152static ScrapFlavorType 153get_flavor_type_from_symbol (sym) 154 Lisp_Object sym; 155{ 156 Lisp_Object str = Fget (sym, Qmac_ostype); 157 158 if (STRINGP (str) && SBYTES (str) == 4) 159 return EndianU32_BtoN (*((UInt32 *) SDATA (str))); 160 161 return 0; 162} 163 164/* Check if the symbol SYM has a corresponding scrap flavor type. */ 165 166static int 167valid_scrap_target_type_p (sym) 168 Lisp_Object sym; 169{ 170 return get_flavor_type_from_symbol (sym) != 0; 171} 172 173/* Clear the scrap whose reference is *SCRAP. */ 174 175static INLINE OSStatus 176clear_scrap (scrap) 177 ScrapRef *scrap; 178{ 179#if TARGET_API_MAC_CARBON 180#ifdef MAC_OSX 181 return ClearScrap (scrap); 182#else 183 return ClearCurrentScrap (); 184#endif 185#else /* !TARGET_API_MAC_CARBON */ 186 return ZeroScrap (); 187#endif /* !TARGET_API_MAC_CARBON */ 188} 189 190/* Put Lisp String STR to the scrap SCRAP. The target type is 191 specified by TYPE. */ 192 193static OSStatus 194put_scrap_string (scrap, type, str) 195 ScrapRef scrap; 196 Lisp_Object type, str; 197{ 198 ScrapFlavorType flavor_type = get_flavor_type_from_symbol (type); 199 200 if (flavor_type == 0) 201 return noTypeErr; 202 203#if TARGET_API_MAC_CARBON 204 return PutScrapFlavor (scrap, flavor_type, kScrapFlavorMaskNone, 205 SBYTES (str), SDATA (str)); 206#else /* !TARGET_API_MAC_CARBON */ 207 return PutScrap (SBYTES (str), flavor_type, SDATA (str)); 208#endif /* !TARGET_API_MAC_CARBON */ 209} 210 211/* Put TIMESTAMP to the scrap SCRAP. The timestamp is used for 212 checking if the scrap is owned by the process. */ 213 214static INLINE OSStatus 215put_scrap_private_timestamp (scrap, timestamp) 216 ScrapRef scrap; 217 unsigned long timestamp; 218{ 219#if TARGET_API_MAC_CARBON 220 return PutScrapFlavor (scrap, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, 221 kScrapFlavorMaskSenderOnly, 222 sizeof (timestamp), ×tamp); 223#else /* !TARGET_API_MAC_CARBON */ 224 return PutScrap (sizeof (timestamp), SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, 225 ×tamp); 226#endif /* !TARGET_API_MAC_CARBON */ 227} 228 229/* Check if data for the target type TYPE is available in SCRAP. */ 230 231static ScrapFlavorType 232scrap_has_target_type (scrap, type) 233 ScrapRef scrap; 234 Lisp_Object type; 235{ 236 OSStatus err; 237 ScrapFlavorType flavor_type = get_flavor_type_from_symbol (type); 238 239 if (flavor_type) 240 { 241#if TARGET_API_MAC_CARBON 242 ScrapFlavorFlags flags; 243 244 err = GetScrapFlavorFlags (scrap, flavor_type, &flags); 245 if (err != noErr) 246 flavor_type = 0; 247#else /* !TARGET_API_MAC_CARBON */ 248 SInt32 size, offset; 249 250 size = GetScrap (NULL, flavor_type, &offset); 251 if (size < 0) 252 flavor_type = 0; 253#endif /* !TARGET_API_MAC_CARBON */ 254 } 255 256 return flavor_type; 257} 258 259/* Get data for the target type TYPE from SCRAP and create a Lisp 260 string. Return nil if failed to get data. */ 261 262static Lisp_Object 263get_scrap_string (scrap, type) 264 ScrapRef scrap; 265 Lisp_Object type; 266{ 267 OSStatus err; 268 Lisp_Object result = Qnil; 269 ScrapFlavorType flavor_type = get_flavor_type_from_symbol (type); 270#if TARGET_API_MAC_CARBON 271 Size size; 272 273 if (flavor_type) 274 { 275 err = GetScrapFlavorSize (scrap, flavor_type, &size); 276 if (err == noErr) 277 { 278 do 279 { 280 result = make_uninit_string (size); 281 err = GetScrapFlavorData (scrap, flavor_type, 282 &size, SDATA (result)); 283 if (err != noErr) 284 result = Qnil; 285 else if (size < SBYTES (result)) 286 result = make_unibyte_string (SDATA (result), size); 287 } 288 while (STRINGP (result) && size > SBYTES (result)); 289 } 290 } 291#else 292 Handle handle; 293 SInt32 size, offset; 294 295 if (flavor_type) 296 size = GetScrap (NULL, flavor_type, &offset); 297 if (size >= 0) 298 { 299 handle = NewHandle (size); 300 HLock (handle); 301 size = GetScrap (handle, flavor_type, &offset); 302 if (size >= 0) 303 result = make_unibyte_string (*handle, size); 304 DisposeHandle (handle); 305 } 306#endif 307 308 return result; 309} 310 311/* Get timestamp from the scrap SCRAP and set to *TIMPSTAMP. */ 312 313static OSStatus 314get_scrap_private_timestamp (scrap, timestamp) 315 ScrapRef scrap; 316 unsigned long *timestamp; 317{ 318 OSStatus err = noErr; 319#if TARGET_API_MAC_CARBON 320 ScrapFlavorFlags flags; 321 322 err = GetScrapFlavorFlags (scrap, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, &flags); 323 if (err == noErr) 324 { 325 if (!(flags & kScrapFlavorMaskSenderOnly)) 326 err = noTypeErr; 327 else 328 { 329 Size size = sizeof (*timestamp); 330 331 err = GetScrapFlavorData (scrap, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, 332 &size, timestamp); 333 if (err == noErr && size != sizeof (*timestamp)) 334 err = noTypeErr; 335 } 336 } 337#else /* !TARGET_API_MAC_CARBON */ 338 Handle handle; 339 SInt32 size, offset; 340 341 size = GetScrap (NULL, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, &offset); 342 if (size == sizeof (*timestamp)) 343 { 344 handle = NewHandle (size); 345 HLock (handle); 346 size = GetScrap (handle, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, &offset); 347 if (size == sizeof (*timestamp)) 348 *timestamp = *((unsigned long *) *handle); 349 DisposeHandle (handle); 350 } 351 if (size != sizeof (*timestamp)) 352 err = noTypeErr; 353#endif /* !TARGET_API_MAC_CARBON */ 354 355 return err; 356} 357 358/* Get the list of target types in SCRAP. The return value is a list 359 of target type symbols possibly followed by scrap flavor type 360 strings. */ 361 362static Lisp_Object 363get_scrap_target_type_list (scrap) 364 ScrapRef scrap; 365{ 366 Lisp_Object result = Qnil, rest, target_type; 367#if TARGET_API_MAC_CARBON 368 OSStatus err; 369 UInt32 count, i, type; 370 ScrapFlavorInfo *flavor_info = NULL; 371 Lisp_Object strings = Qnil; 372 373 err = GetScrapFlavorCount (scrap, &count); 374 if (err == noErr) 375 flavor_info = xmalloc (sizeof (ScrapFlavorInfo) * count); 376 err = GetScrapFlavorInfoList (scrap, &count, flavor_info); 377 if (err != noErr) 378 { 379 xfree (flavor_info); 380 flavor_info = NULL; 381 } 382 if (flavor_info == NULL) 383 count = 0; 384#endif 385 for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest)) 386 { 387 ScrapFlavorType flavor_type = 0; 388 389 if (CONSP (XCAR (rest)) 390 && (target_type = XCAR (XCAR (rest)), 391 SYMBOLP (target_type)) 392 && (flavor_type = scrap_has_target_type (scrap, target_type))) 393 { 394 result = Fcons (target_type, result); 395#if TARGET_API_MAC_CARBON 396 for (i = 0; i < count; i++) 397 if (flavor_info[i].flavorType == flavor_type) 398 { 399 flavor_info[i].flavorType = 0; 400 break; 401 } 402#endif 403 } 404 } 405#if TARGET_API_MAC_CARBON 406 if (flavor_info) 407 { 408 for (i = 0; i < count; i++) 409 if (flavor_info[i].flavorType) 410 { 411 type = EndianU32_NtoB (flavor_info[i].flavorType); 412 strings = Fcons (make_unibyte_string ((char *) &type, 4), strings); 413 } 414 result = nconc2 (result, strings); 415 xfree (flavor_info); 416 } 417#endif 418 419 return result; 420} 421 422/* Do protocol to assert ourself as a selection owner. 423 Update the Vselection_alist so that we can reply to later requests for 424 our selection. */ 425 426static void 427x_own_selection (selection_name, selection_value) 428 Lisp_Object selection_name, selection_value; 429{ 430 OSStatus err; 431 ScrapRef scrap; 432 struct gcpro gcpro1, gcpro2; 433 Lisp_Object rest, handler_fn, value, type; 434 int count; 435 436 CHECK_SYMBOL (selection_name); 437 438 GCPRO2 (selection_name, selection_value); 439 440 BLOCK_INPUT; 441 442 err = get_scrap_from_symbol (selection_name, 1, &scrap); 443 if (err == noErr && scrap) 444 { 445 /* Don't allow a quit within the converter. 446 When the user types C-g, he would be surprised 447 if by luck it came during a converter. */ 448 count = SPECPDL_INDEX (); 449 specbind (Qinhibit_quit, Qt); 450 451 for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest)) 452 { 453 if (!(CONSP (XCAR (rest)) 454 && (type = XCAR (XCAR (rest)), 455 SYMBOLP (type)) 456 && valid_scrap_target_type_p (type) 457 && (handler_fn = XCDR (XCAR (rest)), 458 SYMBOLP (handler_fn)))) 459 continue; 460 461 if (!NILP (handler_fn)) 462 value = call3 (handler_fn, selection_name, 463 type, selection_value); 464 465 if (STRINGP (value)) 466 err = put_scrap_string (scrap, type, value); 467 else if (CONSP (value) 468 && EQ (XCAR (value), type) 469 && STRINGP (XCDR (value))) 470 err = put_scrap_string (scrap, type, XCDR (value)); 471 } 472 473 unbind_to (count, Qnil); 474 475 if (err == noErr) 476 err = put_scrap_private_timestamp (scrap, last_event_timestamp); 477 } 478 479 UNBLOCK_INPUT; 480 481 UNGCPRO; 482 483 if (scrap && err != noErr) 484 error ("Can't set selection"); 485 486 /* Now update the local cache */ 487 { 488 Lisp_Object selection_time; 489 Lisp_Object selection_data; 490 Lisp_Object prev_value; 491 492 selection_time = long_to_cons (last_event_timestamp); 493 selection_data = Fcons (selection_name, 494 Fcons (selection_value, 495 Fcons (selection_time, 496 Fcons (selected_frame, Qnil)))); 497 prev_value = assq_no_quit (selection_name, Vselection_alist); 498 499 Vselection_alist = Fcons (selection_data, Vselection_alist); 500 501 /* If we already owned the selection, remove the old selection data. 502 Perhaps we should destructively modify it instead. 503 Don't use Fdelq as that may QUIT. */ 504 if (!NILP (prev_value)) 505 { 506 Lisp_Object rest; /* we know it's not the CAR, so it's easy. */ 507 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest)) 508 if (EQ (prev_value, Fcar (XCDR (rest)))) 509 { 510 XSETCDR (rest, Fcdr (XCDR (rest))); 511 break; 512 } 513 } 514 } 515} 516 517/* Given a selection-name and desired type, look up our local copy of 518 the selection value and convert it to the type. 519 The value is nil or a string. 520 This function is used both for remote requests (LOCAL_REQUEST is zero) 521 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero). 522 523 This calls random Lisp code, and may signal or gc. */ 524 525static Lisp_Object 526x_get_local_selection (selection_symbol, target_type, local_request) 527 Lisp_Object selection_symbol, target_type; 528 int local_request; 529{ 530 Lisp_Object local_value; 531 Lisp_Object handler_fn, value, type, check; 532 int count; 533 534 if (NILP (Fx_selection_owner_p (selection_symbol))) 535 return Qnil; 536 537 local_value = assq_no_quit (selection_symbol, Vselection_alist); 538 539 /* TIMESTAMP is a special case 'cause that's easiest. */ 540 if (EQ (target_type, QTIMESTAMP)) 541 { 542 handler_fn = Qnil; 543 value = XCAR (XCDR (XCDR (local_value))); 544 } 545#if 0 546 else if (EQ (target_type, QDELETE)) 547 { 548 handler_fn = Qnil; 549 Fx_disown_selection_internal 550 (selection_symbol, 551 XCAR (XCDR (XCDR (local_value)))); 552 value = QNULL; 553 } 554#endif 555 else 556 { 557 /* Don't allow a quit within the converter. 558 When the user types C-g, he would be surprised 559 if by luck it came during a converter. */ 560 count = SPECPDL_INDEX (); 561 specbind (Qinhibit_quit, Qt); 562 563 CHECK_SYMBOL (target_type); 564 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist)); 565 /* gcpro is not needed here since nothing but HANDLER_FN 566 is live, and that ought to be a symbol. */ 567 568 if (!NILP (handler_fn)) 569 value = call3 (handler_fn, 570 selection_symbol, (local_request ? Qnil : target_type), 571 XCAR (XCDR (local_value))); 572 else 573 value = Qnil; 574 unbind_to (count, Qnil); 575 } 576 577 /* Make sure this value is of a type that we could transmit 578 to another X client. */ 579 580 check = value; 581 if (CONSP (value) 582 && SYMBOLP (XCAR (value))) 583 type = XCAR (value), 584 check = XCDR (value); 585 586 if (STRINGP (check) 587 || VECTORP (check) 588 || SYMBOLP (check) 589 || INTEGERP (check) 590 || NILP (value)) 591 return value; 592 /* Check for a value that cons_to_long could handle. */ 593 else if (CONSP (check) 594 && INTEGERP (XCAR (check)) 595 && (INTEGERP (XCDR (check)) 596 || 597 (CONSP (XCDR (check)) 598 && INTEGERP (XCAR (XCDR (check))) 599 && NILP (XCDR (XCDR (check)))))) 600 return value; 601 602 signal_error ("Invalid data returned by selection-conversion function", 603 list2 (handler_fn, value)); 604} 605 606 607/* Clear all selections that were made from frame F. 608 We do this when about to delete a frame. */ 609 610void 611x_clear_frame_selections (f) 612 FRAME_PTR f; 613{ 614 Lisp_Object frame; 615 Lisp_Object rest; 616 617 XSETFRAME (frame, f); 618 619 /* Otherwise, we're really honest and truly being told to drop it. 620 Don't use Fdelq as that may QUIT;. */ 621 622 /* Delete elements from the beginning of Vselection_alist. */ 623 while (!NILP (Vselection_alist) 624 && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist))))))) 625 { 626 /* Let random Lisp code notice that the selection has been stolen. */ 627 Lisp_Object hooks, selection_symbol; 628 629 hooks = Vx_lost_selection_functions; 630 selection_symbol = Fcar (Fcar (Vselection_alist)); 631 632 if (!EQ (hooks, Qunbound) 633 && !NILP (Fx_selection_owner_p (selection_symbol))) 634 { 635 for (; CONSP (hooks); hooks = Fcdr (hooks)) 636 call1 (Fcar (hooks), selection_symbol); 637#if 0 /* This can crash when deleting a frame 638 from x_connection_closed. Anyway, it seems unnecessary; 639 something else should cause a redisplay. */ 640 redisplay_preserve_echo_area (21); 641#endif 642 } 643 644 Vselection_alist = Fcdr (Vselection_alist); 645 } 646 647 /* Delete elements after the beginning of Vselection_alist. */ 648 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest)) 649 if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest)))))))) 650 { 651 /* Let random Lisp code notice that the selection has been stolen. */ 652 Lisp_Object hooks, selection_symbol; 653 654 hooks = Vx_lost_selection_functions; 655 selection_symbol = Fcar (Fcar (XCDR (rest))); 656 657 if (!EQ (hooks, Qunbound) 658 && !NILP (Fx_selection_owner_p (selection_symbol))) 659 { 660 for (; CONSP (hooks); hooks = Fcdr (hooks)) 661 call1 (Fcar (hooks), selection_symbol); 662#if 0 /* See above */ 663 redisplay_preserve_echo_area (22); 664#endif 665 } 666 XSETCDR (rest, Fcdr (XCDR (rest))); 667 break; 668 } 669} 670 671/* Do protocol to read selection-data from the server. 672 Converts this to Lisp data and returns it. */ 673 674static Lisp_Object 675x_get_foreign_selection (selection_symbol, target_type, time_stamp) 676 Lisp_Object selection_symbol, target_type, time_stamp; 677{ 678 OSStatus err; 679 ScrapRef scrap; 680 Lisp_Object result = Qnil; 681 682 BLOCK_INPUT; 683 684 err = get_scrap_from_symbol (selection_symbol, 0, &scrap); 685 if (err == noErr && scrap) 686 { 687 if (EQ (target_type, QTARGETS)) 688 { 689 result = get_scrap_target_type_list (scrap); 690 result = Fvconcat (1, &result); 691 } 692 else 693 { 694 result = get_scrap_string (scrap, target_type); 695 if (STRINGP (result)) 696 Fput_text_property (make_number (0), make_number (SBYTES (result)), 697 Qforeign_selection, target_type, result); 698 } 699 } 700 701 UNBLOCK_INPUT; 702 703 return result; 704} 705 706 707DEFUN ("x-own-selection-internal", Fx_own_selection_internal, 708 Sx_own_selection_internal, 2, 2, 0, 709 doc: /* Assert a selection of the given TYPE with the given VALUE. 710TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. 711VALUE is typically a string, or a cons of two markers, but may be 712anything that the functions on `selection-converter-alist' know about. */) 713 (selection_name, selection_value) 714 Lisp_Object selection_name, selection_value; 715{ 716 check_mac (); 717 CHECK_SYMBOL (selection_name); 718 if (NILP (selection_value)) error ("SELECTION-VALUE may not be nil"); 719 x_own_selection (selection_name, selection_value); 720 return selection_value; 721} 722 723 724/* Request the selection value from the owner. If we are the owner, 725 simply return our selection value. If we are not the owner, this 726 will block until all of the data has arrived. */ 727 728DEFUN ("x-get-selection-internal", Fx_get_selection_internal, 729 Sx_get_selection_internal, 2, 3, 0, 730 doc: /* Return text selected from some Mac application. 731SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'. 732TYPE is the type of data desired, typically `STRING'. 733TIME_STAMP is ignored on Mac. */) 734 (selection_symbol, target_type, time_stamp) 735 Lisp_Object selection_symbol, target_type, time_stamp; 736{ 737 Lisp_Object val = Qnil; 738 struct gcpro gcpro1, gcpro2; 739 GCPRO2 (target_type, val); /* we store newly consed data into these */ 740 check_mac (); 741 CHECK_SYMBOL (selection_symbol); 742 CHECK_SYMBOL (target_type); 743 744 val = x_get_local_selection (selection_symbol, target_type, 1); 745 746 if (NILP (val)) 747 { 748 val = x_get_foreign_selection (selection_symbol, target_type, time_stamp); 749 goto DONE; 750 } 751 752 if (CONSP (val) 753 && SYMBOLP (XCAR (val))) 754 { 755 val = XCDR (val); 756 if (CONSP (val) && NILP (XCDR (val))) 757 val = XCAR (val); 758 } 759 DONE: 760 UNGCPRO; 761 return val; 762} 763 764DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal, 765 Sx_disown_selection_internal, 1, 2, 0, 766 doc: /* If we own the selection SELECTION, disown it. 767Disowning it means there is no such selection. */) 768 (selection, time) 769 Lisp_Object selection; 770 Lisp_Object time; 771{ 772 OSStatus err; 773 ScrapRef scrap; 774 Lisp_Object local_selection_data; 775 776 check_mac (); 777 CHECK_SYMBOL (selection); 778 779 if (NILP (Fx_selection_owner_p (selection))) 780 return Qnil; /* Don't disown the selection when we're not the owner. */ 781 782 local_selection_data = assq_no_quit (selection, Vselection_alist); 783 784 /* Don't use Fdelq as that may QUIT;. */ 785 786 if (EQ (local_selection_data, Fcar (Vselection_alist))) 787 Vselection_alist = Fcdr (Vselection_alist); 788 else 789 { 790 Lisp_Object rest; 791 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest)) 792 if (EQ (local_selection_data, Fcar (XCDR (rest)))) 793 { 794 XSETCDR (rest, Fcdr (XCDR (rest))); 795 break; 796 } 797 } 798 799 /* Let random lisp code notice that the selection has been stolen. */ 800 801 { 802 Lisp_Object rest; 803 rest = Vx_lost_selection_functions; 804 if (!EQ (rest, Qunbound)) 805 { 806 for (; CONSP (rest); rest = Fcdr (rest)) 807 call1 (Fcar (rest), selection); 808 prepare_menu_bars (); 809 redisplay_preserve_echo_area (20); 810 } 811 } 812 813 BLOCK_INPUT; 814 815 err = get_scrap_from_symbol (selection, 0, &scrap); 816 if (err == noErr && scrap) 817 clear_scrap (&scrap); 818 819 UNBLOCK_INPUT; 820 821 return Qt; 822} 823 824 825DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p, 826 0, 1, 0, 827 doc: /* Whether the current Emacs process owns the given SELECTION. 828The arg should be the name of the selection in question, typically one of 829the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. 830For convenience, the symbol nil is the same as `PRIMARY', 831and t is the same as `SECONDARY'. */) 832 (selection) 833 Lisp_Object selection; 834{ 835 OSStatus err; 836 ScrapRef scrap; 837 Lisp_Object result = Qnil, local_selection_data; 838 839 check_mac (); 840 CHECK_SYMBOL (selection); 841 if (EQ (selection, Qnil)) selection = QPRIMARY; 842 if (EQ (selection, Qt)) selection = QSECONDARY; 843 844 local_selection_data = assq_no_quit (selection, Vselection_alist); 845 846 if (NILP (local_selection_data)) 847 return Qnil; 848 849 BLOCK_INPUT; 850 851 err = get_scrap_from_symbol (selection, 0, &scrap); 852 if (err == noErr && scrap) 853 { 854 unsigned long timestamp; 855 856 err = get_scrap_private_timestamp (scrap, ×tamp); 857 if (err == noErr 858 && (timestamp 859 == cons_to_long (XCAR (XCDR (XCDR (local_selection_data)))))) 860 result = Qt; 861 } 862 else 863 result = Qt; 864 865 UNBLOCK_INPUT; 866 867 return result; 868} 869 870DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p, 871 0, 1, 0, 872 doc: /* Whether there is an owner for the given SELECTION. 873The arg should be the name of the selection in question, typically one of 874the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. 875For convenience, the symbol nil is the same as `PRIMARY', 876and t is the same as `SECONDARY'. */) 877 (selection) 878 Lisp_Object selection; 879{ 880 OSStatus err; 881 ScrapRef scrap; 882 Lisp_Object result = Qnil, rest; 883 884 /* It should be safe to call this before we have an Mac frame. */ 885 if (! FRAME_MAC_P (SELECTED_FRAME ())) 886 return Qnil; 887 888 CHECK_SYMBOL (selection); 889 if (!NILP (Fx_selection_owner_p (selection))) 890 return Qt; 891 if (EQ (selection, Qnil)) selection = QPRIMARY; 892 if (EQ (selection, Qt)) selection = QSECONDARY; 893 894 BLOCK_INPUT; 895 896 err = get_scrap_from_symbol (selection, 0, &scrap); 897 if (err == noErr && scrap) 898 for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest)) 899 { 900 if (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest))) 901 && scrap_has_target_type (scrap, XCAR (XCAR (rest)))) 902 { 903 result = Qt; 904 break; 905 } 906 } 907 908 UNBLOCK_INPUT; 909 910 return result; 911} 912 913 914/*********************************************************************** 915 Apple event support 916***********************************************************************/ 917int mac_ready_for_apple_events = 0; 918static Lisp_Object Vmac_apple_event_map; 919static Lisp_Object Qmac_apple_event_class, Qmac_apple_event_id; 920static Lisp_Object Qemacs_suspension_id; 921extern Lisp_Object Qundefined; 922extern void mac_store_apple_event P_ ((Lisp_Object, Lisp_Object, 923 const AEDesc *)); 924 925struct apple_event_binding 926{ 927 UInt32 code; /* Apple event class or ID. */ 928 Lisp_Object key, binding; 929}; 930 931struct suspended_ae_info 932{ 933 UInt32 expiration_tick, suspension_id; 934 AppleEvent apple_event, reply; 935 struct suspended_ae_info *next; 936}; 937 938/* List of apple events deferred at the startup time. */ 939static struct suspended_ae_info *deferred_apple_events = NULL; 940 941/* List of suspended apple events, in order of expiration_tick. */ 942static struct suspended_ae_info *suspended_apple_events = NULL; 943 944static void 945find_event_binding_fun (key, binding, args, data) 946 Lisp_Object key, binding, args; 947 void *data; 948{ 949 struct apple_event_binding *event_binding = 950 (struct apple_event_binding *)data; 951 Lisp_Object code_string; 952 953 if (!SYMBOLP (key)) 954 return; 955 code_string = Fget (key, args); 956 if (STRINGP (code_string) && SBYTES (code_string) == 4 957 && (EndianU32_BtoN (*((UInt32 *) SDATA (code_string))) 958 == event_binding->code)) 959 { 960 event_binding->key = key; 961 event_binding->binding = binding; 962 } 963} 964 965static void 966find_event_binding (keymap, event_binding, class_p) 967 Lisp_Object keymap; 968 struct apple_event_binding *event_binding; 969 int class_p; 970{ 971 if (event_binding->code == 0) 972 event_binding->binding = 973 access_keymap (keymap, event_binding->key, 0, 1, 0); 974 else 975 { 976 event_binding->binding = Qnil; 977 map_keymap (keymap, find_event_binding_fun, 978 class_p ? Qmac_apple_event_class : Qmac_apple_event_id, 979 event_binding, 0); 980 } 981} 982 983void 984mac_find_apple_event_spec (class, id, class_key, id_key, binding) 985 AEEventClass class; 986 AEEventID id; 987 Lisp_Object *class_key, *id_key, *binding; 988{ 989 struct apple_event_binding event_binding; 990 Lisp_Object keymap; 991 992 *binding = Qnil; 993 994 keymap = get_keymap (Vmac_apple_event_map, 0, 0); 995 if (NILP (keymap)) 996 return; 997 998 event_binding.code = class; 999 event_binding.key = *class_key; 1000 event_binding.binding = Qnil; 1001 find_event_binding (keymap, &event_binding, 1); 1002 *class_key = event_binding.key; 1003 keymap = get_keymap (event_binding.binding, 0, 0); 1004 if (NILP (keymap)) 1005 return; 1006 1007 event_binding.code = id; 1008 event_binding.key = *id_key; 1009 event_binding.binding = Qnil; 1010 find_event_binding (keymap, &event_binding, 0); 1011 *id_key = event_binding.key; 1012 *binding = event_binding.binding; 1013} 1014 1015static OSErr 1016defer_apple_events (apple_event, reply) 1017 const AppleEvent *apple_event, *reply; 1018{ 1019 OSErr err; 1020 struct suspended_ae_info *new; 1021 1022 new = xmalloc (sizeof (struct suspended_ae_info)); 1023 bzero (new, sizeof (struct suspended_ae_info)); 1024 new->apple_event.descriptorType = typeNull; 1025 new->reply.descriptorType = typeNull; 1026 1027 err = AESuspendTheCurrentEvent (apple_event); 1028 1029 /* Mac OS 10.3 Xcode manual says AESuspendTheCurrentEvent makes 1030 copies of the Apple event and the reply, but Mac OS 10.4 Xcode 1031 manual says it doesn't. Anyway we create copies of them and save 1032 them in `deferred_apple_events'. */ 1033 if (err == noErr) 1034 err = AEDuplicateDesc (apple_event, &new->apple_event); 1035 if (err == noErr) 1036 err = AEDuplicateDesc (reply, &new->reply); 1037 if (err == noErr) 1038 { 1039 new->next = deferred_apple_events; 1040 deferred_apple_events = new; 1041 } 1042 else 1043 { 1044 AEDisposeDesc (&new->apple_event); 1045 AEDisposeDesc (&new->reply); 1046 xfree (new); 1047 } 1048 1049 return err; 1050} 1051 1052static OSErr 1053mac_handle_apple_event_1 (class, id, apple_event, reply) 1054 Lisp_Object class, id; 1055 const AppleEvent *apple_event; 1056 AppleEvent *reply; 1057{ 1058 OSErr err; 1059 static UInt32 suspension_id = 0; 1060 struct suspended_ae_info *new; 1061 1062 new = xmalloc (sizeof (struct suspended_ae_info)); 1063 bzero (new, sizeof (struct suspended_ae_info)); 1064 new->apple_event.descriptorType = typeNull; 1065 new->reply.descriptorType = typeNull; 1066 1067 err = AESuspendTheCurrentEvent (apple_event); 1068 if (err == noErr) 1069 err = AEDuplicateDesc (apple_event, &new->apple_event); 1070 if (err == noErr) 1071 err = AEDuplicateDesc (reply, &new->reply); 1072 if (err == noErr) 1073 err = AEPutAttributePtr (&new->apple_event, KEY_EMACS_SUSPENSION_ID_ATTR, 1074 typeUInt32, &suspension_id, sizeof (UInt32)); 1075 if (err == noErr) 1076 { 1077 OSErr err1; 1078 SInt32 reply_requested; 1079 1080 err1 = AEGetAttributePtr (&new->apple_event, keyReplyRequestedAttr, 1081 typeSInt32, NULL, &reply_requested, 1082 sizeof (SInt32), NULL); 1083 if (err1 != noErr) 1084 { 1085 /* Emulate keyReplyRequestedAttr in older versions. */ 1086 reply_requested = reply->descriptorType != typeNull; 1087 err = AEPutAttributePtr (&new->apple_event, keyReplyRequestedAttr, 1088 typeSInt32, &reply_requested, 1089 sizeof (SInt32)); 1090 } 1091 } 1092 if (err == noErr) 1093 { 1094 SInt32 timeout = 0; 1095 struct suspended_ae_info **p; 1096 1097 new->suspension_id = suspension_id; 1098 suspension_id++; 1099 err = AEGetAttributePtr (apple_event, keyTimeoutAttr, typeSInt32, 1100 NULL, &timeout, sizeof (SInt32), NULL); 1101 new->expiration_tick = TickCount () + timeout; 1102 1103 for (p = &suspended_apple_events; *p; p = &(*p)->next) 1104 if ((*p)->expiration_tick >= new->expiration_tick) 1105 break; 1106 new->next = *p; 1107 *p = new; 1108 1109 mac_store_apple_event (class, id, &new->apple_event); 1110 } 1111 else 1112 { 1113 AEDisposeDesc (&new->reply); 1114 AEDisposeDesc (&new->apple_event); 1115 xfree (new); 1116 } 1117 1118 return err; 1119} 1120 1121static pascal OSErr 1122mac_handle_apple_event (apple_event, reply, refcon) 1123 const AppleEvent *apple_event; 1124 AppleEvent *reply; 1125 SInt32 refcon; 1126{ 1127 OSErr err; 1128 UInt32 suspension_id; 1129 AEEventClass event_class; 1130 AEEventID event_id; 1131 Lisp_Object class_key, id_key, binding; 1132 1133 if (!mac_ready_for_apple_events) 1134 { 1135 err = defer_apple_events (apple_event, reply); 1136 if (err != noErr) 1137 return errAEEventNotHandled; 1138 return noErr; 1139 } 1140 1141 err = AEGetAttributePtr (apple_event, KEY_EMACS_SUSPENSION_ID_ATTR, 1142 typeUInt32, NULL, 1143 &suspension_id, sizeof (UInt32), NULL); 1144 if (err == noErr) 1145 /* Previously suspended event. Pass it to the next handler. */ 1146 return errAEEventNotHandled; 1147 1148 err = AEGetAttributePtr (apple_event, keyEventClassAttr, typeType, NULL, 1149 &event_class, sizeof (AEEventClass), NULL); 1150 if (err == noErr) 1151 err = AEGetAttributePtr (apple_event, keyEventIDAttr, typeType, NULL, 1152 &event_id, sizeof (AEEventID), NULL); 1153 if (err == noErr) 1154 { 1155 mac_find_apple_event_spec (event_class, event_id, 1156 &class_key, &id_key, &binding); 1157 if (!NILP (binding) && !EQ (binding, Qundefined)) 1158 { 1159 if (INTEGERP (binding)) 1160 return XINT (binding); 1161 err = mac_handle_apple_event_1 (class_key, id_key, 1162 apple_event, reply); 1163 } 1164 else 1165 err = errAEEventNotHandled; 1166 } 1167 if (err == noErr) 1168 return noErr; 1169 else 1170 return errAEEventNotHandled; 1171} 1172 1173static int 1174cleanup_suspended_apple_events (head, all_p) 1175 struct suspended_ae_info **head; 1176 int all_p; 1177{ 1178 UInt32 current_tick = TickCount (), nresumed = 0; 1179 struct suspended_ae_info *p, *next; 1180 1181 for (p = *head; p; p = next) 1182 { 1183 if (!all_p && p->expiration_tick > current_tick) 1184 break; 1185 AESetTheCurrentEvent (&p->apple_event); 1186 AEResumeTheCurrentEvent (&p->apple_event, &p->reply, 1187 (AEEventHandlerUPP) kAENoDispatch, 0); 1188 AEDisposeDesc (&p->reply); 1189 AEDisposeDesc (&p->apple_event); 1190 nresumed++; 1191 next = p->next; 1192 xfree (p); 1193 } 1194 *head = p; 1195 1196 return nresumed; 1197} 1198 1199static void 1200cleanup_all_suspended_apple_events () 1201{ 1202 cleanup_suspended_apple_events (&deferred_apple_events, 1); 1203 cleanup_suspended_apple_events (&suspended_apple_events, 1); 1204} 1205 1206void 1207init_apple_event_handler () 1208{ 1209 OSErr err; 1210 long result; 1211 1212 /* Make sure we have Apple events before starting. */ 1213 err = Gestalt (gestaltAppleEventsAttr, &result); 1214 if (err != noErr) 1215 abort (); 1216 1217 if (!(result & (1 << gestaltAppleEventsPresent))) 1218 abort (); 1219 1220 err = AEInstallEventHandler (typeWildCard, typeWildCard, 1221#if TARGET_API_MAC_CARBON 1222 NewAEEventHandlerUPP (mac_handle_apple_event), 1223#else 1224 NewAEEventHandlerProc (mac_handle_apple_event), 1225#endif 1226 0L, false); 1227 if (err != noErr) 1228 abort (); 1229 1230 atexit (cleanup_all_suspended_apple_events); 1231} 1232 1233static UInt32 1234get_suspension_id (apple_event) 1235 Lisp_Object apple_event; 1236{ 1237 Lisp_Object tem; 1238 1239 CHECK_CONS (apple_event); 1240 CHECK_STRING_CAR (apple_event); 1241 if (SBYTES (XCAR (apple_event)) != 4 1242 || strcmp (SDATA (XCAR (apple_event)), "aevt") != 0) 1243 error ("Not an apple event"); 1244 1245 tem = assq_no_quit (Qemacs_suspension_id, XCDR (apple_event)); 1246 if (NILP (tem)) 1247 error ("Suspension ID not available"); 1248 1249 tem = XCDR (tem); 1250 if (!(CONSP (tem) 1251 && STRINGP (XCAR (tem)) && SBYTES (XCAR (tem)) == 4 1252 && strcmp (SDATA (XCAR (tem)), "magn") == 0 1253 && STRINGP (XCDR (tem)) && SBYTES (XCDR (tem)) == 4)) 1254 error ("Bad suspension ID format"); 1255 1256 return *((UInt32 *) SDATA (XCDR (tem))); 1257} 1258 1259 1260DEFUN ("mac-process-deferred-apple-events", Fmac_process_deferred_apple_events, Smac_process_deferred_apple_events, 0, 0, 0, 1261 doc: /* Process Apple events that are deferred at the startup time. */) 1262 () 1263{ 1264 if (mac_ready_for_apple_events) 1265 return Qnil; 1266 1267 BLOCK_INPUT; 1268 mac_ready_for_apple_events = 1; 1269 if (deferred_apple_events) 1270 { 1271 struct suspended_ae_info *prev, *tail, *next; 1272 1273 /* `nreverse' deferred_apple_events. */ 1274 prev = NULL; 1275 for (tail = deferred_apple_events; tail; tail = next) 1276 { 1277 next = tail->next; 1278 tail->next = prev; 1279 prev = tail; 1280 } 1281 1282 /* Now `prev' points to the first cell. */ 1283 for (tail = prev; tail; tail = next) 1284 { 1285 next = tail->next; 1286 AEResumeTheCurrentEvent (&tail->apple_event, &tail->reply, 1287 ((AEEventHandlerUPP) 1288 kAEUseStandardDispatch), 0); 1289 AEDisposeDesc (&tail->reply); 1290 AEDisposeDesc (&tail->apple_event); 1291 xfree (tail); 1292 } 1293 1294 deferred_apple_events = NULL; 1295 } 1296 UNBLOCK_INPUT; 1297 1298 return Qt; 1299} 1300 1301DEFUN ("mac-cleanup-expired-apple-events", Fmac_cleanup_expired_apple_events, Smac_cleanup_expired_apple_events, 0, 0, 0, 1302 doc: /* Clean up expired Apple events. 1303Return the number of expired events. */) 1304 () 1305{ 1306 int nexpired; 1307 1308 BLOCK_INPUT; 1309 nexpired = cleanup_suspended_apple_events (&suspended_apple_events, 0); 1310 UNBLOCK_INPUT; 1311 1312 return make_number (nexpired); 1313} 1314 1315DEFUN ("mac-ae-set-reply-parameter", Fmac_ae_set_reply_parameter, Smac_ae_set_reply_parameter, 3, 3, 0, 1316 doc: /* Set parameter KEYWORD to DESCRIPTOR on reply of APPLE-EVENT. 1317KEYWORD is a 4-byte string. DESCRIPTOR is a Lisp representation of an 1318Apple event descriptor. It has the form of (TYPE . DATA), where TYPE 1319is a 4-byte string. Valid format of DATA is as follows: 1320 1321 * If TYPE is "null", then DATA is nil. 1322 * If TYPE is "list", then DATA is a list (DESCRIPTOR1 ... DESCRIPTORn). 1323 * If TYPE is "reco", then DATA is a list ((KEYWORD1 . DESCRIPTOR1) 1324 ... (KEYWORDn . DESCRIPTORn)). 1325 * If TYPE is "aevt", then DATA is ignored and the descriptor is 1326 treated as null. 1327 * Otherwise, DATA is a string. 1328 1329If a (sub-)descriptor is in an invalid format, it is silently treated 1330as null. 1331 1332Return t if the parameter is successfully set. Otherwise return nil. */) 1333 (apple_event, keyword, descriptor) 1334 Lisp_Object apple_event, keyword, descriptor; 1335{ 1336 Lisp_Object result = Qnil; 1337 UInt32 suspension_id; 1338 struct suspended_ae_info *p; 1339 1340 suspension_id = get_suspension_id (apple_event); 1341 1342 CHECK_STRING (keyword); 1343 if (SBYTES (keyword) != 4) 1344 error ("Apple event keyword must be a 4-byte string: %s", 1345 SDATA (keyword)); 1346 1347 BLOCK_INPUT; 1348 for (p = suspended_apple_events; p; p = p->next) 1349 if (p->suspension_id == suspension_id) 1350 break; 1351 if (p && p->reply.descriptorType != typeNull) 1352 { 1353 OSErr err; 1354 1355 err = mac_ae_put_lisp (&p->reply, 1356 EndianU32_BtoN (*((UInt32 *) SDATA (keyword))), 1357 descriptor); 1358 if (err == noErr) 1359 result = Qt; 1360 } 1361 UNBLOCK_INPUT; 1362 1363 return result; 1364} 1365 1366DEFUN ("mac-resume-apple-event", Fmac_resume_apple_event, Smac_resume_apple_event, 1, 2, 0, 1367 doc: /* Resume handling of APPLE-EVENT. 1368Every Apple event handled by the Lisp interpreter is suspended first. 1369This function resumes such a suspended event either to complete Apple 1370event handling to give a reply, or to redispatch it to other handlers. 1371 1372If optional ERROR-CODE is an integer, it specifies the error number 1373that is set in the reply. If ERROR-CODE is t, the resumed event is 1374handled with the standard dispatching mechanism, but it is not handled 1375by Emacs again, thus it is redispatched to other handlers. 1376 1377Return t if APPLE-EVENT is successfully resumed. Otherwise return 1378nil, which means the event is already resumed or expired. */) 1379 (apple_event, error_code) 1380 Lisp_Object apple_event, error_code; 1381{ 1382 Lisp_Object result = Qnil; 1383 UInt32 suspension_id; 1384 struct suspended_ae_info **p, *ae; 1385 1386 suspension_id = get_suspension_id (apple_event); 1387 1388 BLOCK_INPUT; 1389 for (p = &suspended_apple_events; *p; p = &(*p)->next) 1390 if ((*p)->suspension_id == suspension_id) 1391 break; 1392 if (*p) 1393 { 1394 ae = *p; 1395 *p = (*p)->next; 1396 if (INTEGERP (error_code) 1397 && ae->reply.descriptorType != typeNull) 1398 { 1399 SInt32 errn = XINT (error_code); 1400 1401 AEPutParamPtr (&ae->reply, keyErrorNumber, typeSInt32, 1402 &errn, sizeof (SInt32)); 1403 } 1404 AESetTheCurrentEvent (&ae->apple_event); 1405 AEResumeTheCurrentEvent (&ae->apple_event, &ae->reply, 1406 ((AEEventHandlerUPP) 1407 (EQ (error_code, Qt) ? 1408 kAEUseStandardDispatch : kAENoDispatch)), 1409 0); 1410 AEDisposeDesc (&ae->reply); 1411 AEDisposeDesc (&ae->apple_event); 1412 xfree (ae); 1413 result = Qt; 1414 } 1415 UNBLOCK_INPUT; 1416 1417 return result; 1418} 1419 1420 1421/*********************************************************************** 1422 Drag and drop support 1423***********************************************************************/ 1424#if TARGET_API_MAC_CARBON 1425static Lisp_Object Vmac_dnd_known_types; 1426static pascal OSErr mac_do_track_drag P_ ((DragTrackingMessage, WindowRef, 1427 void *, DragRef)); 1428static pascal OSErr mac_do_receive_drag P_ ((WindowRef, void *, DragRef)); 1429static DragTrackingHandlerUPP mac_do_track_dragUPP = NULL; 1430static DragReceiveHandlerUPP mac_do_receive_dragUPP = NULL; 1431 1432extern void mac_store_drag_event P_ ((WindowRef, Point, SInt16, 1433 const AEDesc *)); 1434 1435static pascal OSErr 1436mac_do_track_drag (message, window, refcon, drag) 1437 DragTrackingMessage message; 1438 WindowRef window; 1439 void *refcon; 1440 DragRef drag; 1441{ 1442 OSErr err = noErr; 1443 static int can_accept; 1444 UInt16 num_items, index; 1445 1446 if (GetFrontWindowOfClass (kMovableModalWindowClass, false)) 1447 return dragNotAcceptedErr; 1448 1449 switch (message) 1450 { 1451 case kDragTrackingEnterHandler: 1452 err = CountDragItems (drag, &num_items); 1453 if (err != noErr) 1454 break; 1455 can_accept = 0; 1456 for (index = 1; index <= num_items; index++) 1457 { 1458 ItemReference item; 1459 FlavorFlags flags; 1460 Lisp_Object rest; 1461 1462 err = GetDragItemReferenceNumber (drag, index, &item); 1463 if (err != noErr) 1464 continue; 1465 for (rest = Vmac_dnd_known_types; CONSP (rest); rest = XCDR (rest)) 1466 { 1467 Lisp_Object str; 1468 FlavorType type; 1469 1470 str = XCAR (rest); 1471 if (!(STRINGP (str) && SBYTES (str) == 4)) 1472 continue; 1473 type = EndianU32_BtoN (*((UInt32 *) SDATA (str))); 1474 1475 err = GetFlavorFlags (drag, item, type, &flags); 1476 if (err == noErr) 1477 { 1478 can_accept = 1; 1479 break; 1480 } 1481 } 1482 } 1483 break; 1484 1485 case kDragTrackingEnterWindow: 1486 if (can_accept) 1487 { 1488 RgnHandle hilite_rgn = NewRgn (); 1489 1490 if (hilite_rgn) 1491 { 1492 Rect r; 1493 1494 GetWindowPortBounds (window, &r); 1495 OffsetRect (&r, -r.left, -r.top); 1496 RectRgn (hilite_rgn, &r); 1497 ShowDragHilite (drag, hilite_rgn, true); 1498 DisposeRgn (hilite_rgn); 1499 } 1500 SetThemeCursor (kThemeCopyArrowCursor); 1501 } 1502 break; 1503 1504 case kDragTrackingInWindow: 1505 break; 1506 1507 case kDragTrackingLeaveWindow: 1508 if (can_accept) 1509 { 1510 HideDragHilite (drag); 1511 SetThemeCursor (kThemeArrowCursor); 1512 } 1513 break; 1514 1515 case kDragTrackingLeaveHandler: 1516 break; 1517 } 1518 1519 if (err != noErr) 1520 return dragNotAcceptedErr; 1521 return noErr; 1522} 1523 1524static pascal OSErr 1525mac_do_receive_drag (window, refcon, drag) 1526 WindowRef window; 1527 void *refcon; 1528 DragRef drag; 1529{ 1530 OSErr err; 1531 int num_types, i; 1532 Lisp_Object rest, str; 1533 FlavorType *types; 1534 AppleEvent apple_event; 1535 Point mouse_pos; 1536 SInt16 modifiers; 1537 1538 if (GetFrontWindowOfClass (kMovableModalWindowClass, false)) 1539 return dragNotAcceptedErr; 1540 1541 num_types = 0; 1542 for (rest = Vmac_dnd_known_types; CONSP (rest); rest = XCDR (rest)) 1543 { 1544 str = XCAR (rest); 1545 if (STRINGP (str) && SBYTES (str) == 4) 1546 num_types++; 1547 } 1548 1549 types = xmalloc (sizeof (FlavorType) * num_types); 1550 i = 0; 1551 for (rest = Vmac_dnd_known_types; CONSP (rest); rest = XCDR (rest)) 1552 { 1553 str = XCAR (rest); 1554 if (STRINGP (str) && SBYTES (str) == 4) 1555 types[i++] = EndianU32_BtoN (*((UInt32 *) SDATA (str))); 1556 } 1557 1558 err = create_apple_event_from_drag_ref (drag, num_types, types, 1559 &apple_event); 1560 xfree (types); 1561 1562 if (err == noErr) 1563 err = GetDragMouse (drag, &mouse_pos, NULL); 1564 if (err == noErr) 1565 { 1566 GlobalToLocal (&mouse_pos); 1567 err = GetDragModifiers (drag, NULL, NULL, &modifiers); 1568 } 1569 if (err == noErr) 1570 { 1571 UInt32 key_modifiers = modifiers; 1572 1573 err = AEPutParamPtr (&apple_event, kEventParamKeyModifiers, 1574 typeUInt32, &key_modifiers, sizeof (UInt32)); 1575 } 1576 1577 if (err == noErr) 1578 { 1579 mac_store_drag_event (window, mouse_pos, 0, &apple_event); 1580 AEDisposeDesc (&apple_event); 1581 mac_wakeup_from_rne (); 1582 return noErr; 1583 } 1584 else 1585 return dragNotAcceptedErr; 1586} 1587#endif /* TARGET_API_MAC_CARBON */ 1588 1589OSErr 1590install_drag_handler (window) 1591 WindowRef window; 1592{ 1593 OSErr err = noErr; 1594 1595#if TARGET_API_MAC_CARBON 1596 if (mac_do_track_dragUPP == NULL) 1597 mac_do_track_dragUPP = NewDragTrackingHandlerUPP (mac_do_track_drag); 1598 if (mac_do_receive_dragUPP == NULL) 1599 mac_do_receive_dragUPP = NewDragReceiveHandlerUPP (mac_do_receive_drag); 1600 1601 err = InstallTrackingHandler (mac_do_track_dragUPP, window, NULL); 1602 if (err == noErr) 1603 err = InstallReceiveHandler (mac_do_receive_dragUPP, window, NULL); 1604#endif 1605 1606 return err; 1607} 1608 1609void 1610remove_drag_handler (window) 1611 WindowRef window; 1612{ 1613#if TARGET_API_MAC_CARBON 1614 if (mac_do_track_dragUPP) 1615 RemoveTrackingHandler (mac_do_track_dragUPP, window); 1616 if (mac_do_receive_dragUPP) 1617 RemoveReceiveHandler (mac_do_receive_dragUPP, window); 1618#endif 1619} 1620 1621 1622/*********************************************************************** 1623 Services menu support 1624***********************************************************************/ 1625#ifdef MAC_OSX 1626void 1627init_service_handler () 1628{ 1629 static const EventTypeSpec specs[] = 1630 {{kEventClassService, kEventServiceGetTypes}, 1631 {kEventClassService, kEventServiceCopy}, 1632 {kEventClassService, kEventServicePaste}, 1633 {kEventClassService, kEventServicePerform}}; 1634 InstallApplicationEventHandler (NewEventHandlerUPP (mac_handle_service_event), 1635 GetEventTypeCount (specs), specs, NULL, NULL); 1636} 1637 1638extern OSStatus mac_store_service_event P_ ((EventRef)); 1639 1640static OSStatus 1641copy_scrap_flavor_data (from_scrap, to_scrap, flavor_type) 1642 ScrapRef from_scrap, to_scrap; 1643 ScrapFlavorType flavor_type; 1644{ 1645 OSStatus err; 1646 Size size, size_allocated; 1647 char *buf = NULL; 1648 1649 err = GetScrapFlavorSize (from_scrap, flavor_type, &size); 1650 if (err == noErr) 1651 buf = xmalloc (size); 1652 while (buf) 1653 { 1654 size_allocated = size; 1655 err = GetScrapFlavorData (from_scrap, flavor_type, &size, buf); 1656 if (err != noErr) 1657 { 1658 xfree (buf); 1659 buf = NULL; 1660 } 1661 else if (size_allocated < size) 1662 buf = xrealloc (buf, size); 1663 else 1664 break; 1665 } 1666 if (err == noErr) 1667 { 1668 if (buf == NULL) 1669 err = memFullErr; 1670 else 1671 { 1672 err = PutScrapFlavor (to_scrap, flavor_type, kScrapFlavorMaskNone, 1673 size, buf); 1674 xfree (buf); 1675 } 1676 } 1677 1678 return err; 1679} 1680 1681static OSStatus 1682mac_handle_service_event (call_ref, event, data) 1683 EventHandlerCallRef call_ref; 1684 EventRef event; 1685 void *data; 1686{ 1687 OSStatus err = noErr; 1688 ScrapRef cur_scrap, specific_scrap; 1689 UInt32 event_kind = GetEventKind (event); 1690 CFMutableArrayRef copy_types, paste_types; 1691 CFStringRef type; 1692 Lisp_Object rest; 1693 ScrapFlavorType flavor_type; 1694 1695 /* Check if Vmac_service_selection is a valid selection that has a 1696 corresponding scrap. */ 1697 if (!SYMBOLP (Vmac_service_selection)) 1698 err = eventNotHandledErr; 1699 else 1700 err = get_scrap_from_symbol (Vmac_service_selection, 0, &cur_scrap); 1701 if (!(err == noErr && cur_scrap)) 1702 return eventNotHandledErr; 1703 1704 switch (event_kind) 1705 { 1706 case kEventServiceGetTypes: 1707 /* Set paste types. */ 1708 err = GetEventParameter (event, kEventParamServicePasteTypes, 1709 typeCFMutableArrayRef, NULL, 1710 sizeof (CFMutableArrayRef), NULL, 1711 &paste_types); 1712 if (err != noErr) 1713 break; 1714 1715 for (rest = Vselection_converter_alist; CONSP (rest); 1716 rest = XCDR (rest)) 1717 if (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest))) 1718 && (flavor_type = 1719 get_flavor_type_from_symbol (XCAR (XCAR (rest))))) 1720 { 1721 type = CreateTypeStringWithOSType (flavor_type); 1722 if (type) 1723 { 1724 CFArrayAppendValue (paste_types, type); 1725 CFRelease (type); 1726 } 1727 } 1728 1729 /* Set copy types. */ 1730 err = GetEventParameter (event, kEventParamServiceCopyTypes, 1731 typeCFMutableArrayRef, NULL, 1732 sizeof (CFMutableArrayRef), NULL, 1733 ©_types); 1734 if (err != noErr) 1735 break; 1736 1737 if (NILP (Fx_selection_owner_p (Vmac_service_selection))) 1738 break; 1739 else 1740 goto copy_all_flavors; 1741 1742 case kEventServiceCopy: 1743 err = GetEventParameter (event, kEventParamScrapRef, 1744 typeScrapRef, NULL, 1745 sizeof (ScrapRef), NULL, &specific_scrap); 1746 if (err != noErr 1747 || NILP (Fx_selection_owner_p (Vmac_service_selection))) 1748 { 1749 err = eventNotHandledErr; 1750 break; 1751 } 1752 1753 copy_all_flavors: 1754 { 1755 UInt32 count, i; 1756 ScrapFlavorInfo *flavor_info = NULL; 1757 ScrapFlavorFlags flags; 1758 1759 err = GetScrapFlavorCount (cur_scrap, &count); 1760 if (err == noErr) 1761 flavor_info = xmalloc (sizeof (ScrapFlavorInfo) * count); 1762 err = GetScrapFlavorInfoList (cur_scrap, &count, flavor_info); 1763 if (err != noErr) 1764 { 1765 xfree (flavor_info); 1766 flavor_info = NULL; 1767 } 1768 if (flavor_info == NULL) 1769 break; 1770 1771 for (i = 0; i < count; i++) 1772 { 1773 flavor_type = flavor_info[i].flavorType; 1774 err = GetScrapFlavorFlags (cur_scrap, flavor_type, &flags); 1775 if (err == noErr && !(flags & kScrapFlavorMaskSenderOnly)) 1776 { 1777 if (event_kind == kEventServiceCopy) 1778 err = copy_scrap_flavor_data (cur_scrap, specific_scrap, 1779 flavor_type); 1780 else /* event_kind == kEventServiceGetTypes */ 1781 { 1782 type = CreateTypeStringWithOSType (flavor_type); 1783 if (type) 1784 { 1785 CFArrayAppendValue (copy_types, type); 1786 CFRelease (type); 1787 } 1788 } 1789 } 1790 } 1791 xfree (flavor_info); 1792 } 1793 break; 1794 1795 case kEventServicePaste: 1796 case kEventServicePerform: 1797 { 1798 int data_exists_p = 0; 1799 1800 err = GetEventParameter (event, kEventParamScrapRef, typeScrapRef, 1801 NULL, sizeof (ScrapRef), NULL, 1802 &specific_scrap); 1803 if (err == noErr) 1804 err = clear_scrap (&cur_scrap); 1805 if (err == noErr) 1806 for (rest = Vselection_converter_alist; CONSP (rest); 1807 rest = XCDR (rest)) 1808 { 1809 if (! (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest))))) 1810 continue; 1811 flavor_type = get_flavor_type_from_symbol (XCAR (XCAR (rest))); 1812 if (flavor_type == 0) 1813 continue; 1814 err = copy_scrap_flavor_data (specific_scrap, cur_scrap, 1815 flavor_type); 1816 if (err == noErr) 1817 data_exists_p = 1; 1818 } 1819 if (!data_exists_p) 1820 err = eventNotHandledErr; 1821 else 1822 err = mac_store_service_event (event); 1823 } 1824 break; 1825 } 1826 1827 if (err != noErr) 1828 err = eventNotHandledErr; 1829 return err; 1830} 1831#endif 1832 1833 1834void 1835syms_of_macselect () 1836{ 1837 defsubr (&Sx_get_selection_internal); 1838 defsubr (&Sx_own_selection_internal); 1839 defsubr (&Sx_disown_selection_internal); 1840 defsubr (&Sx_selection_owner_p); 1841 defsubr (&Sx_selection_exists_p); 1842 defsubr (&Smac_process_deferred_apple_events); 1843 defsubr (&Smac_cleanup_expired_apple_events); 1844 defsubr (&Smac_resume_apple_event); 1845 defsubr (&Smac_ae_set_reply_parameter); 1846 1847 Vselection_alist = Qnil; 1848 staticpro (&Vselection_alist); 1849 1850 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist, 1851 doc: /* An alist associating selection-types with functions. 1852These functions are called to convert the selection, with three args: 1853the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD'); 1854a desired type to which the selection should be converted; 1855and the local selection value (whatever was given to `x-own-selection'). 1856 1857The function should return the value to send to the Scrap Manager 1858\(must be a string). A return value of nil 1859means that the conversion could not be done. */); 1860 Vselection_converter_alist = Qnil; 1861 1862 DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions, 1863 doc: /* A list of functions to be called when Emacs loses a selection. 1864\(This happens when a Lisp program explicitly clears the selection.) 1865The functions are called with one argument, the selection type 1866\(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */); 1867 Vx_lost_selection_functions = Qnil; 1868 1869 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system, 1870 doc: /* Coding system for communicating with other programs. 1871When sending or receiving text via cut_buffer, selection, and clipboard, 1872the text is encoded or decoded by this coding system. 1873The default value is determined by the system script code. */); 1874 Vselection_coding_system = Qnil; 1875 1876 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system, 1877 doc: /* Coding system for the next communication with other programs. 1878Usually, `selection-coding-system' is used for communicating with 1879other programs. But, if this variable is set, it is used for the 1880next communication only. After the communication, this variable is 1881set to nil. */); 1882 Vnext_selection_coding_system = Qnil; 1883 1884 DEFVAR_LISP ("mac-apple-event-map", &Vmac_apple_event_map, 1885 doc: /* Keymap for Apple events handled by Emacs. */); 1886 Vmac_apple_event_map = Qnil; 1887 1888#if TARGET_API_MAC_CARBON 1889 DEFVAR_LISP ("mac-dnd-known-types", &Vmac_dnd_known_types, 1890 doc: /* The types accepted by default for dropped data. 1891The types are chosen in the order they appear in the list. */); 1892 Vmac_dnd_known_types = list4 (build_string ("hfs "), build_string ("utxt"), 1893 build_string ("TEXT"), build_string ("TIFF")); 1894#ifdef MAC_OSX 1895 Vmac_dnd_known_types = Fcons (build_string ("furl"), Vmac_dnd_known_types); 1896#endif 1897#endif 1898 1899#ifdef MAC_OSX 1900 DEFVAR_LISP ("mac-service-selection", &Vmac_service_selection, 1901 doc: /* Selection name for communication via Services menu. */); 1902 Vmac_service_selection = intern ("PRIMARY"); 1903#endif 1904 1905 QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY); 1906 QSECONDARY = intern ("SECONDARY"); staticpro (&QSECONDARY); 1907 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP); 1908 QTARGETS = intern ("TARGETS"); staticpro (&QTARGETS); 1909 1910 Qforeign_selection = intern ("foreign-selection"); 1911 staticpro (&Qforeign_selection); 1912 1913 Qmac_scrap_name = intern ("mac-scrap-name"); 1914 staticpro (&Qmac_scrap_name); 1915 1916 Qmac_ostype = intern ("mac-ostype"); 1917 staticpro (&Qmac_ostype); 1918 1919 Qmac_apple_event_class = intern ("mac-apple-event-class"); 1920 staticpro (&Qmac_apple_event_class); 1921 1922 Qmac_apple_event_id = intern ("mac-apple-event-id"); 1923 staticpro (&Qmac_apple_event_id); 1924 1925 Qemacs_suspension_id = intern ("emacs-suspension-id"); 1926 staticpro (&Qemacs_suspension_id); 1927} 1928 1929/* arch-tag: f3c91ad8-99e0-4bd6-9eef-251b2f848732 1930 (do not change this comment) */ 1931