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