src/macselect.c

   1 /* Selection processing for Emacs on Mac OS.
   2    Copyright (C) 2005 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 2, 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 #include <Endian.h>
  30 typedef int ScrapRef;
  31 typedef ResType ScrapFlavorType;
  32 #endif /* !TARGET_API_MAC_CARBON */
  33
  34 static OSErr get_scrap_from_symbol P_ ((Lisp_Object, int, ScrapRef *));
  35 static ScrapFlavorType get_flavor_type_from_symbol P_ ((Lisp_Object));
  36 static int valid_scrap_target_type_p P_ ((Lisp_Object));
  37 static OSErr clear_scrap P_ ((ScrapRef *));
  38 static OSErr put_scrap_string P_ ((ScrapRef, Lisp_Object, Lisp_Object));
  39 static OSErr put_scrap_private_timestamp P_ ((ScrapRef, unsigned long));
  40 static ScrapFlavorType scrap_has_target_type P_ ((ScrapRef, Lisp_Object));
  41 static Lisp_Object get_scrap_string P_ ((ScrapRef, Lisp_Object));
  42 static OSErr get_scrap_private_timestamp P_ ((ScrapRef, unsigned long *));
  43 static Lisp_Object get_scrap_target_type_list P_ ((ScrapRef));
  44 static void x_own_selection P_ ((Lisp_Object, Lisp_Object));
  45 static Lisp_Object x_get_local_selection P_ ((Lisp_Object, Lisp_Object, int));
  46 static Lisp_Object x_get_foreign_selection P_ ((Lisp_Object,
  47                                                 Lisp_Object,
  48                                                 Lisp_Object));
  49 EXFUN (Fx_selection_owner_p, 1);
  50 #ifdef MAC_OSX
  51 static OSStatus mac_handle_service_event P_ ((EventHandlerCallRef,
  52                                               EventRef, void *));
  53 void init_service_handler P_ ((void));
  54 #endif
  55
  56 Lisp_Object QPRIMARY, QSECONDARY, QTIMESTAMP, QTARGETS;
  57
  58 static Lisp_Object Vx_lost_selection_functions;
  59 /* Coding system for communicating with other programs via scrap.  */
  60 static Lisp_Object Vselection_coding_system;
  61
  62 /* Coding system for the next communicating with other programs.  */
  63 static Lisp_Object Vnext_selection_coding_system;
  64
  65 static Lisp_Object Qforeign_selection;
  66
  67 /* The timestamp of the last input event Emacs received from the
  68    window server.  */
  69 /* Defined in keyboard.c.  */
  70 extern unsigned long last_event_timestamp;
  71
  72 /* This is an association list whose elements are of the form
  73      ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
  74    SELECTION-NAME is a lisp symbol.
  75    SELECTION-VALUE is the value that emacs owns for that selection.
  76      It may be any kind of Lisp object.
  77    SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
  78      as a cons of two 16-bit numbers (making a 32 bit time.)
  79    FRAME is the frame for which we made the selection.
  80    If there is an entry in this alist, and the data for the flavor
  81      type SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP in the corresponding scrap
  82      (if exists) coincides with SELECTION-TIMESTAMP, then it can be
  83      assumed that Emacs owns that selection.
  84    The only (eq) parts of this list that are visible from Lisp are the
  85     selection-values.  */
  86 static Lisp_Object Vselection_alist;
  87
  88 #define SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP 'Etsp'
  89
  90 /* This is an alist whose CARs are selection-types and whose CDRs are
  91    the names of Lisp functions to call to convert the given Emacs
  92    selection value to a string representing the given selection type.
  93    This is for Lisp-level extension of the emacs selection
  94    handling.  */
  95 static Lisp_Object Vselection_converter_alist;
  96
  97 /* A selection name (represented as a Lisp symbol) can be associated
  98    with a named scrap via `mac-scrap-name' property.  Likewise for a
  99    selection type with a scrap flavor type via `mac-ostype'.  */
 100 static Lisp_Object Qmac_scrap_name, Qmac_ostype;
 101
 102 #ifdef MAC_OSX
 103 /* Selection name for communication via Services menu.  */
 104 static Lisp_Object Vmac_services_selection;
 105 #endif
 106 \f
 107 /* Get a reference to the scrap corresponding to the symbol SYM.  The
 108    reference is set to *SCRAP, and it becomes NULL if there's no
 109    corresponding scrap.  Clear the scrap if CLEAR_P is non-zero.  */
 110
 111 static OSErr
 112 get_scrap_from_symbol (sym, clear_p, scrap)
 113      Lisp_Object sym;
 114      int clear_p;
 115      ScrapRef *scrap;
 116 {
 117   OSErr err = noErr;
 118   Lisp_Object str = Fget (sym, Qmac_scrap_name);
 119
 120   if (!STRINGP (str))
 121     *scrap = NULL;
 122   else
 123     {
 124 #if TARGET_API_MAC_CARBON
 125 #ifdef MAC_OSX
 126       CFStringRef scrap_name = cfstring_create_with_string (str);
 127       OptionBits options = (clear_p ? kScrapClearNamedScrap
 128                             : kScrapGetNamedScrap);
 129
 130       err = GetScrapByName (scrap_name, options, scrap);
 131       CFRelease (scrap_name);
 132 #else   /* !MAC_OSX */
 133       if (clear_p)
 134         err = ClearCurrentScrap ();
 135       if (err == noErr)
 136         err = GetCurrentScrap (scrap);
 137 #endif  /* !MAC_OSX */
 138 #else   /* !TARGET_API_MAC_CARBON */
 139       if (clear_p)
 140         err = ZeroScrap ();
 141       if (err == noErr)
 142         *scrap = 1;
 143 #endif  /* !TARGET_API_MAC_CARBON */
 144     }
 145
 146   return err;
 147 }
 148
 149 /* Get a scrap flavor type from the symbol SYM.  Return 0 if no
 150    corresponding flavor type.  */
 151
 152 static ScrapFlavorType
 153 get_flavor_type_from_symbol (sym)
 154      Lisp_Object sym;
 155 {
 156   Lisp_Object str = Fget (sym, Qmac_ostype);
 157
 158   if (STRINGP (str) && SBYTES (str) == 4)
 159     return EndianU32_BtoN (*((UInt32 *) SDATA (str)));
 160
 161   return 0;
 162 }
 163
 164 /* Check if the symbol SYM has a corresponding scrap flavor type.  */
 165
 166 static int
 167 valid_scrap_target_type_p (sym)
 168      Lisp_Object sym;
 169 {
 170   return get_flavor_type_from_symbol (sym) != 0;
 171 }
 172
 173 /* Clear the scrap whose reference is *SCRAP. */
 174
 175 static INLINE OSErr
 176 clear_scrap (scrap)
 177      ScrapRef *scrap;
 178 {
 179 #if TARGET_API_MAC_CARBON
 180 #ifdef MAC_OSX
 181   return ClearScrap (scrap);
 182 #else
 183   return ClearCurrentScrap ();
 184 #endif
 185 #else  /* !TARGET_API_MAC_CARBON */
 186   return ZeroScrap ();
 187 #endif  /* !TARGET_API_MAC_CARBON */
 188 }
 189
 190 /* Put Lisp String STR to the scrap SCRAP.  The target type is
 191    specified by TYPE. */
 192
 193 static OSErr
 194 put_scrap_string (scrap, type, str)
 195      ScrapRef scrap;
 196      Lisp_Object type, str;
 197 {
 198   ScrapFlavorType flavor_type = get_flavor_type_from_symbol (type);
 199
 200   if (flavor_type == 0)
 201     return noTypeErr;
 202
 203 #if TARGET_API_MAC_CARBON
 204   return PutScrapFlavor (scrap, flavor_type, kScrapFlavorMaskNone,
 205                          SBYTES (str), SDATA (str));
 206 #else  /* !TARGET_API_MAC_CARBON */
 207   return PutScrap (SBYTES (str), flavor_type, SDATA (str));
 208 #endif  /* !TARGET_API_MAC_CARBON */
 209 }
 210
 211 /* Put TIMESTAMP to the scrap SCRAP.  The timestamp is used for
 212    checking if the scrap is owned by the process.  */
 213
 214 static INLINE OSErr
 215 put_scrap_private_timestamp (scrap, timestamp)
 216      ScrapRef scrap;
 217      unsigned long timestamp;
 218 {
 219 #if TARGET_API_MAC_CARBON
 220   return PutScrapFlavor (scrap, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP,
 221                          kScrapFlavorMaskSenderOnly,
 222                          sizeof (timestamp), &timestamp);
 223 #else  /* !TARGET_API_MAC_CARBON */
 224   return PutScrap (sizeof (timestamp), SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP,
 225                    &timestamp);
 226 #endif  /* !TARGET_API_MAC_CARBON */
 227 }
 228
 229 /* Check if data for the target type TYPE is available in SCRAP.  */
 230
 231 static ScrapFlavorType
 232 scrap_has_target_type (scrap, type)
 233      ScrapRef scrap;
 234      Lisp_Object type;
 235 {
 236   OSErr err;
 237   ScrapFlavorType flavor_type = get_flavor_type_from_symbol (type);
 238
 239   if (flavor_type)
 240     {
 241 #if TARGET_API_MAC_CARBON
 242       ScrapFlavorFlags flags;
 243
 244       err = GetScrapFlavorFlags (scrap, flavor_type, &flags);
 245       if (err != noErr)
 246         flavor_type = 0;
 247 #else  /* !TARGET_API_MAC_CARBON */
 248       SInt32 size, offset;
 249
 250       size = GetScrap (NULL, flavor_type, &offset);
 251       if (size < 0)
 252         flavor_type = 0;
 253 #endif  /* !TARGET_API_MAC_CARBON */
 254     }
 255
 256   return flavor_type;
 257 }
 258
 259 /* Get data for the target type TYPE from SCRAP and create a Lisp
 260    string.  Return nil if failed to get data.  */
 261
 262 static Lisp_Object
 263 get_scrap_string (scrap, type)
 264      ScrapRef scrap;
 265      Lisp_Object type;
 266 {
 267   OSErr err;
 268   Lisp_Object result = Qnil;
 269   ScrapFlavorType flavor_type = get_flavor_type_from_symbol (type);
 270 #if TARGET_API_MAC_CARBON
 271   Size size;
 272
 273   if (flavor_type)
 274     {
 275       err = GetScrapFlavorSize (scrap, flavor_type, &size);
 276       if (err == noErr)
 277         {
 278           do
 279             {
 280               result = make_uninit_string (size);
 281               err = GetScrapFlavorData (scrap, flavor_type,
 282                                         &size, SDATA (result));
 283               if (err != noErr)
 284                 result = Qnil;
 285               else if (size < SBYTES (result))
 286                 result = make_unibyte_string (SDATA (result), size);
 287             }
 288           while (STRINGP (result) && size > SBYTES (result));
 289         }
 290     }
 291 #else
 292   Handle handle;
 293   SInt32 size, offset;
 294
 295   if (flavor_type)
 296     size = GetScrap (NULL, flavor_type, &offset);
 297   if (size >= 0)
 298     {
 299       handle = NewHandle (size);
 300       HLock (handle);
 301       size = GetScrap (handle, flavor_type, &offset);
 302       if (size >= 0)
 303         result = make_unibyte_string (*handle, size);
 304       DisposeHandle (handle);
 305     }
 306 #endif
 307
 308   return result;
 309 }
 310
 311 /* Get timestamp from the scrap SCRAP and set to *TIMPSTAMP.  */
 312
 313 static OSErr
 314 get_scrap_private_timestamp (scrap, timestamp)
 315      ScrapRef scrap;
 316      unsigned long *timestamp;
 317 {
 318   OSErr err = noErr;
 319 #if TARGET_API_MAC_CARBON
 320   ScrapFlavorFlags flags;
 321
 322   err = GetScrapFlavorFlags (scrap, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, &flags);
 323   if (err == noErr)
 324     {
 325       if (!(flags & kScrapFlavorMaskSenderOnly))
 326         err = noTypeErr;
 327       else
 328         {
 329           Size size = sizeof (*timestamp);
 330
 331           err = GetScrapFlavorData (scrap, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP,
 332                                     &size, timestamp);
 333           if (err == noErr && size != sizeof (*timestamp))
 334             err = noTypeErr;
 335         }
 336     }
 337 #else  /* !TARGET_API_MAC_CARBON */
 338   Handle handle;
 339   SInt32 size, offset;
 340
 341   size = GetScrap (NULL, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, &offset);
 342   if (size == sizeof (*timestamp))
 343     {
 344       handle = NewHandle (size);
 345       HLock (handle);
 346       size = GetScrap (handle, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, &offset);
 347       if (size == sizeof (*timestamp))
 348         *timestamp = *((unsigned long *) *handle);
 349       DisposeHandle (handle);
 350     }
 351   if (size != sizeof (*timestamp))
 352     err = noTypeErr;
 353 #endif  /* !TARGET_API_MAC_CARBON */
 354
 355   return err;
 356 }
 357
 358 /* Get the list of target types in SCRAP.  The return value is a list
 359    of target type symbols possibly followed by scrap flavor type
 360    strings.  */
 361
 362 static Lisp_Object
 363 get_scrap_target_type_list (scrap)
 364      ScrapRef scrap;
 365 {
 366   Lisp_Object result = Qnil, rest, target_type;
 367 #if TARGET_API_MAC_CARBON
 368   OSErr err;
 369   UInt32 count, i, type;
 370   ScrapFlavorInfo *flavor_info = NULL;
 371   Lisp_Object strings = Qnil;
 372
 373   err = GetScrapFlavorCount (scrap, &count);
 374   if (err == noErr)
 375     flavor_info = xmalloc (sizeof (ScrapFlavorInfo) * count);
 376   if (flavor_info)
 377     {
 378       err = GetScrapFlavorInfoList (scrap, &count, flavor_info);
 379       if (err != noErr)
 380         {
 381           xfree (flavor_info);
 382           flavor_info = NULL;
 383         }
 384     }
 385   if (flavor_info == NULL)
 386     count = 0;
 387 #endif
 388   for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest))
 389     {
 390       ScrapFlavorType flavor_type = 0;
 391
 392       if (CONSP (XCAR (rest)) && SYMBOLP (target_type = XCAR (XCAR (rest)))
 393           && (flavor_type = scrap_has_target_type (scrap, target_type)))
 394         {
 395           result = Fcons (target_type, result);
 396 #if TARGET_API_MAC_CARBON
 397           for (i = 0; i < count; i++)
 398             if (flavor_info[i].flavorType == flavor_type)
 399               {
 400                 flavor_info[i].flavorType = 0;
 401                 break;
 402               }
 403 #endif
 404         }
 405     }
 406 #if TARGET_API_MAC_CARBON
 407   if (flavor_info)
 408     {
 409       for (i = 0; i < count; i++)
 410         if (flavor_info[i].flavorType)
 411           {
 412             type = EndianU32_NtoB (flavor_info[i].flavorType);
 413             strings = Fcons (make_unibyte_string ((char *) &type, 4), strings);
 414           }
 415       result = nconc2 (result, strings);
 416       xfree (flavor_info);
 417     }
 418 #endif
 419
 420   return result;
 421 }
 422 \f
 423 /* Do protocol to assert ourself as a selection owner.
 424    Update the Vselection_alist so that we can reply to later requests for
 425    our selection.  */
 426
 427 static void
 428 x_own_selection (selection_name, selection_value)
 429      Lisp_Object selection_name, selection_value;
 430 {
 431   OSErr err;
 432   ScrapRef scrap;
 433   struct gcpro gcpro1, gcpro2;
 434   Lisp_Object rest, handler_fn, value, type;
 435   int count;
 436
 437   CHECK_SYMBOL (selection_name);
 438
 439   GCPRO2 (selection_name, selection_value);
 440
 441   BLOCK_INPUT;
 442
 443   err = get_scrap_from_symbol (selection_name, 1, &scrap);
 444   if (err == noErr && scrap)
 445     {
 446       /* Don't allow a quit within the converter.
 447          When the user types C-g, he would be surprised
 448          if by luck it came during a converter.  */
 449       count = SPECPDL_INDEX ();
 450       specbind (Qinhibit_quit, Qt);
 451
 452       for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest))
 453         {
 454           if (!(CONSP (XCAR (rest))
 455                 && SYMBOLP (type = XCAR (XCAR (rest)))
 456                 && valid_scrap_target_type_p (type)
 457                 && SYMBOLP (handler_fn = XCDR (XCAR (rest)))))
 458             continue;
 459
 460           if (!NILP (handler_fn))
 461             value = call3 (handler_fn, selection_name,
 462                            type, selection_value);
 463
 464           if (STRINGP (value))
 465             err = put_scrap_string (scrap, type, value);
 466           else if (CONSP (value)
 467                    && EQ (XCAR (value), type)
 468                    && STRINGP (XCDR (value)))
 469             err = put_scrap_string (scrap, type, XCDR (value));
 470         }
 471
 472       unbind_to (count, Qnil);
 473
 474       if (err == noErr)
 475         err = put_scrap_private_timestamp (scrap, last_event_timestamp);
 476     }
 477
 478   UNBLOCK_INPUT;
 479
 480   UNGCPRO;
 481
 482   if (scrap && err != noErr)
 483     error ("Can't set selection");
 484
 485   /* Now update the local cache */
 486   {
 487     Lisp_Object selection_time;
 488     Lisp_Object selection_data;
 489     Lisp_Object prev_value;
 490
 491     selection_time = long_to_cons (last_event_timestamp);
 492     selection_data = Fcons (selection_name,
 493                             Fcons (selection_value,
 494                                    Fcons (selection_time,
 495                                           Fcons (selected_frame, Qnil))));
 496     prev_value = assq_no_quit (selection_name, Vselection_alist);
 497
 498     Vselection_alist = Fcons (selection_data, Vselection_alist);
 499
 500     /* If we already owned the selection, remove the old selection data.
 501        Perhaps we should destructively modify it instead.
 502        Don't use Fdelq as that may QUIT.  */
 503     if (!NILP (prev_value))
 504       {
 505         Lisp_Object rest;       /* we know it's not the CAR, so it's easy.  */
 506         for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
 507           if (EQ (prev_value, Fcar (XCDR (rest))))
 508             {
 509               XSETCDR (rest, Fcdr (XCDR (rest)));
 510               break;
 511             }
 512       }
 513   }
 514 }
 515 \f
 516 /* Given a selection-name and desired type, look up our local copy of
 517    the selection value and convert it to the type.
 518    The value is nil or a string.
 519    This function is used both for remote requests (LOCAL_REQUEST is zero)
 520    and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
 521
 522    This calls random Lisp code, and may signal or gc.  */
 523
 524 static Lisp_Object
 525 x_get_local_selection (selection_symbol, target_type, local_request)
 526      Lisp_Object selection_symbol, target_type;
 527      int local_request;
 528 {
 529   Lisp_Object local_value;
 530   Lisp_Object handler_fn, value, type, check;
 531   int count;
 532
 533   if (NILP (Fx_selection_owner_p (selection_symbol)))
 534     return Qnil;
 535
 536   local_value = assq_no_quit (selection_symbol, Vselection_alist);
 537
 538   /* TIMESTAMP is a special case 'cause that's easiest.  */
 539   if (EQ (target_type, QTIMESTAMP))
 540     {
 541       handler_fn = Qnil;
 542       value = XCAR (XCDR (XCDR (local_value)));
 543     }
 544 #if 0
 545   else if (EQ (target_type, QDELETE))
 546     {
 547       handler_fn = Qnil;
 548       Fx_disown_selection_internal
 549         (selection_symbol,
 550          XCAR (XCDR (XCDR (local_value))));
 551       value = QNULL;
 552     }
 553 #endif
 554   else
 555     {
 556       /* Don't allow a quit within the converter.
 557          When the user types C-g, he would be surprised
 558          if by luck it came during a converter.  */
 559       count = SPECPDL_INDEX ();
 560       specbind (Qinhibit_quit, Qt);
 561
 562       CHECK_SYMBOL (target_type);
 563       handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
 564       /* gcpro is not needed here since nothing but HANDLER_FN
 565          is live, and that ought to be a symbol.  */
 566
 567       if (!NILP (handler_fn))
 568         value = call3 (handler_fn,
 569                        selection_symbol, (local_request ? Qnil : target_type),
 570                        XCAR (XCDR (local_value)));
 571       else
 572         value = Qnil;
 573       unbind_to (count, Qnil);
 574     }
 575
 576   /* Make sure this value is of a type that we could transmit
 577      to another X client.  */
 578
 579   check = value;
 580   if (CONSP (value)
 581       && SYMBOLP (XCAR (value)))
 582     type = XCAR (value),
 583     check = XCDR (value);
 584
 585   if (STRINGP (check)
 586       || VECTORP (check)
 587       || SYMBOLP (check)
 588       || INTEGERP (check)
 589       || NILP (value))
 590     return value;
 591   /* Check for a value that cons_to_long could handle.  */
 592   else if (CONSP (check)
 593            && INTEGERP (XCAR (check))
 594            && (INTEGERP (XCDR (check))
 595                ||
 596                (CONSP (XCDR (check))
 597                 && INTEGERP (XCAR (XCDR (check)))
 598                 && NILP (XCDR (XCDR (check))))))
 599     return value;
 600   else
 601     return
 602       Fsignal (Qerror,
 603                Fcons (build_string ("invalid data returned by selection-conversion function"),
 604                       Fcons (handler_fn, Fcons (value, Qnil))));
 605 }
 606
 607 \f
 608 /* Clear all selections that were made from frame F.
 609    We do this when about to delete a frame.  */
 610
 611 void
 612 x_clear_frame_selections (f)
 613      FRAME_PTR f;
 614 {
 615   Lisp_Object frame;
 616   Lisp_Object rest;
 617
 618   XSETFRAME (frame, f);
 619
 620   /* Otherwise, we're really honest and truly being told to drop it.
 621      Don't use Fdelq as that may QUIT;.  */
 622
 623   /* Delete elements from the beginning of Vselection_alist.  */
 624   while (!NILP (Vselection_alist)
 625          && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
 626     {
 627       /* Let random Lisp code notice that the selection has been stolen.  */
 628       Lisp_Object hooks, selection_symbol;
 629
 630       hooks = Vx_lost_selection_functions;
 631       selection_symbol = Fcar (Fcar (Vselection_alist));
 632
 633       if (!EQ (hooks, Qunbound)
 634           && !NILP (Fx_selection_owner_p (selection_symbol)))
 635         {
 636           for (; CONSP (hooks); hooks = Fcdr (hooks))
 637             call1 (Fcar (hooks), selection_symbol);
 638 #if 0 /* This can crash when deleting a frame
 639          from x_connection_closed.  Anyway, it seems unnecessary;
 640          something else should cause a redisplay.  */
 641           redisplay_preserve_echo_area (21);
 642 #endif
 643         }
 644
 645       Vselection_alist = Fcdr (Vselection_alist);
 646     }
 647
 648   /* Delete elements after the beginning of Vselection_alist.  */
 649   for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
 650     if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest))))))))
 651       {
 652         /* Let random Lisp code notice that the selection has been stolen.  */
 653         Lisp_Object hooks, selection_symbol;
 654
 655         hooks = Vx_lost_selection_functions;
 656         selection_symbol = Fcar (Fcar (XCDR (rest)));
 657
 658         if (!EQ (hooks, Qunbound)
 659           && !NILP (Fx_selection_owner_p (selection_symbol)))
 660           {
 661             for (; CONSP (hooks); hooks = Fcdr (hooks))
 662               call1 (Fcar (hooks), selection_symbol);
 663 #if 0 /* See above */
 664             redisplay_preserve_echo_area (22);
 665 #endif
 666           }
 667         XSETCDR (rest, Fcdr (XCDR (rest)));
 668         break;
 669       }
 670 }
 671 \f
 672 /* Do protocol to read selection-data from the server.
 673    Converts this to Lisp data and returns it.  */
 674
 675 static Lisp_Object
 676 x_get_foreign_selection (selection_symbol, target_type, time_stamp)
 677      Lisp_Object selection_symbol, target_type, time_stamp;
 678 {
 679   OSErr err;
 680   ScrapRef scrap;
 681   Lisp_Object result = Qnil;
 682
 683   BLOCK_INPUT;
 684
 685   err = get_scrap_from_symbol (selection_symbol, 0, &scrap);
 686   if (err == noErr && scrap)
 687     {
 688       if (EQ (target_type, QTARGETS))
 689         {
 690           result = get_scrap_target_type_list (scrap);
 691           result = Fvconcat (1, &result);
 692         }
 693       else
 694         {
 695           result = get_scrap_string (scrap, target_type);
 696           if (STRINGP (result))
 697             Fput_text_property (make_number (0), make_number (SBYTES (result)),
 698                                 Qforeign_selection, target_type, result);
 699         }
 700     }
 701
 702   UNBLOCK_INPUT;
 703
 704   return result;
 705 }
 706
 707
 708 DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
 709        Sx_own_selection_internal, 2, 2, 0,
 710        doc: /* Assert a selection of the given TYPE with the given VALUE.
 711 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
 712 VALUE is typically a string, or a cons of two markers, but may be
 713 anything that the functions on `selection-converter-alist' know about.  */)
 714      (selection_name, selection_value)
 715      Lisp_Object selection_name, selection_value;
 716 {
 717   check_mac ();
 718   CHECK_SYMBOL (selection_name);
 719   if (NILP (selection_value)) error ("SELECTION-VALUE may not be nil");
 720   x_own_selection (selection_name, selection_value);
 721   return selection_value;
 722 }
 723
 724
 725 /* Request the selection value from the owner.  If we are the owner,
 726    simply return our selection value.  If we are not the owner, this
 727    will block until all of the data has arrived.  */
 728
 729 DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
 730        Sx_get_selection_internal, 2, 3, 0,
 731        doc: /* Return text selected from some Mac application.
 732 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
 733 TYPE is the type of data desired, typically `STRING'.
 734 TIME_STAMP is ignored on Mac.  */)
 735      (selection_symbol, target_type, time_stamp)
 736      Lisp_Object selection_symbol, target_type, time_stamp;
 737 {
 738   Lisp_Object val = Qnil;
 739   struct gcpro gcpro1, gcpro2;
 740   GCPRO2 (target_type, val); /* we store newly consed data into these */
 741   check_mac ();
 742   CHECK_SYMBOL (selection_symbol);
 743   CHECK_SYMBOL (target_type);
 744
 745   val = x_get_local_selection (selection_symbol, target_type, 1);
 746
 747   if (NILP (val))
 748     {
 749       val = x_get_foreign_selection (selection_symbol, target_type, time_stamp);
 750       goto DONE;
 751     }
 752
 753   if (CONSP (val)
 754       && SYMBOLP (XCAR (val)))
 755     {
 756       val = XCDR (val);
 757       if (CONSP (val) && NILP (XCDR (val)))
 758         val = XCAR (val);
 759     }
 760  DONE:
 761   UNGCPRO;
 762   return val;
 763 }
 764
 765 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
 766        Sx_disown_selection_internal, 1, 2, 0,
 767        doc: /* If we own the selection SELECTION, disown it.
 768 Disowning it means there is no such selection.  */)
 769      (selection, time)
 770      Lisp_Object selection;
 771      Lisp_Object time;
 772 {
 773   OSErr err;
 774   ScrapRef scrap;
 775   Lisp_Object local_selection_data;
 776
 777   check_mac ();
 778   CHECK_SYMBOL (selection);
 779
 780   if (NILP (Fx_selection_owner_p (selection)))
 781     return Qnil;  /* Don't disown the selection when we're not the owner.  */
 782
 783   local_selection_data = assq_no_quit (selection, Vselection_alist);
 784
 785   /* Don't use Fdelq as that may QUIT;.  */
 786
 787   if (EQ (local_selection_data, Fcar (Vselection_alist)))
 788     Vselection_alist = Fcdr (Vselection_alist);
 789   else
 790     {
 791       Lisp_Object rest;
 792       for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
 793         if (EQ (local_selection_data, Fcar (XCDR (rest))))
 794           {
 795             XSETCDR (rest, Fcdr (XCDR (rest)));
 796             break;
 797           }
 798     }
 799
 800   /* Let random lisp code notice that the selection has been stolen.  */
 801
 802   {
 803     Lisp_Object rest;
 804     rest = Vx_lost_selection_functions;
 805     if (!EQ (rest, Qunbound))
 806       {
 807         for (; CONSP (rest); rest = Fcdr (rest))
 808           call1 (Fcar (rest), selection);
 809         prepare_menu_bars ();
 810         redisplay_preserve_echo_area (20);
 811       }
 812   }
 813
 814   BLOCK_INPUT;
 815
 816   err = get_scrap_from_symbol (selection, 0, &scrap);
 817   if (err == noErr && scrap)
 818     clear_scrap (&scrap);
 819
 820   UNBLOCK_INPUT;
 821
 822   return Qt;
 823 }
 824
 825
 826 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
 827        0, 1, 0,
 828        doc: /* Whether the current Emacs process owns the given SELECTION.
 829 The arg should be the name of the selection in question, typically one of
 830 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
 831 For convenience, the symbol nil is the same as `PRIMARY',
 832 and t is the same as `SECONDARY'.  */)
 833      (selection)
 834      Lisp_Object selection;
 835 {
 836   OSErr err;
 837   ScrapRef scrap;
 838   Lisp_Object result = Qnil, local_selection_data;
 839
 840   check_mac ();
 841   CHECK_SYMBOL (selection);
 842   if (EQ (selection, Qnil)) selection = QPRIMARY;
 843   if (EQ (selection, Qt)) selection = QSECONDARY;
 844
 845   local_selection_data = assq_no_quit (selection, Vselection_alist);
 846
 847   if (NILP (local_selection_data))
 848     return Qnil;
 849
 850   BLOCK_INPUT;
 851
 852   err = get_scrap_from_symbol (selection, 0, &scrap);
 853   if (err == noErr && scrap)
 854     {
 855       unsigned long timestamp;
 856
 857       err = get_scrap_private_timestamp (scrap, &timestamp);
 858       if (err == noErr
 859           && (timestamp
 860               == cons_to_long (XCAR (XCDR (XCDR (local_selection_data))))))
 861         result = Qt;
 862     }
 863   else
 864     result = Qt;
 865
 866   UNBLOCK_INPUT;
 867
 868   return result;
 869 }
 870
 871 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
 872        0, 1, 0,
 873        doc: /* Whether there is an owner for the given SELECTION.
 874 The arg should be the name of the selection in question, typically one of
 875 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
 876 For convenience, the symbol nil is the same as `PRIMARY',
 877 and t is the same as `SECONDARY'.  */)
 878      (selection)
 879      Lisp_Object selection;
 880 {
 881   OSErr err;
 882   ScrapRef scrap;
 883   Lisp_Object result = Qnil, rest;
 884
 885   /* It should be safe to call this before we have an Mac frame.  */
 886   if (! FRAME_MAC_P (SELECTED_FRAME ()))
 887     return Qnil;
 888
 889   CHECK_SYMBOL (selection);
 890   if (!NILP (Fx_selection_owner_p (selection)))
 891     return Qt;
 892   if (EQ (selection, Qnil)) selection = QPRIMARY;
 893   if (EQ (selection, Qt)) selection = QSECONDARY;
 894
 895   BLOCK_INPUT;
 896
 897   err = get_scrap_from_symbol (selection, 0, &scrap);
 898   if (err == noErr && scrap)
 899     for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest))
 900       {
 901         if (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest)))
 902             && scrap_has_target_type (scrap, XCAR (XCAR (rest))))
 903           {
 904             result = Qt;
 905             break;
 906           }
 907       }
 908
 909   UNBLOCK_INPUT;
 910
 911   return result;
 912 }
 913
 914 \f
 915 int mac_ready_for_apple_events = 0;
 916 static Lisp_Object Vmac_apple_event_map;
 917 static Lisp_Object Qmac_apple_event_class, Qmac_apple_event_id;
 918 static struct
 919 {
 920   AppleEvent *buf;
 921   int size, count;
 922 } deferred_apple_events;
 923 extern Lisp_Object Qundefined;
 924 extern OSErr mac_store_apple_event P_ ((Lisp_Object, Lisp_Object,
 925                                         const AEDesc *));
 926
 927 struct apple_event_binding
 928 {
 929   UInt32 code;                  /* Apple event class or ID.  */
 930   Lisp_Object key, binding;
 931 };
 932
 933 static void
 934 find_event_binding_fun (key, binding, args, data)
 935      Lisp_Object key, binding, args;
 936      void *data;
 937 {
 938   struct apple_event_binding *event_binding =
 939     (struct apple_event_binding *)data;
 940   Lisp_Object code_string;
 941
 942   if (!SYMBOLP (key))
 943     return;
 944   code_string = Fget (key, args);
 945   if (STRINGP (code_string) && SBYTES (code_string) == 4
 946       && (EndianU32_BtoN (*((UInt32 *) SDATA (code_string)))
 947           == event_binding->code))
 948     {
 949       event_binding->key = key;
 950       event_binding->binding = binding;
 951     }
 952 }
 953
 954 static void
 955 find_event_binding (keymap, event_binding, class_p)
 956      Lisp_Object keymap;
 957      struct apple_event_binding *event_binding;
 958      int class_p;
 959 {
 960   if (event_binding->code == 0)
 961     event_binding->binding =
 962       access_keymap (keymap, event_binding->key, 0, 1, 0);
 963   else
 964     {
 965       event_binding->binding = Qnil;
 966       map_keymap (keymap, find_event_binding_fun,
 967                   class_p ? Qmac_apple_event_class : Qmac_apple_event_id,
 968                   event_binding, 0);
 969     }
 970 }
 971
 972 void
 973 mac_find_apple_event_spec (class, id, class_key, id_key, binding)
 974      AEEventClass class;
 975      AEEventID id;
 976      Lisp_Object *class_key, *id_key, *binding;
 977 {
 978   struct apple_event_binding event_binding;
 979   Lisp_Object keymap;
 980
 981   *binding = Qnil;
 982
 983   keymap = get_keymap (Vmac_apple_event_map, 0, 0);
 984   if (NILP (keymap))
 985     return;
 986
 987   event_binding.code = class;
 988   event_binding.key = *class_key;
 989   event_binding.binding = Qnil;
 990   find_event_binding (keymap, &event_binding, 1);
 991   *class_key = event_binding.key;
 992   keymap = get_keymap (event_binding.binding, 0, 0);
 993   if (NILP (keymap))
 994     return;
 995
 996   event_binding.code = id;
 997   event_binding.key = *id_key;
 998   event_binding.binding = Qnil;
 999   find_event_binding (keymap, &event_binding, 0);
1000   *id_key = event_binding.key;
1001   *binding = event_binding.binding;
1002 }
1003
1004 static OSErr
1005 defer_apple_events (apple_event, reply)
1006      const AppleEvent *apple_event, *reply;
1007 {
1008   OSErr err;
1009
1010   err = AESuspendTheCurrentEvent (apple_event);
1011
1012   /* Mac OS 10.3 Xcode manual says AESuspendTheCurrentEvent makes
1013      copies of the Apple event and the reply, but Mac OS 10.4 Xcode
1014      manual says it doesn't.  Anyway we create copies of them and save
1015      them in `deferred_apple_events'.  */
1016   if (err == noErr)
1017     {
1018       if (deferred_apple_events.buf == NULL)
1019         {
1020           deferred_apple_events.size = 16;
1021           deferred_apple_events.count = 0;
1022           deferred_apple_events.buf =
1023             xmalloc (sizeof (AppleEvent) * deferred_apple_events.size);
1024           if (deferred_apple_events.buf == NULL)
1025             err = memFullErr;
1026         }
1027       else if (deferred_apple_events.count == deferred_apple_events.size)
1028         {
1029           AppleEvent *newbuf;
1030
1031           deferred_apple_events.size *= 2;
1032           newbuf = xrealloc (deferred_apple_events.buf,
1033                              sizeof (AppleEvent) * deferred_apple_events.size);
1034           if (newbuf)
1035             deferred_apple_events.buf = newbuf;
1036           else
1037             err = memFullErr;
1038         }
1039     }
1040
1041   if (err == noErr)
1042     {
1043       int count = deferred_apple_events.count;
1044
1045       AEDuplicateDesc (apple_event, deferred_apple_events.buf + count);
1046       AEDuplicateDesc (reply, deferred_apple_events.buf + count + 1);
1047       deferred_apple_events.count += 2;
1048     }
1049
1050   return err;
1051 }
1052
1053 static pascal OSErr
1054 mac_handle_apple_event (apple_event, reply, refcon)
1055      const AppleEvent *apple_event;
1056      AppleEvent *reply;
1057      SInt32 refcon;
1058 {
1059   OSErr err;
1060   AEEventClass event_class;
1061   AEEventID event_id;
1062   Lisp_Object class_key, id_key, binding;
1063
1064   /* We can't handle an Apple event that requests a reply, but this
1065      seems to be too restrictive.  */
1066 #if 0
1067   if (reply->descriptorType != typeNull)
1068     return errAEEventNotHandled;
1069 #endif
1070
1071   if (!mac_ready_for_apple_events)
1072     {
1073       err = defer_apple_events (apple_event, reply);
1074       if (err != noErr)
1075         return errAEEventNotHandled;
1076       return noErr;
1077     }
1078
1079   err = AEGetAttributePtr (apple_event, keyEventClassAttr, typeType, NULL,
1080                            &event_class, sizeof (AEEventClass), NULL);
1081   if (err == noErr)
1082     err = AEGetAttributePtr (apple_event, keyEventIDAttr, typeType, NULL,
1083                              &event_id, sizeof (AEEventID), NULL);
1084   if (err == noErr)
1085     {
1086       mac_find_apple_event_spec (event_class, event_id,
1087                                  &class_key, &id_key, &binding);
1088       if (!NILP (binding) && !EQ (binding, Qundefined))
1089         {
1090           if (INTEGERP (binding))
1091             return XINT (binding);
1092           err = mac_store_apple_event (class_key, id_key, apple_event);
1093           if (err == noErr)
1094             return noErr;
1095         }
1096     }
1097   return errAEEventNotHandled;
1098 }
1099
1100 void
1101 init_apple_event_handler ()
1102 {
1103   OSErr err;
1104   long result;
1105
1106   /* Make sure we have Apple events before starting.  */
1107   err = Gestalt (gestaltAppleEventsAttr, &result);
1108   if (err != noErr)
1109     abort ();
1110
1111   if (!(result & (1 << gestaltAppleEventsPresent)))
1112     abort ();
1113
1114   err = AEInstallEventHandler (typeWildCard, typeWildCard,
1115 #if TARGET_API_MAC_CARBON
1116                                NewAEEventHandlerUPP (mac_handle_apple_event),
1117 #else
1118                                NewAEEventHandlerProc (mac_handle_apple_event),
1119 #endif
1120                                0L, false);
1121   if (err != noErr)
1122     abort ();
1123 }
1124
1125 DEFUN ("mac-process-deferred-apple-events", Fmac_process_deferred_apple_events, Smac_process_deferred_apple_events, 0, 0, 0,
1126        doc: /* Process Apple events that are deferred at the startup time.  */)
1127   ()
1128 {
1129   Lisp_Object result = Qnil;
1130   long i;
1131
1132   if (mac_ready_for_apple_events)
1133     return Qnil;
1134
1135   BLOCK_INPUT;
1136   mac_ready_for_apple_events = 1;
1137   if (deferred_apple_events.buf)
1138     {
1139       for (i = 0; i < deferred_apple_events.count; i += 2)
1140         {
1141           AEResumeTheCurrentEvent (deferred_apple_events.buf + i,
1142                                    deferred_apple_events.buf + i + 1,
1143                                    ((AEEventHandlerUPP)
1144                                     kAEUseStandardDispatch), 0);
1145           AEDisposeDesc (deferred_apple_events.buf + i);
1146           AEDisposeDesc (deferred_apple_events.buf + i + 1);
1147         }
1148       xfree (deferred_apple_events.buf);
1149       bzero (&deferred_apple_events, sizeof (deferred_apple_events));
1150
1151       result = Qt;
1152     }
1153   UNBLOCK_INPUT;
1154
1155   return result;
1156 }
1157
1158 \f
1159 #ifdef MAC_OSX
1160 void
1161 init_service_handler ()
1162 {
1163   EventTypeSpec specs[] = {{kEventClassService, kEventServiceGetTypes},
1164                            {kEventClassService, kEventServiceCopy},
1165                            {kEventClassService, kEventServicePaste},
1166                            {kEventClassService, kEventServicePerform}};
1167   InstallApplicationEventHandler (NewEventHandlerUPP (mac_handle_service_event),
1168                                   GetEventTypeCount (specs), specs, NULL, NULL);
1169 }
1170
1171 extern OSErr mac_store_services_event P_ ((EventRef));
1172
1173 static OSStatus
1174 copy_scrap_flavor_data (from_scrap, to_scrap, flavor_type)
1175      ScrapRef from_scrap, to_scrap;
1176      ScrapFlavorType flavor_type;
1177 {
1178   OSStatus err;
1179   Size size, size_allocated;
1180   char *buf = NULL;
1181
1182   err = GetScrapFlavorSize (from_scrap, flavor_type, &size);
1183   if (err == noErr)
1184     buf = xmalloc (size);
1185   while (buf)
1186     {
1187       size_allocated = size;
1188       err = GetScrapFlavorData (from_scrap, flavor_type, &size, buf);
1189       if (err != noErr)
1190         {
1191           xfree (buf);
1192           buf = NULL;
1193         }
1194       else if (size_allocated < size)
1195         {
1196           char *newbuf = xrealloc (buf, size);
1197
1198           if (newbuf)
1199             buf = newbuf;
1200           else
1201             {
1202               xfree (buf);
1203               buf = NULL;
1204             }
1205         }
1206       else
1207         break;
1208     }
1209   if (err == noErr)
1210     {
1211       if (buf == NULL)
1212         err = memFullErr;
1213       else
1214         {
1215           err = PutScrapFlavor (to_scrap, flavor_type, kScrapFlavorMaskNone,
1216                                 size, buf);
1217           xfree (buf);
1218         }
1219     }
1220
1221   return err;
1222 }
1223
1224 static OSStatus
1225 mac_handle_service_event (call_ref, event, data)
1226      EventHandlerCallRef call_ref;
1227      EventRef event;
1228      void *data;
1229 {
1230   OSStatus err = noErr;
1231   ScrapRef cur_scrap, specific_scrap;
1232   UInt32 event_kind = GetEventKind (event);
1233   CFMutableArrayRef copy_types, paste_types;
1234   CFStringRef type;
1235   Lisp_Object rest;
1236   ScrapFlavorType flavor_type;
1237
1238   /* Check if Vmac_services_selection is a valid selection that has a
1239      corresponding scrap.  */
1240   if (!SYMBOLP (Vmac_services_selection))
1241     err = eventNotHandledErr;
1242   else
1243     err = get_scrap_from_symbol (Vmac_services_selection, 0, &cur_scrap);
1244   if (!(err == noErr && cur_scrap))
1245     return eventNotHandledErr;
1246
1247   switch (event_kind)
1248     {
1249     case kEventServiceGetTypes:
1250       /* Set paste types. */
1251       err = GetEventParameter (event, kEventParamServicePasteTypes,
1252                                typeCFMutableArrayRef, NULL,
1253                                sizeof (CFMutableArrayRef), NULL,
1254                                &paste_types);
1255       if (err != noErr)
1256         break;
1257
1258       for (rest = Vselection_converter_alist; CONSP (rest);
1259            rest = XCDR (rest))
1260         if (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest)))
1261             && (flavor_type =
1262                 get_flavor_type_from_symbol (XCAR (XCAR (rest)))))
1263           {
1264             type = CreateTypeStringWithOSType (flavor_type);
1265             if (type)
1266               {
1267                 CFArrayAppendValue (paste_types, type);
1268                 CFRelease (type);
1269               }
1270           }
1271
1272       /* Set copy types.  */
1273       err = GetEventParameter (event, kEventParamServiceCopyTypes,
1274                                typeCFMutableArrayRef, NULL,
1275                                sizeof (CFMutableArrayRef), NULL,
1276                                &copy_types);
1277       if (err != noErr)
1278         break;
1279
1280       if (NILP (Fx_selection_owner_p (Vmac_services_selection)))
1281         break;
1282       else
1283         goto copy_all_flavors;
1284
1285     case kEventServiceCopy:
1286       err = GetEventParameter (event, kEventParamScrapRef,
1287                                typeScrapRef, NULL,
1288                                sizeof (ScrapRef), NULL, &specific_scrap);
1289       if (err != noErr
1290           || NILP (Fx_selection_owner_p (Vmac_services_selection)))
1291         {
1292           err = eventNotHandledErr;
1293           break;
1294         }
1295
1296     copy_all_flavors:
1297       {
1298         UInt32 count, i;
1299         ScrapFlavorInfo *flavor_info = NULL;
1300         ScrapFlavorFlags flags;
1301
1302         err = GetScrapFlavorCount (cur_scrap, &count);
1303         if (err == noErr)
1304           flavor_info = xmalloc (sizeof (ScrapFlavorInfo) * count);
1305         if (flavor_info)
1306           {
1307             err = GetScrapFlavorInfoList (cur_scrap, &count, flavor_info);
1308             if (err != noErr)
1309               {
1310                 xfree (flavor_info);
1311                 flavor_info = NULL;
1312               }
1313           }
1314         if (flavor_info == NULL)
1315           break;
1316
1317         for (i = 0; i < count; i++)
1318           {
1319             flavor_type = flavor_info[i].flavorType;
1320             err = GetScrapFlavorFlags (cur_scrap, flavor_type, &flags);
1321             if (err == noErr && !(flags & kScrapFlavorMaskSenderOnly))
1322               {
1323                 if (event_kind == kEventServiceCopy)
1324                   err = copy_scrap_flavor_data (cur_scrap, specific_scrap,
1325                                                 flavor_type);
1326                 else         /* event_kind == kEventServiceGetTypes */
1327                   {
1328                     type = CreateTypeStringWithOSType (flavor_type);
1329                     if (type)
1330                       {
1331                         CFArrayAppendValue (copy_types, type);
1332                         CFRelease (type);
1333                       }
1334                   }
1335               }
1336           }
1337         xfree (flavor_info);
1338       }
1339       break;
1340
1341     case kEventServicePaste:
1342     case kEventServicePerform:
1343       {
1344         int data_exists_p = 0;
1345
1346         err = GetEventParameter (event, kEventParamScrapRef, typeScrapRef,
1347                                  NULL, sizeof (ScrapRef), NULL,
1348                                  &specific_scrap);
1349         if (err == noErr)
1350           err = clear_scrap (&cur_scrap);
1351         if (err == noErr)
1352           for (rest = Vselection_converter_alist; CONSP (rest);
1353                rest = XCDR (rest))
1354             {
1355               if (! (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest)))))
1356                 continue;
1357               flavor_type = get_flavor_type_from_symbol (XCAR (XCAR (rest)));
1358               if (flavor_type == 0)
1359                 continue;
1360               err = copy_scrap_flavor_data (specific_scrap, cur_scrap,
1361                                             flavor_type);
1362               if (err == noErr)
1363                 data_exists_p = 1;
1364             }
1365         if (!data_exists_p)
1366           err = eventNotHandledErr;
1367         else
1368           err = mac_store_services_event (event);
1369       }
1370       break;
1371     }
1372
1373   if (err != noErr)
1374     err = eventNotHandledErr;
1375   return err;
1376 }
1377 #endif
1378
1379
1380 void
1381 syms_of_macselect ()
1382 {
1383   defsubr (&Sx_get_selection_internal);
1384   defsubr (&Sx_own_selection_internal);
1385   defsubr (&Sx_disown_selection_internal);
1386   defsubr (&Sx_selection_owner_p);
1387   defsubr (&Sx_selection_exists_p);
1388   defsubr (&Smac_process_deferred_apple_events);
1389
1390   Vselection_alist = Qnil;
1391   staticpro (&Vselection_alist);
1392
1393   DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
1394                doc: /* An alist associating selection-types with functions.
1395 These functions are called to convert the selection, with three args:
1396 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
1397 a desired type to which the selection should be converted;
1398 and the local selection value (whatever was given to `x-own-selection').
1399
1400 The function should return the value to send to the Scrap Manager
1401 \(must be a string).  A return value of nil
1402 means that the conversion could not be done.
1403 A return value which is the symbol `NULL'
1404 means that a side-effect was executed,
1405 and there is no meaningful selection value.  */);
1406   Vselection_converter_alist = Qnil;
1407
1408   DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions,
1409                doc: /* A list of functions to be called when Emacs loses a selection.
1410 \(This happens when a Lisp program explicitly clears the selection.)
1411 The functions are called with one argument, the selection type
1412 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD').  */);
1413   Vx_lost_selection_functions = Qnil;
1414
1415   DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
1416                doc: /* Coding system for communicating with other programs.
1417 When sending or receiving text via cut_buffer, selection, and clipboard,
1418 the text is encoded or decoded by this coding system.
1419 The default value is determined by the system script code.  */);
1420   Vselection_coding_system = Qnil;
1421
1422   DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
1423                doc: /* Coding system for the next communication with other programs.
1424 Usually, `selection-coding-system' is used for communicating with
1425 other programs.  But, if this variable is set, it is used for the
1426 next communication only.  After the communication, this variable is
1427 set to nil.  */);
1428   Vnext_selection_coding_system = Qnil;
1429
1430   DEFVAR_LISP ("mac-apple-event-map", &Vmac_apple_event_map,
1431                doc: /* Keymap for Apple events handled by Emacs.  */);
1432   Vmac_apple_event_map = Qnil;
1433
1434 #ifdef MAC_OSX
1435   DEFVAR_LISP ("mac-services-selection", &Vmac_services_selection,
1436                doc: /* Selection name for communication via Services menu.  */);
1437   Vmac_services_selection = intern ("PRIMARY");
1438 #endif
1439
1440   QPRIMARY   = intern ("PRIMARY");      staticpro (&QPRIMARY);
1441   QSECONDARY = intern ("SECONDARY");    staticpro (&QSECONDARY);
1442   QTIMESTAMP = intern ("TIMESTAMP");    staticpro (&QTIMESTAMP);
1443   QTARGETS   = intern ("TARGETS");      staticpro (&QTARGETS);
1444
1445   Qforeign_selection = intern ("foreign-selection");
1446   staticpro (&Qforeign_selection);
1447
1448   Qmac_scrap_name = intern ("mac-scrap-name");
1449   staticpro (&Qmac_scrap_name);
1450
1451   Qmac_ostype = intern ("mac-ostype");
1452   staticpro (&Qmac_ostype);
1453
1454   Qmac_apple_event_class = intern ("mac-apple-event-class");
1455   staticpro (&Qmac_apple_event_class);
1456
1457   Qmac_apple_event_id = intern ("mac-apple-event-id");
1458   staticpro (&Qmac_apple_event_id);
1459 }
1460
1461 /* arch-tag: f3c91ad8-99e0-4bd6-9eef-251b2f848732
1462    (do not change this comment) */