src/macselect.c

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