(U+5364-itaiji-002): New character.
[chise/xemacs-chise.git.1] / 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 }