Mercurial > hg > xemacs-beta
annotate src/select-msw.c @ 5518:3cc7470ea71c
gnuclient: if TMPDIR was set and connect failed, try again with /tmp
2011-06-03 Aidan Kehoe <kehoea@parhasard.net>
* gnuslib.c (connect_to_unix_server):
Retry with /tmp as a directory in which to search for Unix sockets
if an attempt to connect with some other directory failed (which
may be because gnuclient and gnuserv don't share an environment
value for TMPDIR, or because gnuserv was compiled with USE_TMPDIR
turned off).
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Fri, 03 Jun 2011 18:40:57 +0100 |
| parents | 308d34e9f07d |
| children | 56144c8593a8 |
| rev | line source |
|---|---|
| 428 | 1 /* mswindows selection processing for XEmacs |
| 2 Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. | |
| 800 | 3 Copyright (C) 2000, 2001, 2002 Ben Wing. |
| 428 | 4 |
| 5 This file is part of XEmacs. | |
| 6 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4982
diff
changeset
|
7 XEmacs is free software: you can redistribute it and/or modify it |
| 428 | 8 under the terms of the GNU General Public License as published by the |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4982
diff
changeset
|
9 Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4982
diff
changeset
|
10 option) any later version. |
| 428 | 11 |
| 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 17 You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4982
diff
changeset
|
18 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 428 | 19 |
| 20 /* Synched up with: Not synched with FSF. */ | |
| 21 | |
| 771 | 22 /* This file Mule-ized 7-00?? Needs some Unicode review. --ben */ |
| 23 | |
| 428 | 24 /* Authorship: |
| 25 | |
| 26 Written by Kevin Gallo for FSF Emacs. | |
| 27 Rewritten for mswindows by Jonathan Harris, December 1997 for 21.0. | |
| 771 | 28 Rewritten April 2000 by Ben Wing -- support device methods, Mule-ize. |
| 442 | 29 Hacked by Alastair Houghton, July 2000 for enhanced clipboard support. |
| 30 */ | |
| 428 | 31 |
| 32 #include <config.h> | |
| 33 #include "lisp.h" | |
| 771 | 34 #include "buffer.h" |
| 872 | 35 #include "frame-impl.h" |
| 428 | 36 #include "select.h" |
| 442 | 37 #include "opaque.h" |
| 38 #include "file-coding.h" | |
| 428 | 39 |
| 872 | 40 #include "console-msw-impl.h" |
| 428 | 41 |
| 771 | 42 static int in_own_selection; |
| 43 | |
| 442 | 44 /* A list of handles that we must release. Not accessible from Lisp. */ |
| 45 static Lisp_Object Vhandle_alist; | |
| 46 | |
| 771 | 47 void |
| 48 mswindows_handle_destroyclipboard (void) | |
| 49 { | |
| 50 /* We also receive a destroy message when we call EmptyClipboard() and | |
| 51 we already own it. In this case we don't want to call | |
| 52 handle_selection_clear() because it will remove what we're trying | |
| 53 to add! */ | |
| 54 if (!in_own_selection) | |
| 55 { | |
| 56 /* We own the clipboard and someone else wants it. Delete our | |
| 57 cached copy of the clipboard contents so we'll ask for it from | |
| 58 Windows again when someone does a paste, and destroy any memory | |
| 59 objects we hold on the clipboard that are not in the list of types | |
| 60 that Windows will delete itself. */ | |
| 61 mswindows_destroy_selection (QCLIPBOARD); | |
| 62 handle_selection_clear (QCLIPBOARD); | |
| 63 } | |
| 64 } | |
| 65 | |
| 66 static int | |
| 67 mswindows_empty_clipboard (void) | |
| 68 { | |
| 69 int retval; | |
| 70 | |
| 71 in_own_selection = 1; | |
| 72 retval = EmptyClipboard (); | |
| 73 in_own_selection = 0; | |
| 74 return retval; | |
| 75 } | |
| 76 | |
| 442 | 77 /* Test if this is an X symbol that we understand */ |
| 78 static int | |
| 79 x_sym_p (Lisp_Object value) | |
| 80 { | |
| 81 if (NILP (value) || INTP (value)) | |
| 82 return 0; | |
| 83 | |
| 84 /* Check for some of the X symbols */ | |
| 85 if (EQ (value, QSTRING)) return 1; | |
| 86 if (EQ (value, QTEXT)) return 1; | |
| 87 if (EQ (value, QCOMPOUND_TEXT)) return 1; | |
| 88 | |
| 89 return 0; | |
| 90 } | |
| 91 | |
| 92 /* This converts a Lisp symbol to an MS-Windows clipboard format. | |
| 93 We have symbols for all predefined clipboard formats, but that | |
| 94 doesn't mean we support them all ;-) | |
| 95 The name of this function is actually a lie - it also knows about | |
| 96 integers and strings... */ | |
| 97 static UINT | |
| 98 symbol_to_ms_cf (Lisp_Object value) | |
| 428 | 99 { |
| 442 | 100 /* If it's NIL, we're in trouble. */ |
| 101 if (NILP (value)) return 0; | |
| 102 | |
| 103 /* If it's an integer, assume it's a format ID */ | |
| 104 if (INTP (value)) return (UINT) (XINT (value)); | |
| 105 | |
| 106 /* If it's a string, register the format(!) */ | |
| 107 if (STRINGP (value)) | |
| 771 | 108 { |
| 109 Extbyte *valext; | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
110 valext = LISP_STRING_TO_TSTR (value); |
| 771 | 111 return qxeRegisterClipboardFormat (valext); |
| 112 } | |
| 442 | 113 |
| 114 /* Check for Windows clipboard format symbols */ | |
| 115 if (EQ (value, QCF_TEXT)) return CF_TEXT; | |
| 116 if (EQ (value, QCF_BITMAP)) return CF_BITMAP; | |
| 117 if (EQ (value, QCF_METAFILEPICT)) return CF_METAFILEPICT; | |
| 118 if (EQ (value, QCF_SYLK)) return CF_SYLK; | |
| 119 if (EQ (value, QCF_DIF)) return CF_DIF; | |
| 120 if (EQ (value, QCF_TIFF)) return CF_TIFF; | |
| 121 if (EQ (value, QCF_OEMTEXT)) return CF_OEMTEXT; | |
| 122 if (EQ (value, QCF_DIB)) return CF_DIB; | |
| 123 #ifdef CF_DIBV5 | |
| 124 if (EQ (value, QCF_DIBV5)) return CF_DIBV5; | |
| 125 #endif | |
| 126 if (EQ (value, QCF_PALETTE)) return CF_PALETTE; | |
| 127 if (EQ (value, QCF_PENDATA)) return CF_PENDATA; | |
| 128 if (EQ (value, QCF_RIFF)) return CF_RIFF; | |
| 129 if (EQ (value, QCF_WAVE)) return CF_WAVE; | |
| 130 if (EQ (value, QCF_UNICODETEXT)) return CF_UNICODETEXT; | |
| 131 if (EQ (value, QCF_ENHMETAFILE)) return CF_ENHMETAFILE; | |
| 132 if (EQ (value, QCF_HDROP)) return CF_HDROP; | |
| 133 if (EQ (value, QCF_LOCALE)) return CF_LOCALE; | |
| 134 if (EQ (value, QCF_OWNERDISPLAY)) return CF_OWNERDISPLAY; | |
| 135 if (EQ (value, QCF_DSPTEXT)) return CF_DSPTEXT; | |
| 136 if (EQ (value, QCF_DSPBITMAP)) return CF_DSPBITMAP; | |
| 137 if (EQ (value, QCF_DSPMETAFILEPICT)) return CF_DSPMETAFILEPICT; | |
| 138 if (EQ (value, QCF_DSPENHMETAFILE)) return CF_DSPENHMETAFILE; | |
| 139 | |
| 140 return 0; | |
| 141 } | |
| 142 | |
| 143 /* This converts an MS-Windows clipboard format to its corresponding | |
| 144 Lisp symbol, or a Lisp integer otherwise. */ | |
| 145 static Lisp_Object | |
| 146 ms_cf_to_symbol (UINT format) | |
| 147 { | |
| 148 switch (format) | |
| 149 { | |
| 150 case CF_TEXT: return QCF_TEXT; | |
| 151 case CF_BITMAP: return QCF_BITMAP; | |
| 152 case CF_METAFILEPICT: return QCF_METAFILEPICT; | |
| 153 case CF_SYLK: return QCF_SYLK; | |
| 154 case CF_DIF: return QCF_DIF; | |
| 155 case CF_TIFF: return QCF_TIFF; | |
| 156 case CF_OEMTEXT: return QCF_OEMTEXT; | |
| 157 case CF_DIB: return QCF_DIB; | |
| 158 #ifdef CF_DIBV5 | |
| 159 case CF_DIBV5: return QCF_DIBV5; | |
| 160 #endif | |
| 161 case CF_PALETTE: return QCF_PALETTE; | |
| 162 case CF_PENDATA: return QCF_PENDATA; | |
| 163 case CF_RIFF: return QCF_RIFF; | |
| 164 case CF_WAVE: return QCF_WAVE; | |
| 165 case CF_UNICODETEXT: return QCF_UNICODETEXT; | |
| 166 case CF_ENHMETAFILE: return QCF_ENHMETAFILE; | |
| 167 case CF_HDROP: return QCF_HDROP; | |
| 168 case CF_LOCALE: return QCF_LOCALE; | |
| 169 case CF_OWNERDISPLAY: return QCF_OWNERDISPLAY; | |
| 170 case CF_DSPTEXT: return QCF_DSPTEXT; | |
| 171 case CF_DSPBITMAP: return QCF_DSPBITMAP; | |
| 172 case CF_DSPMETAFILEPICT: return QCF_DSPMETAFILEPICT; | |
| 173 case CF_DSPENHMETAFILE: return QCF_DSPENHMETAFILE; | |
| 174 default: return make_int ((int) format); | |
| 175 } | |
| 176 } | |
| 428 | 177 |
| 442 | 178 /* Test if the specified clipboard format is auto-released by the OS. If |
| 179 not, we must remember the handle on Vhandle_alist, and free it if | |
| 180 the clipboard is emptied or if we set data with the same format. */ | |
| 181 static int | |
| 182 cf_is_autofreed (UINT format) | |
| 183 { | |
| 184 switch (format) | |
| 185 { | |
| 186 /* This list comes from the SDK documentation */ | |
| 187 case CF_DSPENHMETAFILE: | |
| 188 case CF_DSPMETAFILEPICT: | |
| 189 case CF_ENHMETAFILE: | |
| 190 case CF_METAFILEPICT: | |
| 191 case CF_BITMAP: | |
| 192 case CF_DSPBITMAP: | |
| 193 case CF_PALETTE: | |
| 194 case CF_DIB: | |
| 195 #ifdef CF_DIBV5 | |
| 196 case CF_DIBV5: | |
| 197 #endif | |
| 198 case CF_DSPTEXT: | |
| 199 case CF_OEMTEXT: | |
| 200 case CF_TEXT: | |
| 201 case CF_UNICODETEXT: | |
| 202 return TRUE; | |
| 203 | |
| 204 default: | |
| 205 return FALSE; | |
| 206 } | |
| 207 } | |
| 208 | |
| 209 /* Do protocol to assert ourself as a selection owner. | |
| 210 | |
| 211 Under mswindows, we: | |
| 212 | |
| 213 * Only set the clipboard if (eq selection-name 'CLIPBOARD) | |
| 214 | |
| 215 * Check if an X atom name has been passed. If so, convert to CF_TEXT | |
| 216 (or CF_UNICODETEXT) remembering to perform LF -> CR-LF conversion. | |
| 217 | |
| 218 * Otherwise assume the data is formatted appropriately for the data type | |
| 219 that was passed. | |
| 220 | |
| 221 Then set the clipboard as necessary. | |
| 222 */ | |
| 223 static Lisp_Object | |
| 224 mswindows_own_selection (Lisp_Object selection_name, | |
| 225 Lisp_Object selection_value, | |
| 226 Lisp_Object how_to_add, | |
| 456 | 227 Lisp_Object selection_type, |
| 2286 | 228 int UNUSED (owned_p)) |
| 442 | 229 { |
| 230 HGLOBAL hValue = NULL; | |
| 231 UINT cfType; | |
| 232 int is_X_type = FALSE; | |
| 233 Lisp_Object cfObject; | |
| 234 Lisp_Object data = Qnil; | |
| 235 int size; | |
| 236 void *src, *dst; | |
| 237 struct frame *f = NULL; | |
| 428 | 238 |
| 442 | 239 /* Only continue if we're trying to set the clipboard - mswindows doesn't |
| 240 use the same selection model as X */ | |
| 241 if (!EQ (selection_name, QCLIPBOARD)) | |
| 242 return Qnil; | |
| 243 | |
| 244 /* If this is one of the X-style atom name symbols, or NIL, convert it | |
| 245 as appropriate */ | |
| 246 if (NILP (selection_type) || x_sym_p (selection_type)) | |
| 247 { | |
| 248 /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */ | |
| 771 | 249 if (XEUNICODE_P) |
| 250 { | |
| 251 cfType = CF_UNICODETEXT; | |
| 252 cfObject = QCF_UNICODETEXT; | |
| 253 } | |
| 254 else | |
| 255 { | |
| 256 cfType = CF_TEXT; | |
| 257 cfObject = QCF_TEXT; | |
| 258 } | |
| 442 | 259 is_X_type = TRUE; |
| 260 } | |
| 261 else | |
| 262 { | |
| 263 cfType = symbol_to_ms_cf (selection_type); | |
| 264 | |
| 265 /* Only continue if we can figure out a clipboard type */ | |
| 266 if (!cfType) | |
| 267 return Qnil; | |
| 268 | |
| 269 cfObject = selection_type; | |
| 270 } | |
| 271 | |
| 272 /* Convert things appropriately */ | |
| 273 data = select_convert_out (selection_name, | |
| 274 cfObject, | |
| 275 selection_value); | |
| 428 | 276 |
| 442 | 277 if (NILP (data)) |
| 278 return Qnil; | |
| 279 | |
| 280 if (CONSP (data)) | |
| 281 { | |
| 282 if (!EQ (XCAR (data), cfObject)) | |
| 283 cfType = symbol_to_ms_cf (XCAR (data)); | |
| 284 | |
| 285 if (!cfType) | |
| 286 return Qnil; | |
| 287 | |
| 288 data = XCDR (data); | |
| 289 } | |
| 290 | |
| 291 /* We support opaque or string values, but we only mention string | |
| 771 | 292 values for now... |
| 293 #### where do the opaque objects come from? currently they're not | |
| 294 allowed to be exported to the lisp level! */ | |
| 442 | 295 if (!OPAQUEP (data) |
| 296 && !STRINGP (data)) | |
| 297 return Qnil; | |
| 298 | |
| 299 /* Find the frame */ | |
| 430 | 300 f = selected_frame (); |
| 442 | 301 |
| 302 /* Open the clipboard */ | |
| 430 | 303 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f))) |
| 428 | 304 return Qnil; |
| 305 | |
| 771 | 306 /* Obtain the data */ |
| 307 if (OPAQUEP (data)) | |
| 308 { | |
| 309 src = XOPAQUE_DATA (data); | |
| 310 size = XOPAQUE_SIZE (data); | |
| 311 } | |
| 312 else | |
| 313 /* we do NOT append a zero byte. we don't know whether we're dealing | |
| 314 with regular text, unicode text, binary data, etc. */ | |
| 851 | 315 TO_EXTERNAL_FORMAT (LISP_STRING, data, MALLOC, (src, size), |
| 771 | 316 Qbinary); |
| 317 | |
| 442 | 318 /* Allocate memory */ |
| 319 hValue = GlobalAlloc (GMEM_DDESHARE | GMEM_MOVEABLE, size); | |
| 320 | |
| 321 if (!hValue) | |
| 428 | 322 { |
| 323 CloseClipboard (); | |
| 442 | 324 |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
325 xfree (src); |
| 442 | 326 return Qnil; |
| 327 } | |
| 328 | |
| 329 dst = GlobalLock (hValue); | |
| 330 | |
| 331 if (!dst) | |
| 332 { | |
| 333 GlobalFree (hValue); | |
| 334 CloseClipboard (); | |
| 335 | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
336 xfree (src); |
| 428 | 337 return Qnil; |
| 338 } | |
| 442 | 339 |
| 340 memcpy (dst, src, size); | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
341 xfree (src); |
| 442 | 342 |
| 343 GlobalUnlock (hValue); | |
| 344 | |
| 345 /* Empty the clipboard if we're replacing everything */ | |
| 346 if (NILP (how_to_add) || EQ (how_to_add, Qreplace_all)) | |
| 428 | 347 { |
| 771 | 348 if (!mswindows_empty_clipboard ()) |
| 428 | 349 { |
| 442 | 350 CloseClipboard (); |
| 351 GlobalFree (hValue); | |
| 352 | |
| 353 return Qnil; | |
| 354 } | |
| 428 | 355 } |
| 442 | 356 |
| 357 /* Append is currently handled in select.el; perhaps this should change, | |
| 358 but it only really makes sense for ordinary text in any case... */ | |
| 359 | |
| 360 SetClipboardData (cfType, hValue); | |
| 361 | |
| 362 if (!cf_is_autofreed (cfType)) | |
| 363 { | |
| 364 Lisp_Object alist_elt = Qnil, rest; | |
| 365 Lisp_Object cfType_int = make_int (cfType); | |
| 366 | |
| 367 /* First check if there's an element in the alist for this type | |
| 368 already. */ | |
| 369 alist_elt = assq_no_quit (cfType_int, Vhandle_alist); | |
| 370 | |
| 371 /* Add an element to the alist */ | |
| 372 Vhandle_alist = Fcons (Fcons (cfType_int, make_opaque_ptr (hValue)), | |
| 373 Vhandle_alist); | |
| 374 | |
| 375 if (!NILP (alist_elt)) | |
| 376 { | |
| 377 /* Free the original handle */ | |
| 378 GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (alist_elt))); | |
| 379 | |
| 771 | 380 /* Remove the original one (adding first makes life easier, |
| 381 because we don't have to special case this being the | |
| 382 first element) */ | |
| 442 | 383 for (rest = Vhandle_alist; !NILP (rest); rest = Fcdr (rest)) |
| 384 if (EQ (cfType_int, Fcar (XCDR (rest)))) | |
| 385 { | |
| 386 XCDR (rest) = Fcdr (XCDR (rest)); | |
| 387 break; | |
| 388 } | |
| 389 } | |
| 390 } | |
| 391 | |
| 428 | 392 CloseClipboard (); |
| 442 | 393 |
| 394 /* #### Should really return a time, though this is because of the | |
| 395 X model (by the looks of things) */ | |
| 396 return Qnil; | |
| 428 | 397 } |
| 398 | |
| 399 static Lisp_Object | |
| 442 | 400 mswindows_available_selection_types (Lisp_Object selection_name) |
| 401 { | |
| 402 Lisp_Object types = Qnil; | |
| 403 UINT format = 0; | |
| 404 struct frame *f = NULL; | |
| 405 | |
| 406 if (!EQ (selection_name, QCLIPBOARD)) | |
| 407 return Qnil; | |
| 408 | |
| 409 /* Find the frame */ | |
| 410 f = selected_frame (); | |
| 411 | |
| 412 /* Open the clipboard */ | |
| 413 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f))) | |
| 414 return Qnil; | |
| 415 | |
| 771 | 416 /* [[ ajh - Should there be an unwind-protect handler around this? |
| 417 It could (well it probably won't, but it's always better to | |
| 418 be safe) run out of memory and leave the clipboard open... ]] | |
| 419 -- xemacs in general makes no provisions for out-of-memory errors; | |
| 420 we will probably just crash. fixing this is a huge amount of work, | |
| 421 so don't bother protecting in this case. --ben */ | |
| 442 | 422 |
| 423 while ((format = EnumClipboardFormats (format))) | |
| 424 types = Fcons (ms_cf_to_symbol (format), types); | |
| 425 | |
| 426 /* Close it */ | |
| 427 CloseClipboard (); | |
| 428 | |
| 429 return types; | |
| 430 } | |
| 431 | |
| 432 static Lisp_Object | |
| 433 mswindows_register_selection_data_type (Lisp_Object type_name) | |
| 428 | 434 { |
| 442 | 435 /* Type already checked in select.c */ |
| 771 | 436 Extbyte *nameext; |
| 437 UINT format; | |
| 442 | 438 |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
439 nameext = LISP_STRING_TO_TSTR (type_name); |
| 771 | 440 format = qxeRegisterClipboardFormat (nameext); |
| 442 | 441 |
| 442 if (format) | |
| 443 return make_int ((int) format); | |
| 444 else | |
| 445 return Qnil; | |
| 446 } | |
| 447 | |
| 448 static Lisp_Object | |
| 449 mswindows_selection_data_type_name (Lisp_Object type_id) | |
| 450 { | |
| 771 | 451 UINT format; |
| 452 Extbyte *namebuf; | |
| 453 int numchars; | |
| 442 | 454 |
| 455 /* If it's an integer, convert to a symbol if appropriate */ | |
| 456 if (INTP (type_id)) | |
| 457 type_id = ms_cf_to_symbol (XINT (type_id)); | |
| 458 | |
| 459 /* If this is a symbol, return it */ | |
| 460 if (SYMBOLP (type_id)) | |
| 461 return type_id; | |
| 462 | |
| 463 /* Find the format code */ | |
| 464 format = symbol_to_ms_cf (type_id); | |
| 465 | |
| 466 if (!format) | |
| 467 return Qnil; | |
| 468 | |
| 469 /* Microsoft, stupid Microsoft */ | |
| 771 | 470 { |
| 800 | 471 int size = 64; |
| 771 | 472 do |
| 473 { | |
| 800 | 474 size *= 2; |
| 771 | 475 namebuf = alloca_extbytes (size * XETCHAR_SIZE); |
| 476 numchars = qxeGetClipboardFormatName (format, namebuf, size); | |
| 477 } | |
| 478 while (numchars >= size - 1); | |
| 479 } | |
| 442 | 480 |
| 481 if (numchars) | |
| 771 | 482 return build_tstr_string (namebuf); |
| 428 | 483 |
| 484 return Qnil; | |
| 485 } | |
| 486 | |
| 442 | 487 static Lisp_Object |
| 488 mswindows_get_foreign_selection (Lisp_Object selection_symbol, | |
| 489 Lisp_Object target_type) | |
| 428 | 490 { |
| 442 | 491 HGLOBAL hValue = NULL; |
| 492 UINT cfType; | |
| 493 Lisp_Object cfObject = Qnil, ret = Qnil, value = Qnil; | |
| 494 int is_X_type = FALSE; | |
| 495 int size; | |
| 496 void *data; | |
| 497 struct frame *f = NULL; | |
| 498 struct gcpro gcpro1; | |
| 499 | |
| 500 /* Only continue if we're trying to read the clipboard - mswindows doesn't | |
| 501 use the same selection model as X */ | |
| 502 if (!EQ (selection_symbol, QCLIPBOARD)) | |
| 503 return Qnil; | |
| 428 | 504 |
| 442 | 505 /* If this is one of the X-style atom name symbols, or NIL, convert it |
| 506 as appropriate */ | |
| 507 if (NILP (target_type) || x_sym_p (target_type)) | |
| 508 { | |
| 509 /* Should COMPOUND_TEXT map to CF_UNICODETEXT? */ | |
| 771 | 510 if (XEUNICODE_P) |
| 511 { | |
| 512 cfType = CF_UNICODETEXT; | |
| 513 cfObject = QCF_UNICODETEXT; | |
| 514 } | |
| 515 else | |
| 516 { | |
| 517 cfType = CF_TEXT; | |
| 518 cfObject = QCF_TEXT; | |
| 519 } | |
| 442 | 520 is_X_type = TRUE; |
| 521 } | |
| 522 else | |
| 523 { | |
| 524 cfType = symbol_to_ms_cf (target_type); | |
| 525 | |
| 526 /* Only continue if we can figure out a clipboard type */ | |
| 527 if (!cfType) | |
| 528 return Qnil; | |
| 529 | |
| 530 cfObject = ms_cf_to_symbol (cfType); | |
| 531 } | |
| 532 | |
| 533 /* Find the frame */ | |
| 534 f = selected_frame (); | |
| 535 | |
| 536 /* Open the clipboard */ | |
| 537 if (!OpenClipboard (FRAME_MSWINDOWS_HANDLE (f))) | |
| 428 | 538 return Qnil; |
| 539 | |
| 442 | 540 /* Read the clipboard */ |
| 541 hValue = GetClipboardData (cfType); | |
| 542 | |
| 543 if (!hValue) | |
| 428 | 544 { |
| 442 | 545 CloseClipboard (); |
| 428 | 546 |
| 442 | 547 return Qnil; |
| 548 } | |
| 428 | 549 |
| 442 | 550 /* Find the data */ |
| 551 size = GlobalSize (hValue); | |
| 552 data = GlobalLock (hValue); | |
| 428 | 553 |
| 442 | 554 if (!data) |
| 555 { | |
| 556 CloseClipboard (); | |
| 557 | |
| 558 return Qnil; | |
| 428 | 559 } |
| 560 | |
| 442 | 561 /* Place it in a Lisp string */ |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
2286
diff
changeset
|
562 ret = make_extstring ((Extbyte *) data, size, Qbinary); |
| 442 | 563 |
| 564 GlobalUnlock (data); | |
| 428 | 565 CloseClipboard (); |
| 566 | |
| 442 | 567 GCPRO1 (ret); |
| 428 | 568 |
| 442 | 569 /* Convert this to the appropriate type. If we can't find anything, |
| 570 then we return a cons of the form (DATA-TYPE . STRING), where the | |
| 571 string contains the raw binary data. */ | |
| 572 value = select_convert_in (selection_symbol, | |
| 573 cfObject, | |
| 574 ret); | |
| 428 | 575 |
| 442 | 576 UNGCPRO; |
| 430 | 577 |
| 442 | 578 if (NILP (value)) |
| 579 return Fcons (cfObject, ret); | |
| 580 else | |
| 581 return value; | |
| 428 | 582 } |
| 583 | |
| 584 static void | |
| 2286 | 585 mswindows_disown_selection (Lisp_Object selection, |
| 586 Lisp_Object UNUSED (timeval)) | |
| 428 | 587 { |
| 588 if (EQ (selection, QCLIPBOARD)) | |
| 442 | 589 { |
| 590 BOOL success = OpenClipboard (NULL); | |
| 591 if (success) | |
| 592 { | |
| 771 | 593 /* the caller calls handle_selection_clear(). */ |
| 594 success = mswindows_empty_clipboard (); | |
| 442 | 595 /* Close it regardless of whether empty worked. */ |
| 596 if (!CloseClipboard ()) | |
| 597 success = FALSE; | |
| 598 } | |
| 599 | |
| 600 /* #### return success ? Qt : Qnil; */ | |
| 601 } | |
| 602 } | |
| 603 | |
| 604 void | |
| 605 mswindows_destroy_selection (Lisp_Object selection) | |
| 606 { | |
| 607 /* Do nothing if this isn't for the clipboard. */ | |
| 608 if (!EQ (selection, QCLIPBOARD)) | |
| 609 return; | |
| 610 | |
| 611 /* Right. We need to delete everything in Vhandle_alist. */ | |
| 612 { | |
| 613 LIST_LOOP_2 (elt, Vhandle_alist) | |
| 614 GlobalFree ((HGLOBAL) get_opaque_ptr (XCDR (elt))); | |
| 615 } | |
| 616 | |
| 617 Vhandle_alist = Qnil; | |
| 618 } | |
| 619 | |
| 620 static Lisp_Object | |
| 621 mswindows_selection_exists_p (Lisp_Object selection, | |
| 622 Lisp_Object selection_type) | |
| 623 { | |
| 624 /* We used to be picky about the format, but now we support anything. */ | |
| 625 if (EQ (selection, QCLIPBOARD)) | |
| 626 { | |
| 627 if (NILP (selection_type)) | |
| 628 return CountClipboardFormats () ? Qt : Qnil; | |
| 629 else | |
| 630 return IsClipboardFormatAvailable (symbol_to_ms_cf (selection_type)) | |
| 631 ? Qt : Qnil; | |
| 632 } | |
| 633 else | |
| 634 return Qnil; | |
| 428 | 635 } |
| 636 | |
| 637 | |
| 638 /************************************************************************/ | |
| 639 /* initialization */ | |
| 640 /************************************************************************/ | |
| 641 | |
| 642 void | |
| 643 console_type_create_select_mswindows (void) | |
| 644 { | |
| 645 CONSOLE_HAS_METHOD (mswindows, own_selection); | |
| 646 CONSOLE_HAS_METHOD (mswindows, disown_selection); | |
| 442 | 647 CONSOLE_HAS_METHOD (mswindows, selection_exists_p); |
| 428 | 648 CONSOLE_HAS_METHOD (mswindows, get_foreign_selection); |
| 442 | 649 CONSOLE_HAS_METHOD (mswindows, available_selection_types); |
| 650 CONSOLE_HAS_METHOD (mswindows, register_selection_data_type); | |
| 651 CONSOLE_HAS_METHOD (mswindows, selection_data_type_name); | |
| 428 | 652 } |
| 653 | |
| 654 void | |
| 655 syms_of_select_mswindows (void) | |
| 656 { | |
| 657 } | |
| 658 | |
| 659 void | |
| 660 vars_of_select_mswindows (void) | |
| 661 { | |
| 442 | 662 /* Initialise Vhandle_alist */ |
| 663 Vhandle_alist = Qnil; | |
| 664 staticpro (&Vhandle_alist); | |
| 428 | 665 } |
| 771 | 666 |
| 667 void | |
| 668 init_select_mswindows (void) | |
| 669 { | |
| 670 /* Reinitialise Vhandle_alist */ | |
| 671 /* #### Why do we need to do this? Somehow I added this. --ben */ | |
| 672 Vhandle_alist = Qnil; | |
| 673 } |