git.chise.org Git - chise/xemacs-chise.git.1/blob - src/select-msw.c

   1 /* mswindows selection processing for XEmacs
   2    Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
   3
   4 This file is part of XEmacs.
   5
   6 XEmacs is free software; you can redistribute it and/or modify it
   7 under the terms of the GNU General Public License as published by the
   8 Free Software Foundation; either version 2, or (at your option) any
   9 later version.
  10
  11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14 for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with XEmacs; 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 /* Synched up with: Not synched with FSF. */
  22
  23 /* Authorship:
  24
  25    Written by Kevin Gallo for FSF Emacs.
  26    Rewritten for mswindows by Jonathan Harris, December 1997 for 21.0.
  27    Hacked by Alastair Houghton, July 2000 for enhanced clipboard support.
  28 */
  29
  30 #include <config.h>
  31 #include "lisp.h"
  32 #include "frame.h"
  33 #include "select.h"
  34 #include "opaque.h"
  35 #include "file-coding.h"
  36 #include "buffer.h"
  37
  38 #include "console-msw.h"
  39
  40 /* A list of handles that we must release. Not accessible from Lisp. */
  41 static Lisp_Object Vhandle_alist;
  42
  43 /* Test if this is an X symbol that we understand */
  44 static int
  45 x_sym_p (Lisp_Object value)
  46 {
  47   if (NILP (value) || INTP (value))
  48     return 0;
  49
  50   /* Check for some of the X symbols */
  51   if (EQ (value, QSTRING))              return 1;
  52   if (EQ (value, QTEXT))                return 1;
  53   if (EQ (value, QCOMPOUND_TEXT))       return 1;
  54
  55   return 0;
  56 }
  57
  58 /* This converts a Lisp symbol to an MS-Windows clipboard format.
  59    We have symbols for all predefined clipboard formats, but that
  60    doesn't mean we support them all ;-)
  61    The name of this function is actually a lie - it also knows about
  62    integers and strings... */
  63 static UINT
  64 symbol_to_ms_cf (Lisp_Object value)
  65 {
  66   /* If it's NIL, we're in trouble. */
  67   if (NILP (value))                     return 0;
  68
  69   /* If it's an integer, assume it's a format ID */
  70   if (INTP (value))                     return (UINT) (XINT (value));
  71
  72   /* If it's a string, register the format(!) */
  73   if (STRINGP (value))
  74     return RegisterClipboardFormat (XSTRING_DATA (value));
  75
  76   /* Check for Windows clipboard format symbols */
  77   if (EQ (value, QCF_TEXT))             return CF_TEXT;
  78   if (EQ (value, QCF_BITMAP))           return CF_BITMAP;
  79   if (EQ (value, QCF_METAFILEPICT))     return CF_METAFILEPICT;
  80   if (EQ (value, QCF_SYLK))             return CF_SYLK;
  81   if (EQ (value, QCF_DIF))              return CF_DIF;
  82   if (EQ (value, QCF_TIFF))             return CF_TIFF;
  83   if (EQ (value, QCF_OEMTEXT))          return CF_OEMTEXT;
  84   if (EQ (value, QCF_DIB))              return CF_DIB;
  85   if (EQ (value, QCF_PALETTE))          return CF_PALETTE;
  86   if (EQ (value, QCF_PENDATA))          return CF_PENDATA;
  87   if (EQ (value, QCF_RIFF))             return CF_RIFF;
  88   if (EQ (value, QCF_WAVE))             return CF_WAVE;
  89   if (EQ (value, QCF_UNICODETEXT))      return CF_UNICODETEXT;
  90   if (EQ (value, QCF_ENHMETAFILE))      return CF_ENHMETAFILE;
  91   if (EQ (value, QCF_HDROP))            return CF_HDROP;
  92   if (EQ (value, QCF_LOCALE))           return CF_LOCALE;
  93   if (EQ (value, QCF_OWNERDISPLAY))     return CF_OWNERDISPLAY;
  94   if (EQ (value, QCF_DSPTEXT))          return CF_DSPTEXT;
  95   if (EQ (value, QCF_DSPBITMAP))        return CF_DSPBITMAP;
  96   if (EQ (value, QCF_DSPMETAFILEPICT))  return CF_DSPMETAFILEPICT;
  97   if (EQ (value, QCF_DSPENHMETAFILE))   return CF_DSPENHMETAFILE;
  98
  99   return 0;
 100 }
 101
 102 /* This converts an MS-Windows clipboard format to its corresponding
 103    Lisp symbol, or a Lisp integer otherwise. */
 104 static Lisp_Object
 105 ms_cf_to_symbol (UINT format)
 106 {
 107   switch (format)
 108     {
 109     case CF_TEXT:               return QCF_TEXT;
 110     case CF_BITMAP:             return QCF_BITMAP;
 111     case CF_METAFILEPICT:       return QCF_METAFILEPICT;
 112     case CF_SYLK:               return QCF_SYLK;
 113     case CF_DIF:                return QCF_DIF;
 114     case CF_TIFF:               return QCF_TIFF;
 115     case CF_OEMTEXT:            return QCF_OEMTEXT;
 116     case CF_DIB:                return QCF_DIB;
 117     case CF_PALETTE:            return QCF_PALETTE;
 118     case CF_PENDATA:            return QCF_PENDATA;
 119     case CF_RIFF:               return QCF_RIFF;
 120     case CF_WAVE:               return QCF_WAVE;
 121     case CF_UNICODETEXT:        return QCF_UNICODETEXT;
 122     case CF_ENHMETAFILE:        return QCF_ENHMETAFILE;
 123     case CF_HDROP:              return QCF_HDROP;
 124     case CF_LOCALE:             return QCF_LOCALE;
 125     case CF_OWNERDISPLAY:       return QCF_OWNERDISPLAY;
 126     case CF_DSPTEXT:            return QCF_DSPTEXT;
 127     case CF_DSPBITMAP:          return QCF_DSPBITMAP;
 128     case CF_DSPMETAFILEPICT:    return QCF_DSPMETAFILEPICT;
 129     case CF_DSPENHMETAFILE:     return QCF_DSPENHMETAFILE;
 130     default:                    return make_int ((int) format);
 131     }
 132 }
 133
 134 /* Test if the specified clipboard format is auto-released by the OS. If
 135    not, we must remember the handle on Vhandle_alist, and free it if
 136    the clipboard is emptied or if we set data with the same format. */
 137 static int
 138 cf_is_autofreed (UINT format)
 139 {
 140   switch (format)
 141     {
 142     /* This list comes from the SDK documentation */
 143     case CF_DSPENHMETAFILE:
 144     case CF_DSPMETAFILEPICT:
 145     case CF_ENHMETAFILE:
 146     case CF_BITMAP:
 147     case CF_DSPBITMAP:
 148     case CF_PALETTE:
 149     case CF_DIB:
 150     case CF_DSPTEXT:
 151     case CF_OEMTEXT:
 152     case CF_TEXT:
 153     case CF_UNICODETEXT:
 154       return TRUE;
 155
 156     default:
 157       return FALSE;
 158     }
 159 }
 160
 161 /* Do protocol to assert ourself as a selection owner.
 162
 163    Under mswindows, we:
 164
 165    * Only set the clipboard if (eq selection-name 'CLIPBOARD)
 166
 167    * Check if an X atom name has been passed. If so, convert to CF_TEXT
 168      (or CF_UNICODETEXT) remembering to perform LF -> CR-LF conversion.
 169
 170    * Otherwise assume the data is formatted appropriately for the data type
 171      that was passed.
 172
 173    Then set the clipboard as necessary.
 174 */
 175 static Lisp_Object
 176 mswindows_own_selection (Lisp_Object selection_name,
 177                          Lisp_Object selection_value,
 178                          Lisp_Object how_to_add,
 179                          Lisp_Object selection_type)
 180 {
 181   HGLOBAL       hValue = NULL;
 182   UINT          cfType;
 183   int           is_X_type = FALSE;
 184   Lisp_Object   cfObject;
 185   Lisp_Object   data = Qnil;
 186   int           size;
 187   void          *src, *dst;
 188   struct frame  *f = NULL;
 189
 190   /* Only continue if we're trying to set the clipboard - mswindows doesn't
 191      use the same selection model as X */
 192   if (!EQ (selection_name, QCLIPBOARD))
 193     return Qnil;
 194
 195   /* If this is one of the X-style atom name symbols, or NIL, convert it
 196      as appropriate */
 197   if (NILP (selection_type) || x_sym_p (selection_type))
 198     {
 199       /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */
 200       cfType = CF_TEXT;
 201       cfObject = QCF_TEXT;
 202       is_X_type = TRUE;
 203     }
 204   else
 205     {
 206       cfType = symbol_to_ms_cf (selection_type);
 207
 208       /* Only continue if we can figure out a clipboard type */
 209       if (!cfType)
 210         return Qnil;
 211
 212       cfObject = selection_type;
 213     }
 214
 215   /* Convert things appropriately */
 216   data = select_convert_out (selection_name,
 217                              cfObject,
 218                              selection_value);
 219
 220   if (NILP (data))
 221     return Qnil;
 222
 223   if (CONSP (data))
 224     {
 225       if (!EQ (XCAR (data), cfObject))
 226         cfType = symbol_to_ms_cf (XCAR (data));
 227
 228       if (!cfType)
 229         return Qnil;
 230
 231       data = XCDR (data);
 232     }
 233
 234   /* We support opaque or string values, but we only mention string
 235      values for now... */
 236   if (!OPAQUEP (data)
 237       && !STRINGP (data))
 238     return Qnil;
 239
 240   /* Compute the data length */
 241   if (OPAQUEP (data))
 242     size = XOPAQUE_SIZE (data);
 243   else
 244     size = XSTRING_LENGTH (data) + 1;
 245
 246   /* Find the frame */
 247   f = selected_frame ();
 248
 249   /* Open the clipboard */
 250   if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
 251     return Qnil;
 252
 253   /* Allocate memory */
 254   hValue = GlobalAlloc (GMEM_DDESHARE | GMEM_MOVEABLE, size);
 255
 256   if (!hValue)
 257     {
 258       CloseClipboard ();
 259
 260       return Qnil;
 261     }
 262
 263   /* Copy the data */
 264   if (OPAQUEP (data))
 265     src = XOPAQUE_DATA (data);
 266   else
 267     src = XSTRING_DATA (data);
 268
 269   dst = GlobalLock (hValue);
 270
 271   if (!dst)
 272     {
 273       GlobalFree (hValue);
 274       CloseClipboard ();
 275
 276       return Qnil;
 277     }
 278
 279   memcpy (dst, src, size);
 280
 281   GlobalUnlock (hValue);
 282
 283   /* Empty the clipboard if we're replacing everything */
 284   if (NILP (how_to_add) || EQ (how_to_add, Qreplace_all))
 285     {
 286       if (!EmptyClipboard ())
 287         {
 288           CloseClipboard ();
 289           GlobalFree (hValue);
 290
 291           return Qnil;
 292         }
 293     }
 294
 295   /* Append is currently handled in select.el; perhaps this should change,
 296      but it only really makes sense for ordinary text in any case... */
 297
 298   SetClipboardData (cfType, hValue);
 299
 300   if (!cf_is_autofreed (cfType))
 301     {
 302       Lisp_Object alist_elt = Qnil, rest;
 303       Lisp_Object cfType_int = make_int (cfType);
 304
 305       /* First check if there's an element in the alist for this type
 306          already. */
 307       alist_elt = assq_no_quit (cfType_int, Vhandle_alist);
 308
 309       /* Add an element to the alist */
 310       Vhandle_alist = Fcons (Fcons (cfType_int, make_opaque_ptr (hValue)),
 311                              Vhandle_alist);
 312
 313       if (!NILP (alist_elt))
 314         {
 315           /* Free the original handle */
 316           GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (alist_elt)));
 317
 318           /* Remove the original one (adding first makes life easier, because
 319              we don't have to special case this being the first element)      */
 320           for (rest = Vhandle_alist; !NILP (rest); rest = Fcdr (rest))
 321             if (EQ (cfType_int, Fcar (XCDR (rest))))
 322               {
 323                 XCDR (rest) = Fcdr (XCDR (rest));
 324                 break;
 325               }
 326         }
 327     }
 328
 329   CloseClipboard ();
 330
 331   /* #### Should really return a time, though this is because of the
 332      X model (by the looks of things) */
 333   return Qnil;
 334 }
 335
 336 static Lisp_Object
 337 mswindows_available_selection_types (Lisp_Object selection_name)
 338 {
 339   Lisp_Object   types = Qnil;
 340   UINT          format = 0;
 341   struct frame  *f = NULL;
 342
 343   if (!EQ (selection_name, QCLIPBOARD))
 344     return Qnil;
 345
 346   /* Find the frame */
 347   f = selected_frame ();
 348
 349   /* Open the clipboard */
 350   if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
 351     return Qnil;
 352
 353   /* #### ajh - Should there be an unwind-protect handler around this?
 354                 It could (well it probably won't, but it's always better to
 355                 be safe) run out of memory and leave the clipboard open... */
 356
 357   while ((format = EnumClipboardFormats (format)))
 358     types = Fcons (ms_cf_to_symbol (format), types);
 359
 360   /* Close it */
 361   CloseClipboard ();
 362
 363   return types;
 364 }
 365
 366 static Lisp_Object
 367 mswindows_register_selection_data_type (Lisp_Object type_name)
 368 {
 369   /* Type already checked in select.c */
 370   const char *name = XSTRING_DATA (type_name);
 371   UINT        format;
 372
 373   format = RegisterClipboardFormat (name);
 374
 375   if (format)
 376     return make_int ((int) format);
 377   else
 378     return Qnil;
 379 }
 380
 381 static Lisp_Object
 382 mswindows_selection_data_type_name (Lisp_Object type_id)
 383 {
 384   UINT          format;
 385   int           numchars;
 386   char          name_buf[128];
 387
 388   /* If it's an integer, convert to a symbol if appropriate */
 389   if (INTP (type_id))
 390     type_id = ms_cf_to_symbol (XINT (type_id));
 391
 392   /* If this is a symbol, return it */
 393   if (SYMBOLP (type_id))
 394     return type_id;
 395
 396   /* Find the format code */
 397   format = symbol_to_ms_cf (type_id);
 398
 399   if (!format)
 400     return Qnil;
 401
 402   /* Microsoft, stupid Microsoft */
 403   numchars = GetClipboardFormatName (format, name_buf, 128);
 404
 405   if (numchars)
 406     {
 407       Lisp_Object name;
 408
 409       /* Do this properly - though we could support UNICODE (UCS-2) if
 410          MULE could hack it. */
 411       name = make_ext_string (name_buf, numchars,
 412                               Fget_coding_system (Qraw_text));
 413
 414       return name;
 415     }
 416
 417   return Qnil;
 418 }
 419
 420 static Lisp_Object
 421 mswindows_get_foreign_selection (Lisp_Object selection_symbol,
 422                                  Lisp_Object target_type)
 423 {
 424   HGLOBAL       hValue = NULL;
 425   UINT          cfType;
 426   Lisp_Object   cfObject = Qnil, ret = Qnil, value = Qnil;
 427   int           is_X_type = FALSE;
 428   int           size;
 429   void          *data;
 430   struct frame  *f = NULL;
 431   struct gcpro  gcpro1;
 432
 433   /* Only continue if we're trying to read the clipboard - mswindows doesn't
 434      use the same selection model as X */
 435   if (!EQ (selection_symbol, QCLIPBOARD))
 436     return Qnil;
 437
 438   /* If this is one fo the X-style atom name symbols, or NIL, convert it
 439      as appropriate */
 440   if (NILP (target_type) || x_sym_p (target_type))
 441     {
 442       /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */
 443       cfType = CF_TEXT;
 444       cfObject = QCF_TEXT;
 445       is_X_type = TRUE;
 446     }
 447   else
 448     {
 449       cfType = symbol_to_ms_cf (target_type);
 450
 451       /* Only continue if we can figure out a clipboard type */
 452       if (!cfType)
 453         return Qnil;
 454
 455       cfObject = ms_cf_to_symbol (cfType);
 456     }
 457
 458   /* Find the frame */
 459   f = selected_frame ();
 460
 461   /* Open the clipboard */
 462   if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
 463     return Qnil;
 464
 465   /* Read the clipboard */
 466   hValue = GetClipboardData (cfType);
 467
 468   if (!hValue)
 469     {
 470       CloseClipboard ();
 471
 472       return Qnil;
 473     }
 474
 475   /* Find the data */
 476   size = GlobalSize (hValue);
 477   data = GlobalLock (hValue);
 478
 479   if (!data)
 480     {
 481       CloseClipboard ();
 482
 483       return Qnil;
 484     }
 485
 486   /* Place it in a Lisp string */
 487   TO_INTERNAL_FORMAT (DATA, (data, size),
 488                       LISP_STRING, ret,
 489                       Qbinary);
 490
 491   GlobalUnlock (data);
 492   CloseClipboard ();
 493
 494   GCPRO1 (ret);
 495
 496   /* Convert this to the appropriate type. If we can't find anything,
 497      then we return a cons of the form (DATA-TYPE . STRING), where the
 498      string contains the raw binary data. */
 499   value = select_convert_in (selection_symbol,
 500                              cfObject,
 501                              ret);
 502
 503   UNGCPRO;
 504
 505   if (NILP (value))
 506     return Fcons (cfObject, ret);
 507   else
 508     return value;
 509 }
 510
 511 static void
 512 mswindows_disown_selection (Lisp_Object selection, Lisp_Object timeval)
 513 {
 514   if (EQ (selection, QCLIPBOARD))
 515     {
 516       BOOL success = OpenClipboard (NULL);
 517       if (success)
 518         {
 519           success = EmptyClipboard ();
 520           /* Close it regardless of whether empty worked. */
 521           if (!CloseClipboard ())
 522             success = FALSE;
 523         }
 524
 525       /* #### return success ? Qt : Qnil; */
 526     }
 527 }
 528
 529 void
 530 mswindows_destroy_selection (Lisp_Object selection)
 531 {
 532   Lisp_Object alist_elt;
 533
 534   /* Do nothing if this isn't for the clipboard. */
 535   if (!EQ (selection, QCLIPBOARD))
 536     return;
 537
 538   /* Right. We need to delete everything in Vhandle_alist. */
 539   alist_elt = Vhandle_alist;
 540
 541   for (alist_elt; !NILP (alist_elt); alist_elt = Fcdr (alist_elt))
 542     GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (alist_elt)));
 543
 544   Vhandle_alist = Qnil;
 545 }
 546
 547 static Lisp_Object
 548 mswindows_selection_exists_p (Lisp_Object selection,
 549                               Lisp_Object selection_type)
 550 {
 551   /* We used to be picky about the format, but now we support anything. */
 552   if (EQ (selection, QCLIPBOARD))
 553     {
 554       if (NILP (selection_type))
 555         return CountClipboardFormats () ? Qt : Qnil;
 556       else
 557         return IsClipboardFormatAvailable (symbol_to_ms_cf (selection_type))
 558           ? Qt : Qnil;
 559     }
 560   else
 561     return Qnil;
 562 }
 563
 564 \f
 565 /************************************************************************/
 566 /*                            initialization                            */
 567 /************************************************************************/
 568
 569 void
 570 console_type_create_select_mswindows (void)
 571 {
 572   CONSOLE_HAS_METHOD (mswindows, own_selection);
 573   CONSOLE_HAS_METHOD (mswindows, disown_selection);
 574   CONSOLE_HAS_METHOD (mswindows, selection_exists_p);
 575   CONSOLE_HAS_METHOD (mswindows, get_foreign_selection);
 576   CONSOLE_HAS_METHOD (mswindows, available_selection_types);
 577   CONSOLE_HAS_METHOD (mswindows, register_selection_data_type);
 578   CONSOLE_HAS_METHOD (mswindows, selection_data_type_name);
 579 }
 580
 581 void
 582 syms_of_select_mswindows (void)
 583 {
 584 }
 585
 586 void
 587 vars_of_select_mswindows (void)
 588 {
 589   /* Initialise Vhandle_alist */
 590   Vhandle_alist = Qnil;
 591   staticpro (&Vhandle_alist);
 592 }