Mercurial > hg > xemacs-beta

comparison src/select-msw.c @ 410:de805c49cfc1 r21-2-35

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-35
author cvs
date Mon, 13 Aug 2007 11:19:21 +0200
parents 2f8bb876ab1d
children 697ef44129c6
comparison
equal deleted inserted replaced
409:301b9ebbdf3b 410:de805c49cfc1
22 22
23 /* Authorship: 23 /* Authorship:
24 24
25 Written by Kevin Gallo for FSF Emacs. 25 Written by Kevin Gallo for FSF Emacs.
26 Rewritten for mswindows by Jonathan Harris, December 1997 for 21.0. 26 Rewritten for mswindows by Jonathan Harris, December 1997 for 21.0.
27 */ 27 Hacked by Alastair Houghton, July 2000 for enhanced clipboard support.
28 28 */
29 29
30 #include <config.h> 30 #include <config.h>
31 #include "lisp.h" 31 #include "lisp.h"
32 #include "frame.h" 32 #include "frame.h"
33 #include "select.h" 33 #include "select.h"
34 #include "opaque.h"
35 #include "file-coding.h"
36 #include "buffer.h"
34 37
35 #include "console-msw.h" 38 #include "console-msw.h"
36 39
37 40 /* A list of handles that we must release. Not accessible from Lisp. */
38 /* Do protocol to assert ourself as a selection owner. Under mswindows 41 static Lisp_Object Vhandle_alist;
39 this is easy, we just set the clipboard. */ 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 */
40 static Lisp_Object 175 static Lisp_Object
41 mswindows_own_selection (Lisp_Object selection_name, 176 mswindows_own_selection (Lisp_Object selection_name,
42 Lisp_Object selection_value) 177 Lisp_Object selection_value,
43 { 178 Lisp_Object how_to_add,
44 Lisp_Object converted_value = get_local_selection (selection_name, QSTRING); 179 Lisp_Object selection_type)
45 180 {
46 if (!NILP (converted_value) && 181 HGLOBAL hValue = NULL;
47 CONSP (converted_value) && 182 UINT cfType;
48 EQ (XCAR (converted_value), QSTRING) && 183 int is_X_type = FALSE;
49 /* pure mswindows behaviour only says we can own the selection 184 Lisp_Object cfObject;
50 if it is the clipboard */ 185 Lisp_Object data = Qnil;
51 EQ (selection_name, QCLIPBOARD)) 186 int size;
52 { 187 void *src, *dst;
53 int rawsize, size, i; 188 struct frame *f = NULL;
54 unsigned char *src, *dst, *next; 189
55 HGLOBAL h = NULL; 190 /* Only continue if we're trying to set the clipboard - mswindows doesn't
56 struct frame *f = NULL; 191 use the same selection model as X */
57 struct gcpro gcpro1, gcpro2; 192 if (!EQ (selection_name, QCLIPBOARD))
58 Lisp_Object string = XCDR (converted_value); 193 return Qnil;
59 194
60 GCPRO2 (converted_value, string); 195 /* If this is one of the X-style atom name symbols, or NIL, convert it
61 196 as appropriate */
62 CHECK_STRING (string); 197 if (NILP (selection_type) || x_sym_p (selection_type))
63 198 {
64 /* Calculate size with LFs converted to CRLFs because 199 /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */
65 * CF_TEXT format uses CRLF delimited ASCIIZ */ 200 cfType = CF_TEXT;
66 src = XSTRING_DATA (string); 201 cfObject = QCF_TEXT;
67 size = rawsize = XSTRING_LENGTH (string) + 1; 202 is_X_type = TRUE;
68 for (i=0; i<rawsize; i++) 203 }
69 if (src[i] == '\n') 204 else
70 size++; 205 {
71 206 cfType = symbol_to_ms_cf (selection_type);
72 f = selected_frame (); 207
73 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f))) 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 ())
74 { 287 {
75 UNGCPRO; 288 CloseClipboard ();
289 GlobalFree (hValue);
290
76 return Qnil; 291 return Qnil;
77 } 292 }
78 293 }
79 /* This call to EmptyClipboard may post an event back to us if 294
80 we already own the clipboard (to tell us we lost it) and this 295 /* Append is currently handled in select.el; perhaps this should change,
81 event may execute random lisp code. Hence we must protect 296 but it only really makes sense for ordinary text in any case... */
82 the string and get its address again after the call. */ 297
83 if (!EmptyClipboard () || 298 SetClipboardData (cfType, hValue);
84 (h = GlobalAlloc (GMEM_MOVEABLE | GMEM_DDESHARE, size)) == NULL || 299
85 (dst = (unsigned char *) GlobalLock (h)) == NULL) 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))
86 { 314 {
87 if (h != NULL) GlobalFree (h); 315 /* Free the original handle */
88 CloseClipboard (); 316 GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (alist_elt)));
89 UNGCPRO; 317
90 return Qnil; 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 }
91 } 326 }
92 src = XSTRING_DATA (string); 327 }
93 328
94 /* Convert LFs to CRLFs */ 329 CloseClipboard ();
95 do 330
96 { 331 /* #### Should really return a time, though this is because of the
97 /* copy next line or remaining bytes including '\0' */ 332 X model (by the looks of things) */
98 next = (char*) memccpy (dst, src, '\n', rawsize); 333 return Qnil;
99 if (next) 334 }
100 { 335
101 /* copied one line ending with '\n' */ 336 static Lisp_Object
102 int copied = next - dst; 337 mswindows_available_selection_types (Lisp_Object selection_name)
103 rawsize -= copied; 338 {
104 src += copied; 339 Lisp_Object types = Qnil;
105 /* insert '\r' before '\n' */ 340 UINT format = 0;
106 next[-1] = '\r'; 341 struct frame *f = NULL;
107 next[0] = '\n'; 342
108 dst = next+1; 343 if (!EQ (selection_name, QCLIPBOARD))
109 } 344 return Qnil;
110 } 345
111 while (next); 346 /* Find the frame */
112 347 f = selected_frame ();
113 GlobalUnlock (h); 348
114 349 /* Open the clipboard */
115 i = (SetClipboardData (CF_TEXT, h) != NULL); 350 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
116 351 return Qnil;
117 CloseClipboard (); 352
118 353 /* #### ajh - Should there be an unwind-protect handler around this?
119 UNGCPRO; 354 It could (well it probably won't, but it's always better to
120 /* #### we are supposed to return a time! */ 355 be safe) run out of memory and leave the clipboard open... */
121 /* return i ? Qt : Qnil; */ 356
122 return Qnil; 357 while ((format = EnumClipboardFormats (format)))
123 } 358 types = Fcons (ms_cf_to_symbol (format), types);
124 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
125 return Qnil; 417 return Qnil;
126 } 418 }
127 419
128 static Lisp_Object 420 static Lisp_Object
129 mswindows_get_foreign_selection (Lisp_Object selection_symbol, 421 mswindows_get_foreign_selection (Lisp_Object selection_symbol,
130 Lisp_Object target_type) 422 Lisp_Object target_type)
131 { 423 {
132 if (EQ (selection_symbol, QCLIPBOARD)) 424 HGLOBAL hValue = NULL;
133 { 425 UINT cfType;
134 HANDLE h; 426 Lisp_Object cfObject = Qnil, ret = Qnil, value = Qnil;
135 unsigned char *src, *dst, *next; 427 int is_X_type = FALSE;
136 Lisp_Object ret = Qnil; 428 int size;
137 429 void *data;
138 if (!OpenClipboard (NULL)) 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)
139 return Qnil; 453 return Qnil;
140 454
141 if ((h = GetClipboardData (CF_TEXT)) != NULL && 455 cfObject = ms_cf_to_symbol (cfType);
142 (src = (unsigned char *) GlobalLock (h)) != NULL) 456 }
143 { 457
144 int i; 458 /* Find the frame */
145 int size, rawsize; 459 f = selected_frame ();
146 size = rawsize = strlen (src); 460
147 461 /* Open the clipboard */
148 for (i=0; i<rawsize; i++) 462 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f)))
149 if (src[i] == '\r' && src[i+1] == '\n') 463 return Qnil;
150 size--; 464
151 465 /* Read the clipboard */
152 /* Convert CRLFs to LFs */ 466 hValue = GetClipboardData (cfType);
153 ret = make_uninit_string (size); 467
154 dst = XSTRING_DATA (ret); 468 if (!hValue)
155 do 469 {
156 {
157 /* copy next line or remaining bytes excluding '\0' */
158 next = (unsigned char *) memccpy (dst, src, '\r', rawsize);
159 if (next)
160 {
161 /* copied one line ending with '\r' */
162 int copied = next - dst;
163 rawsize -= copied;
164 src += copied;
165 if (*src == '\n')
166 dst += copied - 1; /* overwrite '\r' */
167 else
168 dst += copied;
169 }
170 }
171 while (next);
172
173 GlobalUnlock (h);
174 }
175
176 CloseClipboard (); 470 CloseClipboard ();
177 471
178 return ret; 472 return Qnil;
179 } 473 }
180 else 474
181 return Qnil; 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;
182 } 509 }
183 510
184 static void 511 static void
185 mswindows_disown_selection (Lisp_Object selection, Lisp_Object timeval) 512 mswindows_disown_selection (Lisp_Object selection, Lisp_Object timeval)
186 { 513 {
197 524
198 /* #### return success ? Qt : Qnil; */ 525 /* #### return success ? Qt : Qnil; */
199 } 526 }
200 } 527 }
201 528
202 static Lisp_Object 529 void
203 mswindows_selection_exists_p (Lisp_Object selection) 530 mswindows_destroy_selection (Lisp_Object selection)
204 { 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. */
205 if (EQ (selection, QCLIPBOARD)) 552 if (EQ (selection, QCLIPBOARD))
206 return IsClipboardFormatAvailable (CF_TEXT) ? Qt : Qnil; 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 }
207 else 560 else
208 return Qnil; 561 return Qnil;
209 } 562 }
210 563
211 564
218 { 571 {
219 CONSOLE_HAS_METHOD (mswindows, own_selection); 572 CONSOLE_HAS_METHOD (mswindows, own_selection);
220 CONSOLE_HAS_METHOD (mswindows, disown_selection); 573 CONSOLE_HAS_METHOD (mswindows, disown_selection);
221 CONSOLE_HAS_METHOD (mswindows, selection_exists_p); 574 CONSOLE_HAS_METHOD (mswindows, selection_exists_p);
222 CONSOLE_HAS_METHOD (mswindows, get_foreign_selection); 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);
223 } 579 }
224 580
225 void 581 void
226 syms_of_select_mswindows (void) 582 syms_of_select_mswindows (void)
227 { 583 {
228 } 584 }
229 585
230 void 586 void
231 vars_of_select_mswindows (void) 587 vars_of_select_mswindows (void)
232 { 588 {
233 } 589 /* Initialise Vhandle_alist */
590 Vhandle_alist = Qnil;
591 staticpro (&Vhandle_alist);
592 }