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
  27 #if !TARGET_API_MAC_CARBON
  28 #include <Endian.h>
  29 typedef int ScrapRef;
  30 typedef ResType ScrapFlavorType;
  31 #endif /* !TARGET_API_MAC_CARBON */
  32
  33 static OSErr get_scrap_from_symbol P_ ((Lisp_Object, int, ScrapRef *));
  34 static ScrapFlavorType get_flavor_type_from_symbol P_ ((Lisp_Object));
  35 static int valid_scrap_target_type_p P_ ((Lisp_Object));
  36 static OSErr clear_scrap P_ ((ScrapRef *));
  37 static OSErr put_scrap_string P_ ((ScrapRef, Lisp_Object, Lisp_Object));
  38 static OSErr put_scrap_private_timestamp P_ ((ScrapRef, unsigned long));
  39 static ScrapFlavorType scrap_has_target_type P_ ((ScrapRef, Lisp_Object));
  40 static Lisp_Object get_scrap_string P_ ((ScrapRef, Lisp_Object));
  41 static OSErr get_scrap_private_timestamp P_ ((ScrapRef, unsigned long *));
  42 static Lisp_Object get_scrap_target_type_list P_ ((ScrapRef));
  43 static void x_own_selection P_ ((Lisp_Object, Lisp_Object));
  44 static Lisp_Object x_get_local_selection P_ ((Lisp_Object, Lisp_Object, int));
  45 static Lisp_Object x_get_foreign_selection P_ ((Lisp_Object,
  46                                                 Lisp_Object,
  47                                                 Lisp_Object));
  48 EXFUN (Fx_selection_owner_p, 1);
  49 #ifdef MAC_OSX
  50 static OSStatus mac_handle_service_event P_ ((EventHandlerCallRef,
  51                                               EventRef, void *));
  52 void init_service_handler P_ ((void));
  53 #endif
  54
  55 Lisp_Object QPRIMARY, QSECONDARY, QTIMESTAMP, QTARGETS;
  56
  57 static Lisp_Object Vx_lost_selection_functions;
  58 /* Coding system for communicating with other programs via scrap.  */
  59 static Lisp_Object Vselection_coding_system;
  60
  61 /* Coding system for the next communicating with other programs.  */
  62 static Lisp_Object Vnext_selection_coding_system;
  63
  64 static Lisp_Object Qforeign_selection;
  65
  66 /* The timestamp of the last input event Emacs received from the
  67    window server.  */
  68 /* Defined in keyboard.c.  */
  69 extern unsigned long last_event_timestamp;
  70
  71 /* This is an association list whose elements are of the form
  72      ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
  73    SELECTION-NAME is a lisp symbol.
  74    SELECTION-VALUE is the value that emacs owns for that selection.
  75      It may be any kind of Lisp object.
  76    SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
  77      as a cons of two 16-bit numbers (making a 32 bit time.)
  78    FRAME is the frame for which we made the selection.
  79    If there is an entry in this alist, and the data for the flavor
  80      type SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP in the corresponding scrap
  81      (if exists) coincides with SELECTION-TIMESTAMP, then it can be
  82      assumed that Emacs owns that selection.
  83    The only (eq) parts of this list that are visible from Lisp are the
  84     selection-values.  */
  85 static Lisp_Object Vselection_alist;
  86
  87 #define SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP 'Etsp'
  88
  89 /* This is an alist whose CARs are selection-types and whose CDRs are
  90    the names of Lisp functions to call to convert the given Emacs
  91    selection value to a string representing the given selection type.
  92    This is for Lisp-level extension of the emacs selection
  93    handling.  */
  94 static Lisp_Object Vselection_converter_alist;
  95
  96 /* A selection name (represented as a Lisp symbol) can be associated
  97    with a named scrap via `mac-scrap-name' property.  Likewise for a
  98    selection type with a scrap flavor type via `mac-ostype'.  */
  99 static Lisp_Object Qmac_scrap_name, Qmac_ostype;
 100
 101 #ifdef MAC_OSX
 102 /* Selection name for communication via Services menu.  */
 103 static Lisp_Object Vmac_services_selection;
 104 #endif
 105 \f
 106 /* Get a reference to the scrap corresponding to the symbol SYM.  The
 107    reference is set to *SCRAP, and it becomes NULL if there's no
 108    corresponding scrap.  Clear the scrap if CLEAR_P is non-zero.  */
 109
 110 static OSErr
 111 get_scrap_from_symbol (sym, clear_p, scrap)
 112      Lisp_Object sym;
 113      int clear_p;
 114      ScrapRef *scrap;
 115 {
 116   OSErr err = noErr;
 117   Lisp_Object str = Fget (sym, Qmac_scrap_name);
 118
 119   if (!STRINGP (str))
 120     *scrap = NULL;
 121   else
 122     {
 123 #if TARGET_API_MAC_CARBON
 124 #ifdef MAC_OSX
 125       CFStringRef scrap_name = cfstring_create_with_string (str);
 126       OptionBits options = (clear_p ? kScrapClearNamedScrap
 127                             : kScrapGetNamedScrap);
 128
 129       err = GetScrapByName (scrap_name, options, scrap);
 130       CFRelease (scrap_name);
 131 #else   /* !MAC_OSX */
 132       if (clear_p)
 133         err = ClearCurrentScrap ();
 134       if (err == noErr)
 135         err = GetCurrentScrap (scrap);
 136 #endif  /* !MAC_OSX */
 137 #else   /* !TARGET_API_MAC_CARBON */
 138       if (clear_p)
 139         err = ZeroScrap ();
 140       if (err == noErr)
 141         *scrap = 1;
 142 #endif  /* !TARGET_API_MAC_CARBON */
 143     }
 144
 145   return err;
 146 }
 147
 148 /* Get a scrap flavor type from the symbol SYM.  Return 0 if no
 149    corresponding flavor type.  */
 150
 151 static ScrapFlavorType
 152 get_flavor_type_from_symbol (sym)
 153      Lisp_Object sym;
 154 {
 155   ScrapFlavorType val;
 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     if (!(flags & kScrapFlavorMaskSenderOnly))
 325       err = noTypeErr;
 326     else
 327       {
 328         Size size = sizeof (*timestamp);
 329
 330         err = GetScrapFlavorData (scrap, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP,
 331                                   &size, timestamp);
 332         if (err == noErr && size != sizeof (*timestamp))
 333           err = noTypeErr;
 334       }
 335 #else  /* !TARGET_API_MAC_CARBON */
 336   Handle handle;
 337   SInt32 size, offset;
 338
 339   size = GetScrap (NULL, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, &offset);
 340   if (size == sizeof (*timestamp))
 341     {
 342       handle = NewHandle (size);
 343       HLock (handle);
 344       size = GetScrap (handle, SCRAP_FLAVOR_TYPE_EMACS_TIMESTAMP, &offset);
 345       if (size == sizeof (*timestamp))
 346         *timestamp = *((unsigned long *) *handle);
 347       DisposeHandle (handle);
 348     }
 349   if (size != sizeof (*timestamp))
 350     err = noTypeErr;
 351 #endif  /* !TARGET_API_MAC_CARBON */
 352
 353   return err;
 354 }
 355
 356 /* Get the list of target types in SCRAP.  The return value is a list
 357    of target type symbols possibly followed by scrap flavor type
 358    strings.  */
 359
 360 static Lisp_Object
 361 get_scrap_target_type_list (scrap)
 362      ScrapRef scrap;
 363 {
 364   Lisp_Object result = Qnil, rest, target_type;
 365 #if TARGET_API_MAC_CARBON
 366   OSErr err;
 367   UInt32 count, i, type;
 368   ScrapFlavorInfo *flavor_info = NULL;
 369   Lisp_Object strings = Qnil;
 370
 371   err = GetScrapFlavorCount (scrap, &count);
 372   if (err == noErr)
 373     flavor_info = xmalloc (sizeof (ScrapFlavorInfo) * count);
 374   if (flavor_info)
 375     {
 376       err = GetScrapFlavorInfoList (scrap, &count, flavor_info);
 377       if (err != noErr)
 378         {
 379           xfree (flavor_info);
 380           flavor_info = NULL;
 381         }
 382     }
 383   if (flavor_info == NULL)
 384     count = 0;
 385 #endif
 386   for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest))
 387     {
 388       ScrapFlavorType flavor_type = 0;
 389
 390       if (CONSP (XCAR (rest)) && SYMBOLP (target_type = XCAR (XCAR (rest)))
 391           && (flavor_type = scrap_has_target_type (scrap, target_type)))
 392         {
 393           result = Fcons (target_type, result);
 394 #if TARGET_API_MAC_CARBON
 395           for (i = 0; i < count; i++)
 396             if (flavor_info[i].flavorType == flavor_type)
 397               {
 398                 flavor_info[i].flavorType = 0;
 399                 break;
 400               }
 401 #endif
 402         }
 403     }
 404 #if TARGET_API_MAC_CARBON
 405   if (flavor_info)
 406     {
 407       for (i = 0; i < count; i++)
 408         if (flavor_info[i].flavorType)
 409           {
 410             type = EndianU32_NtoB (flavor_info[i].flavorType);
 411             strings = Fcons (make_unibyte_string ((char *) &type, 4), strings);
 412           }
 413       result = nconc2 (result, strings);
 414       xfree (flavor_info);
 415     }
 416 #endif
 417
 418   return result;
 419 }
 420 \f
 421 /* Do protocol to assert ourself as a selection owner.
 422    Update the Vselection_alist so that we can reply to later requests for
 423    our selection.  */
 424
 425 static void
 426 x_own_selection (selection_name, selection_value)
 427      Lisp_Object selection_name, selection_value;
 428 {
 429   OSErr err;
 430   ScrapRef scrap;
 431   struct gcpro gcpro1, gcpro2;
 432   Lisp_Object rest, handler_fn, value, type;
 433   int count;
 434
 435   CHECK_SYMBOL (selection_name);
 436
 437   GCPRO2 (selection_name, selection_value);
 438
 439   BLOCK_INPUT;
 440
 441   err = get_scrap_from_symbol (selection_name, 1, &scrap);
 442   if (err == noErr && scrap)
 443     {
 444       /* Don't allow a quit within the converter.
 445          When the user types C-g, he would be surprised
 446          if by luck it came during a converter.  */
 447       count = SPECPDL_INDEX ();
 448       specbind (Qinhibit_quit, Qt);
 449
 450       for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest))
 451         {
 452           if (!(CONSP (XCAR (rest))
 453                 && SYMBOLP (type = XCAR (XCAR (rest)))
 454                 && valid_scrap_target_type_p (type)
 455                 && SYMBOLP (handler_fn = XCDR (XCAR (rest)))))
 456             continue;
 457
 458           if (!NILP (handler_fn))
 459             value = call3 (handler_fn, selection_name,
 460                            type, selection_value);
 461
 462           if (STRINGP (value))
 463             err = put_scrap_string (scrap, type, value);
 464           else if (CONSP (value)
 465                    && EQ (XCAR (value), type)
 466                    && STRINGP (XCDR (value)))
 467             err = put_scrap_string (scrap, type, XCDR (value));
 468         }
 469
 470       unbind_to (count, Qnil);
 471
 472       if (err == noErr)
 473         err = put_scrap_private_timestamp (scrap, last_event_timestamp);
 474     }
 475
 476   UNBLOCK_INPUT;
 477
 478   UNGCPRO;
 479
 480   if (scrap && err != noErr)
 481     error ("Can't set selection");
 482
 483   /* Now update the local cache */
 484   {
 485     Lisp_Object selection_time;
 486     Lisp_Object selection_data;
 487     Lisp_Object prev_value;
 488
 489     selection_time = long_to_cons (last_event_timestamp);
 490     selection_data = Fcons (selection_name,
 491                             Fcons (selection_value,
 492                                    Fcons (selection_time,
 493                                           Fcons (selected_frame, Qnil))));
 494     prev_value = assq_no_quit (selection_name, Vselection_alist);
 495
 496     Vselection_alist = Fcons (selection_data, Vselection_alist);
 497
 498     /* If we already owned the selection, remove the old selection data.
 499        Perhaps we should destructively modify it instead.
 500        Don't use Fdelq as that may QUIT.  */
 501     if (!NILP (prev_value))
 502       {
 503         Lisp_Object rest;       /* we know it's not the CAR, so it's easy.  */
 504         for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
 505           if (EQ (prev_value, Fcar (XCDR (rest))))
 506             {
 507               XSETCDR (rest, Fcdr (XCDR (rest)));
 508               break;
 509             }
 510       }
 511   }
 512 }
 513 \f
 514 /* Given a selection-name and desired type, look up our local copy of
 515    the selection value and convert it to the type.
 516    The value is nil or a string.
 517    This function is used both for remote requests (LOCAL_REQUEST is zero)
 518    and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
 519
 520    This calls random Lisp code, and may signal or gc.  */
 521
 522 static Lisp_Object
 523 x_get_local_selection (selection_symbol, target_type, local_request)
 524      Lisp_Object selection_symbol, target_type;
 525      int local_request;
 526 {
 527   Lisp_Object local_value;
 528   Lisp_Object handler_fn, value, type, check;
 529   int count;
 530
 531   if (NILP (Fx_selection_owner_p (selection_symbol)))
 532     return Qnil;
 533
 534   local_value = assq_no_quit (selection_symbol, Vselection_alist);
 535
 536   /* TIMESTAMP is a special case 'cause that's easiest.  */
 537   if (EQ (target_type, QTIMESTAMP))
 538     {
 539       handler_fn = Qnil;
 540       value = XCAR (XCDR (XCDR (local_value)));
 541     }
 542 #if 0
 543   else if (EQ (target_type, QDELETE))
 544     {
 545       handler_fn = Qnil;
 546       Fx_disown_selection_internal
 547         (selection_symbol,
 548          XCAR (XCDR (XCDR (local_value))));
 549       value = QNULL;
 550     }
 551 #endif
 552   else
 553     {
 554       /* Don't allow a quit within the converter.
 555          When the user types C-g, he would be surprised
 556          if by luck it came during a converter.  */
 557       count = SPECPDL_INDEX ();
 558       specbind (Qinhibit_quit, Qt);
 559
 560       CHECK_SYMBOL (target_type);
 561       handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
 562       /* gcpro is not needed here since nothing but HANDLER_FN
 563          is live, and that ought to be a symbol.  */
 564
 565       if (!NILP (handler_fn))
 566         value = call3 (handler_fn,
 567                        selection_symbol, (local_request ? Qnil : target_type),
 568                        XCAR (XCDR (local_value)));
 569       else
 570         value = Qnil;
 571       unbind_to (count, Qnil);
 572     }
 573
 574   /* Make sure this value is of a type that we could transmit
 575      to another X client.  */
 576
 577   check = value;
 578   if (CONSP (value)
 579       && SYMBOLP (XCAR (value)))
 580     type = XCAR (value),
 581     check = XCDR (value);
 582
 583   if (STRINGP (check)
 584       || VECTORP (check)
 585       || SYMBOLP (check)
 586       || INTEGERP (check)
 587       || NILP (value))
 588     return value;
 589   /* Check for a value that cons_to_long could handle.  */
 590   else if (CONSP (check)
 591            && INTEGERP (XCAR (check))
 592            && (INTEGERP (XCDR (check))
 593                ||
 594                (CONSP (XCDR (check))
 595                 && INTEGERP (XCAR (XCDR (check)))
 596                 && NILP (XCDR (XCDR (check))))))
 597     return value;
 598   else
 599     return
 600       Fsignal (Qerror,
 601                Fcons (build_string ("invalid data returned by selection-conversion function"),
 602                       Fcons (handler_fn, Fcons (value, Qnil))));
 603 }
 604
 605 \f
 606 /* Clear all selections that were made from frame F.
 607    We do this when about to delete a frame.  */
 608
 609 void
 610 x_clear_frame_selections (f)
 611      FRAME_PTR f;
 612 {
 613   Lisp_Object frame;
 614   Lisp_Object rest;
 615
 616   XSETFRAME (frame, f);
 617
 618   /* Otherwise, we're really honest and truly being told to drop it.
 619      Don't use Fdelq as that may QUIT;.  */
 620
 621   /* Delete elements from the beginning of Vselection_alist.  */
 622   while (!NILP (Vselection_alist)
 623          && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
 624     {
 625       /* Let random Lisp code notice that the selection has been stolen.  */
 626       Lisp_Object hooks, selection_symbol;
 627
 628       hooks = Vx_lost_selection_functions;
 629       selection_symbol = Fcar (Fcar (Vselection_alist));
 630
 631       if (!EQ (hooks, Qunbound)
 632           && !NILP (Fx_selection_owner_p (selection_symbol)))
 633         {
 634           for (; CONSP (hooks); hooks = Fcdr (hooks))
 635             call1 (Fcar (hooks), selection_symbol);
 636 #if 0 /* This can crash when deleting a frame
 637          from x_connection_closed.  Anyway, it seems unnecessary;
 638          something else should cause a redisplay.  */
 639           redisplay_preserve_echo_area (21);
 640 #endif
 641         }
 642
 643       Vselection_alist = Fcdr (Vselection_alist);
 644     }
 645
 646   /* Delete elements after the beginning of Vselection_alist.  */
 647   for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
 648     if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest))))))))
 649       {
 650         /* Let random Lisp code notice that the selection has been stolen.  */
 651         Lisp_Object hooks, selection_symbol;
 652
 653         hooks = Vx_lost_selection_functions;
 654         selection_symbol = Fcar (Fcar (XCDR (rest)));
 655
 656         if (!EQ (hooks, Qunbound)
 657           && !NILP (Fx_selection_owner_p (selection_symbol)))
 658           {
 659             for (; CONSP (hooks); hooks = Fcdr (hooks))
 660               call1 (Fcar (hooks), selection_symbol);
 661 #if 0 /* See above */
 662             redisplay_preserve_echo_area (22);
 663 #endif
 664           }
 665         XSETCDR (rest, Fcdr (XCDR (rest)));
 666         break;
 667       }
 668 }
 669 \f
 670 /* Do protocol to read selection-data from the server.
 671    Converts this to Lisp data and returns it.  */
 672
 673 static Lisp_Object
 674 x_get_foreign_selection (selection_symbol, target_type, time_stamp)
 675      Lisp_Object selection_symbol, target_type, time_stamp;
 676 {
 677   OSErr err;
 678   ScrapRef scrap;
 679   Lisp_Object result = Qnil;
 680
 681   BLOCK_INPUT;
 682
 683   err = get_scrap_from_symbol (selection_symbol, 0, &scrap);
 684   if (err == noErr && scrap)
 685     if (EQ (target_type, QTARGETS))
 686       {
 687         result = get_scrap_target_type_list (scrap);
 688         result = Fvconcat (1, &result);
 689       }
 690     else
 691       {
 692         result = get_scrap_string (scrap, target_type);
 693         if (STRINGP (result))
 694           Fput_text_property (make_number (0), make_number (SBYTES (result)),
 695                               Qforeign_selection, target_type, result);
 696       }
 697
 698   UNBLOCK_INPUT;
 699
 700   return result;
 701 }
 702
 703
 704 DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
 705        Sx_own_selection_internal, 2, 2, 0,
 706        doc: /* Assert a selection of the given TYPE with the given VALUE.
 707 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
 708 VALUE is typically a string, or a cons of two markers, but may be
 709 anything that the functions on `selection-converter-alist' know about.  */)
 710      (selection_name, selection_value)
 711      Lisp_Object selection_name, selection_value;
 712 {
 713   check_mac ();
 714   CHECK_SYMBOL (selection_name);
 715   if (NILP (selection_value)) error ("selection-value may not be nil");
 716   x_own_selection (selection_name, selection_value);
 717   return selection_value;
 718 }
 719
 720
 721 /* Request the selection value from the owner.  If we are the owner,
 722    simply return our selection value.  If we are not the owner, this
 723    will block until all of the data has arrived.  */
 724
 725 DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
 726        Sx_get_selection_internal, 2, 3, 0,
 727        doc: /* Return text selected from some Mac window.
 728 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
 729 TYPE is the type of data desired, typically `STRING'.
 730 TIME_STAMP is ignored on Mac.  */)
 731   (selection_symbol, target_type, time_stamp)
 732      Lisp_Object selection_symbol, target_type, time_stamp;
 733 {
 734   Lisp_Object val = Qnil;
 735   struct gcpro gcpro1, gcpro2;
 736   GCPRO2 (target_type, val); /* we store newly consed data into these */
 737   check_mac ();
 738   CHECK_SYMBOL (selection_symbol);
 739   CHECK_SYMBOL (target_type);
 740
 741   val = x_get_local_selection (selection_symbol, target_type, 1);
 742
 743   if (NILP (val))
 744     {
 745       val = x_get_foreign_selection (selection_symbol, target_type, time_stamp);
 746       goto DONE;
 747     }
 748
 749   if (CONSP (val)
 750       && SYMBOLP (XCAR (val)))
 751     {
 752       val = XCDR (val);
 753       if (CONSP (val) && NILP (XCDR (val)))
 754         val = XCAR (val);
 755     }
 756  DONE:
 757   UNGCPRO;
 758   return val;
 759 }
 760
 761 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
 762        Sx_disown_selection_internal, 1, 2, 0,
 763        doc: /* If we own the selection SELECTION, disown it.
 764 Disowning it means there is no such selection.  */)
 765      (selection, time)
 766      Lisp_Object selection;
 767      Lisp_Object time;
 768 {
 769   OSErr err;
 770   ScrapRef scrap;
 771   Lisp_Object local_selection_data;
 772
 773   check_mac ();
 774   CHECK_SYMBOL (selection);
 775
 776   if (NILP (Fx_selection_owner_p (selection)))
 777     return Qnil;  /* Don't disown the selection when we're not the owner.  */
 778
 779   local_selection_data = assq_no_quit (selection, Vselection_alist);
 780
 781   /* Don't use Fdelq as that may QUIT;.  */
 782
 783   if (EQ (local_selection_data, Fcar (Vselection_alist)))
 784     Vselection_alist = Fcdr (Vselection_alist);
 785   else
 786     {
 787       Lisp_Object rest;
 788       for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
 789         if (EQ (local_selection_data, Fcar (XCDR (rest))))
 790           {
 791             XSETCDR (rest, Fcdr (XCDR (rest)));
 792             break;
 793           }
 794     }
 795
 796   /* Let random lisp code notice that the selection has been stolen.  */
 797
 798   {
 799     Lisp_Object rest;
 800     rest = Vx_lost_selection_functions;
 801     if (!EQ (rest, Qunbound))
 802       {
 803         for (; CONSP (rest); rest = Fcdr (rest))
 804           call1 (Fcar (rest), selection);
 805         prepare_menu_bars ();
 806         redisplay_preserve_echo_area (20);
 807       }
 808   }
 809
 810   BLOCK_INPUT;
 811
 812   err = get_scrap_from_symbol (selection, 0, &scrap);
 813   if (err == noErr && scrap)
 814     clear_scrap (&scrap);
 815
 816   UNBLOCK_INPUT;
 817
 818   return Qt;
 819 }
 820
 821
 822 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
 823        0, 1, 0,
 824        doc: /* Whether the current Emacs process owns the given Selection.
 825 The arg should be the name of the selection in question, typically one of
 826 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
 827 For convenience, the symbol nil is the same as `PRIMARY',
 828 and t is the same as `SECONDARY'.  */)
 829      (selection)
 830      Lisp_Object selection;
 831 {
 832   OSErr err;
 833   ScrapRef scrap;
 834   Lisp_Object result = Qnil, local_selection_data;
 835
 836   check_mac ();
 837   CHECK_SYMBOL (selection);
 838   if (EQ (selection, Qnil)) selection = QPRIMARY;
 839   if (EQ (selection, Qt)) selection = QSECONDARY;
 840
 841   local_selection_data = assq_no_quit (selection, Vselection_alist);
 842
 843   if (NILP (local_selection_data))
 844     return Qnil;
 845
 846   BLOCK_INPUT;
 847
 848   err = get_scrap_from_symbol (selection, 0, &scrap);
 849   if (err == noErr && scrap)
 850     {
 851       unsigned long timestamp;
 852
 853       err = get_scrap_private_timestamp (scrap, &timestamp);
 854       if (err == noErr
 855           && (timestamp
 856               == cons_to_long (XCAR (XCDR (XCDR (local_selection_data))))))
 857         result = Qt;
 858     }
 859   else
 860     result = Qt;
 861
 862   UNBLOCK_INPUT;
 863
 864   return result;
 865 }
 866
 867 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
 868        0, 1, 0,
 869        doc: /* Whether there is an owner for the given Selection.
 870 The arg should be the name of the selection in question, typically one of
 871 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
 872 For convenience, the symbol nil is the same as `PRIMARY',
 873 and t is the same as `SECONDARY'.  */)
 874      (selection)
 875      Lisp_Object selection;
 876 {
 877   OSErr err;
 878   ScrapRef scrap;
 879   Lisp_Object result = Qnil, rest;
 880
 881   /* It should be safe to call this before we have an Mac frame.  */
 882   if (! FRAME_MAC_P (SELECTED_FRAME ()))
 883     return Qnil;
 884
 885   CHECK_SYMBOL (selection);
 886   if (!NILP (Fx_selection_owner_p (selection)))
 887     return Qt;
 888   if (EQ (selection, Qnil)) selection = QPRIMARY;
 889   if (EQ (selection, Qt)) selection = QSECONDARY;
 890
 891   BLOCK_INPUT;
 892
 893   err = get_scrap_from_symbol (selection, 0, &scrap);
 894   if (err == noErr && scrap)
 895     for (rest = Vselection_converter_alist; CONSP (rest); rest = XCDR (rest))
 896       {
 897         if (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest)))
 898             && scrap_has_target_type (scrap, XCAR (XCAR (rest))))
 899           {
 900             result = Qt;
 901             break;
 902           }
 903       }
 904
 905   UNBLOCK_INPUT;
 906
 907   return result;
 908 }
 909
 910 \f
 911 #ifdef MAC_OSX
 912 void
 913 init_service_handler ()
 914 {
 915   EventTypeSpec specs[] = {{kEventClassService, kEventServiceGetTypes},
 916                            {kEventClassService, kEventServiceCopy},
 917                            {kEventClassService, kEventServicePaste},
 918                            {kEventClassService, kEventServicePerform}};
 919   InstallApplicationEventHandler (NewEventHandlerUPP (mac_handle_service_event),
 920                                   GetEventTypeCount (specs), specs, NULL, NULL);
 921 }
 922
 923 extern void mac_store_services_event P_ ((EventRef));
 924
 925 static OSStatus
 926 mac_handle_service_event (call_ref, event, data)
 927      EventHandlerCallRef call_ref;
 928      EventRef event;
 929      void *data;
 930 {
 931   OSStatus err = noErr;
 932   ScrapRef cur_scrap;
 933
 934   /* Check if Vmac_services_selection is a valid selection that has a
 935      corresponding scrap.  */
 936   if (!SYMBOLP (Vmac_services_selection))
 937     err = eventNotHandledErr;
 938   else
 939     err = get_scrap_from_symbol (Vmac_services_selection, 0, &cur_scrap);
 940   if (!(err == noErr && cur_scrap))
 941     return eventNotHandledErr;
 942
 943   switch (GetEventKind (event))
 944     {
 945     case kEventServiceGetTypes:
 946       {
 947         CFMutableArrayRef copy_types, paste_types;
 948         CFStringRef type;
 949         Lisp_Object rest;
 950         ScrapFlavorType flavor_type;
 951
 952         /* Set paste types. */
 953         err = GetEventParameter (event, kEventParamServicePasteTypes,
 954                                  typeCFMutableArrayRef, NULL,
 955                                  sizeof (CFMutableArrayRef), NULL,
 956                                  &paste_types);
 957         if (err == noErr)
 958           for (rest = Vselection_converter_alist; CONSP (rest);
 959                rest = XCDR (rest))
 960             if (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest)))
 961                 && (flavor_type =
 962                     get_flavor_type_from_symbol (XCAR (XCAR (rest)))))
 963               {
 964                 type = CreateTypeStringWithOSType (flavor_type);
 965                 if (type)
 966                   {
 967                     CFArrayAppendValue (paste_types, type);
 968                     CFRelease (type);
 969                   }
 970               }
 971
 972         /* Set copy types.  */
 973         err = GetEventParameter (event, kEventParamServiceCopyTypes,
 974                                  typeCFMutableArrayRef, NULL,
 975                                  sizeof (CFMutableArrayRef), NULL,
 976                                  &copy_types);
 977         if (err == noErr
 978             && !NILP (Fx_selection_owner_p (Vmac_services_selection)))
 979           for (rest = get_scrap_target_type_list (cur_scrap);
 980                CONSP (rest) && SYMBOLP (XCAR (rest)); rest = XCDR (rest))
 981             {
 982               flavor_type = get_flavor_type_from_symbol (XCAR (rest));
 983               if (flavor_type)
 984                 {
 985                   type = CreateTypeStringWithOSType (flavor_type);
 986                   if (type)
 987                     {
 988                       CFArrayAppendValue (copy_types, type);
 989                       CFRelease (type);
 990                     }
 991                 }
 992             }
 993       }
 994       break;
 995
 996     case kEventServiceCopy:
 997       {
 998         ScrapRef specific_scrap;
 999         Lisp_Object rest, data;
1000
1001         err = GetEventParameter (event, kEventParamScrapRef,
1002                                  typeScrapRef, NULL,
1003                                  sizeof (ScrapRef), NULL, &specific_scrap);
1004         if (err == noErr
1005             && !NILP (Fx_selection_owner_p (Vmac_services_selection)))
1006           for (rest = get_scrap_target_type_list (cur_scrap);
1007                CONSP (rest) && SYMBOLP (XCAR (rest)); rest = XCDR (rest))
1008             {
1009               data = get_scrap_string (cur_scrap, XCAR (rest));
1010               if (STRINGP (data))
1011                 err = put_scrap_string (specific_scrap, XCAR (rest), data);
1012             }
1013         else
1014           err = eventNotHandledErr;
1015       }
1016       break;
1017
1018     case kEventServicePaste:
1019     case kEventServicePerform:
1020       {
1021         ScrapRef specific_scrap;
1022         Lisp_Object rest, data;
1023         int data_exists_p = 0;
1024
1025         err = GetEventParameter (event, kEventParamScrapRef, typeScrapRef,
1026                                  NULL, sizeof (ScrapRef), NULL,
1027                                  &specific_scrap);
1028         if (err == noErr)
1029           err = clear_scrap (&cur_scrap);
1030         if (err == noErr)
1031           for (rest = Vselection_converter_alist; CONSP (rest);
1032                rest = XCDR (rest))
1033             {
1034               if (! (CONSP (XCAR (rest)) && SYMBOLP (XCAR (XCAR (rest)))))
1035                 continue;
1036               data = get_scrap_string (specific_scrap, XCAR (XCAR (rest)));
1037               if (STRINGP (data))
1038                 {
1039                   err = put_scrap_string (cur_scrap, XCAR (XCAR (rest)),
1040                                           data);
1041                   if (err != noErr)
1042                     break;
1043                   data_exists_p = 1;
1044                 }
1045             }
1046         if (err == noErr)
1047           if (data_exists_p)
1048             mac_store_application_menu_event (event);
1049           else
1050             err = eventNotHandledErr;
1051       }
1052       break;
1053     }
1054
1055   return err;
1056 }
1057 #endif
1058
1059
1060 void
1061 syms_of_macselect ()
1062 {
1063   defsubr (&Sx_get_selection_internal);
1064   defsubr (&Sx_own_selection_internal);
1065   defsubr (&Sx_disown_selection_internal);
1066   defsubr (&Sx_selection_owner_p);
1067   defsubr (&Sx_selection_exists_p);
1068
1069   Vselection_alist = Qnil;
1070   staticpro (&Vselection_alist);
1071
1072   DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
1073                doc: /* An alist associating selection-types with functions.
1074 These functions are called to convert the selection, with three args:
1075 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
1076 a desired type to which the selection should be converted;
1077 and the local selection value (whatever was given to `x-own-selection').
1078
1079 The function should return the value to send to the Scrap Manager
1080 \(a string).  A return value of nil
1081 means that the conversion could not be done.
1082 A return value which is the symbol `NULL'
1083 means that a side-effect was executed,
1084 and there is no meaningful selection value.  */);
1085   Vselection_converter_alist = Qnil;
1086
1087   DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions,
1088                doc: /* A list of functions to be called when Emacs loses a selection.
1089 \(This happens when a Lisp program explicitly clears the selection.)
1090 The functions are called with one argument, the selection type
1091 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD').  */);
1092   Vx_lost_selection_functions = Qnil;
1093
1094   DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
1095                doc: /* Coding system for communicating with other programs.
1096 When sending or receiving text via cut_buffer, selection, and clipboard,
1097 the text is encoded or decoded by this coding system.
1098 The default value is determined by the system script code.  */);
1099   Vselection_coding_system = Qnil;
1100
1101   DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
1102                doc: /* Coding system for the next communication with other programs.
1103 Usually, `selection-coding-system' is used for communicating with
1104 other programs.  But, if this variable is set, it is used for the
1105 next communication only.  After the communication, this variable is
1106 set to nil.  */);
1107   Vnext_selection_coding_system = Qnil;
1108
1109 #ifdef MAC_OSX
1110   DEFVAR_LISP ("mac-services-selection", &Vmac_services_selection,
1111                doc: /* Selection name for communication via Services menu.  */);
1112   Vmac_services_selection = intern ("PRIMARY");
1113 #endif
1114
1115   QPRIMARY   = intern ("PRIMARY");      staticpro (&QPRIMARY);
1116   QSECONDARY = intern ("SECONDARY");    staticpro (&QSECONDARY);
1117   QTIMESTAMP = intern ("TIMESTAMP");    staticpro (&QTIMESTAMP);
1118   QTARGETS   = intern ("TARGETS");      staticpro (&QTARGETS);
1119
1120   Qforeign_selection = intern ("foreign-selection");
1121   staticpro (&Qforeign_selection);
1122
1123   Qmac_scrap_name = intern ("mac-scrap-name");
1124   staticpro (&Qmac_scrap_name);
1125
1126   Qmac_ostype = intern ("mac-ostype");
1127   staticpro (&Qmac_ostype);
1128 }
1129
1130 /* arch-tag: f3c91ad8-99e0-4bd6-9eef-251b2f848732
1131    (do not change this comment) */