git.chise.org Git - chise/xemacs-chise.git-/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                          int owned_p /* Not used */)
 191 {
 192   HGLOBAL       hValue = NULL;
 193   UINT          cfType;
 194   int           is_X_type = FALSE;
 195   Lisp_Object   cfObject;
 196   Lisp_Object   data = Qnil;
 197   int           size;
 198   void          *src, *dst;
 199   struct frame  *f = NULL;
 200
 201   /* Only continue if we're trying to set the clipboard - mswindows doesn't
 202      use the same selection model as X */
 203   if (!EQ (selection_name, QCLIPBOARD))
 204     return Qnil;
 205
 206   /* If this is one of the X-style atom name symbols, or NIL, convert it
 207      as appropriate */
 208   if (NILP (selection_type) || x_sym_p (selection_type))
 209     {
 210       /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */
 211       cfType = CF_TEXT;
 212       cfObject = QCF_TEXT;
 213       is_X_type = TRUE;
 214     }
 215   else
 216     {
 217       cfType = symbol_to_ms_cf (selection_type);
 218
 219       /* Only continue if we can figure out a clipboard type */
 220       if (!cfType)
 221         return Qnil;
 222
 223       cfObject = selection_type;
 224     }
 225
 226   /* Convert things appropriately */
 227   data = select_convert_out (selection_name,
 228                              cfObject,
 229                              selection_value);
 230
 231   if (NILP (data))
 232     return Qnil;
 233
 234   if (CONSP (data))
 235     {
 236       if (!EQ (XCAR (data), cfObject))
 237         cfType = symbol_to_ms_cf (XCAR (data));
 238
 239       if (!cfType)
 240         return Qnil;
 241
 242       data = XCDR (data);
 243     }
 244
 245   /* We support opaque or string values, but we only mention string
 246      values for now... */
 247   if (!OPAQUEP (data)
 248       && !STRINGP (data))
 249     return Qnil;
 250
 251   /* Compute the data length */
 252   if (OPAQUEP (data))
 253     size = XOPAQUE_SIZE (data);
 254   else
 255     size = XSTRING_LENGTH (data) + 1;
 256
 257   /* Find the frame */
 258   f = selected_frame ();
 259
 260   /* Open the clipboard */
 261   if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
 262     return Qnil;
 263
 264   /* Allocate memory */
 265   hValue = GlobalAlloc (GMEM_DDESHARE | GMEM_MOVEABLE, size);
 266
 267   if (!hValue)
 268     {
 269       CloseClipboard ();
 270
 271       return Qnil;
 272     }
 273
 274   /* Copy the data */
 275   if (OPAQUEP (data))
 276     src = XOPAQUE_DATA (data);
 277   else
 278     src = XSTRING_DATA (data);
 279
 280   dst = GlobalLock (hValue);
 281
 282   if (!dst)
 283     {
 284       GlobalFree (hValue);
 285       CloseClipboard ();
 286
 287       return Qnil;
 288     }
 289
 290   memcpy (dst, src, size);
 291
 292   GlobalUnlock (hValue);
 293
 294   /* Empty the clipboard if we're replacing everything */
 295   if (NILP (how_to_add) || EQ (how_to_add, Qreplace_all))
 296     {
 297       if (!EmptyClipboard ())
 298         {
 299           CloseClipboard ();
 300           GlobalFree (hValue);
 301
 302           return Qnil;
 303         }
 304     }
 305
 306   /* Append is currently handled in select.el; perhaps this should change,
 307      but it only really makes sense for ordinary text in any case... */
 308
 309   SetClipboardData (cfType, hValue);
 310
 311   if (!cf_is_autofreed (cfType))
 312     {
 313       Lisp_Object alist_elt = Qnil, rest;
 314       Lisp_Object cfType_int = make_int (cfType);
 315
 316       /* First check if there's an element in the alist for this type
 317          already. */
 318       alist_elt = assq_no_quit (cfType_int, Vhandle_alist);
 319
 320       /* Add an element to the alist */
 321       Vhandle_alist = Fcons (Fcons (cfType_int, make_opaque_ptr (hValue)),
 322                              Vhandle_alist);
 323
 324       if (!NILP (alist_elt))
 325         {
 326           /* Free the original handle */
 327           GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (alist_elt)));
 328
 329           /* Remove the original one (adding first makes life easier, because
 330              we don't have to special case this being the first element)      */
 331           for (rest = Vhandle_alist; !NILP (rest); rest = Fcdr (rest))
 332             if (EQ (cfType_int, Fcar (XCDR (rest))))
 333               {
 334                 XCDR (rest) = Fcdr (XCDR (rest));
 335                 break;
 336               }
 337         }
 338     }
 339
 340   CloseClipboard ();
 341
 342   /* #### Should really return a time, though this is because of the
 343      X model (by the looks of things) */
 344   return Qnil;
 345 }
 346
 347 static Lisp_Object
 348 mswindows_available_selection_types (Lisp_Object selection_name)
 349 {
 350   Lisp_Object   types = Qnil;
 351   UINT          format = 0;
 352   struct frame  *f = NULL;
 353
 354   if (!EQ (selection_name, QCLIPBOARD))
 355     return Qnil;
 356
 357   /* Find the frame */
 358   f = selected_frame ();
 359
 360   /* Open the clipboard */
 361   if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
 362     return Qnil;
 363
 364   /* #### ajh - Should there be an unwind-protect handler around this?
 365                 It could (well it probably won't, but it's always better to
 366                 be safe) run out of memory and leave the clipboard open... */
 367
 368   while ((format = EnumClipboardFormats (format)))
 369     types = Fcons (ms_cf_to_symbol (format), types);
 370
 371   /* Close it */
 372   CloseClipboard ();
 373
 374   return types;
 375 }
 376
 377 static Lisp_Object
 378 mswindows_register_selection_data_type (Lisp_Object type_name)
 379 {
 380   /* Type already checked in select.c */
 381   const char *name = XSTRING_DATA (type_name);
 382   UINT        format;
 383
 384   format = RegisterClipboardFormat (name);
 385
 386   if (format)
 387     return make_int ((int) format);
 388   else
 389     return Qnil;
 390 }
 391
 392 static Lisp_Object
 393 mswindows_selection_data_type_name (Lisp_Object type_id)
 394 {
 395   UINT          format;
 396   int           numchars;
 397   char          name_buf[128];
 398
 399   /* If it's an integer, convert to a symbol if appropriate */
 400   if (INTP (type_id))
 401     type_id = ms_cf_to_symbol (XINT (type_id));
 402
 403   /* If this is a symbol, return it */
 404   if (SYMBOLP (type_id))
 405     return type_id;
 406
 407   /* Find the format code */
 408   format = symbol_to_ms_cf (type_id);
 409
 410   if (!format)
 411     return Qnil;
 412
 413   /* Microsoft, stupid Microsoft */
 414   numchars = GetClipboardFormatName (format, name_buf, 128);
 415
 416   if (numchars)
 417     {
 418       Lisp_Object name;
 419
 420       /* Do this properly - though we could support UNICODE (UCS-2) if
 421          MULE could hack it. */
 422       name = make_ext_string (name_buf, numchars,
 423                               Fget_coding_system (Qraw_text));
 424
 425       return name;
 426     }
 427
 428   return Qnil;
 429 }
 430
 431 static Lisp_Object
 432 mswindows_get_foreign_selection (Lisp_Object selection_symbol,
 433                                  Lisp_Object target_type)
 434 {
 435   HGLOBAL       hValue = NULL;
 436   UINT          cfType;
 437   Lisp_Object   cfObject = Qnil, ret = Qnil, value = Qnil;
 438   int           is_X_type = FALSE;
 439   int           size;
 440   void          *data;
 441   struct frame  *f = NULL;
 442   struct gcpro  gcpro1;
 443
 444   /* Only continue if we're trying to read the clipboard - mswindows doesn't
 445      use the same selection model as X */
 446   if (!EQ (selection_symbol, QCLIPBOARD))
 447     return Qnil;
 448
 449   /* If this is one of the X-style atom name symbols, or NIL, convert it
 450      as appropriate */
 451   if (NILP (target_type) || x_sym_p (target_type))
 452     {
 453       /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */
 454       cfType = CF_TEXT;
 455       cfObject = QCF_TEXT;
 456       is_X_type = TRUE;
 457     }
 458   else
 459     {
 460       cfType = symbol_to_ms_cf (target_type);
 461
 462       /* Only continue if we can figure out a clipboard type */
 463       if (!cfType)
 464         return Qnil;
 465
 466       cfObject = ms_cf_to_symbol (cfType);
 467     }
 468
 469   /* Find the frame */
 470   f = selected_frame ();
 471
 472   /* Open the clipboard */
 473   if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
 474     return Qnil;
 475
 476   /* Read the clipboard */
 477   hValue = GetClipboardData (cfType);
 478
 479   if (!hValue)
 480     {
 481       CloseClipboard ();
 482
 483       return Qnil;
 484     }
 485
 486   /* Find the data */
 487   size = GlobalSize (hValue);
 488   data = GlobalLock (hValue);
 489
 490   if (!data)
 491     {
 492       CloseClipboard ();
 493
 494       return Qnil;
 495     }
 496
 497   /* Place it in a Lisp string */
 498   TO_INTERNAL_FORMAT (DATA, (data, size),
 499                       LISP_STRING, ret,
 500                       Qbinary);
 501
 502   GlobalUnlock (data);
 503   CloseClipboard ();
 504
 505   GCPRO1 (ret);
 506
 507   /* Convert this to the appropriate type. If we can't find anything,
 508      then we return a cons of the form (DATA-TYPE . STRING), where the
 509      string contains the raw binary data. */
 510   value = select_convert_in (selection_symbol,
 511                              cfObject,
 512                              ret);
 513
 514   UNGCPRO;
 515
 516   if (NILP (value))
 517     return Fcons (cfObject, ret);
 518   else
 519     return value;
 520 }
 521
 522 static void
 523 mswindows_disown_selection (Lisp_Object selection, Lisp_Object timeval)
 524 {
 525   if (EQ (selection, QCLIPBOARD))
 526     {
 527       BOOL success = OpenClipboard (NULL);
 528       if (success)
 529         {
 530           success = EmptyClipboard ();
 531           /* Close it regardless of whether empty worked. */
 532           if (!CloseClipboard ())
 533             success = FALSE;
 534         }
 535
 536       /* #### return success ? Qt : Qnil; */
 537     }
 538 }
 539
 540 void
 541 mswindows_destroy_selection (Lisp_Object selection)
 542 {
 543   /* Do nothing if this isn't for the clipboard. */
 544   if (!EQ (selection, QCLIPBOARD))
 545     return;
 546
 547   /* Right. We need to delete everything in Vhandle_alist. */
 548   {
 549     LIST_LOOP_2 (elt, Vhandle_alist)
 550       GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (elt)));
 551   }
 552
 553   Vhandle_alist = Qnil;
 554 }
 555
 556 static Lisp_Object
 557 mswindows_selection_exists_p (Lisp_Object selection,
 558                               Lisp_Object selection_type)
 559 {
 560   /* We used to be picky about the format, but now we support anything. */
 561   if (EQ (selection, QCLIPBOARD))
 562     {
 563       if (NILP (selection_type))
 564         return CountClipboardFormats () ? Qt : Qnil;
 565       else
 566         return IsClipboardFormatAvailable (symbol_to_ms_cf (selection_type))
 567           ? Qt : Qnil;
 568     }
 569   else
 570     return Qnil;
 571 }
 572
 573 \f
 574 /************************************************************************/
 575 /*                            initialization                            */
 576 /************************************************************************/
 577
 578 void
 579 console_type_create_select_mswindows (void)
 580 {
 581   CONSOLE_HAS_METHOD (mswindows, own_selection);
 582   CONSOLE_HAS_METHOD (mswindows, disown_selection);
 583   CONSOLE_HAS_METHOD (mswindows, selection_exists_p);
 584   CONSOLE_HAS_METHOD (mswindows, get_foreign_selection);
 585   CONSOLE_HAS_METHOD (mswindows, available_selection_types);
 586   CONSOLE_HAS_METHOD (mswindows, register_selection_data_type);
 587   CONSOLE_HAS_METHOD (mswindows, selection_data_type_name);
 588 }
 589
 590 void
 591 syms_of_select_mswindows (void)
 592 {
 593 }
 594
 595 void
 596 vars_of_select_mswindows (void)
 597 {
 598   /* Initialise Vhandle_alist */
 599   Vhandle_alist = Qnil;
 600   staticpro (&Vhandle_alist);
 601 }