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