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