Mercurial > hg > xemacs-beta
annotate src/select-x.c @ 5167:e374ea766cc1
clean up, rearrange allocation statistics code
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-03-21 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (assert_proper_sizing):
* alloc.c (c_readonly):
* alloc.c (malloced_storage_size):
* alloc.c (fixed_type_block_overhead):
* alloc.c (lisp_object_storage_size):
* alloc.c (inc_lrecord_stats):
* alloc.c (dec_lrecord_stats):
* alloc.c (pluralize_word):
* alloc.c (object_memory_usage_stats):
* alloc.c (Fobject_memory_usage):
* alloc.c (compute_memusage_stats_length):
* alloc.c (disksave_object_finalization_1):
* alloc.c (Fgarbage_collect):
* mc-alloc.c:
* mc-alloc.c (mc_alloced_storage_size):
* mc-alloc.h:
No functionality change here. Collect the allocations-statistics
code that was scattered throughout alloc.c into one place. Add
remaining section headings so that all sections have headings
clearly identifying the start of the section and its purpose.
Expose mc_alloced_storage_size() even when not MEMORY_USAGE_STATS;
this fixes build problems and is related to the export of
lisp_object_storage_size() and malloced_storage_size() when
non-MEMORY_USAGE_STATS in the previous change set.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Sun, 21 Mar 2010 04:41:49 -0500 |
| parents | 358aa3bb603f |
| children | 6c6d78781d59 8b2f75cecb89 |
| rev | line source |
|---|---|
| 428 | 1 /* X Selection processing for XEmacs |
| 2 Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. | |
| 793 | 3 Copyright (C) 2001, 2002 Ben Wing. |
| 428 | 4 |
| 5 This file is part of XEmacs. | |
| 6 | |
| 7 XEmacs is free software; you can redistribute it and/or modify it | |
| 8 under the terms of the GNU General Public License as published by the | |
| 9 Free Software Foundation; either version 2, or (at your option) any | |
| 10 later version. | |
| 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 | |
| 18 along with XEmacs; see the file COPYING. If not, write to | |
| 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 20 Boston, MA 02111-1307, USA. */ | |
| 21 | |
| 22 /* Synched up with: Not synched with FSF. */ | |
| 23 | |
| 24 /* Rewritten by jwz */ | |
| 25 | |
| 26 #include <config.h> | |
| 27 #include "lisp.h" | |
| 28 | |
| 771 | 29 #include "charset.h" |
| 872 | 30 #include "device-impl.h" |
| 31 #include "frame-impl.h" | |
| 800 | 32 #include "opaque.h" |
| 33 #include "select.h" | |
| 34 | |
| 872 | 35 #include "console-x-impl.h" |
| 428 | 36 #include "objects-x.h" |
| 37 | |
| 38 #include "systime.h" | |
| 39 | |
| 40 int lisp_to_time (Lisp_Object, time_t *); | |
| 41 Lisp_Object time_to_lisp (time_t); | |
| 42 | |
| 43 #ifdef LWLIB_USES_MOTIF | |
| 44 # define MOTIF_CLIPBOARDS | |
| 45 #endif | |
| 46 | |
| 47 #ifdef MOTIF_CLIPBOARDS | |
| 1315 | 48 # include "xmotif.h" |
| 49 /* Kludge around shadowing warnings */ | |
| 50 # define index index_ | |
| 428 | 51 # include <Xm/CutPaste.h> |
| 1315 | 52 # undef index |
| 428 | 53 static void hack_motif_clipboard_selection (Atom selection_atom, |
| 54 Lisp_Object selection_value, | |
| 55 Time thyme, Display *display, | |
| 456 | 56 Window selecting_window, |
| 57 int owned_p); | |
| 428 | 58 #endif |
| 59 | |
| 60 #define CUT_BUFFER_SUPPORT | |
| 61 | |
| 62 #ifdef CUT_BUFFER_SUPPORT | |
| 63 Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3, | |
| 64 QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7; | |
| 65 #endif | |
| 66 | |
| 67 Lisp_Object Vx_sent_selection_hooks; | |
| 68 | |
| 69 /* If this is a smaller number than the max-request-size of the display, | |
| 70 emacs will use INCR selection transfer when the selection is larger | |
| 71 than this. The max-request-size is usually around 64k, so if you want | |
| 72 emacs to use incremental selection transfers when the selection is | |
| 73 smaller than that, set this. I added this mostly for debugging the | |
| 74 incremental transfer stuff, but it might improve server performance. | |
| 75 */ | |
| 76 #define MAX_SELECTION_QUANTUM 0xFFFFFF | |
| 77 | |
| 78 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize (dpy) << 2) - 100) | |
| 79 | |
| 80 /* If the selection owner takes too long to reply to a selection request, | |
| 81 we give up on it. This is in seconds (0 = no timeout). | |
| 82 */ | |
| 458 | 83 Fixnum x_selection_timeout; |
| 428 | 84 |
| 456 | 85 /* Enable motif selection optimizations. */ |
| 86 int x_selection_strict_motif_ownership; | |
| 87 | |
| 428 | 88 |
| 89 /* Utility functions */ | |
| 90 | |
| 91 static Lisp_Object x_get_window_property_as_lisp_data (Display *, | |
| 92 Window, | |
| 93 Atom property, | |
| 94 Lisp_Object target_type, | |
| 95 Atom selection_atom); | |
| 96 | |
| 97 static int expect_property_change (Display *, Window, Atom prop, int state); | |
| 98 static void wait_for_property_change (long); | |
| 99 static void unexpect_property_change (int); | |
| 100 static int waiting_for_other_props_on_window (Display *, Window); | |
| 101 | |
| 102 /* This converts a Lisp symbol to a server Atom, avoiding a server | |
| 103 roundtrip whenever possible. | |
| 104 */ | |
| 105 static Atom | |
| 106 symbol_to_x_atom (struct device *d, Lisp_Object sym, int only_if_exists) | |
| 107 { | |
| 108 Display *display = DEVICE_X_DISPLAY (d); | |
| 109 | |
| 110 if (NILP (sym)) return XA_PRIMARY; | |
| 111 if (EQ (sym, Qt)) return XA_SECONDARY; | |
| 112 if (EQ (sym, QPRIMARY)) return XA_PRIMARY; | |
| 113 if (EQ (sym, QSECONDARY)) return XA_SECONDARY; | |
| 114 if (EQ (sym, QSTRING)) return XA_STRING; | |
| 115 if (EQ (sym, QINTEGER)) return XA_INTEGER; | |
| 116 if (EQ (sym, QATOM)) return XA_ATOM; | |
| 117 if (EQ (sym, QCLIPBOARD)) return DEVICE_XATOM_CLIPBOARD (d); | |
| 118 if (EQ (sym, QTIMESTAMP)) return DEVICE_XATOM_TIMESTAMP (d); | |
| 119 if (EQ (sym, QTEXT)) return DEVICE_XATOM_TEXT (d); | |
| 120 if (EQ (sym, QDELETE)) return DEVICE_XATOM_DELETE (d); | |
| 121 if (EQ (sym, QMULTIPLE)) return DEVICE_XATOM_MULTIPLE (d); | |
| 122 if (EQ (sym, QINCR)) return DEVICE_XATOM_INCR (d); | |
| 123 if (EQ (sym, QEMACS_TMP)) return DEVICE_XATOM_EMACS_TMP (d); | |
| 124 if (EQ (sym, QTARGETS)) return DEVICE_XATOM_TARGETS (d); | |
| 125 if (EQ (sym, QNULL)) return DEVICE_XATOM_NULL (d); | |
| 126 if (EQ (sym, QATOM_PAIR)) return DEVICE_XATOM_ATOM_PAIR (d); | |
| 127 if (EQ (sym, QCOMPOUND_TEXT)) return DEVICE_XATOM_COMPOUND_TEXT (d); | |
| 128 | |
| 129 #ifdef CUT_BUFFER_SUPPORT | |
| 130 if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0; | |
| 131 if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1; | |
| 132 if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2; | |
| 133 if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3; | |
| 134 if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4; | |
| 135 if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5; | |
| 136 if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6; | |
| 137 if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7; | |
| 138 #endif /* CUT_BUFFER_SUPPORT */ | |
| 139 | |
| 140 { | |
| 647 | 141 const Extbyte *nameext; |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
142 nameext = LISP_STRING_TO_EXTERNAL (Fsymbol_name (sym), Qctext); |
| 428 | 143 return XInternAtom (display, nameext, only_if_exists ? True : False); |
| 144 } | |
| 145 } | |
| 146 | |
| 147 | |
| 148 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips | |
| 149 and calls to intern whenever possible. | |
| 150 */ | |
| 151 static Lisp_Object | |
| 152 x_atom_to_symbol (struct device *d, Atom atom) | |
| 153 { | |
| 154 Display *display = DEVICE_X_DISPLAY (d); | |
| 155 | |
| 156 if (! atom) return Qnil; | |
| 157 if (atom == XA_PRIMARY) return QPRIMARY; | |
| 158 if (atom == XA_SECONDARY) return QSECONDARY; | |
| 159 if (atom == XA_STRING) return QSTRING; | |
| 160 if (atom == XA_INTEGER) return QINTEGER; | |
| 161 if (atom == XA_ATOM) return QATOM; | |
| 162 if (atom == DEVICE_XATOM_CLIPBOARD (d)) return QCLIPBOARD; | |
| 163 if (atom == DEVICE_XATOM_TIMESTAMP (d)) return QTIMESTAMP; | |
| 164 if (atom == DEVICE_XATOM_TEXT (d)) return QTEXT; | |
| 165 if (atom == DEVICE_XATOM_DELETE (d)) return QDELETE; | |
| 166 if (atom == DEVICE_XATOM_MULTIPLE (d)) return QMULTIPLE; | |
| 167 if (atom == DEVICE_XATOM_INCR (d)) return QINCR; | |
| 168 if (atom == DEVICE_XATOM_EMACS_TMP (d)) return QEMACS_TMP; | |
| 169 if (atom == DEVICE_XATOM_TARGETS (d)) return QTARGETS; | |
| 170 if (atom == DEVICE_XATOM_NULL (d)) return QNULL; | |
| 171 if (atom == DEVICE_XATOM_ATOM_PAIR (d)) return QATOM_PAIR; | |
| 172 if (atom == DEVICE_XATOM_COMPOUND_TEXT (d)) return QCOMPOUND_TEXT; | |
| 173 | |
| 174 #ifdef CUT_BUFFER_SUPPORT | |
| 175 if (atom == XA_CUT_BUFFER0) return QCUT_BUFFER0; | |
| 176 if (atom == XA_CUT_BUFFER1) return QCUT_BUFFER1; | |
| 177 if (atom == XA_CUT_BUFFER2) return QCUT_BUFFER2; | |
| 178 if (atom == XA_CUT_BUFFER3) return QCUT_BUFFER3; | |
| 179 if (atom == XA_CUT_BUFFER4) return QCUT_BUFFER4; | |
| 180 if (atom == XA_CUT_BUFFER5) return QCUT_BUFFER5; | |
| 181 if (atom == XA_CUT_BUFFER6) return QCUT_BUFFER6; | |
| 182 if (atom == XA_CUT_BUFFER7) return QCUT_BUFFER7; | |
| 183 #endif | |
| 184 | |
| 185 { | |
| 867 | 186 Ibyte *intstr; |
| 771 | 187 Extbyte *str = XGetAtomName (display, atom); |
| 428 | 188 |
| 189 if (! str) return Qnil; | |
| 190 | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
191 intstr = EXTERNAL_TO_ITEXT (str, Qctext); |
| 428 | 192 XFree (str); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3833
diff
changeset
|
193 return intern_istring (intstr); |
| 428 | 194 } |
| 195 } | |
| 196 | |
| 4984 | 197 #define THIS_IS_X |
| 198 #include "select-xlike-inc.c" | |
| 199 #undef THIS_IS_X | |
| 428 | 200 |
| 201 /* Do protocol to assert ourself as a selection owner. | |
| 202 */ | |
| 203 static Lisp_Object | |
| 2286 | 204 x_own_selection (Lisp_Object selection_name, |
| 205 #ifdef MOTIF_CLIPBOARDS | |
| 206 Lisp_Object selection_value, | |
| 207 #else | |
| 208 Lisp_Object UNUSED (selection_value), | |
| 209 #endif | |
| 210 Lisp_Object UNUSED (how_to_add), | |
| 211 Lisp_Object UNUSED (selection_type), | |
| 212 #ifdef MOTIF_CLIPBOARDS | |
| 213 int owned_p | |
| 214 #else | |
| 215 int UNUSED (owned_p) | |
| 216 #endif | |
| 217 ) | |
| 428 | 218 { |
| 219 struct device *d = decode_x_device (Qnil); | |
| 220 Display *display = DEVICE_X_DISPLAY (d); | |
| 221 struct frame *sel_frame = selected_frame (); | |
| 222 Window selecting_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame)); | |
| 223 Lisp_Object selection_time; | |
| 224 /* Use the time of the last-read mouse or keyboard event. | |
| 225 For selection purposes, we use this as a sleazy way of knowing what the | |
| 226 current time is in server-time. This assumes that the most recently read | |
| 227 mouse or keyboard event has something to do with the assertion of the | |
| 228 selection, which is probably true. | |
| 229 */ | |
| 230 Time thyme = DEVICE_X_MOUSE_TIMESTAMP (d); | |
| 231 Atom selection_atom; | |
| 232 | |
| 233 CHECK_SYMBOL (selection_name); | |
| 234 selection_atom = symbol_to_x_atom (d, selection_name, 0); | |
| 235 | |
| 236 XSetSelectionOwner (display, selection_atom, selecting_window, thyme); | |
| 237 | |
| 2620 | 238 /* [[ We do NOT use time_to_lisp() here any more, like we used to. |
| 428 | 239 That assumed equivalence of time_t and Time, which is not |
| 240 necessarily the case (e.g. under OSF on the Alphas, where | |
| 2620 | 241 Time is a 64-bit quantity and time_t is a 32-bit quantity).]] |
| 242 | |
| 243 This is wrong--on Digital Unix, time_t is a sixty-four-bit quantity, | |
| 244 and Time is, as the X protocol dictates, a thirty-two-bit quantity. | |
| 442 | 245 |
| 2620 | 246 [[ Opaque pointers are the clean way to go here. ]] |
| 247 | |
| 248 Again, I disagree--the Lisp selection infrastructure needs to be | |
| 249 able to manipulate the selection timestamps if it is, as we want | |
| 250 it to, to be able to do most of the work. Though I have moved the | |
| 251 conversion to lisp to get-xemacs-selection-timestamp. -- Aidan. */ | |
| 252 | |
| 440 | 253 selection_time = make_opaque (&thyme, sizeof (thyme)); |
| 428 | 254 |
| 255 #ifdef MOTIF_CLIPBOARDS | |
| 256 hack_motif_clipboard_selection (selection_atom, selection_value, | |
| 456 | 257 thyme, display, selecting_window, owned_p); |
| 428 | 258 #endif |
| 259 return selection_time; | |
| 260 } | |
| 261 | |
| 262 #ifdef MOTIF_CLIPBOARDS /* Bend over baby. Take it and like it. */ | |
| 263 | |
| 264 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK | |
| 265 static void motif_clipboard_cb (); | |
| 266 # endif | |
| 267 | |
| 268 static void | |
| 269 hack_motif_clipboard_selection (Atom selection_atom, | |
| 270 Lisp_Object selection_value, | |
| 271 Time thyme, | |
| 272 Display *display, | |
| 456 | 273 Window selecting_window, |
| 274 int owned_p) | |
| 428 | 275 { |
| 276 struct device *d = get_device_from_display (display); | |
| 277 /* Those Motif wankers can't be bothered to follow the ICCCM, and do | |
| 278 their own non-Xlib non-Xt clipboard processing. So we have to do | |
| 279 this so that linked-in Motif widgets don't get themselves wedged. | |
| 280 */ | |
| 281 if (selection_atom == DEVICE_XATOM_CLIPBOARD (d) | |
| 282 && STRINGP (selection_value) | |
| 283 | |
| 284 /* If we already own the clipboard, don't own it again in the Motif | |
| 285 way. This might lose in some subtle way, since the timestamp won't | |
| 286 be current, but owning the selection on the Motif way does a | |
| 287 SHITLOAD of X protocol, and it makes killing text be incredibly | |
| 288 slow when using an X terminal. ARRRRGGGHHH!!!! | |
| 289 */ | |
| 290 /* No, this is no good, because then Motif text fields don't bother | |
| 291 to look up the new value, and you can't Copy from a buffer, Paste | |
| 292 into a text field, then Copy something else from the buffer and | |
| 293 paste it into the text field -- it pastes the first thing again. */ | |
| 456 | 294 && (!owned_p |
| 295 /* Selectively re-enable this because for most users its | |
| 296 just too painful - especially over a remote link. */ | |
| 297 || x_selection_strict_motif_ownership) | |
| 428 | 298 ) |
| 299 { | |
| 300 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK | |
| 301 Widget widget = FRAME_X_TEXT_WIDGET (selected_frame()); | |
| 302 #endif | |
| 303 long itemid; | |
| 304 #if XmVersion >= 1002 | |
| 305 long dataid; | |
| 306 #else | |
| 307 int dataid; /* 1.2 wants long, but 1.1.5 wants int... */ | |
| 308 #endif | |
| 309 XmString fmh; | |
| 310 String encoding = "STRING"; | |
| 867 | 311 const Ibyte *data = XSTRING_DATA (selection_value); |
| 444 | 312 Bytecount bytes = XSTRING_LENGTH (selection_value); |
| 428 | 313 |
| 314 #ifdef MULE | |
| 315 { | |
| 316 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII; | |
| 867 | 317 const Ibyte *ptr = data, *end = ptr + bytes; |
| 428 | 318 /* Optimize for the common ASCII case */ |
| 319 while (ptr <= end) | |
| 320 { | |
| 826 | 321 if (byte_ascii_p (*ptr)) |
| 428 | 322 { |
| 323 ptr++; | |
| 324 continue; | |
| 325 } | |
| 326 | |
| 327 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 || | |
| 328 (*ptr) == LEADING_BYTE_CONTROL_1) | |
| 329 { | |
| 330 chartypes = LATIN_1; | |
| 331 ptr += 2; | |
| 332 continue; | |
| 333 } | |
| 334 | |
| 335 chartypes = WORLD; | |
| 336 break; | |
| 337 } | |
| 338 | |
| 339 if (chartypes == LATIN_1) | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
340 LISP_STRING_TO_SIZED_EXTERNAL (selection_value, data, bytes, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
341 Qbinary); |
| 428 | 342 else if (chartypes == WORLD) |
| 343 { | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
344 LISP_STRING_TO_SIZED_EXTERNAL (selection_value, data, bytes, |
|
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
345 Qctext); |
| 428 | 346 encoding = "COMPOUND_TEXT"; |
| 347 } | |
| 348 } | |
| 349 #endif /* MULE */ | |
| 350 | |
| 351 fmh = XmStringCreateLtoR ("Clipboard", XmSTRING_DEFAULT_CHARSET); | |
| 352 while (ClipboardSuccess != | |
| 353 XmClipboardStartCopy (display, selecting_window, fmh, thyme, | |
| 354 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK | |
| 355 widget, motif_clipboard_cb, | |
| 356 #else | |
| 357 0, NULL, | |
| 358 #endif | |
| 359 &itemid)) | |
| 360 ; | |
| 361 XmStringFree (fmh); | |
| 362 while (ClipboardSuccess != | |
| 363 XmClipboardCopy (display, selecting_window, itemid, encoding, | |
| 364 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK | |
| 365 /* O'Reilly examples say size can be 0, | |
| 366 but this clearly is not the case. */ | |
| 367 0, bytes, (int) selecting_window, /* private id */ | |
| 368 #else /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */ | |
| 369 (XtPointer) data, bytes, 0, | |
| 370 #endif /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */ | |
| 371 &dataid)) | |
| 372 ; | |
| 373 while (ClipboardSuccess != | |
| 374 XmClipboardEndCopy (display, selecting_window, itemid)) | |
| 375 ; | |
| 376 } | |
| 377 } | |
| 378 | |
| 379 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK | |
| 380 /* I tried to treat the clipboard like a real selection, and not send | |
| 381 the data until it was requested, but it looks like that just doesn't | |
| 382 work at all unless the selection owner and requestor are in different | |
| 383 processes. From reading the Motif source, it looks like they never | |
| 384 even considered having two widgets in the same application transfer | |
| 385 data between each other using "by-name" clipboard values. What a | |
| 386 bunch of fuckups. | |
| 387 */ | |
| 388 static void | |
| 389 motif_clipboard_cb (Widget widget, int *data_id, int *private_id, int *reason) | |
| 390 { | |
| 391 switch (*reason) | |
| 392 { | |
| 393 case XmCR_CLIPBOARD_DATA_REQUEST: | |
| 394 { | |
| 395 Display *dpy = XtDisplay (widget); | |
| 396 Window window = (Window) *private_id; | |
| 442 | 397 Lisp_Object selection = select_convert_out (QCLIPBOARD, Qnil, Qnil); |
| 398 | |
| 2500 | 399 /* Whichever lazy git wrote this originally just called ABORT() |
| 442 | 400 when anything didn't go their way... */ |
| 401 | |
| 402 /* Try some other text types */ | |
| 403 if (NILP (selection)) | |
| 404 selection = select_convert_out (QCLIPBOARD, QSTRING, Qnil); | |
| 405 if (NILP (selection)) | |
| 406 selection = select_convert_out (QCLIPBOARD, QTEXT, Qnil); | |
| 407 if (NILP (selection)) | |
| 408 selection = select_convert_out (QCLIPBOARD, QCOMPOUND_TEXT, Qnil); | |
| 409 | |
| 410 if (CONSP (selection) && SYMBOLP (XCAR (selection)) | |
| 411 && (EQ (XCAR (selection), QSTRING) | |
| 412 || EQ (XCAR (selection), QTEXT) | |
| 413 || EQ (XCAR (selection), QCOMPOUND_TEXT))) | |
| 414 selection = XCDR (selection); | |
| 415 | |
| 416 if (NILP (selection)) | |
| 563 | 417 signal_error (Qselection_conversion_error, "no selection", |
| 418 Qunbound); | |
| 442 | 419 |
| 420 if (!STRINGP (selection)) | |
| 421 signal_error (Qselection_conversion_error, | |
| 563 | 422 "couldn't convert selection to string", Qunbound); |
| 442 | 423 |
| 424 | |
| 428 | 425 XmClipboardCopyByName (dpy, window, *data_id, |
| 426 (char *) XSTRING_DATA (selection), | |
| 427 XSTRING_LENGTH (selection) + 1, | |
| 428 0); | |
| 429 } | |
| 430 break; | |
| 431 case XmCR_CLIPBOARD_DATA_DELETE: | |
| 432 default: | |
| 433 /* don't need to free anything */ | |
| 434 break; | |
| 435 } | |
| 436 } | |
| 437 # endif /* MOTIF_INCREMENTAL_CLIPBOARDS_WORK */ | |
| 438 #endif /* MOTIF_CLIPBOARDS */ | |
| 439 | |
| 440 | |
| 441 | |
| 442 | |
| 443 /* Send a SelectionNotify event to the requestor with property=None, meaning | |
| 444 we were unable to do what they wanted. | |
| 445 */ | |
| 446 static void | |
| 447 x_decline_selection_request (XSelectionRequestEvent *event) | |
| 448 { | |
| 449 XSelectionEvent reply; | |
| 450 reply.type = SelectionNotify; | |
| 451 reply.display = event->display; | |
| 452 reply.requestor = event->requestor; | |
| 453 reply.selection = event->selection; | |
| 454 reply.time = event->time; | |
| 455 reply.target = event->target; | |
| 456 reply.property = None; | |
| 457 | |
| 458 XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply); | |
| 459 XFlush (reply.display); | |
| 460 } | |
| 461 | |
| 462 | |
| 463 /* Used as an unwind-protect clause so that, if a selection-converter signals | |
| 464 an error, we tell the requestor that we were unable to do what they wanted | |
| 465 before we throw to top-level or go into the debugger or whatever. | |
| 466 */ | |
| 467 static Lisp_Object | |
| 468 x_selection_request_lisp_error (Lisp_Object closure) | |
| 469 { | |
| 470 XSelectionRequestEvent *event = (XSelectionRequestEvent *) | |
| 471 get_opaque_ptr (closure); | |
| 472 | |
| 473 free_opaque_ptr (closure); | |
| 474 if (event->type == 0) /* we set this to mean "completed normally" */ | |
| 475 return Qnil; | |
| 476 x_decline_selection_request (event); | |
| 477 return Qnil; | |
| 478 } | |
| 479 | |
| 480 | |
| 481 /* Convert our selection to the requested type, and put that data where the | |
| 482 requestor wants it. Then tell them whether we've succeeded. | |
| 483 */ | |
| 484 static void | |
| 485 x_reply_selection_request (XSelectionRequestEvent *event, int format, | |
| 2367 | 486 Rawbyte *data, Bytecount size, Atom type) |
| 428 | 487 { |
| 488 /* This function can GC */ | |
| 489 XSelectionEvent reply; | |
| 490 Display *display = event->display; | |
| 491 struct device *d = get_device_from_display (display); | |
| 492 Window window = event->requestor; | |
| 665 | 493 Bytecount bytes_remaining; |
| 428 | 494 int format_bytes = format/8; |
| 665 | 495 Bytecount max_bytes = SELECTION_QUANTUM (display); |
| 428 | 496 if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM; |
| 497 | |
| 498 reply.type = SelectionNotify; | |
| 499 reply.display = display; | |
| 500 reply.requestor = window; | |
| 501 reply.selection = event->selection; | |
| 502 reply.time = event->time; | |
| 503 reply.target = event->target; | |
| 504 reply.property = (event->property == None ? event->target : event->property); | |
| 505 | |
| 506 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */ | |
| 507 | |
| 508 /* Store the data on the requested property. | |
| 509 If the selection is large, only store the first N bytes of it. | |
| 510 */ | |
| 511 bytes_remaining = size * format_bytes; | |
| 512 if (bytes_remaining <= max_bytes) | |
| 513 { | |
| 514 /* Send all the data at once, with minimal handshaking. */ | |
| 515 #if 0 | |
| 516 stderr_out ("\nStoring all %d\n", bytes_remaining); | |
| 517 #endif | |
| 518 XChangeProperty (display, window, reply.property, type, format, | |
| 519 PropModeReplace, data, size); | |
| 520 /* At this point, the selection was successfully stored; ack it. */ | |
| 521 XSendEvent (display, window, False, 0L, (XEvent *) &reply); | |
| 522 XFlush (display); | |
| 523 } | |
| 524 else | |
| 525 { | |
| 2625 | 526 #ifndef HAVE_XTREGISTERDRAWABLE |
| 2627 | 527 invalid_operation("Copying that much data requires X11R6.", Qunbound); |
| 2625 | 528 #else |
| 428 | 529 /* Send an INCR selection. */ |
| 530 int prop_id; | |
| 2623 | 531 Widget widget = FRAME_X_TEXT_WIDGET (XFRAME(DEVICE_SELECTED_FRAME(d))); |
| 428 | 532 |
| 533 if (x_window_to_frame (d, window)) /* #### debug */ | |
| 2619 | 534 invalid_operation ("attempt to transfer an INCR to ourself!", |
| 535 Qunbound); | |
| 428 | 536 #if 0 |
| 537 stderr_out ("\nINCR %d\n", bytes_remaining); | |
| 538 #endif | |
| 2619 | 539 |
| 540 /* Tell Xt not to drop PropertyNotify events that arrive for the | |
| 541 target window, rather, pass them to us. This would be a hack, but | |
| 542 the Xt selection routines are broken for our purposes--we can't | |
| 543 pass them callbacks from Lisp, for example. Let's call it a | |
| 2629 | 544 workaround. |
| 545 | |
| 546 The call to wait_for_property_change means we can break out of that | |
| 547 function, switch to another frame on the same display (which will | |
| 548 be another Xt widget), select a huge amount of text, and have the | |
| 549 same (foreign) app ask for another incremental selection | |
| 550 transfer. Programming like X11 made sense, would mean that, in that | |
| 551 case, XtRegisterDrawable is called twice with different widgets. | |
| 552 | |
| 553 Since the results of calling XtRegisterDrawable when the drawable | |
| 554 is already registered with another widget are undefined, we want to | |
| 555 avoid that--so, only call it when XtWindowToWidget returns NULL, | |
| 556 which it will only do with a valid Window if it's not already | |
| 557 registered. */ | |
| 558 if (NULL == XtWindowToWidget(display, window)) | |
| 559 { | |
| 560 XtRegisterDrawable(display, (Drawable)window, widget); | |
| 561 } | |
| 2619 | 562 |
| 428 | 563 prop_id = expect_property_change (display, window, reply.property, |
| 564 PropertyDelete); | |
| 565 | |
| 566 XChangeProperty (display, window, reply.property, DEVICE_XATOM_INCR (d), | |
| 2367 | 567 32, PropModeReplace, (Rawbyte *) |
| 428 | 568 &bytes_remaining, 1); |
| 569 XSelectInput (display, window, PropertyChangeMask); | |
| 570 /* Tell 'em the INCR data is there... */ | |
| 571 XSendEvent (display, window, False, 0L, (XEvent *) &reply); | |
| 572 XFlush (display); | |
| 573 | |
| 574 /* First, wait for the requestor to ack by deleting the property. | |
| 575 This can run random lisp code (process handlers) or signal. | |
| 576 */ | |
| 577 wait_for_property_change (prop_id); | |
| 578 | |
| 579 while (bytes_remaining) | |
| 580 { | |
| 665 | 581 Bytecount i = ((bytes_remaining < max_bytes) |
| 428 | 582 ? bytes_remaining |
| 583 : max_bytes); | |
| 584 prop_id = expect_property_change (display, window, reply.property, | |
| 585 PropertyDelete); | |
| 586 #if 0 | |
| 587 stderr_out (" INCR adding %d\n", i); | |
| 588 #endif | |
| 589 /* Append the next chunk of data to the property. */ | |
| 590 XChangeProperty (display, window, reply.property, type, format, | |
| 591 PropModeAppend, data, i / format_bytes); | |
| 592 bytes_remaining -= i; | |
| 593 data += i; | |
| 594 | |
| 595 /* Now wait for the requestor to ack this chunk by deleting the | |
| 596 property. This can run random lisp code or signal. | |
| 597 */ | |
| 598 wait_for_property_change (prop_id); | |
| 599 } | |
| 600 /* Now write a zero-length chunk to the property to tell the requestor | |
| 601 that we're done. */ | |
| 602 #if 0 | |
| 603 stderr_out (" INCR done\n"); | |
| 604 #endif | |
| 605 if (! waiting_for_other_props_on_window (display, window)) | |
| 2619 | 606 { |
| 428 | 607 XSelectInput (display, window, 0L); |
| 2619 | 608 XtUnregisterDrawable(display, (Drawable)window); |
| 609 } | |
| 428 | 610 XChangeProperty (display, window, reply.property, type, format, |
| 611 PropModeReplace, data, 0); | |
| 2625 | 612 #endif /* HAVE_XTREGISTERDRAWABLE */ |
| 428 | 613 } |
| 614 } | |
| 615 | |
| 616 | |
| 617 | |
| 618 /* Called from the event-loop in response to a SelectionRequest event. | |
| 619 */ | |
| 620 void | |
| 621 x_handle_selection_request (XSelectionRequestEvent *event) | |
| 622 { | |
| 623 /* This function can GC */ | |
| 442 | 624 struct gcpro gcpro1, gcpro2; |
| 625 Lisp_Object temp_obj; | |
| 428 | 626 Lisp_Object selection_symbol; |
| 627 Lisp_Object target_symbol = Qnil; | |
| 628 Lisp_Object converted_selection = Qnil; | |
| 629 Time local_selection_time; | |
| 630 Lisp_Object successful_p = Qnil; | |
| 631 int count; | |
| 632 struct device *d = get_device_from_display (event->display); | |
| 633 | |
| 442 | 634 GCPRO2 (converted_selection, target_symbol); |
| 428 | 635 |
| 636 selection_symbol = x_atom_to_symbol (d, event->selection); | |
| 442 | 637 target_symbol = x_atom_to_symbol (d, event->target); |
| 428 | 638 |
| 442 | 639 #if 0 /* #### MULTIPLE doesn't work yet */ |
| 640 if (EQ (target_symbol, QMULTIPLE)) | |
| 641 target_symbol = fetch_multiple_target (event); | |
| 428 | 642 #endif |
| 643 | |
| 2620 | 644 temp_obj = get_selection_raw_time (selection_symbol); |
| 442 | 645 |
| 646 if (NILP (temp_obj)) | |
| 428 | 647 { |
| 442 | 648 /* We don't appear to have the selection. */ |
| 428 | 649 x_decline_selection_request (event); |
| 442 | 650 |
| 428 | 651 goto DONE_LABEL; |
| 652 } | |
| 653 | |
| 442 | 654 local_selection_time = * (Time *) XOPAQUE_DATA (temp_obj); |
| 428 | 655 |
| 656 if (event->time != CurrentTime && | |
| 657 local_selection_time > event->time) | |
| 658 { | |
| 659 /* Someone asked for the selection, and we have one, but not the one | |
| 660 they're looking for. */ | |
| 661 x_decline_selection_request (event); | |
| 662 goto DONE_LABEL; | |
| 663 } | |
| 664 | |
| 442 | 665 converted_selection = select_convert_out (selection_symbol, |
| 666 target_symbol, Qnil); | |
| 667 | |
| 668 /* #### Is this the right thing to do? I'm no X expert. -- ajh */ | |
| 669 if (NILP (converted_selection)) | |
| 670 { | |
| 671 /* We don't appear to have a selection in that data type. */ | |
| 672 x_decline_selection_request (event); | |
| 673 goto DONE_LABEL; | |
| 674 } | |
| 675 | |
| 428 | 676 count = specpdl_depth (); |
| 677 record_unwind_protect (x_selection_request_lisp_error, | |
| 678 make_opaque_ptr (event)); | |
| 679 | |
| 442 | 680 { |
| 2367 | 681 Rawbyte *data; |
| 665 | 682 Bytecount size; |
| 442 | 683 int format; |
| 684 Atom type; | |
| 685 lisp_data_to_selection_data (d, converted_selection, | |
| 686 &data, &type, &size, &format); | |
| 428 | 687 |
| 442 | 688 x_reply_selection_request (event, format, data, size, type); |
| 689 successful_p = Qt; | |
| 690 /* Tell x_selection_request_lisp_error() it's cool. */ | |
| 691 event->type = 0; | |
| 2620 | 692 /* Data need not have been allocated; cf. select-convert-to-delete in |
| 693 lisp/select.el . */ | |
| 694 if ((Rawbyte *)0 != data) | |
| 695 { | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
696 xfree (data); |
| 2620 | 697 } |
| 442 | 698 } |
| 699 | |
| 771 | 700 unbind_to (count); |
| 428 | 701 |
| 702 DONE_LABEL: | |
| 703 | |
| 704 UNGCPRO; | |
| 705 | |
| 706 /* Let random lisp code notice that the selection has been asked for. */ | |
| 707 { | |
| 708 Lisp_Object val = Vx_sent_selection_hooks; | |
| 709 if (!UNBOUNDP (val) && !NILP (val)) | |
| 710 { | |
| 442 | 711 Lisp_Object rest; |
| 428 | 712 if (CONSP (val) && !EQ (XCAR (val), Qlambda)) |
| 713 for (rest = val; !NILP (rest); rest = Fcdr (rest)) | |
| 442 | 714 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p); |
| 428 | 715 else |
| 442 | 716 call3 (val, selection_symbol, target_symbol, successful_p); |
| 428 | 717 } |
| 718 } | |
| 719 } | |
| 720 | |
| 721 | |
| 722 /* Called from the event-loop in response to a SelectionClear event. | |
| 723 */ | |
| 724 void | |
| 725 x_handle_selection_clear (XSelectionClearEvent *event) | |
| 726 { | |
| 727 Display *display = event->display; | |
| 728 struct device *d = get_device_from_display (display); | |
| 729 Atom selection = event->selection; | |
| 730 Time changed_owner_time = event->time; | |
| 731 | |
| 442 | 732 Lisp_Object selection_symbol, local_selection_time_lisp; |
| 428 | 733 Time local_selection_time; |
| 734 | |
| 735 selection_symbol = x_atom_to_symbol (d, selection); | |
| 736 | |
| 2620 | 737 local_selection_time_lisp = get_selection_raw_time (selection_symbol); |
| 428 | 738 |
| 442 | 739 /* We don't own the selection, so that's fine. */ |
| 740 if (NILP (local_selection_time_lisp)) | |
| 741 return; | |
| 428 | 742 |
| 442 | 743 local_selection_time = * (Time *) XOPAQUE_DATA (local_selection_time_lisp); |
| 428 | 744 |
| 745 /* This SelectionClear is for a selection that we no longer own, so we can | |
| 746 disregard it. (That is, we have reasserted the selection since this | |
| 747 request was generated.) | |
| 748 */ | |
| 749 if (changed_owner_time != CurrentTime && | |
| 750 local_selection_time > changed_owner_time) | |
| 751 return; | |
| 442 | 752 |
| 428 | 753 handle_selection_clear (selection_symbol); |
| 754 } | |
| 755 | |
| 756 | |
| 757 /* This stuff is so that INCR selections are reentrant (that is, so we can | |
| 758 be servicing multiple INCR selection requests simultaneously). I haven't | |
| 759 actually tested that yet. | |
| 760 */ | |
| 761 | |
| 762 static int prop_location_tick; | |
| 763 | |
| 764 static struct prop_location { | |
| 765 int tick; | |
| 766 Display *display; | |
| 767 Window window; | |
| 768 Atom property; | |
| 769 int desired_state; | |
| 770 struct prop_location *next; | |
| 771 } *for_whom_the_bell_tolls; | |
| 772 | |
| 773 | |
| 774 static int | |
| 775 property_deleted_p (void *tick) | |
| 776 { | |
| 777 struct prop_location *rest = for_whom_the_bell_tolls; | |
| 778 while (rest) | |
| 779 if (rest->tick == (long) tick) | |
| 780 return 0; | |
| 781 else | |
| 782 rest = rest->next; | |
| 783 return 1; | |
| 784 } | |
| 785 | |
| 786 static int | |
| 787 waiting_for_other_props_on_window (Display *display, Window window) | |
| 788 { | |
| 789 struct prop_location *rest = for_whom_the_bell_tolls; | |
| 790 while (rest) | |
| 791 if (rest->display == display && rest->window == window) | |
| 792 return 1; | |
| 793 else | |
| 794 rest = rest->next; | |
| 795 return 0; | |
| 796 } | |
| 797 | |
| 798 | |
| 799 static int | |
| 800 expect_property_change (Display *display, Window window, | |
| 801 Atom property, int state) | |
| 802 { | |
| 803 struct prop_location *pl = xnew (struct prop_location); | |
| 804 pl->tick = ++prop_location_tick; | |
| 805 pl->display = display; | |
| 806 pl->window = window; | |
| 807 pl->property = property; | |
| 808 pl->desired_state = state; | |
| 809 pl->next = for_whom_the_bell_tolls; | |
| 810 for_whom_the_bell_tolls = pl; | |
| 811 return pl->tick; | |
| 812 } | |
| 813 | |
| 814 static void | |
| 815 unexpect_property_change (int tick) | |
| 816 { | |
| 817 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls; | |
| 818 while (rest) | |
| 819 { | |
| 820 if (rest->tick == tick) | |
| 821 { | |
| 822 if (prev) | |
| 823 prev->next = rest->next; | |
| 824 else | |
| 825 for_whom_the_bell_tolls = rest->next; | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
826 xfree (rest); |
| 428 | 827 return; |
| 828 } | |
| 829 prev = rest; | |
| 830 rest = rest->next; | |
| 831 } | |
| 832 } | |
| 833 | |
| 834 static void | |
| 835 wait_for_property_change (long tick) | |
| 836 { | |
| 837 /* This function can GC */ | |
| 838 wait_delaying_user_input (property_deleted_p, (void *) tick); | |
| 839 } | |
| 840 | |
| 841 | |
| 842 /* Called from the event-loop in response to a PropertyNotify event. | |
| 843 */ | |
| 844 void | |
| 845 x_handle_property_notify (XPropertyEvent *event) | |
| 846 { | |
| 847 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls; | |
| 848 while (rest) | |
| 849 { | |
| 850 if (rest->property == event->atom && | |
| 851 rest->window == event->window && | |
| 852 rest->display == event->display && | |
| 853 rest->desired_state == event->state) | |
| 854 { | |
| 855 #if 0 | |
| 856 stderr_out ("Saw expected prop-%s on %s\n", | |
| 793 | 857 (event->state == PropertyDelete ? "delete" : "change"), |
| 858 XSTRING_DATA | |
| 859 (XSYMBOL (x_atom_to_symbol | |
| 860 (get_device_from_display (event->display), | |
| 1726 | 861 event->atom))->name)); |
| 428 | 862 #endif |
| 863 if (prev) | |
| 864 prev->next = rest->next; | |
| 865 else | |
| 866 for_whom_the_bell_tolls = rest->next; | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
867 xfree (rest); |
| 428 | 868 return; |
| 869 } | |
| 870 prev = rest; | |
| 871 rest = rest->next; | |
| 872 } | |
| 873 #if 0 | |
| 874 stderr_out ("Saw UNexpected prop-%s on %s\n", | |
| 793 | 875 (event->state == PropertyDelete ? "delete" : "change"), |
| 876 XSTRING_DATA (XSYMBOL (x_atom_to_symbol | |
| 877 (get_device_from_display (event->display), | |
| 878 event->atom))->name)); | |
| 428 | 879 #endif |
| 880 } | |
| 881 | |
| 882 | |
| 883 | |
| 884 #if 0 /* #### MULTIPLE doesn't work yet */ | |
| 885 | |
| 886 static Lisp_Object | |
| 887 fetch_multiple_target (XSelectionRequestEvent *event) | |
| 888 { | |
| 889 /* This function can GC */ | |
| 890 Display *display = event->display; | |
| 891 Window window = event->requestor; | |
| 892 Atom target = event->target; | |
| 893 Atom selection_atom = event->selection; | |
| 894 int result; | |
| 895 | |
| 896 return | |
| 897 Fcons (QMULTIPLE, | |
| 898 x_get_window_property_as_lisp_data (display, window, target, | |
| 899 QMULTIPLE, | |
| 900 selection_atom)); | |
| 901 } | |
| 902 | |
| 903 static Lisp_Object | |
| 904 copy_multiple_data (Lisp_Object obj) | |
| 905 { | |
| 906 Lisp_Object vec; | |
| 665 | 907 Elemcount i; |
| 908 Elemcount len; | |
| 428 | 909 if (CONSP (obj)) |
| 910 return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj))); | |
| 911 | |
| 912 CHECK_VECTOR (obj); | |
| 913 len = XVECTOR_LENGTH (obj); | |
| 914 vec = make_vector (len, Qnil); | |
| 915 for (i = 0; i < len; i++) | |
| 916 { | |
| 917 Lisp_Object vec2 = XVECTOR_DATA (obj) [i]; | |
| 918 CHECK_VECTOR (vec2); | |
| 919 if (XVECTOR_LENGTH (vec2) != 2) | |
| 563 | 920 sferror ("vectors must be of length 2", vec2); |
| 428 | 921 XVECTOR_DATA (vec) [i] = make_vector (2, Qnil); |
| 922 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [0] = XVECTOR_DATA (vec2) [0]; | |
| 923 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [1] = XVECTOR_DATA (vec2) [1]; | |
| 924 } | |
| 925 return vec; | |
| 926 } | |
| 927 | |
| 928 #endif /* 0 */ | |
| 929 | |
| 930 | |
| 931 static Window reading_selection_reply; | |
| 932 static Atom reading_which_selection; | |
| 933 static int selection_reply_timed_out; | |
| 934 | |
| 935 static int | |
| 2286 | 936 selection_reply_done (void *UNUSED (unused)) |
| 428 | 937 { |
| 938 return !reading_selection_reply; | |
| 939 } | |
| 940 | |
| 941 static Lisp_Object Qx_selection_reply_timeout_internal; | |
| 942 | |
| 943 DEFUN ("x-selection-reply-timeout-internal", Fx_selection_reply_timeout_internal, | |
| 944 1, 1, 0, /* | |
| 945 */ | |
| 2286 | 946 (UNUSED (arg))) |
| 428 | 947 { |
| 948 selection_reply_timed_out = 1; | |
| 949 reading_selection_reply = 0; | |
| 950 return Qnil; | |
| 951 } | |
| 952 | |
| 953 | |
| 954 /* Do protocol to read selection-data from the server. | |
| 955 Converts this to lisp data and returns it. | |
| 956 */ | |
| 957 static Lisp_Object | |
| 958 x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type) | |
| 959 { | |
| 960 /* This function can GC */ | |
| 961 struct device *d = decode_x_device (Qnil); | |
| 962 Display *display = DEVICE_X_DISPLAY (d); | |
| 963 struct frame *sel_frame = selected_frame (); | |
| 964 Window requestor_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame)); | |
| 965 Time requestor_time = DEVICE_X_MOUSE_TIMESTAMP (d); | |
| 966 Atom target_property = DEVICE_XATOM_EMACS_TMP (d); | |
| 967 Atom selection_atom = symbol_to_x_atom (d, selection_symbol, 0); | |
| 968 int speccount; | |
| 969 Atom type_atom = symbol_to_x_atom (d, (CONSP (target_type) ? | |
| 970 XCAR (target_type) : target_type), 0); | |
| 971 | |
| 972 XConvertSelection (display, selection_atom, type_atom, target_property, | |
| 973 requestor_window, requestor_time); | |
| 974 | |
| 975 /* Block until the reply has been read. */ | |
| 976 reading_selection_reply = requestor_window; | |
| 977 reading_which_selection = selection_atom; | |
| 978 selection_reply_timed_out = 0; | |
| 979 | |
| 980 speccount = specpdl_depth (); | |
| 981 | |
| 982 /* add a timeout handler */ | |
| 983 if (x_selection_timeout > 0) | |
| 984 { | |
| 985 Lisp_Object id = Fadd_timeout (make_int (x_selection_timeout), | |
| 986 Qx_selection_reply_timeout_internal, | |
| 987 Qnil, Qnil); | |
| 988 record_unwind_protect (Fdisable_timeout, id); | |
| 989 } | |
| 990 | |
| 991 /* This is ^Gable */ | |
| 992 wait_delaying_user_input (selection_reply_done, 0); | |
| 993 | |
| 994 if (selection_reply_timed_out) | |
| 563 | 995 signal_error (Qselection_conversion_error, "timed out waiting for reply from selection owner", Qunbound); |
| 428 | 996 |
| 771 | 997 unbind_to (speccount); |
| 428 | 998 |
| 999 /* otherwise, the selection is waiting for us on the requested property. */ | |
| 442 | 1000 |
| 1001 return select_convert_in (selection_symbol, | |
| 1002 target_type, | |
| 1003 x_get_window_property_as_lisp_data(display, | |
| 1004 requestor_window, | |
| 1005 target_property, | |
| 1006 target_type, | |
| 1007 selection_atom)); | |
| 428 | 1008 } |
| 1009 | |
| 1010 | |
| 1011 static void | |
| 1012 x_get_window_property (Display *display, Window window, Atom property, | |
| 2367 | 1013 Rawbyte **data_ret, Bytecount *bytes_ret, |
| 428 | 1014 Atom *actual_type_ret, int *actual_format_ret, |
| 1015 unsigned long *actual_size_ret, int delete_p) | |
| 1016 { | |
| 665 | 1017 Bytecount total_size; |
| 428 | 1018 unsigned long bytes_remaining; |
| 665 | 1019 Bytecount offset = 0; |
| 2367 | 1020 Rawbyte *tmp_data = 0; |
| 428 | 1021 int result; |
| 665 | 1022 Bytecount buffer_size = SELECTION_QUANTUM (display); |
| 428 | 1023 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM; |
| 1024 | |
| 1025 /* First probe the thing to find out how big it is. */ | |
| 1026 result = XGetWindowProperty (display, window, property, | |
| 1027 0, 0, False, AnyPropertyType, | |
| 1028 actual_type_ret, actual_format_ret, | |
| 1029 actual_size_ret, | |
| 1030 &bytes_remaining, &tmp_data); | |
| 1031 if (result != Success) | |
| 1032 { | |
| 1033 *data_ret = 0; | |
| 1034 *bytes_ret = 0; | |
| 1035 return; | |
| 1036 } | |
| 1037 XFree ((char *) tmp_data); | |
| 1038 | |
| 1039 if (*actual_type_ret == None || *actual_format_ret == 0) | |
| 1040 { | |
| 1041 if (delete_p) XDeleteProperty (display, window, property); | |
| 1042 *data_ret = 0; | |
| 1043 *bytes_ret = 0; | |
| 1044 return; | |
| 1045 } | |
| 1046 | |
| 3833 | 1047 /* The manpage for XGetWindowProperty from X.org X11.7.2 sez: |
| 1048 nitems_return [[ our actual_size_ret ]] | |
| 1049 Returns the actual number of 8-bit, 16-bit, or 32-bit items | |
| 1050 stored in the prop_return data. | |
| 1051 prop_return [[ our tmp_data ]] | |
| 1052 Returns the data in the specified format. If the returned | |
| 1053 format is 8, the returned data is represented as a char | |
| 1054 array. If the returned format is 16, the returned data is | |
| 1055 represented as a array of short int type and should be cast | |
| 1056 to that type to obtain the elements. If the returned format | |
| 1057 is 32, the property data will be stored as an array of longs | |
| 1058 (which in a 64-bit application will be 64-bit values that are | |
| 1059 padded in the upper 4 bytes). | |
| 1060 bytes_after_return [[ our bytes_remaining ]] | |
| 1061 Returns the number of bytes remaining to be read in the prop- | |
| 1062 erty if a partial read was performed. | |
| 1063 | |
| 1064 AFAIK XEmacs does not support any platforms where the char type is other | |
| 1065 than 8 bits (Cray?), or where the short type is other than 16 bits. | |
| 1066 There is no such agreement on the size of long, and 64-bit platforms | |
| 1067 generally make long be a 64-bit quantity while while it's 32 bits on | |
| 1068 32-bit platforms. | |
| 1069 | |
| 1070 This means that on all platforms the wire item is the same size as our | |
| 1071 buffer unit when format == 8 or format == 16 or format == wordsize == 32, | |
| 1072 and the buffer size can be taken as bytes_remaining plus padding. | |
| 1073 However, when format == 32 and wordsize == 64, the buffer unit is twice | |
| 1074 the size of the wire item. Obviously this code below is not 128-bit | |
| 1075 safe. (We could replace the factor 2 with (sizeof(long)*8/32.) | |
| 1076 | |
| 1077 We can hope it doesn't much matter on versions of X11 earlier than R7. | |
| 1078 */ | |
| 1079 if (sizeof(long) == 8 && *actual_format_ret == 32) | |
| 1080 total_size = 2 * bytes_remaining + 1; | |
| 1081 else | |
| 1082 total_size = bytes_remaining + 1; | |
| 2367 | 1083 *data_ret = xnew_rawbytes (total_size); |
| 428 | 1084 |
| 1085 /* Now read, until we've gotten it all. */ | |
| 1086 while (bytes_remaining) | |
| 1087 { | |
| 1088 #if 0 | |
| 665 | 1089 Bytecount last = bytes_remaining; |
| 428 | 1090 #endif |
| 1091 result = | |
| 1092 XGetWindowProperty (display, window, property, | |
| 1093 offset/4, buffer_size/4, | |
| 1094 (delete_p ? True : False), | |
| 1095 AnyPropertyType, | |
| 1096 actual_type_ret, actual_format_ret, | |
| 1097 actual_size_ret, &bytes_remaining, &tmp_data); | |
| 1098 #if 0 | |
| 1099 stderr_out ("<< read %d\n", last-bytes_remaining); | |
| 1100 #endif | |
| 1101 /* If this doesn't return Success at this point, it means that | |
| 1102 some clod deleted the selection while we were in the midst of | |
| 1103 reading it. Deal with that, I guess.... | |
| 1104 */ | |
| 1105 if (result != Success) break; | |
| 3833 | 1106 /* Again we need to compute the number of bytes in our buffer, not |
| 1107 the number of bytes transferred for the property. */ | |
| 1108 if (sizeof(long) == 8 && *actual_format_ret == 32) | |
| 1109 *actual_size_ret *= 8; | |
| 1110 else | |
| 1111 *actual_size_ret *= *actual_format_ret / 8; | |
| 428 | 1112 memcpy ((*data_ret) + offset, tmp_data, *actual_size_ret); |
| 1113 offset += *actual_size_ret; | |
| 1114 XFree ((char *) tmp_data); | |
| 1115 } | |
| 1116 *bytes_ret = offset; | |
| 1117 } | |
| 1118 | |
| 1119 | |
| 1120 static void | |
| 1121 receive_incremental_selection (Display *display, Window window, Atom property, | |
| 1122 /* this one is for error messages only */ | |
| 2286 | 1123 Lisp_Object UNUSED (target_type), |
| 665 | 1124 Bytecount min_size_bytes, |
| 2367 | 1125 Rawbyte **data_ret, |
| 665 | 1126 Bytecount *size_bytes_ret, |
| 428 | 1127 Atom *type_ret, int *format_ret, |
| 1128 unsigned long *size_ret) | |
| 1129 { | |
| 1130 /* This function can GC */ | |
| 665 | 1131 Bytecount offset = 0; |
| 428 | 1132 int prop_id; |
| 1133 *size_bytes_ret = min_size_bytes; | |
| 2367 | 1134 *data_ret = xnew_rawbytes (*size_bytes_ret); |
| 428 | 1135 #if 0 |
| 1136 stderr_out ("\nread INCR %d\n", min_size_bytes); | |
| 1137 #endif | |
| 1138 /* At this point, we have read an INCR property, and deleted it (which | |
| 1139 is how we ack its receipt: the sending window will be selecting | |
| 1140 PropertyNotify events on our window to notice this). | |
| 1141 | |
| 1142 Now, we must loop, waiting for the sending window to put a value on | |
| 1143 that property, then reading the property, then deleting it to ack. | |
| 1144 We are done when the sender places a property of length 0. | |
| 1145 */ | |
| 1146 prop_id = expect_property_change (display, window, property, | |
| 1147 PropertyNewValue); | |
| 1148 while (1) | |
| 1149 { | |
| 2367 | 1150 Rawbyte *tmp_data; |
| 665 | 1151 Bytecount tmp_size_bytes; |
| 428 | 1152 wait_for_property_change (prop_id); |
| 1153 /* expect it again immediately, because x_get_window_property may | |
| 1154 .. no it won't, I don't get it. | |
| 1155 .. Ok, I get it now, the Xt code that implements INCR is broken. | |
| 1156 */ | |
| 1157 prop_id = expect_property_change (display, window, property, | |
| 1158 PropertyNewValue); | |
| 1159 x_get_window_property (display, window, property, | |
| 1160 &tmp_data, &tmp_size_bytes, | |
| 1161 type_ret, format_ret, size_ret, 1); | |
| 1162 | |
| 1163 if (tmp_size_bytes == 0) /* we're done */ | |
| 1164 { | |
| 1165 #if 0 | |
| 1166 stderr_out (" read INCR done\n"); | |
| 1167 #endif | |
| 1168 unexpect_property_change (prop_id); | |
| 1726 | 1169 if (tmp_data) |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1170 xfree (tmp_data); |
| 428 | 1171 break; |
| 1172 } | |
| 1173 #if 0 | |
| 1174 stderr_out (" read INCR %d\n", tmp_size_bytes); | |
| 1175 #endif | |
| 1176 if (*size_bytes_ret < offset + tmp_size_bytes) | |
| 1177 { | |
| 1178 #if 0 | |
| 1179 stderr_out (" read INCR realloc %d -> %d\n", | |
| 1180 *size_bytes_ret, offset + tmp_size_bytes); | |
| 1181 #endif | |
| 1182 *size_bytes_ret = offset + tmp_size_bytes; | |
| 2367 | 1183 *data_ret = (Rawbyte *) xrealloc (*data_ret, *size_bytes_ret); |
| 428 | 1184 } |
| 1185 memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes); | |
| 1186 offset += tmp_size_bytes; | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1187 xfree (tmp_data); |
| 428 | 1188 } |
| 1189 } | |
| 1190 | |
| 1191 | |
| 1192 static Lisp_Object | |
| 1193 x_get_window_property_as_lisp_data (Display *display, | |
| 1194 Window window, | |
| 1195 Atom property, | |
| 1196 /* next two for error messages only */ | |
| 1197 Lisp_Object target_type, | |
| 1198 Atom selection_atom) | |
| 1199 { | |
| 1200 /* This function can GC */ | |
| 1201 Atom actual_type; | |
| 1202 int actual_format; | |
| 1203 unsigned long actual_size; | |
| 2367 | 1204 Rawbyte *data = NULL; |
| 665 | 1205 Bytecount bytes = 0; |
| 428 | 1206 Lisp_Object val; |
| 1207 struct device *d = get_device_from_display (display); | |
| 1208 | |
| 1209 x_get_window_property (display, window, property, &data, &bytes, | |
| 1210 &actual_type, &actual_format, &actual_size, 1); | |
| 1211 if (! data) | |
| 1212 { | |
| 1213 if (XGetSelectionOwner (display, selection_atom)) | |
| 1214 /* there is a selection owner */ | |
| 563 | 1215 signal_error (Qselection_conversion_error, |
| 1216 "selection owner couldn't convert", | |
| 1217 Fcons (Qunbound, | |
| 1218 Fcons (x_atom_to_symbol (d, selection_atom), | |
| 1219 actual_type ? | |
| 1220 list2 (target_type, | |
| 1221 x_atom_to_symbol (d, actual_type)) : | |
| 1222 list1 (target_type)))); | |
| 428 | 1223 else |
| 563 | 1224 signal_error (Qselection_conversion_error, |
| 1225 "no selection", | |
| 1226 x_atom_to_symbol (d, selection_atom)); | |
| 428 | 1227 } |
| 1228 | |
| 1229 if (actual_type == DEVICE_XATOM_INCR (d)) | |
| 1230 { | |
| 1231 /* Ok, that data wasn't *the* data, it was just the beginning. */ | |
| 1232 | |
| 665 | 1233 Bytecount min_size_bytes = |
| 647 | 1234 /* careful here. */ |
| 665 | 1235 (Bytecount) (* ((unsigned int *) data)); |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1236 xfree (data); |
| 428 | 1237 receive_incremental_selection (display, window, property, target_type, |
| 1238 min_size_bytes, &data, &bytes, | |
| 1239 &actual_type, &actual_format, | |
| 1240 &actual_size); | |
| 1241 } | |
| 1242 | |
| 1243 /* It's been read. Now convert it to a lisp object in some semi-rational | |
| 1244 manner. */ | |
| 1245 val = selection_data_to_lisp_data (d, data, bytes, | |
| 1246 actual_type, actual_format); | |
| 1247 | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1248 xfree (data); |
| 428 | 1249 return val; |
| 1250 } | |
| 1251 | |
| 1252 | |
| 1253 /* Called from the event loop to handle SelectionNotify events. | |
| 1254 I don't think this needs to be reentrant. | |
| 1255 */ | |
| 1256 void | |
| 1257 x_handle_selection_notify (XSelectionEvent *event) | |
| 1258 { | |
| 1259 if (! reading_selection_reply) | |
| 1260 message ("received an unexpected SelectionNotify event"); | |
| 1261 else if (event->requestor != reading_selection_reply) | |
| 1262 message ("received a SelectionNotify event for the wrong window"); | |
| 1263 else if (event->selection != reading_which_selection) | |
| 1264 message ("received the wrong selection type in SelectionNotify!"); | |
| 1265 else | |
| 1266 reading_selection_reply = 0; /* we're done now. */ | |
| 1267 } | |
| 1268 | |
| 1269 static void | |
| 1270 x_disown_selection (Lisp_Object selection, Lisp_Object timeval) | |
| 1271 { | |
| 1272 struct device *d = decode_x_device (Qnil); | |
| 1273 Display *display = DEVICE_X_DISPLAY (d); | |
| 1274 Time timestamp; | |
| 1275 Atom selection_atom; | |
| 1276 | |
| 1277 CHECK_SYMBOL (selection); | |
| 1278 if (NILP (timeval)) | |
| 1279 timestamp = DEVICE_X_MOUSE_TIMESTAMP (d); | |
| 1280 else | |
| 1281 { | |
| 1282 /* #### This is bogus. See the comment above about problems | |
| 1283 on OSF/1 and DEC Alphas. Yet another reason why it sucks | |
| 1284 to have the implementation (i.e. cons of two 16-bit | |
| 1285 integers) exposed. */ | |
| 1286 time_t the_time; | |
| 1287 lisp_to_time (timeval, &the_time); | |
| 1288 timestamp = (Time) the_time; | |
| 1289 } | |
| 1290 | |
| 1291 selection_atom = symbol_to_x_atom (d, selection, 0); | |
| 1292 | |
| 1293 XSetSelectionOwner (display, selection_atom, None, timestamp); | |
| 1294 } | |
| 1295 | |
| 1296 static Lisp_Object | |
| 442 | 1297 x_selection_exists_p (Lisp_Object selection, |
| 2286 | 1298 Lisp_Object UNUSED (selection_type)) |
| 428 | 1299 { |
| 1300 struct device *d = decode_x_device (Qnil); | |
| 1301 Display *dpy = DEVICE_X_DISPLAY (d); | |
| 1302 return XGetSelectionOwner (dpy, symbol_to_x_atom (d, selection, 0)) != None ? | |
| 1303 Qt : Qnil; | |
| 1304 } | |
| 1305 | |
| 1306 | |
| 1307 #ifdef CUT_BUFFER_SUPPORT | |
| 1308 | |
| 1309 static int cut_buffers_initialized; /* Whether we're sure they all exist */ | |
| 1310 | |
| 1311 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */ | |
| 1312 static void | |
| 1313 initialize_cut_buffers (Display *display, Window window) | |
| 1314 { | |
| 442 | 1315 static unsigned const char * const data = (unsigned const char *) ""; |
| 428 | 1316 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \ |
| 1317 PropModeAppend, data, 0) | |
| 1318 FROB (XA_CUT_BUFFER0); | |
| 1319 FROB (XA_CUT_BUFFER1); | |
| 1320 FROB (XA_CUT_BUFFER2); | |
| 1321 FROB (XA_CUT_BUFFER3); | |
| 1322 FROB (XA_CUT_BUFFER4); | |
| 1323 FROB (XA_CUT_BUFFER5); | |
| 1324 FROB (XA_CUT_BUFFER6); | |
| 1325 FROB (XA_CUT_BUFFER7); | |
| 1326 #undef FROB | |
| 1327 cut_buffers_initialized = 1; | |
| 1328 } | |
| 1329 | |
| 1330 #define CHECK_CUTBUFFER(symbol) do { \ | |
| 1331 CHECK_SYMBOL (symbol); \ | |
| 1332 if (! (EQ (symbol, QCUT_BUFFER0) || \ | |
| 1333 EQ (symbol, QCUT_BUFFER1) || \ | |
| 1334 EQ (symbol, QCUT_BUFFER2) || \ | |
| 1335 EQ (symbol, QCUT_BUFFER3) || \ | |
| 1336 EQ (symbol, QCUT_BUFFER4) || \ | |
| 1337 EQ (symbol, QCUT_BUFFER5) || \ | |
| 1338 EQ (symbol, QCUT_BUFFER6) || \ | |
| 1339 EQ (symbol, QCUT_BUFFER7))) \ | |
| 563 | 1340 invalid_constant ("Doesn't name a cutbuffer", symbol); \ |
| 428 | 1341 } while (0) |
| 1342 | |
| 1343 DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal, 1, 1, 0, /* | |
| 1344 Return the value of the named CUTBUFFER (typically CUT_BUFFER0). | |
| 1345 */ | |
| 1346 (cutbuffer)) | |
| 1347 { | |
| 1348 struct device *d = decode_x_device (Qnil); | |
| 1349 Display *display = DEVICE_X_DISPLAY (d); | |
| 1350 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */ | |
| 1351 Atom cut_buffer_atom; | |
| 2367 | 1352 Rawbyte *data; |
| 665 | 1353 Bytecount bytes; |
| 428 | 1354 Atom type; |
| 1355 int format; | |
| 1356 unsigned long size; | |
| 1357 Lisp_Object ret; | |
| 1358 | |
| 1359 CHECK_CUTBUFFER (cutbuffer); | |
| 1360 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0); | |
| 1361 | |
| 1362 x_get_window_property (display, window, cut_buffer_atom, &data, &bytes, | |
| 1363 &type, &format, &size, 0); | |
| 1364 if (!data) return Qnil; | |
| 1365 | |
| 1366 if (format != 8 || type != XA_STRING) | |
| 563 | 1367 invalid_state_2 ("Cut buffer doesn't contain 8-bit STRING data", |
| 1368 x_atom_to_symbol (d, type), | |
| 1369 make_int (format)); | |
| 428 | 1370 |
| 1371 /* We cheat - if the string contains an ESC character, that's | |
| 1372 technically not allowed in a STRING, so we assume it's | |
| 1373 COMPOUND_TEXT that we stored there ourselves earlier, | |
| 1374 in x-store-cutbuffer-internal */ | |
| 1375 ret = (bytes ? | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3833
diff
changeset
|
1376 make_extstring ((Extbyte *) data, bytes, |
| 428 | 1377 memchr (data, 0x1b, bytes) ? |
| 440 | 1378 Qctext : Qbinary) |
| 428 | 1379 : Qnil); |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1380 xfree (data); |
| 428 | 1381 return ret; |
| 1382 } | |
| 1383 | |
| 1384 | |
| 1385 DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal, 2, 2, 0, /* | |
| 1386 Set the value of the named CUTBUFFER (typically CUT_BUFFER0) to STRING. | |
| 1387 */ | |
| 1388 (cutbuffer, string)) | |
| 1389 { | |
| 1390 struct device *d = decode_x_device (Qnil); | |
| 1391 Display *display = DEVICE_X_DISPLAY (d); | |
| 1392 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */ | |
| 1393 Atom cut_buffer_atom; | |
| 867 | 1394 const Ibyte *data = XSTRING_DATA (string); |
| 444 | 1395 Bytecount bytes = XSTRING_LENGTH (string); |
| 1396 Bytecount bytes_remaining; | |
| 665 | 1397 Bytecount max_bytes = SELECTION_QUANTUM (display); |
| 428 | 1398 #ifdef MULE |
| 867 | 1399 const Ibyte *ptr, *end; |
| 428 | 1400 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII; |
| 1401 #endif | |
| 1402 | |
| 1403 if (max_bytes > MAX_SELECTION_QUANTUM) | |
| 1404 max_bytes = MAX_SELECTION_QUANTUM; | |
| 1405 | |
| 1406 CHECK_CUTBUFFER (cutbuffer); | |
| 1407 CHECK_STRING (string); | |
| 1408 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0); | |
| 1409 | |
| 1410 if (! cut_buffers_initialized) | |
| 1411 initialize_cut_buffers (display, window); | |
| 1412 | |
| 1413 /* We use the STRING encoding (Latin-1 only) if we can, else COMPOUND_TEXT. | |
| 1414 We cheat and use type = `STRING' even when using COMPOUND_TEXT. | |
| 1415 The ICCCM requires that this be so, and other clients assume it, | |
| 1416 as we do ourselves in initialize_cut_buffers. */ | |
| 1417 | |
| 1418 #ifdef MULE | |
| 1419 /* Optimize for the common ASCII case */ | |
| 1420 for (ptr = data, end = ptr + bytes; ptr <= end; ) | |
| 1421 { | |
| 826 | 1422 if (byte_ascii_p (*ptr)) |
| 428 | 1423 { |
| 1424 ptr++; | |
| 1425 continue; | |
| 1426 } | |
| 1427 | |
| 1428 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 || | |
| 1429 (*ptr) == LEADING_BYTE_CONTROL_1) | |
| 1430 { | |
| 1431 chartypes = LATIN_1; | |
| 1432 ptr += 2; | |
| 1433 continue; | |
| 1434 } | |
| 1435 | |
| 1436 chartypes = WORLD; | |
| 1437 break; | |
| 1438 } | |
| 1439 | |
| 1440 if (chartypes == LATIN_1) | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1441 LISP_STRING_TO_SIZED_EXTERNAL (string, data, bytes, Qbinary); |
| 428 | 1442 else if (chartypes == WORLD) |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1443 LISP_STRING_TO_SIZED_EXTERNAL (string, data, bytes, Qctext); |
| 428 | 1444 #endif /* MULE */ |
| 1445 | |
| 1446 bytes_remaining = bytes; | |
| 1447 | |
| 1448 while (bytes_remaining) | |
| 1449 { | |
| 665 | 1450 Bytecount chunk = |
| 647 | 1451 bytes_remaining < max_bytes ? bytes_remaining : max_bytes; |
| 428 | 1452 XChangeProperty (display, window, cut_buffer_atom, XA_STRING, 8, |
| 1453 (bytes_remaining == bytes | |
| 1454 ? PropModeReplace : PropModeAppend), | |
| 1455 data, chunk); | |
| 1456 data += chunk; | |
| 1457 bytes_remaining -= chunk; | |
| 1458 } | |
| 1459 return string; | |
| 1460 } | |
| 1461 | |
| 1462 | |
| 1463 DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal, 1, 1, 0, /* | |
| 1464 Rotate the values of the cutbuffers by the given number of steps; | |
| 1465 positive means move values forward, negative means backward. | |
| 1466 */ | |
| 1467 (n)) | |
| 1468 { | |
| 1469 struct device *d = decode_x_device (Qnil); | |
| 1470 Display *display = DEVICE_X_DISPLAY (d); | |
| 1471 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */ | |
| 1472 Atom props [8]; | |
| 1473 | |
| 1474 CHECK_INT (n); | |
| 1475 if (XINT (n) == 0) | |
| 1476 return n; | |
| 1477 if (! cut_buffers_initialized) | |
| 1478 initialize_cut_buffers (display, window); | |
| 1479 props[0] = XA_CUT_BUFFER0; | |
| 1480 props[1] = XA_CUT_BUFFER1; | |
| 1481 props[2] = XA_CUT_BUFFER2; | |
| 1482 props[3] = XA_CUT_BUFFER3; | |
| 1483 props[4] = XA_CUT_BUFFER4; | |
| 1484 props[5] = XA_CUT_BUFFER5; | |
| 1485 props[6] = XA_CUT_BUFFER6; | |
| 1486 props[7] = XA_CUT_BUFFER7; | |
| 1487 XRotateWindowProperties (display, window, props, 8, XINT (n)); | |
| 1488 return n; | |
| 1489 } | |
| 1490 | |
| 1491 #endif /* CUT_BUFFER_SUPPORT */ | |
| 1492 | |
| 1493 | |
| 1494 | |
| 1495 /************************************************************************/ | |
| 1496 /* initialization */ | |
| 1497 /************************************************************************/ | |
| 1498 | |
| 1499 void | |
| 440 | 1500 syms_of_select_x (void) |
| 428 | 1501 { |
| 1502 | |
| 1503 #ifdef CUT_BUFFER_SUPPORT | |
| 1504 DEFSUBR (Fx_get_cutbuffer_internal); | |
| 1505 DEFSUBR (Fx_store_cutbuffer_internal); | |
| 1506 DEFSUBR (Fx_rotate_cutbuffers_internal); | |
| 1507 #endif /* CUT_BUFFER_SUPPORT */ | |
| 1508 | |
| 1509 /* Unfortunately, timeout handlers must be lisp functions. */ | |
| 563 | 1510 DEFSYMBOL (Qx_selection_reply_timeout_internal); |
| 428 | 1511 DEFSUBR (Fx_selection_reply_timeout_internal); |
| 1512 | |
| 1513 #ifdef CUT_BUFFER_SUPPORT | |
| 1514 defsymbol (&QCUT_BUFFER0, "CUT_BUFFER0"); | |
| 1515 defsymbol (&QCUT_BUFFER1, "CUT_BUFFER1"); | |
| 1516 defsymbol (&QCUT_BUFFER2, "CUT_BUFFER2"); | |
| 1517 defsymbol (&QCUT_BUFFER3, "CUT_BUFFER3"); | |
| 1518 defsymbol (&QCUT_BUFFER4, "CUT_BUFFER4"); | |
| 1519 defsymbol (&QCUT_BUFFER5, "CUT_BUFFER5"); | |
| 1520 defsymbol (&QCUT_BUFFER6, "CUT_BUFFER6"); | |
| 1521 defsymbol (&QCUT_BUFFER7, "CUT_BUFFER7"); | |
| 1522 #endif /* CUT_BUFFER_SUPPORT */ | |
| 1523 } | |
| 1524 | |
| 1525 void | |
| 1526 console_type_create_select_x (void) | |
| 1527 { | |
| 1528 CONSOLE_HAS_METHOD (x, own_selection); | |
| 1529 CONSOLE_HAS_METHOD (x, disown_selection); | |
| 1530 CONSOLE_HAS_METHOD (x, get_foreign_selection); | |
| 1531 CONSOLE_HAS_METHOD (x, selection_exists_p); | |
| 1532 } | |
| 1533 | |
| 1534 void | |
| 440 | 1535 reinit_vars_of_select_x (void) |
| 428 | 1536 { |
| 1537 reading_selection_reply = 0; | |
| 1538 reading_which_selection = 0; | |
| 1539 selection_reply_timed_out = 0; | |
| 1540 for_whom_the_bell_tolls = 0; | |
| 1541 prop_location_tick = 0; | |
| 1542 } | |
| 1543 | |
| 1544 void | |
| 440 | 1545 vars_of_select_x (void) |
| 428 | 1546 { |
| 1547 #ifdef CUT_BUFFER_SUPPORT | |
| 1548 cut_buffers_initialized = 0; | |
| 1549 Fprovide (intern ("cut-buffer")); | |
| 1550 #endif | |
| 1551 | |
| 1552 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks /* | |
| 1553 A function or functions to be called after we have responded to some | |
| 1554 other client's request for the value of a selection that we own. The | |
| 1555 function(s) will be called with four arguments: | |
| 1556 - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD); | |
| 1557 - the name of the selection-type which we were requested to convert the | |
| 1558 selection into before sending (for example, STRING or LENGTH); | |
| 1559 - and whether we successfully transmitted the selection. | |
| 1560 We might have failed (and declined the request) for any number of reasons, | |
| 1561 including being asked for a selection that we no longer own, or being asked | |
| 1562 to convert into a type that we don't know about or that is inappropriate. | |
| 1563 This hook doesn't let you change the behavior of emacs's selection replies, | |
| 1564 it merely informs you that they have happened. | |
| 1565 */ ); | |
| 1566 Vx_sent_selection_hooks = Qunbound; | |
| 1567 | |
| 1568 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout /* | |
| 1569 If the selection owner doesn't reply in this many seconds, we give up. | |
| 1570 A value of 0 means wait as long as necessary. This is initialized from the | |
| 1571 \"*selectionTimeout\" resource (which is expressed in milliseconds). | |
| 1572 */ ); | |
| 1573 x_selection_timeout = 0; | |
| 456 | 1574 |
| 1575 DEFVAR_BOOL ("x-selection-strict-motif-ownership", &x_selection_strict_motif_ownership /* | |
| 863 | 1576 *If nil and XEmacs already owns the clipboard, don't own it again in the |
| 456 | 1577 Motif way. Owning the selection on the Motif way does a huge amount of |
| 1578 X protocol, and it makes killing text incredibly slow when using an | |
| 1579 X terminal. However, when enabled Motif text fields don't bother to look up | |
| 1580 the new value, and you can't Copy from a buffer, Paste into a text | |
| 1581 field, then Copy something else from the buffer and paste it into the | |
| 1582 text field; it pastes the first thing again. | |
| 1583 */ ); | |
| 1584 x_selection_strict_motif_ownership = 1; | |
| 428 | 1585 } |
| 1586 | |
| 1587 void | |
| 440 | 1588 Xatoms_of_select_x (struct device *d) |
| 428 | 1589 { |
| 1590 Display *D = DEVICE_X_DISPLAY (d); | |
| 1591 | |
| 1592 /* Non-predefined atoms that we might end up using a lot */ | |
| 1593 DEVICE_XATOM_CLIPBOARD (d) = XInternAtom (D, "CLIPBOARD", False); | |
| 1594 DEVICE_XATOM_TIMESTAMP (d) = XInternAtom (D, "TIMESTAMP", False); | |
| 1595 DEVICE_XATOM_TEXT (d) = XInternAtom (D, "TEXT", False); | |
| 1596 DEVICE_XATOM_DELETE (d) = XInternAtom (D, "DELETE", False); | |
| 1597 DEVICE_XATOM_MULTIPLE (d) = XInternAtom (D, "MULTIPLE", False); | |
| 1598 DEVICE_XATOM_INCR (d) = XInternAtom (D, "INCR", False); | |
| 1599 DEVICE_XATOM_TARGETS (d) = XInternAtom (D, "TARGETS", False); | |
| 1600 DEVICE_XATOM_NULL (d) = XInternAtom (D, "NULL", False); | |
| 1601 DEVICE_XATOM_ATOM_PAIR (d) = XInternAtom (D, "ATOM_PAIR", False); | |
| 1602 DEVICE_XATOM_COMPOUND_TEXT (d) = XInternAtom (D, "COMPOUND_TEXT", False); | |
| 442 | 1603 |
| 1604 /* #### I don't like the looks of this... what is it for? - ajh */ | |
| 428 | 1605 DEVICE_XATOM_EMACS_TMP (d) = XInternAtom (D, "_EMACS_TMP_", False); |
| 1606 } |