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       ownership_info = mac_get_selection_ownership_info (sel);
 472     else
 473       ownership_info = Qnil;    /* dummy value for local-only selection */
 474     selection_data = Fcons (selection_name,
 475                             Fcons (selection_value,
 476                                    Fcons (selection_time,
 477                                           Fcons (selected_frame,
 478                                                  Fcons (ownership_info,
 479                                                         Qnil)))));
 480     prev_value = assq_no_quit (selection_name, Vselection_alist);
 481
 482     Vselection_alist = Fcons (selection_data, Vselection_alist);
 483
 484     /* If we already owned the selection, remove the old selection data.
 485        Perhaps we should destructively modify it instead.
 486        Don't use Fdelq as that may QUIT.  */
 487     if (!NILP (prev_value))
 488       {
 489         Lisp_Object rest;       /* we know it's not the CAR, so it's easy.  */
 490         for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest))
 491           if (EQ (prev_value, Fcar (XCDR (rest))))
 492             {
 493               XSETCDR (rest, Fcdr (XCDR (rest)));
 494               break;
 495             }
 496       }
 497   }
 498 }
 499 \f
 500 /* Given a selection-name and desired type, look up our local copy of
 501    the selection value and convert it to the type.
 502    The value is nil or a string.
 503    This function is used both for remote requests (LOCAL_REQUEST is zero)
 504    and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
 505
 506    This calls random Lisp code, and may signal or gc.  */
 507
 508 static Lisp_Object
 509 x_get_local_selection (selection_symbol, target_type, local_request)
 510      Lisp_Object selection_symbol, target_type;
 511      int local_request;
 512 {
 513   Lisp_Object local_value;
 514   Lisp_Object handler_fn, value, type, check;
 515   int count;
 516
 517   if (NILP (Fx_selection_owner_p (selection_symbol)))
 518     return Qnil;
 519
 520   local_value = assq_no_quit (selection_symbol, Vselection_alist);
 521
 522   /* TIMESTAMP is a special case 'cause that's easiest.  */
 523   if (EQ (target_type, QTIMESTAMP))
 524     {
 525       handler_fn = Qnil;
 526       value = XCAR (XCDR (XCDR (local_value)));
 527     }
 528 #if 0
 529   else if (EQ (target_type, QDELETE))
 530     {
 531       handler_fn = Qnil;
 532       Fx_disown_selection_internal
 533         (selection_symbol,
 534          XCAR (XCDR (XCDR (local_value))));
 535       value = QNULL;
 536     }
 537 #endif
 538   else
 539     {
 540       /* Don't allow a quit within the converter.
 541          When the user types C-g, he would be surprised
 542          if by luck it came during a converter.  */
 543       count = SPECPDL_INDEX ();
 544       specbind (Qinhibit_quit, Qt);
 545
 546       CHECK_SYMBOL (target_type);
 547       handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
 548       /* gcpro is not needed here since nothing but HANDLER_FN
 549          is live, and that ought to be a symbol.  */
 550
 551       if (!NILP (handler_fn))
 552         value = call3 (handler_fn,
 553                        selection_symbol, (local_request ? Qnil : target_type),
 554                        XCAR (XCDR (local_value)));
 555       else
 556         value = Qnil;
 557       unbind_to (count, Qnil);
 558     }
 559
 560   if (local_request)
 561     return value;
 562
 563   /* Make sure this value is of a type that we could transmit
 564      to another application.  */
 565
 566   type = target_type;
 567   check = value;
 568   if (CONSP (value)
 569       && SYMBOLP (XCAR (value)))
 570     type = XCAR (value),
 571     check = XCDR (value);
 572
 573   if (NILP (value) || mac_valid_selection_value_p (check, type))
 574     return value;
 575
 576   signal_error ("Invalid data returned by selection-conversion function",
 577                 list2 (handler_fn, value));
 578 }
 579
 580 \f
 581 /* Clear all selections that were made from frame F.
 582    We do this when about to delete a frame.  */
 583
 584 void
 585 x_clear_frame_selections (f)
 586      FRAME_PTR f;
 587 {
 588   Lisp_Object frame;
 589   Lisp_Object rest;
 590
 591   XSETFRAME (frame, f);
 592
 593   /* Otherwise, we're really honest and truly being told to drop it.
 594      Don't use Fdelq as that may QUIT;.  */
 595
 596   /* Delete elements from the beginning of Vselection_alist.  */
 597   while (!NILP (Vselection_alist)
 598          && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
 599     {
 600       /* Let random Lisp code notice that the selection has been stolen.  */
 601       Lisp_Object hooks, selection_symbol;
 602
 603       hooks = Vx_lost_selection_functions;
 604       selection_symbol = Fcar (Fcar (Vselection_alist));
 605
 606       if (!EQ (hooks, Qunbound)
 607           && !NILP (Fx_selection_owner_p (selection_symbol)))
 608         {
 609           for (; CONSP (hooks); hooks = Fcdr (hooks))
 610             call1 (Fcar (hooks), selection_symbol);
 611 #if 0 /* This can crash when deleting a frame
 612          from x_connection_closed.  Anyway, it seems unnecessary;
 613          something else should cause a redisplay.  */
 614           redisplay_preserve_echo_area (21);
 615 #endif
 616         }
 617
 618       Vselection_alist = Fcdr (Vselection_alist);
 619     }
 620
 621   /* Delete elements after the beginning of Vselection_alist.  */
 622   for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest))
 623     if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest))))))))
 624       {
 625         /* Let random Lisp code notice that the selection has been stolen.  */
 626         Lisp_Object hooks, selection_symbol;
 627
 628         hooks = Vx_lost_selection_functions;
 629         selection_symbol = Fcar (Fcar (XCDR (rest)));
 630
 631         if (!EQ (hooks, Qunbound)
 632           && !NILP (Fx_selection_owner_p (selection_symbol)))
 633           {
 634             for (; CONSP (hooks); hooks = Fcdr (hooks))
 635               call1 (Fcar (hooks), selection_symbol);
 636 #if 0 /* See above */
 637             redisplay_preserve_echo_area (22);
 638 #endif
 639           }
 640         XSETCDR (rest, Fcdr (XCDR (rest)));
 641         break;
 642       }
 643 }
 644 \f
 645 /* Do protocol to read selection-data from the server.
 646    Converts this to Lisp data and returns it.  */
 647
 648 static Lisp_Object
 649 x_get_foreign_selection (selection_symbol, target_type, time_stamp)
 650      Lisp_Object selection_symbol, target_type, time_stamp;
 651 {
 652   OSStatus err;
 653   Selection sel;
 654   Lisp_Object result = Qnil;
 655
 656   BLOCK_INPUT;
 657
 658   err = mac_get_selection_from_symbol (selection_symbol, 0, &sel);
 659   if (err == noErr && sel)
 660     {
 661       if (EQ (target_type, QTARGETS))
 662         {
 663           result = mac_get_selection_target_list (sel);
 664           result = Fvconcat (1, &result);
 665         }
 666       else
 667         {
 668           result = mac_get_selection_value (sel, target_type);
 669           if (STRINGP (result))
 670             Fput_text_property (make_number (0), make_number (SBYTES (result)),
 671                                 Qforeign_selection, target_type, result);
 672         }
 673     }
 674
 675   UNBLOCK_INPUT;
 676
 677   return result;
 678 }
 679
 680
 681 DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
 682        Sx_own_selection_internal, 2, 2, 0,
 683        doc: /* Assert a selection of the given TYPE with the given VALUE.
 684 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
 685 VALUE is typically a string, or a cons of two markers, but may be
 686 anything that the functions on `selection-converter-alist' know about.  */)
 687      (selection_name, selection_value)
 688      Lisp_Object selection_name, selection_value;
 689 {
 690   check_mac ();
 691   CHECK_SYMBOL (selection_name);
 692   if (NILP (selection_value)) error ("SELECTION-VALUE may not be nil");
 693   x_own_selection (selection_name, selection_value);
 694   return selection_value;
 695 }
 696
 697
 698 /* Request the selection value from the owner.  If we are the owner,
 699    simply return our selection value.  If we are not the owner, this
 700    will block until all of the data has arrived.  */
 701
 702 DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
 703        Sx_get_selection_internal, 2, 3, 0,
 704        doc: /* Return text selected from some Mac application.
 705 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
 706 TYPE is the type of data desired, typically `STRING'.
 707 TIME_STAMP is ignored on Mac.  */)
 708      (selection_symbol, target_type, time_stamp)
 709      Lisp_Object selection_symbol, target_type, time_stamp;
 710 {
 711   Lisp_Object val = Qnil;
 712   struct gcpro gcpro1, gcpro2;
 713   GCPRO2 (target_type, val); /* we store newly consed data into these */
 714   check_mac ();
 715   CHECK_SYMBOL (selection_symbol);
 716   CHECK_SYMBOL (target_type);
 717
 718   val = x_get_local_selection (selection_symbol, target_type, 1);
 719
 720   if (NILP (val))
 721     {
 722       val = x_get_foreign_selection (selection_symbol, target_type, time_stamp);
 723       goto DONE;
 724     }
 725
 726   if (CONSP (val)
 727       && SYMBOLP (XCAR (val)))
 728     {
 729       val = XCDR (val);
 730       if (CONSP (val) && NILP (XCDR (val)))
 731         val = XCAR (val);
 732     }
 733  DONE:
 734   UNGCPRO;
 735   return val;
 736 }
 737
 738 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
 739        Sx_disown_selection_internal, 1, 2, 0,
 740        doc: /* If we own the selection SELECTION, disown it.
 741 Disowning it means there is no such selection.  */)
 742      (selection, time)
 743      Lisp_Object selection;
 744      Lisp_Object time;
 745 {
 746   OSStatus err;
 747   Selection sel;
 748   Lisp_Object local_selection_data;
 749
 750   check_mac ();
 751   CHECK_SYMBOL (selection);
 752
 753   if (NILP (Fx_selection_owner_p (selection)))
 754     return Qnil;  /* Don't disown the selection when we're not the owner.  */
 755
 756   local_selection_data = assq_no_quit (selection, Vselection_alist);
 757
 758   /* Don't use Fdelq as that may QUIT;.  */
 759
 760   if (EQ (local_selection_data, Fcar (Vselection_alist)))
 761     Vselection_alist = Fcdr (Vselection_alist);
 762   else
 763     {
 764       Lisp_Object rest;
 765       for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest))
 766         if (EQ (local_selection_data, Fcar (XCDR (rest))))
 767           {
 768             XSETCDR (rest, Fcdr (XCDR (rest)));
 769             break;
 770           }
 771     }
 772
 773   /* Let random lisp code notice that the selection has been stolen.  */
 774
 775   {
 776     Lisp_Object rest;
 777     rest = Vx_lost_selection_functions;
 778     if (!EQ (rest, Qunbound))
 779       {
 780         for (; CONSP (rest); rest = Fcdr (rest))
 781           call1 (Fcar (rest), selection);
 782         prepare_menu_bars ();
 783         redisplay_preserve_echo_area (20);
 784       }
 785   }
 786
 787   BLOCK_INPUT;
 788
 789   err = mac_get_selection_from_symbol (selection, 0, &sel);
 790   if (err == noErr && sel)
 791     mac_clear_selection (&sel);
 792
 793   UNBLOCK_INPUT;
 794
 795   return Qt;
 796 }
 797
 798
 799 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
 800        0, 1, 0,
 801        doc: /* Whether the current Emacs process owns the given SELECTION.
 802 The arg should be the name of the selection in question, typically one of
 803 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
 804 For convenience, the symbol nil is the same as `PRIMARY',
 805 and t is the same as `SECONDARY'.  */)
 806      (selection)
 807      Lisp_Object selection;
 808 {
 809   OSStatus err;
 810   Selection sel;
 811   Lisp_Object result = Qnil, local_selection_data;
 812
 813   check_mac ();
 814   CHECK_SYMBOL (selection);
 815   if (EQ (selection, Qnil)) selection = QPRIMARY;
 816   if (EQ (selection, Qt)) selection = QSECONDARY;
 817
 818   local_selection_data = assq_no_quit (selection, Vselection_alist);
 819
 820   if (NILP (local_selection_data))
 821     return Qnil;
 822
 823   BLOCK_INPUT;
 824
 825   err = mac_get_selection_from_symbol (selection, 0, &sel);
 826   if (err == noErr && sel)
 827     {
 828       Lisp_Object ownership_info;
 829
 830       ownership_info = XCAR (XCDR (XCDR (XCDR (XCDR (local_selection_data)))));
 831       if (!NILP (Fequal (ownership_info,
 832                          mac_get_selection_ownership_info (sel))))
 833         result = Qt;
 834     }
 835   else
 836     result = Qt;
 837
 838   UNBLOCK_INPUT;
 839
 840   return result;
 841 }
 842
 843 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
 844        0, 1, 0,
 845        doc: /* Whether there is an owner for the given SELECTION.
 846 The arg should be the name of the selection in question, typically one of
 847 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
 848 For convenience, the symbol nil is the same as `PRIMARY',
 849 and t is the same as `SECONDARY'.  */)
 850      (selection)
 851      Lisp_Object selection;
 852 {
 853   OSStatus err;
 854   Selection sel;
 855   Lisp_Object result = Qnil, rest;
 856
 857   /* It should be safe to call this before we have an Mac frame.  */
 858   if (! FRAME_MAC_P (SELECTED_FRAME ()))
 859     return Qnil;
 860
 861   CHECK_SYMBOL (selection);
 862   if (!NILP (Fx_selection_owner_p (selection)))
 863     return Qt;
 864   if (EQ (selection, Qnil)) selection = QPRIMARY;
 865   if (EQ (selection, Qt)) selection = QSECONDARY;
 866
 867   BLOCK_INPUT;
 868
 869   err = mac_get_selection_from_symbol (selection, 0, &sel);
 870   if (err == noErr && sel)
 871     for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest))
 872       {
 873         if (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest)))
 874             && mac_selection_has_target_p (sel, XCAR (XCAR (rest))))
 875           {
 876             result = Qt;
 877             break;
 878           }
 879       }
 880
 881   UNBLOCK_INPUT;
 882
 883   return result;
 884 }
 885
 886 \f
 887 /***********************************************************************
 888                          Apple event support
 889 ***********************************************************************/
 890 int mac_ready_for_apple_events = 0;
 891 static Lisp_Object Vmac_apple_event_map;
 892 static Lisp_Object Qmac_apple_event_class, Qmac_apple_event_id;
 893 static Lisp_Object Qemacs_suspension_id;
 894 extern Lisp_Object Qundefined;
 895 extern void mac_store_apple_event P_ ((Lisp_Object, Lisp_Object,
 896                                        const AEDesc *));
 897
 898 struct apple_event_binding
 899 {
 900   UInt32 code;                  /* Apple event class or ID.  */
 901   Lisp_Object key, binding;
 902 };
 903
 904 struct suspended_ae_info
 905 {
 906   UInt32 expiration_tick, suspension_id;
 907   AppleEvent apple_event, reply;
 908   struct suspended_ae_info *next;
 909 };
 910
 911 /* List of apple events deferred at the startup time.  */
 912 static struct suspended_ae_info *deferred_apple_events = NULL;
 913
 914 /* List of suspended apple events, in order of expiration_tick.  */
 915 static struct suspended_ae_info *suspended_apple_events = NULL;
 916
 917 static void
 918 find_event_binding_fun (key, binding, args, data)
 919      Lisp_Object key, binding, args;
 920      void *data;
 921 {
 922   struct apple_event_binding *event_binding =
 923     (struct apple_event_binding *)data;
 924   Lisp_Object code_string;
 925
 926   if (!SYMBOLP (key))
 927     return;
 928   code_string = Fget (key, args);
 929   if (STRINGP (code_string) && SBYTES (code_string) == 4
 930       && (EndianU32_BtoN (*((UInt32 *) SDATA (code_string)))
 931           == event_binding->code))
 932     {
 933       event_binding->key = key;
 934       event_binding->binding = binding;
 935     }
 936 }
 937
 938 static void
 939 find_event_binding (keymap, event_binding, class_p)
 940      Lisp_Object keymap;
 941      struct apple_event_binding *event_binding;
 942      int class_p;
 943 {
 944   if (event_binding->code == 0)
 945     event_binding->binding =
 946       access_keymap (keymap, event_binding->key, 0, 1, 0);
 947   else
 948     {
 949       event_binding->binding = Qnil;
 950       map_keymap (keymap, find_event_binding_fun,
 951                   class_p ? Qmac_apple_event_class : Qmac_apple_event_id,
 952                   event_binding, 0);
 953     }
 954 }
 955
 956 void
 957 mac_find_apple_event_spec (class, id, class_key, id_key, binding)
 958      AEEventClass class;
 959      AEEventID id;
 960      Lisp_Object *class_key, *id_key, *binding;
 961 {
 962   struct apple_event_binding event_binding;
 963   Lisp_Object keymap;
 964
 965   *binding = Qnil;
 966
 967   keymap = get_keymap (Vmac_apple_event_map, 0, 0);
 968   if (NILP (keymap))
 969     return;
 970
 971   event_binding.code = class;
 972   event_binding.key = *class_key;
 973   event_binding.binding = Qnil;
 974   find_event_binding (keymap, &event_binding, 1);
 975   *class_key = event_binding.key;
 976   keymap = get_keymap (event_binding.binding, 0, 0);
 977   if (NILP (keymap))
 978     return;
 979
 980   event_binding.code = id;
 981   event_binding.key = *id_key;
 982   event_binding.binding = Qnil;
 983   find_event_binding (keymap, &event_binding, 0);
 984   *id_key = event_binding.key;
 985   *binding = event_binding.binding;
 986 }
 987
 988 static OSErr
 989 defer_apple_events (apple_event, reply)
 990      const AppleEvent *apple_event, *reply;
 991 {
 992   OSErr err;
 993   struct suspended_ae_info *new;
 994
 995   new = xmalloc (sizeof (struct suspended_ae_info));
 996   bzero (new, sizeof (struct suspended_ae_info));
 997   new->apple_event.descriptorType = typeNull;
 998   new->reply.descriptorType = typeNull;
 999
1000   err = AESuspendTheCurrentEvent (apple_event);
1001
1002   /* Mac OS 10.3 Xcode manual says AESuspendTheCurrentEvent makes
1003      copies of the Apple event and the reply, but Mac OS 10.4 Xcode
1004      manual says it doesn't.  Anyway we create copies of them and save
1005      them in `deferred_apple_events'.  */
1006   if (err == noErr)
1007     err = AEDuplicateDesc (apple_event, &new->apple_event);
1008   if (err == noErr)
1009     err = AEDuplicateDesc (reply, &new->reply);
1010   if (err == noErr)
1011     {
1012       new->next = deferred_apple_events;
1013       deferred_apple_events = new;
1014     }
1015   else
1016     {
1017       AEDisposeDesc (&new->apple_event);
1018       AEDisposeDesc (&new->reply);
1019       xfree (new);
1020     }
1021
1022   return err;
1023 }
1024
1025 static OSErr
1026 mac_handle_apple_event_1 (class, id, apple_event, reply)
1027      Lisp_Object class, id;
1028      const AppleEvent *apple_event;
1029      AppleEvent *reply;
1030 {
1031   OSErr err;
1032   static UInt32 suspension_id = 0;
1033   struct suspended_ae_info *new;
1034
1035   new = xmalloc (sizeof (struct suspended_ae_info));
1036   bzero (new, sizeof (struct suspended_ae_info));
1037   new->apple_event.descriptorType = typeNull;
1038   new->reply.descriptorType = typeNull;
1039
1040   err = AESuspendTheCurrentEvent (apple_event);
1041   if (err == noErr)
1042     err = AEDuplicateDesc (apple_event, &new->apple_event);
1043   if (err == noErr)
1044     err = AEDuplicateDesc (reply, &new->reply);
1045   if (err == noErr)
1046     err = AEPutAttributePtr (&new->apple_event, KEY_EMACS_SUSPENSION_ID_ATTR,
1047                              typeUInt32, &suspension_id, sizeof (UInt32));
1048   if (err == noErr)
1049     {
1050       OSErr err1;
1051       SInt32 reply_requested;
1052
1053       err1 = AEGetAttributePtr (&new->apple_event, keyReplyRequestedAttr,
1054                                 typeSInt32, NULL, &reply_requested,
1055                                 sizeof (SInt32), NULL);
1056       if (err1 != noErr)
1057         {
1058           /* Emulate keyReplyRequestedAttr in older versions.  */
1059           reply_requested = reply->descriptorType != typeNull;
1060           err = AEPutAttributePtr (&new->apple_event, keyReplyRequestedAttr,
1061                                    typeSInt32, &reply_requested,
1062                                    sizeof (SInt32));
1063         }
1064     }
1065   if (err == noErr)
1066     {
1067       SInt32 timeout = 0;
1068       struct suspended_ae_info **p;
1069
1070       new->suspension_id = suspension_id;
1071       suspension_id++;
1072       err = AEGetAttributePtr (apple_event, keyTimeoutAttr, typeSInt32,
1073                                NULL, &timeout, sizeof (SInt32), NULL);
1074       new->expiration_tick = TickCount () + timeout;
1075
1076       for (p = &suspended_apple_events; *p; p = &(*p)->next)
1077         if ((*p)->expiration_tick >= new->expiration_tick)
1078           break;
1079       new->next = *p;
1080       *p = new;
1081
1082       mac_store_apple_event (class, id, &new->apple_event);
1083     }
1084   else
1085     {
1086       AEDisposeDesc (&new->reply);
1087       AEDisposeDesc (&new->apple_event);
1088       xfree (new);
1089     }
1090
1091   return err;
1092 }
1093
1094 static pascal OSErr
1095 mac_handle_apple_event (apple_event, reply, refcon)
1096      const AppleEvent *apple_event;
1097      AppleEvent *reply;
1098      SInt32 refcon;
1099 {
1100   OSErr err;
1101   UInt32 suspension_id;
1102   AEEventClass event_class;
1103   AEEventID event_id;
1104   Lisp_Object class_key, id_key, binding;
1105
1106   if (!mac_ready_for_apple_events)
1107     {
1108       err = defer_apple_events (apple_event, reply);
1109       if (err != noErr)
1110         return errAEEventNotHandled;
1111       return noErr;
1112     }
1113
1114   err = AEGetAttributePtr (apple_event, KEY_EMACS_SUSPENSION_ID_ATTR,
1115                            typeUInt32, NULL,
1116                            &suspension_id, sizeof (UInt32), NULL);
1117   if (err == noErr)
1118     /* Previously suspended event.  Pass it to the next handler.  */
1119     return errAEEventNotHandled;
1120
1121   err = AEGetAttributePtr (apple_event, keyEventClassAttr, typeType, NULL,
1122                            &event_class, sizeof (AEEventClass), NULL);
1123   if (err == noErr)
1124     err = AEGetAttributePtr (apple_event, keyEventIDAttr, typeType, NULL,
1125                              &event_id, sizeof (AEEventID), NULL);
1126   if (err == noErr)
1127     {
1128       mac_find_apple_event_spec (event_class, event_id,
1129                                  &class_key, &id_key, &binding);
1130       if (!NILP (binding) && !EQ (binding, Qundefined))
1131         {
1132           if (INTEGERP (binding))
1133             return XINT (binding);
1134           err = mac_handle_apple_event_1 (class_key, id_key,
1135                                           apple_event, reply);
1136         }
1137       else
1138         err = errAEEventNotHandled;
1139     }
1140   if (err == noErr)
1141     return noErr;
1142   else
1143     return errAEEventNotHandled;
1144 }
1145
1146 static int
1147 cleanup_suspended_apple_events (head, all_p)
1148      struct suspended_ae_info **head;
1149      int all_p;
1150 {
1151   UInt32 current_tick = TickCount (), nresumed = 0;
1152   struct suspended_ae_info *p, *next;
1153
1154   for (p = *head; p; p = next)
1155     {
1156       if (!all_p && p->expiration_tick > current_tick)
1157         break;
1158       AESetTheCurrentEvent (&p->apple_event);
1159       AEResumeTheCurrentEvent (&p->apple_event, &p->reply,
1160                                (AEEventHandlerUPP) kAENoDispatch, 0);
1161       AEDisposeDesc (&p->reply);
1162       AEDisposeDesc (&p->apple_event);
1163       nresumed++;
1164       next = p->next;
1165       xfree (p);
1166     }
1167   *head = p;
1168
1169   return nresumed;
1170 }
1171
1172 static void
1173 cleanup_all_suspended_apple_events ()
1174 {
1175   cleanup_suspended_apple_events (&deferred_apple_events, 1);
1176   cleanup_suspended_apple_events (&suspended_apple_events, 1);
1177 }
1178
1179 void
1180 init_apple_event_handler ()
1181 {
1182   OSErr err;
1183   long result;
1184
1185   /* Make sure we have Apple events before starting.  */
1186   err = Gestalt (gestaltAppleEventsAttr, &result);
1187   if (err != noErr)
1188     abort ();
1189
1190   if (!(result & (1 << gestaltAppleEventsPresent)))
1191     abort ();
1192
1193   err = AEInstallEventHandler (typeWildCard, typeWildCard,
1194 #if TARGET_API_MAC_CARBON
1195                                NewAEEventHandlerUPP (mac_handle_apple_event),
1196 #else
1197                                NewAEEventHandlerProc (mac_handle_apple_event),
1198 #endif
1199                                0L, false);
1200   if (err != noErr)
1201     abort ();
1202
1203   atexit (cleanup_all_suspended_apple_events);
1204 }
1205
1206 static UInt32
1207 get_suspension_id (apple_event)
1208      Lisp_Object apple_event;
1209 {
1210   Lisp_Object tem;
1211
1212   CHECK_CONS (apple_event);
1213   CHECK_STRING_CAR (apple_event);
1214   if (SBYTES (XCAR (apple_event)) != 4
1215       || strcmp (SDATA (XCAR (apple_event)), "aevt") != 0)
1216     error ("Not an apple event");
1217
1218   tem = assq_no_quit (Qemacs_suspension_id, XCDR (apple_event));
1219   if (NILP (tem))
1220     error ("Suspension ID not available");
1221
1222   tem = XCDR (tem);
1223   if (!(CONSP (tem)
1224         && STRINGP (XCAR (tem)) && SBYTES (XCAR (tem)) == 4
1225         && strcmp (SDATA (XCAR (tem)), "magn") == 0
1226         && STRINGP (XCDR (tem)) && SBYTES (XCDR (tem)) == 4))
1227     error ("Bad suspension ID format");
1228
1229   return *((UInt32 *) SDATA (XCDR (tem)));
1230 }
1231
1232
1233 DEFUN ("mac-process-deferred-apple-events", Fmac_process_deferred_apple_events, Smac_process_deferred_apple_events, 0, 0, 0,
1234        doc: /* Process Apple events that are deferred at the startup time.  */)
1235   ()
1236 {
1237   if (mac_ready_for_apple_events)
1238     return Qnil;
1239
1240   BLOCK_INPUT;
1241   mac_ready_for_apple_events = 1;
1242   if (deferred_apple_events)
1243     {
1244       struct suspended_ae_info *prev, *tail, *next;
1245
1246       /* `nreverse' deferred_apple_events.  */
1247       prev = NULL;
1248       for (tail = deferred_apple_events; tail; tail = next)
1249         {
1250           next = tail->next;
1251           tail->next = prev;
1252           prev = tail;
1253         }
1254
1255       /* Now `prev' points to the first cell.  */
1256       for (tail = prev; tail; tail = next)
1257         {
1258           next = tail->next;
1259           AEResumeTheCurrentEvent (&tail->apple_event, &tail->reply,
1260                                    ((AEEventHandlerUPP)
1261                                     kAEUseStandardDispatch), 0);
1262           AEDisposeDesc (&tail->reply);
1263           AEDisposeDesc (&tail->apple_event);
1264           xfree (tail);
1265         }
1266
1267       deferred_apple_events = NULL;
1268     }
1269   UNBLOCK_INPUT;
1270
1271   return Qt;
1272 }
1273
1274 DEFUN ("mac-cleanup-expired-apple-events", Fmac_cleanup_expired_apple_events, Smac_cleanup_expired_apple_events, 0, 0, 0,
1275        doc: /* Clean up expired Apple events.
1276 Return the number of expired events.   */)
1277      ()
1278 {
1279   int nexpired;
1280
1281   BLOCK_INPUT;
1282   nexpired = cleanup_suspended_apple_events (&suspended_apple_events, 0);
1283   UNBLOCK_INPUT;
1284
1285   return make_number (nexpired);
1286 }
1287
1288 DEFUN ("mac-ae-set-reply-parameter", Fmac_ae_set_reply_parameter, Smac_ae_set_reply_parameter, 3, 3, 0,
1289        doc: /* Set parameter KEYWORD to DESCRIPTOR on reply of APPLE-EVENT.
1290 KEYWORD is a 4-byte string.  DESCRIPTOR is a Lisp representation of an
1291 Apple event descriptor.  It has the form of (TYPE . DATA), where TYPE
1292 is a 4-byte string.  Valid format of DATA is as follows:
1293
1294   * If TYPE is "null", then DATA is nil.
1295   * If TYPE is "list", then DATA is a list (DESCRIPTOR1 ... DESCRIPTORn).
1296   * If TYPE is "reco", then DATA is a list ((KEYWORD1 . DESCRIPTOR1)
1297     ... (KEYWORDn . DESCRIPTORn)).
1298   * If TYPE is "aevt", then DATA is ignored and the descriptor is
1299     treated as null.
1300   * Otherwise, DATA is a string.
1301
1302 If a (sub-)descriptor is in an invalid format, it is silently treated
1303 as null.
1304
1305 Return t if the parameter is successfully set.  Otherwise return nil.  */)
1306      (apple_event, keyword, descriptor)
1307      Lisp_Object apple_event, keyword, descriptor;
1308 {
1309   Lisp_Object result = Qnil;
1310   UInt32 suspension_id;
1311   struct suspended_ae_info *p;
1312
1313   suspension_id = get_suspension_id (apple_event);
1314
1315   CHECK_STRING (keyword);
1316   if (SBYTES (keyword) != 4)
1317     error ("Apple event keyword must be a 4-byte string: %s",
1318            SDATA (keyword));
1319
1320   BLOCK_INPUT;
1321   for (p = suspended_apple_events; p; p = p->next)
1322     if (p->suspension_id == suspension_id)
1323       break;
1324   if (p && p->reply.descriptorType != typeNull)
1325     {
1326       OSErr err;
1327
1328       err = mac_ae_put_lisp (&p->reply,
1329                              EndianU32_BtoN (*((UInt32 *) SDATA (keyword))),
1330                              descriptor);
1331       if (err == noErr)
1332         result = Qt;
1333     }
1334   UNBLOCK_INPUT;
1335
1336   return result;
1337 }
1338
1339 DEFUN ("mac-resume-apple-event", Fmac_resume_apple_event, Smac_resume_apple_event, 1, 2, 0,
1340        doc: /* Resume handling of APPLE-EVENT.
1341 Every Apple event handled by the Lisp interpreter is suspended first.
1342 This function resumes such a suspended event either to complete Apple
1343 event handling to give a reply, or to redispatch it to other handlers.
1344
1345 If optional ERROR-CODE is an integer, it specifies the error number
1346 that is set in the reply.  If ERROR-CODE is t, the resumed event is
1347 handled with the standard dispatching mechanism, but it is not handled
1348 by Emacs again, thus it is redispatched to other handlers.
1349
1350 Return t if APPLE-EVENT is successfully resumed.  Otherwise return
1351 nil, which means the event is already resumed or expired.  */)
1352      (apple_event, error_code)
1353      Lisp_Object apple_event, error_code;
1354 {
1355   Lisp_Object result = Qnil;
1356   UInt32 suspension_id;
1357   struct suspended_ae_info **p, *ae;
1358
1359   suspension_id = get_suspension_id (apple_event);
1360
1361   BLOCK_INPUT;
1362   for (p = &suspended_apple_events; *p; p = &(*p)->next)
1363     if ((*p)->suspension_id == suspension_id)
1364       break;
1365   if (*p)
1366     {
1367       ae = *p;
1368       *p = (*p)->next;
1369       if (INTEGERP (error_code)
1370           && ae->reply.descriptorType != typeNull)
1371         {
1372           SInt32 errn = XINT (error_code);
1373
1374           AEPutParamPtr (&ae->reply, keyErrorNumber, typeSInt32,
1375                          &errn, sizeof (SInt32));
1376         }
1377       AESetTheCurrentEvent (&ae->apple_event);
1378       AEResumeTheCurrentEvent (&ae->apple_event, &ae->reply,
1379                                ((AEEventHandlerUPP)
1380                                 (EQ (error_code, Qt) ?
1381                                  kAEUseStandardDispatch : kAENoDispatch)),
1382                                0);
1383       AEDisposeDesc (&ae->reply);
1384       AEDisposeDesc (&ae->apple_event);
1385       xfree (ae);
1386       result = Qt;
1387     }
1388   UNBLOCK_INPUT;
1389
1390   return result;
1391 }
1392
1393 \f
1394 /***********************************************************************
1395                       Drag and drop support
1396 ***********************************************************************/
1397 #if TARGET_API_MAC_CARBON
1398 static Lisp_Object Vmac_dnd_known_types;
1399 static pascal OSErr mac_do_track_drag P_ ((DragTrackingMessage, WindowRef,
1400                                            void *, DragRef));
1401 static pascal OSErr mac_do_receive_drag P_ ((WindowRef, void *, DragRef));
1402 static DragTrackingHandlerUPP mac_do_track_dragUPP = NULL;
1403 static DragReceiveHandlerUPP mac_do_receive_dragUPP = NULL;
1404
1405 extern void mac_store_drag_event P_ ((WindowRef, Point, SInt16,
1406                                       const AEDesc *));
1407
1408 static pascal OSErr
1409 mac_do_track_drag (message, window, refcon, drag)
1410      DragTrackingMessage message;
1411      WindowRef window;
1412      void *refcon;
1413      DragRef drag;
1414 {
1415   OSErr err = noErr;
1416   static int can_accept;
1417   UInt16 num_items, index;
1418
1419   if (GetFrontWindowOfClass (kMovableModalWindowClass, false))
1420     return dragNotAcceptedErr;
1421
1422   switch (message)
1423     {
1424     case kDragTrackingEnterHandler:
1425       err = CountDragItems (drag, &num_items);
1426       if (err != noErr)
1427         break;
1428       can_accept = 0;
1429       for (index = 1; index <= num_items; index++)
1430         {
1431           ItemReference item;
1432           FlavorFlags flags;
1433           Lisp_Object rest;
1434
1435           err = GetDragItemReferenceNumber (drag, index, &item);
1436           if (err != noErr)
1437             continue;
1438           for (rest = Vmac_dnd_known_types; CONSP (rest); rest = XCDR (rest))
1439             {
1440               Lisp_Object str;
1441               FlavorType type;
1442
1443               str = XCAR (rest);
1444               if (!(STRINGP (str) && SBYTES (str) == 4))
1445                 continue;
1446               type = EndianU32_BtoN (*((UInt32 *) SDATA (str)));
1447
1448               err = GetFlavorFlags (drag, item, type, &flags);
1449               if (err == noErr)
1450                 {
1451                   can_accept = 1;
1452                   break;
1453                 }
1454             }
1455         }
1456       break;
1457
1458     case kDragTrackingEnterWindow:
1459       if (can_accept)
1460         {
1461           RgnHandle hilite_rgn = NewRgn ();
1462
1463           if (hilite_rgn)
1464             {
1465               Rect r;
1466
1467               GetWindowPortBounds (window, &r);
1468               OffsetRect (&r, -r.left, -r.top);
1469               RectRgn (hilite_rgn, &r);
1470               ShowDragHilite (drag, hilite_rgn, true);
1471               DisposeRgn (hilite_rgn);
1472             }
1473           SetThemeCursor (kThemeCopyArrowCursor);
1474         }
1475       break;
1476
1477     case kDragTrackingInWindow:
1478       break;
1479
1480     case kDragTrackingLeaveWindow:
1481       if (can_accept)
1482         {
1483           HideDragHilite (drag);
1484           SetThemeCursor (kThemeArrowCursor);
1485         }
1486       break;
1487
1488     case kDragTrackingLeaveHandler:
1489       break;
1490     }
1491
1492   if (err != noErr)
1493     return dragNotAcceptedErr;
1494   return noErr;
1495 }
1496
1497 static pascal OSErr
1498 mac_do_receive_drag (window, refcon, drag)
1499      WindowRef window;
1500      void *refcon;
1501      DragRef drag;
1502 {
1503   OSErr err;
1504   int num_types, i;
1505   Lisp_Object rest, str;
1506   FlavorType *types;
1507   AppleEvent apple_event;
1508   Point mouse_pos;
1509   SInt16 modifiers;
1510
1511   if (GetFrontWindowOfClass (kMovableModalWindowClass, false))
1512     return dragNotAcceptedErr;
1513
1514   num_types = 0;
1515   for (rest = Vmac_dnd_known_types; CONSP (rest); rest = XCDR (rest))
1516     {
1517       str = XCAR (rest);
1518       if (STRINGP (str) && SBYTES (str) == 4)
1519         num_types++;
1520     }
1521
1522   types = xmalloc (sizeof (FlavorType) * num_types);
1523   i = 0;
1524   for (rest = Vmac_dnd_known_types; CONSP (rest); rest = XCDR (rest))
1525     {
1526       str = XCAR (rest);
1527       if (STRINGP (str) && SBYTES (str) == 4)
1528         types[i++] = EndianU32_BtoN (*((UInt32 *) SDATA (str)));
1529     }
1530
1531   err = create_apple_event_from_drag_ref (drag, num_types, types,
1532                                           &apple_event);
1533   xfree (types);
1534
1535   if (err == noErr)
1536     err = GetDragMouse (drag, &mouse_pos, NULL);
1537   if (err == noErr)
1538     {
1539       GlobalToLocal (&mouse_pos);
1540       err = GetDragModifiers (drag, NULL, NULL, &modifiers);
1541     }
1542   if (err == noErr)
1543     {
1544       UInt32 key_modifiers = modifiers;
1545
1546       err = AEPutParamPtr (&apple_event, kEventParamKeyModifiers,
1547                            typeUInt32, &key_modifiers, sizeof (UInt32));
1548     }
1549
1550   if (err == noErr)
1551     {
1552       mac_store_drag_event (window, mouse_pos, 0, &apple_event);
1553       AEDisposeDesc (&apple_event);
1554       mac_wakeup_from_rne ();
1555       return noErr;
1556     }
1557   else
1558     return dragNotAcceptedErr;
1559 }
1560 #endif  /* TARGET_API_MAC_CARBON */
1561
1562 OSErr
1563 install_drag_handler (window)
1564      WindowRef window;
1565 {
1566   OSErr err = noErr;
1567
1568 #if TARGET_API_MAC_CARBON
1569   if (mac_do_track_dragUPP == NULL)
1570     mac_do_track_dragUPP = NewDragTrackingHandlerUPP (mac_do_track_drag);
1571   if (mac_do_receive_dragUPP == NULL)
1572     mac_do_receive_dragUPP = NewDragReceiveHandlerUPP (mac_do_receive_drag);
1573
1574   err = InstallTrackingHandler (mac_do_track_dragUPP, window, NULL);
1575   if (err == noErr)
1576     err = InstallReceiveHandler (mac_do_receive_dragUPP, window, NULL);
1577 #endif
1578
1579   return err;
1580 }
1581
1582 void
1583 remove_drag_handler (window)
1584      WindowRef window;
1585 {
1586 #if TARGET_API_MAC_CARBON
1587   if (mac_do_track_dragUPP)
1588     RemoveTrackingHandler (mac_do_track_dragUPP, window);
1589   if (mac_do_receive_dragUPP)
1590     RemoveReceiveHandler (mac_do_receive_dragUPP, window);
1591 #endif
1592 }
1593
1594 \f
1595 /***********************************************************************
1596                         Services menu support
1597 ***********************************************************************/
1598 #ifdef MAC_OSX
1599 OSStatus
1600 install_service_handler ()
1601 {
1602   static const EventTypeSpec specs[] =
1603     {{kEventClassService, kEventServiceGetTypes},
1604      {kEventClassService, kEventServiceCopy},
1605      {kEventClassService, kEventServicePaste},
1606      {kEventClassService, kEventServicePerform}};
1607
1608   return InstallApplicationEventHandler (NewEventHandlerUPP
1609                                          (mac_handle_service_event),
1610                                          GetEventTypeCount (specs),
1611                                          specs, NULL, NULL);
1612 }
1613
1614 extern OSStatus mac_store_service_event P_ ((EventRef));
1615
1616 static OSStatus
1617 copy_scrap_flavor_data (from_scrap, to_scrap, flavor_type)
1618      ScrapRef from_scrap, to_scrap;
1619      ScrapFlavorType flavor_type;
1620 {
1621   OSStatus err;
1622   Size size, size_allocated;
1623   char *buf = NULL;
1624
1625   err = GetScrapFlavorSize (from_scrap, flavor_type, &size);
1626   if (err == noErr)
1627     buf = xmalloc (size);
1628   while (buf)
1629     {
1630       size_allocated = size;
1631       err = GetScrapFlavorData (from_scrap, flavor_type, &size, buf);
1632       if (err != noErr)
1633         {
1634           xfree (buf);
1635           buf = NULL;
1636         }
1637       else if (size_allocated < size)
1638         buf = xrealloc (buf, size);
1639       else
1640         break;
1641     }
1642   if (err == noErr)
1643     {
1644       if (buf == NULL)
1645         err = memFullErr;
1646       else
1647         {
1648           err = PutScrapFlavor (to_scrap, flavor_type, kScrapFlavorMaskNone,
1649                                 size, buf);
1650           xfree (buf);
1651         }
1652     }
1653
1654   return err;
1655 }
1656
1657 static OSStatus
1658 mac_handle_service_event (call_ref, event, data)
1659      EventHandlerCallRef call_ref;
1660      EventRef event;
1661      void *data;
1662 {
1663   OSStatus err = noErr;
1664   ScrapRef cur_scrap, specific_scrap;
1665   UInt32 event_kind = GetEventKind (event);
1666   CFMutableArrayRef copy_types, paste_types;
1667   CFStringRef type;
1668   Lisp_Object rest;
1669   ScrapFlavorType flavor_type;
1670
1671   /* Check if Vmac_service_selection is a valid selection that has a
1672      corresponding scrap.  */
1673   if (!SYMBOLP (Vmac_service_selection))
1674     err = eventNotHandledErr;
1675   else
1676     err = mac_get_selection_from_symbol (Vmac_service_selection, 0, &cur_scrap);
1677   if (!(err == noErr && cur_scrap))
1678     return eventNotHandledErr;
1679
1680   switch (event_kind)
1681     {
1682     case kEventServiceGetTypes:
1683       /* Set paste types. */
1684       err = GetEventParameter (event, kEventParamServicePasteTypes,
1685                                typeCFMutableArrayRef, NULL,
1686                                sizeof (CFMutableArrayRef), NULL,
1687                                &paste_types);
1688       if (err != noErr)
1689         break;
1690
1691       for (rest = Vselection_converter_alist; CONSP (rest);
1692            rest = XCDR (rest))
1693         if (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest)))
1694             && (flavor_type =
1695                 get_flavor_type_from_symbol (XCAR (XCAR (rest)), 0)))
1696           {
1697             type = CreateTypeStringWithOSType (flavor_type);
1698             if (type)
1699               {
1700                 CFArrayAppendValue (paste_types, type);
1701                 CFRelease (type);
1702               }
1703           }
1704
1705       /* Set copy types.  */
1706       err = GetEventParameter (event, kEventParamServiceCopyTypes,
1707                                typeCFMutableArrayRef, NULL,
1708                                sizeof (CFMutableArrayRef), NULL,
1709                                &copy_types);
1710       if (err != noErr)
1711         break;
1712
1713       if (NILP (Fx_selection_owner_p (Vmac_service_selection)))
1714         break;
1715       else
1716         goto copy_all_flavors;
1717
1718     case kEventServiceCopy:
1719       err = GetEventParameter (event, kEventParamScrapRef,
1720                                typeScrapRef, NULL,
1721                                sizeof (ScrapRef), NULL, &specific_scrap);
1722       if (err != noErr
1723           || NILP (Fx_selection_owner_p (Vmac_service_selection)))
1724         {
1725           err = eventNotHandledErr;
1726           break;
1727         }
1728
1729     copy_all_flavors:
1730       {
1731         UInt32 count, i;
1732         ScrapFlavorInfo *flavor_info = NULL;
1733         ScrapFlavorFlags flags;
1734
1735         err = GetScrapFlavorCount (cur_scrap, &count);
1736         if (err == noErr)
1737           flavor_info = xmalloc (sizeof (ScrapFlavorInfo) * count);
1738         err = GetScrapFlavorInfoList (cur_scrap, &count, flavor_info);
1739         if (err != noErr)
1740           {
1741             xfree (flavor_info);
1742             flavor_info = NULL;
1743           }
1744         if (flavor_info == NULL)
1745           break;
1746
1747         for (i = 0; i < count; i++)
1748           {
1749             flavor_type = flavor_info[i].flavorType;
1750             err = GetScrapFlavorFlags (cur_scrap, flavor_type, &flags);
1751             if (err == noErr && !(flags & kScrapFlavorMaskSenderOnly))
1752               {
1753                 if (event_kind == kEventServiceCopy)
1754                   err = copy_scrap_flavor_data (cur_scrap, specific_scrap,
1755                                                 flavor_type);
1756                 else         /* event_kind == kEventServiceGetTypes */
1757                   {
1758                     type = CreateTypeStringWithOSType (flavor_type);
1759                     if (type)
1760                       {
1761                         CFArrayAppendValue (copy_types, type);
1762                         CFRelease (type);
1763                       }
1764                   }
1765               }
1766           }
1767         xfree (flavor_info);
1768       }
1769       break;
1770
1771     case kEventServicePaste:
1772     case kEventServicePerform:
1773       {
1774         int data_exists_p = 0;
1775
1776         err = GetEventParameter (event, kEventParamScrapRef, typeScrapRef,
1777                                  NULL, sizeof (ScrapRef), NULL,
1778                                  &specific_scrap);
1779         if (err == noErr)
1780           err = mac_clear_selection (&cur_scrap);
1781         if (err == noErr)
1782           for (rest = Vselection_converter_alist; CONSP (rest);
1783                rest = XCDR (rest))
1784             {
1785               if (! (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest)))))
1786                 continue;
1787               flavor_type = get_flavor_type_from_symbol (XCAR (XCAR (rest)),
1788                                                          specific_scrap);
1789               if (flavor_type == 0)
1790                 continue;
1791               err = copy_scrap_flavor_data (specific_scrap, cur_scrap,
1792                                             flavor_type);
1793               if (err == noErr)
1794                 data_exists_p = 1;
1795             }
1796         if (!data_exists_p)
1797           err = eventNotHandledErr;
1798         else
1799           err = mac_store_service_event (event);
1800       }
1801       break;
1802     }
1803
1804   if (err != noErr)
1805     err = eventNotHandledErr;
1806   return err;
1807 }
1808 #endif
1809
1810
1811 void
1812 syms_of_macselect ()
1813 {
1814   defsubr (&Sx_get_selection_internal);
1815   defsubr (&Sx_own_selection_internal);
1816   defsubr (&Sx_disown_selection_internal);
1817   defsubr (&Sx_selection_owner_p);
1818   defsubr (&Sx_selection_exists_p);
1819   defsubr (&Smac_process_deferred_apple_events);
1820   defsubr (&Smac_cleanup_expired_apple_events);
1821   defsubr (&Smac_resume_apple_event);
1822   defsubr (&Smac_ae_set_reply_parameter);
1823
1824   Vselection_alist = Qnil;
1825   staticpro (&Vselection_alist);
1826
1827   DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
1828                doc: /* An alist associating selection-types with functions.
1829 These functions are called to convert the selection, with three args:
1830 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
1831 a desired type to which the selection should be converted;
1832 and the local selection value (whatever was given to `x-own-selection').
1833
1834 The function should return the value to send to the Scrap Manager
1835 \(must be a string).  A return value of nil
1836 means that the conversion could not be done.  */);
1837   Vselection_converter_alist = Qnil;
1838
1839   DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions,
1840                doc: /* A list of functions to be called when Emacs loses a selection.
1841 \(This happens when a Lisp program explicitly clears the selection.)
1842 The functions are called with one argument, the selection type
1843 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD').  */);
1844   Vx_lost_selection_functions = Qnil;
1845
1846   DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
1847                doc: /* Coding system for communicating with other programs.
1848 When sending or receiving text via cut_buffer, selection, and clipboard,
1849 the text is encoded or decoded by this coding system.
1850 The default value is determined by the system script code.  */);
1851   Vselection_coding_system = Qnil;
1852
1853   DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
1854                doc: /* Coding system for the next communication with other programs.
1855 Usually, `selection-coding-system' is used for communicating with
1856 other programs.  But, if this variable is set, it is used for the
1857 next communication only.  After the communication, this variable is
1858 set to nil.  */);
1859   Vnext_selection_coding_system = Qnil;
1860
1861   DEFVAR_LISP ("mac-apple-event-map", &Vmac_apple_event_map,
1862                doc: /* Keymap for Apple events handled by Emacs.  */);
1863   Vmac_apple_event_map = Qnil;
1864
1865 #if TARGET_API_MAC_CARBON
1866   DEFVAR_LISP ("mac-dnd-known-types", &Vmac_dnd_known_types,
1867                doc: /* The types accepted by default for dropped data.
1868 The types are chosen in the order they appear in the list.  */);
1869   Vmac_dnd_known_types = list4 (build_string ("hfs "), build_string ("utxt"),
1870                                 build_string ("TEXT"), build_string ("TIFF"));
1871 #ifdef MAC_OSX
1872   Vmac_dnd_known_types = Fcons (build_string ("furl"), Vmac_dnd_known_types);
1873 #endif
1874 #endif
1875
1876 #ifdef MAC_OSX
1877   DEFVAR_LISP ("mac-service-selection", &Vmac_service_selection,
1878                doc: /* Selection name for communication via Services menu.  */);
1879   Vmac_service_selection = intern ("PRIMARY");
1880 #endif
1881
1882   QPRIMARY   = intern ("PRIMARY");      staticpro (&QPRIMARY);
1883   QSECONDARY = intern ("SECONDARY");    staticpro (&QSECONDARY);
1884   QTIMESTAMP = intern ("TIMESTAMP");    staticpro (&QTIMESTAMP);
1885   QTARGETS   = intern ("TARGETS");      staticpro (&QTARGETS);
1886
1887   Qforeign_selection = intern ("foreign-selection");
1888   staticpro (&Qforeign_selection);
1889
1890   Qmac_scrap_name = intern ("mac-scrap-name");
1891   staticpro (&Qmac_scrap_name);
1892
1893   Qmac_ostype = intern ("mac-ostype");
1894   staticpro (&Qmac_ostype);
1895
1896   Qmac_apple_event_class = intern ("mac-apple-event-class");
1897   staticpro (&Qmac_apple_event_class);
1898
1899   Qmac_apple_event_id = intern ("mac-apple-event-id");
1900   staticpro (&Qmac_apple_event_id);
1901
1902   Qemacs_suspension_id = intern ("emacs-suspension-id");
1903   staticpro (&Qemacs_suspension_id);
1904 }
1905
1906 /* arch-tag: f3c91ad8-99e0-4bd6-9eef-251b2f848732
1907    (do not change this comment) */