Mercurial > hg > xemacs-beta
annotate src/select-x.c @ 5616:79e9934779c1
Use va_run_hooks_with_args() for x-sent-selection-hooks, lost-selection-hooks
src/ChangeLog addition:
2011-12-22 Aidan Kehoe <kehoea@parhasard.net>
* select-gtk.c (vars_of_select_gtk):
* select-x.c:
* select-x.c (x_handle_selection_request):
* select-x.c (syms_of_select_x):
* select-x.c (vars_of_select_x):
* select.c:
* select.c (handle_selection_clear):
* select.c (syms_of_select):
* select.c (vars_of_select):
Use va_run_hooks_with_args for x-sent-selection-hooks
and lost-selection-hooks, instead of rolling our own.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Thu, 22 Dec 2011 15:02:02 +0000 |
| parents | 56144c8593a8 |
| children | 2f22818d92d4 |
| rev | line source |
|---|---|
| 428 | 1 /* X Selection processing for XEmacs |
| 2 Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. | |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
4985
diff
changeset
|
3 Copyright (C) 2001, 2002, 2010 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:
5178
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:
5178
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:
5178
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:
5178
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 | |
| 22 /* Rewritten by jwz */ | |
| 23 | |
| 24 #include <config.h> | |
| 25 #include "lisp.h" | |
| 26 | |
| 771 | 27 #include "charset.h" |
| 872 | 28 #include "device-impl.h" |
| 29 #include "frame-impl.h" | |
| 800 | 30 #include "opaque.h" |
| 31 #include "select.h" | |
| 32 | |
| 872 | 33 #include "console-x-impl.h" |
|
5176
8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
Ben Wing <ben@xemacs.org>
parents:
4985
diff
changeset
|
34 #include "fontcolor-x.h" |
| 428 | 35 |
| 36 #include "systime.h" | |
| 37 | |
| 38 int lisp_to_time (Lisp_Object, time_t *); | |
| 39 Lisp_Object time_to_lisp (time_t); | |
| 40 | |
| 41 #ifdef LWLIB_USES_MOTIF | |
| 42 # define MOTIF_CLIPBOARDS | |
| 43 #endif | |
| 44 | |
| 45 #ifdef MOTIF_CLIPBOARDS | |
| 1315 | 46 # include "xmotif.h" |
| 47 /* Kludge around shadowing warnings */ | |
| 48 # define index index_ | |
| 428 | 49 # include <Xm/CutPaste.h> |
| 1315 | 50 # undef index |
| 428 | 51 static void hack_motif_clipboard_selection (Atom selection_atom, |
| 52 Lisp_Object selection_value, | |
| 53 Time thyme, Display *display, | |
| 456 | 54 Window selecting_window, |
| 55 int owned_p); | |
| 428 | 56 #endif |
| 57 | |
| 58 #define CUT_BUFFER_SUPPORT | |
| 59 | |
| 60 #ifdef CUT_BUFFER_SUPPORT | |
| 61 Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3, | |
| 62 QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7; | |
| 63 #endif | |
| 64 | |
| 65 Lisp_Object Vx_sent_selection_hooks; | |
| 66 | |
|
5616
79e9934779c1
Use va_run_hooks_with_args() for x-sent-selection-hooks, lost-selection-hooks
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
67 Lisp_Object Qx_sent_selection_hooks; |
|
79e9934779c1
Use va_run_hooks_with_args() for x-sent-selection-hooks, lost-selection-hooks
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
68 |
| 428 | 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 . */ | |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
4985
diff
changeset
|
694 if (data) |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
695 xfree (data); |
| 442 | 696 } |
| 697 | |
| 771 | 698 unbind_to (count); |
| 428 | 699 |
| 700 DONE_LABEL: | |
| 701 | |
| 702 UNGCPRO; | |
| 703 | |
| 704 /* Let random lisp code notice that the selection has been asked for. */ | |
|
5616
79e9934779c1
Use va_run_hooks_with_args() for x-sent-selection-hooks, lost-selection-hooks
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
705 va_run_hook_with_args (Qx_sent_selection_hooks, 3, selection_symbol, |
|
79e9934779c1
Use va_run_hooks_with_args() for x-sent-selection-hooks, lost-selection-hooks
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
706 target_symbol, successful_p); |
| 428 | 707 } |
| 708 | |
| 709 | |
| 710 /* Called from the event-loop in response to a SelectionClear event. | |
| 711 */ | |
| 712 void | |
| 713 x_handle_selection_clear (XSelectionClearEvent *event) | |
| 714 { | |
| 715 Display *display = event->display; | |
| 716 struct device *d = get_device_from_display (display); | |
| 717 Atom selection = event->selection; | |
| 718 Time changed_owner_time = event->time; | |
| 719 | |
| 442 | 720 Lisp_Object selection_symbol, local_selection_time_lisp; |
| 428 | 721 Time local_selection_time; |
| 722 | |
| 723 selection_symbol = x_atom_to_symbol (d, selection); | |
| 724 | |
| 2620 | 725 local_selection_time_lisp = get_selection_raw_time (selection_symbol); |
| 428 | 726 |
| 442 | 727 /* We don't own the selection, so that's fine. */ |
| 728 if (NILP (local_selection_time_lisp)) | |
| 729 return; | |
| 428 | 730 |
| 442 | 731 local_selection_time = * (Time *) XOPAQUE_DATA (local_selection_time_lisp); |
| 428 | 732 |
| 733 /* This SelectionClear is for a selection that we no longer own, so we can | |
| 734 disregard it. (That is, we have reasserted the selection since this | |
| 735 request was generated.) | |
| 736 */ | |
| 737 if (changed_owner_time != CurrentTime && | |
| 738 local_selection_time > changed_owner_time) | |
| 739 return; | |
| 442 | 740 |
| 428 | 741 handle_selection_clear (selection_symbol); |
| 742 } | |
| 743 | |
| 744 | |
| 745 /* This stuff is so that INCR selections are reentrant (that is, so we can | |
| 746 be servicing multiple INCR selection requests simultaneously). I haven't | |
| 747 actually tested that yet. | |
| 748 */ | |
| 749 | |
| 750 static int prop_location_tick; | |
| 751 | |
| 752 static struct prop_location { | |
| 753 int tick; | |
| 754 Display *display; | |
| 755 Window window; | |
| 756 Atom property; | |
| 757 int desired_state; | |
| 758 struct prop_location *next; | |
| 759 } *for_whom_the_bell_tolls; | |
| 760 | |
| 761 | |
| 762 static int | |
| 763 property_deleted_p (void *tick) | |
| 764 { | |
| 765 struct prop_location *rest = for_whom_the_bell_tolls; | |
| 766 while (rest) | |
| 767 if (rest->tick == (long) tick) | |
| 768 return 0; | |
| 769 else | |
| 770 rest = rest->next; | |
| 771 return 1; | |
| 772 } | |
| 773 | |
| 774 static int | |
| 775 waiting_for_other_props_on_window (Display *display, Window window) | |
| 776 { | |
| 777 struct prop_location *rest = for_whom_the_bell_tolls; | |
| 778 while (rest) | |
| 779 if (rest->display == display && rest->window == window) | |
| 780 return 1; | |
| 781 else | |
| 782 rest = rest->next; | |
| 783 return 0; | |
| 784 } | |
| 785 | |
| 786 | |
| 787 static int | |
| 788 expect_property_change (Display *display, Window window, | |
| 789 Atom property, int state) | |
| 790 { | |
| 791 struct prop_location *pl = xnew (struct prop_location); | |
| 792 pl->tick = ++prop_location_tick; | |
| 793 pl->display = display; | |
| 794 pl->window = window; | |
| 795 pl->property = property; | |
| 796 pl->desired_state = state; | |
| 797 pl->next = for_whom_the_bell_tolls; | |
| 798 for_whom_the_bell_tolls = pl; | |
| 799 return pl->tick; | |
| 800 } | |
| 801 | |
| 802 static void | |
| 803 unexpect_property_change (int tick) | |
| 804 { | |
| 805 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls; | |
| 806 while (rest) | |
| 807 { | |
| 808 if (rest->tick == tick) | |
| 809 { | |
| 810 if (prev) | |
| 811 prev->next = rest->next; | |
| 812 else | |
| 813 for_whom_the_bell_tolls = rest->next; | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
814 xfree (rest); |
| 428 | 815 return; |
| 816 } | |
| 817 prev = rest; | |
| 818 rest = rest->next; | |
| 819 } | |
| 820 } | |
| 821 | |
| 822 static void | |
| 823 wait_for_property_change (long tick) | |
| 824 { | |
| 825 /* This function can GC */ | |
| 826 wait_delaying_user_input (property_deleted_p, (void *) tick); | |
| 827 } | |
| 828 | |
| 829 | |
| 830 /* Called from the event-loop in response to a PropertyNotify event. | |
| 831 */ | |
| 832 void | |
| 833 x_handle_property_notify (XPropertyEvent *event) | |
| 834 { | |
| 835 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls; | |
| 836 while (rest) | |
| 837 { | |
| 838 if (rest->property == event->atom && | |
| 839 rest->window == event->window && | |
| 840 rest->display == event->display && | |
| 841 rest->desired_state == event->state) | |
| 842 { | |
| 843 #if 0 | |
| 844 stderr_out ("Saw expected prop-%s on %s\n", | |
| 793 | 845 (event->state == PropertyDelete ? "delete" : "change"), |
| 846 XSTRING_DATA | |
| 847 (XSYMBOL (x_atom_to_symbol | |
| 848 (get_device_from_display (event->display), | |
| 1726 | 849 event->atom))->name)); |
| 428 | 850 #endif |
| 851 if (prev) | |
| 852 prev->next = rest->next; | |
| 853 else | |
| 854 for_whom_the_bell_tolls = rest->next; | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
855 xfree (rest); |
| 428 | 856 return; |
| 857 } | |
| 858 prev = rest; | |
| 859 rest = rest->next; | |
| 860 } | |
| 861 #if 0 | |
| 862 stderr_out ("Saw UNexpected prop-%s on %s\n", | |
| 793 | 863 (event->state == PropertyDelete ? "delete" : "change"), |
| 864 XSTRING_DATA (XSYMBOL (x_atom_to_symbol | |
| 865 (get_device_from_display (event->display), | |
| 866 event->atom))->name)); | |
| 428 | 867 #endif |
| 868 } | |
| 869 | |
| 870 | |
| 871 | |
| 872 #if 0 /* #### MULTIPLE doesn't work yet */ | |
| 873 | |
| 874 static Lisp_Object | |
| 875 fetch_multiple_target (XSelectionRequestEvent *event) | |
| 876 { | |
| 877 /* This function can GC */ | |
| 878 Display *display = event->display; | |
| 879 Window window = event->requestor; | |
| 880 Atom target = event->target; | |
| 881 Atom selection_atom = event->selection; | |
| 882 int result; | |
| 883 | |
| 884 return | |
| 885 Fcons (QMULTIPLE, | |
| 886 x_get_window_property_as_lisp_data (display, window, target, | |
| 887 QMULTIPLE, | |
| 888 selection_atom)); | |
| 889 } | |
| 890 | |
| 891 static Lisp_Object | |
| 892 copy_multiple_data (Lisp_Object obj) | |
| 893 { | |
| 894 Lisp_Object vec; | |
| 665 | 895 Elemcount i; |
| 896 Elemcount len; | |
| 428 | 897 if (CONSP (obj)) |
| 898 return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj))); | |
| 899 | |
| 900 CHECK_VECTOR (obj); | |
| 901 len = XVECTOR_LENGTH (obj); | |
| 902 vec = make_vector (len, Qnil); | |
| 903 for (i = 0; i < len; i++) | |
| 904 { | |
| 905 Lisp_Object vec2 = XVECTOR_DATA (obj) [i]; | |
| 906 CHECK_VECTOR (vec2); | |
| 907 if (XVECTOR_LENGTH (vec2) != 2) | |
| 563 | 908 sferror ("vectors must be of length 2", vec2); |
| 428 | 909 XVECTOR_DATA (vec) [i] = make_vector (2, Qnil); |
| 910 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [0] = XVECTOR_DATA (vec2) [0]; | |
| 911 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [1] = XVECTOR_DATA (vec2) [1]; | |
| 912 } | |
| 913 return vec; | |
| 914 } | |
| 915 | |
| 916 #endif /* 0 */ | |
| 917 | |
| 918 | |
| 919 static Window reading_selection_reply; | |
| 920 static Atom reading_which_selection; | |
| 921 static int selection_reply_timed_out; | |
| 922 | |
| 923 static int | |
| 2286 | 924 selection_reply_done (void *UNUSED (unused)) |
| 428 | 925 { |
| 926 return !reading_selection_reply; | |
| 927 } | |
| 928 | |
| 929 static Lisp_Object Qx_selection_reply_timeout_internal; | |
| 930 | |
| 931 DEFUN ("x-selection-reply-timeout-internal", Fx_selection_reply_timeout_internal, | |
| 932 1, 1, 0, /* | |
| 933 */ | |
| 2286 | 934 (UNUSED (arg))) |
| 428 | 935 { |
| 936 selection_reply_timed_out = 1; | |
| 937 reading_selection_reply = 0; | |
| 938 return Qnil; | |
| 939 } | |
| 940 | |
| 941 | |
| 942 /* Do protocol to read selection-data from the server. | |
| 943 Converts this to lisp data and returns it. | |
| 944 */ | |
| 945 static Lisp_Object | |
| 946 x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type) | |
| 947 { | |
| 948 /* This function can GC */ | |
| 949 struct device *d = decode_x_device (Qnil); | |
| 950 Display *display = DEVICE_X_DISPLAY (d); | |
| 951 struct frame *sel_frame = selected_frame (); | |
| 952 Window requestor_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame)); | |
| 953 Time requestor_time = DEVICE_X_MOUSE_TIMESTAMP (d); | |
| 954 Atom target_property = DEVICE_XATOM_EMACS_TMP (d); | |
| 955 Atom selection_atom = symbol_to_x_atom (d, selection_symbol, 0); | |
| 956 int speccount; | |
| 957 Atom type_atom = symbol_to_x_atom (d, (CONSP (target_type) ? | |
| 958 XCAR (target_type) : target_type), 0); | |
| 959 | |
| 960 XConvertSelection (display, selection_atom, type_atom, target_property, | |
| 961 requestor_window, requestor_time); | |
| 962 | |
| 963 /* Block until the reply has been read. */ | |
| 964 reading_selection_reply = requestor_window; | |
| 965 reading_which_selection = selection_atom; | |
| 966 selection_reply_timed_out = 0; | |
| 967 | |
| 968 speccount = specpdl_depth (); | |
| 969 | |
| 970 /* add a timeout handler */ | |
| 971 if (x_selection_timeout > 0) | |
| 972 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
973 Lisp_Object id = Fadd_timeout (make_fixnum (x_selection_timeout), |
| 428 | 974 Qx_selection_reply_timeout_internal, |
| 975 Qnil, Qnil); | |
| 976 record_unwind_protect (Fdisable_timeout, id); | |
| 977 } | |
| 978 | |
| 979 /* This is ^Gable */ | |
| 980 wait_delaying_user_input (selection_reply_done, 0); | |
| 981 | |
| 982 if (selection_reply_timed_out) | |
| 563 | 983 signal_error (Qselection_conversion_error, "timed out waiting for reply from selection owner", Qunbound); |
| 428 | 984 |
| 771 | 985 unbind_to (speccount); |
| 428 | 986 |
| 987 /* otherwise, the selection is waiting for us on the requested property. */ | |
| 442 | 988 |
| 989 return select_convert_in (selection_symbol, | |
| 990 target_type, | |
| 991 x_get_window_property_as_lisp_data(display, | |
| 992 requestor_window, | |
| 993 target_property, | |
| 994 target_type, | |
| 995 selection_atom)); | |
| 428 | 996 } |
| 997 | |
| 998 | |
| 999 static void | |
| 1000 x_get_window_property (Display *display, Window window, Atom property, | |
| 2367 | 1001 Rawbyte **data_ret, Bytecount *bytes_ret, |
| 428 | 1002 Atom *actual_type_ret, int *actual_format_ret, |
| 1003 unsigned long *actual_size_ret, int delete_p) | |
| 1004 { | |
| 665 | 1005 Bytecount total_size; |
| 428 | 1006 unsigned long bytes_remaining; |
| 665 | 1007 Bytecount offset = 0; |
| 2367 | 1008 Rawbyte *tmp_data = 0; |
| 428 | 1009 int result; |
| 665 | 1010 Bytecount buffer_size = SELECTION_QUANTUM (display); |
| 428 | 1011 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM; |
| 1012 | |
| 1013 /* First probe the thing to find out how big it is. */ | |
| 1014 result = XGetWindowProperty (display, window, property, | |
| 1015 0, 0, False, AnyPropertyType, | |
| 1016 actual_type_ret, actual_format_ret, | |
| 1017 actual_size_ret, | |
| 1018 &bytes_remaining, &tmp_data); | |
| 1019 if (result != Success) | |
| 1020 { | |
| 1021 *data_ret = 0; | |
| 1022 *bytes_ret = 0; | |
| 1023 return; | |
| 1024 } | |
| 1025 XFree ((char *) tmp_data); | |
| 1026 | |
| 1027 if (*actual_type_ret == None || *actual_format_ret == 0) | |
| 1028 { | |
| 1029 if (delete_p) XDeleteProperty (display, window, property); | |
| 1030 *data_ret = 0; | |
| 1031 *bytes_ret = 0; | |
| 1032 return; | |
| 1033 } | |
| 1034 | |
| 3833 | 1035 /* The manpage for XGetWindowProperty from X.org X11.7.2 sez: |
| 1036 nitems_return [[ our actual_size_ret ]] | |
| 1037 Returns the actual number of 8-bit, 16-bit, or 32-bit items | |
| 1038 stored in the prop_return data. | |
| 1039 prop_return [[ our tmp_data ]] | |
| 1040 Returns the data in the specified format. If the returned | |
| 1041 format is 8, the returned data is represented as a char | |
| 1042 array. If the returned format is 16, the returned data is | |
| 1043 represented as a array of short int type and should be cast | |
| 1044 to that type to obtain the elements. If the returned format | |
| 1045 is 32, the property data will be stored as an array of longs | |
| 1046 (which in a 64-bit application will be 64-bit values that are | |
| 1047 padded in the upper 4 bytes). | |
| 1048 bytes_after_return [[ our bytes_remaining ]] | |
| 1049 Returns the number of bytes remaining to be read in the prop- | |
| 1050 erty if a partial read was performed. | |
| 1051 | |
| 1052 AFAIK XEmacs does not support any platforms where the char type is other | |
| 1053 than 8 bits (Cray?), or where the short type is other than 16 bits. | |
| 1054 There is no such agreement on the size of long, and 64-bit platforms | |
| 1055 generally make long be a 64-bit quantity while while it's 32 bits on | |
| 1056 32-bit platforms. | |
| 1057 | |
| 1058 This means that on all platforms the wire item is the same size as our | |
| 1059 buffer unit when format == 8 or format == 16 or format == wordsize == 32, | |
| 1060 and the buffer size can be taken as bytes_remaining plus padding. | |
| 1061 However, when format == 32 and wordsize == 64, the buffer unit is twice | |
| 1062 the size of the wire item. Obviously this code below is not 128-bit | |
| 1063 safe. (We could replace the factor 2 with (sizeof(long)*8/32.) | |
| 1064 | |
| 1065 We can hope it doesn't much matter on versions of X11 earlier than R7. | |
| 1066 */ | |
| 1067 if (sizeof(long) == 8 && *actual_format_ret == 32) | |
| 1068 total_size = 2 * bytes_remaining + 1; | |
| 1069 else | |
| 1070 total_size = bytes_remaining + 1; | |
| 2367 | 1071 *data_ret = xnew_rawbytes (total_size); |
| 428 | 1072 |
| 1073 /* Now read, until we've gotten it all. */ | |
| 1074 while (bytes_remaining) | |
| 1075 { | |
| 1076 #if 0 | |
| 665 | 1077 Bytecount last = bytes_remaining; |
| 428 | 1078 #endif |
| 1079 result = | |
| 1080 XGetWindowProperty (display, window, property, | |
| 1081 offset/4, buffer_size/4, | |
| 1082 (delete_p ? True : False), | |
| 1083 AnyPropertyType, | |
| 1084 actual_type_ret, actual_format_ret, | |
| 1085 actual_size_ret, &bytes_remaining, &tmp_data); | |
| 1086 #if 0 | |
| 1087 stderr_out ("<< read %d\n", last-bytes_remaining); | |
| 1088 #endif | |
| 1089 /* If this doesn't return Success at this point, it means that | |
| 1090 some clod deleted the selection while we were in the midst of | |
| 1091 reading it. Deal with that, I guess.... | |
| 1092 */ | |
| 1093 if (result != Success) break; | |
| 3833 | 1094 /* Again we need to compute the number of bytes in our buffer, not |
| 1095 the number of bytes transferred for the property. */ | |
| 1096 if (sizeof(long) == 8 && *actual_format_ret == 32) | |
| 1097 *actual_size_ret *= 8; | |
| 1098 else | |
| 1099 *actual_size_ret *= *actual_format_ret / 8; | |
| 428 | 1100 memcpy ((*data_ret) + offset, tmp_data, *actual_size_ret); |
| 1101 offset += *actual_size_ret; | |
| 1102 XFree ((char *) tmp_data); | |
| 1103 } | |
| 1104 *bytes_ret = offset; | |
| 1105 } | |
| 1106 | |
| 1107 | |
| 1108 static void | |
| 1109 receive_incremental_selection (Display *display, Window window, Atom property, | |
| 1110 /* this one is for error messages only */ | |
| 2286 | 1111 Lisp_Object UNUSED (target_type), |
| 665 | 1112 Bytecount min_size_bytes, |
| 2367 | 1113 Rawbyte **data_ret, |
| 665 | 1114 Bytecount *size_bytes_ret, |
| 428 | 1115 Atom *type_ret, int *format_ret, |
| 1116 unsigned long *size_ret) | |
| 1117 { | |
| 1118 /* This function can GC */ | |
| 665 | 1119 Bytecount offset = 0; |
| 428 | 1120 int prop_id; |
| 1121 *size_bytes_ret = min_size_bytes; | |
| 2367 | 1122 *data_ret = xnew_rawbytes (*size_bytes_ret); |
| 428 | 1123 #if 0 |
| 1124 stderr_out ("\nread INCR %d\n", min_size_bytes); | |
| 1125 #endif | |
| 1126 /* At this point, we have read an INCR property, and deleted it (which | |
| 1127 is how we ack its receipt: the sending window will be selecting | |
| 1128 PropertyNotify events on our window to notice this). | |
| 1129 | |
| 1130 Now, we must loop, waiting for the sending window to put a value on | |
| 1131 that property, then reading the property, then deleting it to ack. | |
| 1132 We are done when the sender places a property of length 0. | |
| 1133 */ | |
| 1134 prop_id = expect_property_change (display, window, property, | |
| 1135 PropertyNewValue); | |
| 1136 while (1) | |
| 1137 { | |
| 2367 | 1138 Rawbyte *tmp_data; |
| 665 | 1139 Bytecount tmp_size_bytes; |
| 428 | 1140 wait_for_property_change (prop_id); |
| 1141 /* expect it again immediately, because x_get_window_property may | |
| 1142 .. no it won't, I don't get it. | |
| 1143 .. Ok, I get it now, the Xt code that implements INCR is broken. | |
| 1144 */ | |
| 1145 prop_id = expect_property_change (display, window, property, | |
| 1146 PropertyNewValue); | |
| 1147 x_get_window_property (display, window, property, | |
| 1148 &tmp_data, &tmp_size_bytes, | |
| 1149 type_ret, format_ret, size_ret, 1); | |
| 1150 | |
| 1151 if (tmp_size_bytes == 0) /* we're done */ | |
| 1152 { | |
| 1153 #if 0 | |
| 1154 stderr_out (" read INCR done\n"); | |
| 1155 #endif | |
| 1156 unexpect_property_change (prop_id); | |
| 1726 | 1157 if (tmp_data) |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1158 xfree (tmp_data); |
| 428 | 1159 break; |
| 1160 } | |
| 1161 #if 0 | |
| 1162 stderr_out (" read INCR %d\n", tmp_size_bytes); | |
| 1163 #endif | |
| 1164 if (*size_bytes_ret < offset + tmp_size_bytes) | |
| 1165 { | |
| 1166 #if 0 | |
| 1167 stderr_out (" read INCR realloc %d -> %d\n", | |
| 1168 *size_bytes_ret, offset + tmp_size_bytes); | |
| 1169 #endif | |
| 1170 *size_bytes_ret = offset + tmp_size_bytes; | |
| 2367 | 1171 *data_ret = (Rawbyte *) xrealloc (*data_ret, *size_bytes_ret); |
| 428 | 1172 } |
| 1173 memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes); | |
| 1174 offset += tmp_size_bytes; | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1175 xfree (tmp_data); |
| 428 | 1176 } |
| 1177 } | |
| 1178 | |
| 1179 | |
| 1180 static Lisp_Object | |
| 1181 x_get_window_property_as_lisp_data (Display *display, | |
| 1182 Window window, | |
| 1183 Atom property, | |
| 1184 /* next two for error messages only */ | |
| 1185 Lisp_Object target_type, | |
| 1186 Atom selection_atom) | |
| 1187 { | |
| 1188 /* This function can GC */ | |
| 1189 Atom actual_type; | |
| 1190 int actual_format; | |
| 1191 unsigned long actual_size; | |
| 2367 | 1192 Rawbyte *data = NULL; |
| 665 | 1193 Bytecount bytes = 0; |
| 428 | 1194 Lisp_Object val; |
| 1195 struct device *d = get_device_from_display (display); | |
| 1196 | |
| 1197 x_get_window_property (display, window, property, &data, &bytes, | |
| 1198 &actual_type, &actual_format, &actual_size, 1); | |
| 1199 if (! data) | |
| 1200 { | |
| 1201 if (XGetSelectionOwner (display, selection_atom)) | |
| 1202 /* there is a selection owner */ | |
| 563 | 1203 signal_error (Qselection_conversion_error, |
| 1204 "selection owner couldn't convert", | |
| 1205 Fcons (Qunbound, | |
| 1206 Fcons (x_atom_to_symbol (d, selection_atom), | |
| 1207 actual_type ? | |
| 1208 list2 (target_type, | |
| 1209 x_atom_to_symbol (d, actual_type)) : | |
| 1210 list1 (target_type)))); | |
| 428 | 1211 else |
| 563 | 1212 signal_error (Qselection_conversion_error, |
| 1213 "no selection", | |
| 1214 x_atom_to_symbol (d, selection_atom)); | |
| 428 | 1215 } |
| 1216 | |
| 1217 if (actual_type == DEVICE_XATOM_INCR (d)) | |
| 1218 { | |
| 1219 /* Ok, that data wasn't *the* data, it was just the beginning. */ | |
| 1220 | |
| 665 | 1221 Bytecount min_size_bytes = |
| 647 | 1222 /* careful here. */ |
| 665 | 1223 (Bytecount) (* ((unsigned int *) data)); |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1224 xfree (data); |
| 428 | 1225 receive_incremental_selection (display, window, property, target_type, |
| 1226 min_size_bytes, &data, &bytes, | |
| 1227 &actual_type, &actual_format, | |
| 1228 &actual_size); | |
| 1229 } | |
| 1230 | |
| 1231 /* It's been read. Now convert it to a lisp object in some semi-rational | |
| 1232 manner. */ | |
| 1233 val = selection_data_to_lisp_data (d, data, bytes, | |
| 1234 actual_type, actual_format); | |
| 1235 | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1236 xfree (data); |
| 428 | 1237 return val; |
| 1238 } | |
| 1239 | |
| 1240 | |
| 1241 /* Called from the event loop to handle SelectionNotify events. | |
| 1242 I don't think this needs to be reentrant. | |
| 1243 */ | |
| 1244 void | |
| 1245 x_handle_selection_notify (XSelectionEvent *event) | |
| 1246 { | |
| 1247 if (! reading_selection_reply) | |
| 1248 message ("received an unexpected SelectionNotify event"); | |
| 1249 else if (event->requestor != reading_selection_reply) | |
| 1250 message ("received a SelectionNotify event for the wrong window"); | |
| 1251 else if (event->selection != reading_which_selection) | |
| 1252 message ("received the wrong selection type in SelectionNotify!"); | |
| 1253 else | |
| 1254 reading_selection_reply = 0; /* we're done now. */ | |
| 1255 } | |
| 1256 | |
| 1257 static void | |
| 1258 x_disown_selection (Lisp_Object selection, Lisp_Object timeval) | |
| 1259 { | |
| 1260 struct device *d = decode_x_device (Qnil); | |
| 1261 Display *display = DEVICE_X_DISPLAY (d); | |
| 1262 Time timestamp; | |
| 1263 Atom selection_atom; | |
| 1264 | |
| 1265 CHECK_SYMBOL (selection); | |
| 1266 if (NILP (timeval)) | |
| 1267 timestamp = DEVICE_X_MOUSE_TIMESTAMP (d); | |
| 1268 else | |
| 1269 { | |
| 1270 /* #### This is bogus. See the comment above about problems | |
| 1271 on OSF/1 and DEC Alphas. Yet another reason why it sucks | |
| 1272 to have the implementation (i.e. cons of two 16-bit | |
| 1273 integers) exposed. */ | |
| 1274 time_t the_time; | |
| 1275 lisp_to_time (timeval, &the_time); | |
| 1276 timestamp = (Time) the_time; | |
| 1277 } | |
| 1278 | |
| 1279 selection_atom = symbol_to_x_atom (d, selection, 0); | |
| 1280 | |
| 1281 XSetSelectionOwner (display, selection_atom, None, timestamp); | |
| 1282 } | |
| 1283 | |
| 1284 static Lisp_Object | |
| 442 | 1285 x_selection_exists_p (Lisp_Object selection, |
| 2286 | 1286 Lisp_Object UNUSED (selection_type)) |
| 428 | 1287 { |
| 1288 struct device *d = decode_x_device (Qnil); | |
| 1289 Display *dpy = DEVICE_X_DISPLAY (d); | |
| 1290 return XGetSelectionOwner (dpy, symbol_to_x_atom (d, selection, 0)) != None ? | |
| 1291 Qt : Qnil; | |
| 1292 } | |
| 1293 | |
| 1294 | |
| 1295 #ifdef CUT_BUFFER_SUPPORT | |
| 1296 | |
| 1297 static int cut_buffers_initialized; /* Whether we're sure they all exist */ | |
| 1298 | |
| 1299 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */ | |
| 1300 static void | |
| 1301 initialize_cut_buffers (Display *display, Window window) | |
| 1302 { | |
| 442 | 1303 static unsigned const char * const data = (unsigned const char *) ""; |
| 428 | 1304 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \ |
| 1305 PropModeAppend, data, 0) | |
| 1306 FROB (XA_CUT_BUFFER0); | |
| 1307 FROB (XA_CUT_BUFFER1); | |
| 1308 FROB (XA_CUT_BUFFER2); | |
| 1309 FROB (XA_CUT_BUFFER3); | |
| 1310 FROB (XA_CUT_BUFFER4); | |
| 1311 FROB (XA_CUT_BUFFER5); | |
| 1312 FROB (XA_CUT_BUFFER6); | |
| 1313 FROB (XA_CUT_BUFFER7); | |
| 1314 #undef FROB | |
| 1315 cut_buffers_initialized = 1; | |
| 1316 } | |
| 1317 | |
| 1318 #define CHECK_CUTBUFFER(symbol) do { \ | |
| 1319 CHECK_SYMBOL (symbol); \ | |
| 1320 if (! (EQ (symbol, QCUT_BUFFER0) || \ | |
| 1321 EQ (symbol, QCUT_BUFFER1) || \ | |
| 1322 EQ (symbol, QCUT_BUFFER2) || \ | |
| 1323 EQ (symbol, QCUT_BUFFER3) || \ | |
| 1324 EQ (symbol, QCUT_BUFFER4) || \ | |
| 1325 EQ (symbol, QCUT_BUFFER5) || \ | |
| 1326 EQ (symbol, QCUT_BUFFER6) || \ | |
| 1327 EQ (symbol, QCUT_BUFFER7))) \ | |
| 563 | 1328 invalid_constant ("Doesn't name a cutbuffer", symbol); \ |
| 428 | 1329 } while (0) |
| 1330 | |
| 1331 DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal, 1, 1, 0, /* | |
| 1332 Return the value of the named CUTBUFFER (typically CUT_BUFFER0). | |
| 1333 */ | |
| 1334 (cutbuffer)) | |
| 1335 { | |
| 1336 struct device *d = decode_x_device (Qnil); | |
| 1337 Display *display = DEVICE_X_DISPLAY (d); | |
| 1338 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */ | |
| 1339 Atom cut_buffer_atom; | |
| 2367 | 1340 Rawbyte *data; |
| 665 | 1341 Bytecount bytes; |
| 428 | 1342 Atom type; |
| 1343 int format; | |
| 1344 unsigned long size; | |
| 1345 Lisp_Object ret; | |
| 1346 | |
| 1347 CHECK_CUTBUFFER (cutbuffer); | |
| 1348 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0); | |
| 1349 | |
| 1350 x_get_window_property (display, window, cut_buffer_atom, &data, &bytes, | |
| 1351 &type, &format, &size, 0); | |
| 1352 if (!data) return Qnil; | |
| 1353 | |
| 1354 if (format != 8 || type != XA_STRING) | |
| 563 | 1355 invalid_state_2 ("Cut buffer doesn't contain 8-bit STRING data", |
| 1356 x_atom_to_symbol (d, type), | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
1357 make_fixnum (format)); |
| 428 | 1358 |
| 1359 /* We cheat - if the string contains an ESC character, that's | |
| 1360 technically not allowed in a STRING, so we assume it's | |
| 1361 COMPOUND_TEXT that we stored there ourselves earlier, | |
| 1362 in x-store-cutbuffer-internal */ | |
| 1363 ret = (bytes ? | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
3833
diff
changeset
|
1364 make_extstring ((Extbyte *) data, bytes, |
| 428 | 1365 memchr (data, 0x1b, bytes) ? |
| 440 | 1366 Qctext : Qbinary) |
| 428 | 1367 : Qnil); |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1368 xfree (data); |
| 428 | 1369 return ret; |
| 1370 } | |
| 1371 | |
| 1372 | |
| 1373 DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal, 2, 2, 0, /* | |
| 1374 Set the value of the named CUTBUFFER (typically CUT_BUFFER0) to STRING. | |
| 1375 */ | |
| 1376 (cutbuffer, string)) | |
| 1377 { | |
| 1378 struct device *d = decode_x_device (Qnil); | |
| 1379 Display *display = DEVICE_X_DISPLAY (d); | |
| 1380 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */ | |
| 1381 Atom cut_buffer_atom; | |
| 867 | 1382 const Ibyte *data = XSTRING_DATA (string); |
| 444 | 1383 Bytecount bytes = XSTRING_LENGTH (string); |
| 1384 Bytecount bytes_remaining; | |
| 665 | 1385 Bytecount max_bytes = SELECTION_QUANTUM (display); |
| 428 | 1386 #ifdef MULE |
| 867 | 1387 const Ibyte *ptr, *end; |
| 428 | 1388 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII; |
| 1389 #endif | |
| 1390 | |
| 1391 if (max_bytes > MAX_SELECTION_QUANTUM) | |
| 1392 max_bytes = MAX_SELECTION_QUANTUM; | |
| 1393 | |
| 1394 CHECK_CUTBUFFER (cutbuffer); | |
| 1395 CHECK_STRING (string); | |
| 1396 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0); | |
| 1397 | |
| 1398 if (! cut_buffers_initialized) | |
| 1399 initialize_cut_buffers (display, window); | |
| 1400 | |
| 1401 /* We use the STRING encoding (Latin-1 only) if we can, else COMPOUND_TEXT. | |
| 1402 We cheat and use type = `STRING' even when using COMPOUND_TEXT. | |
| 1403 The ICCCM requires that this be so, and other clients assume it, | |
| 1404 as we do ourselves in initialize_cut_buffers. */ | |
| 1405 | |
| 1406 #ifdef MULE | |
| 1407 /* Optimize for the common ASCII case */ | |
| 1408 for (ptr = data, end = ptr + bytes; ptr <= end; ) | |
| 1409 { | |
| 826 | 1410 if (byte_ascii_p (*ptr)) |
| 428 | 1411 { |
| 1412 ptr++; | |
| 1413 continue; | |
| 1414 } | |
| 1415 | |
| 1416 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 || | |
| 1417 (*ptr) == LEADING_BYTE_CONTROL_1) | |
| 1418 { | |
| 1419 chartypes = LATIN_1; | |
| 1420 ptr += 2; | |
| 1421 continue; | |
| 1422 } | |
| 1423 | |
| 1424 chartypes = WORLD; | |
| 1425 break; | |
| 1426 } | |
| 1427 | |
| 1428 if (chartypes == LATIN_1) | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1429 LISP_STRING_TO_SIZED_EXTERNAL (string, data, bytes, Qbinary); |
| 428 | 1430 else if (chartypes == WORLD) |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1431 LISP_STRING_TO_SIZED_EXTERNAL (string, data, bytes, Qctext); |
| 428 | 1432 #endif /* MULE */ |
| 1433 | |
| 1434 bytes_remaining = bytes; | |
| 1435 | |
| 1436 while (bytes_remaining) | |
| 1437 { | |
| 665 | 1438 Bytecount chunk = |
| 647 | 1439 bytes_remaining < max_bytes ? bytes_remaining : max_bytes; |
| 428 | 1440 XChangeProperty (display, window, cut_buffer_atom, XA_STRING, 8, |
| 1441 (bytes_remaining == bytes | |
| 1442 ? PropModeReplace : PropModeAppend), | |
| 1443 data, chunk); | |
| 1444 data += chunk; | |
| 1445 bytes_remaining -= chunk; | |
| 1446 } | |
| 1447 return string; | |
| 1448 } | |
| 1449 | |
| 1450 | |
| 1451 DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal, 1, 1, 0, /* | |
| 1452 Rotate the values of the cutbuffers by the given number of steps; | |
| 1453 positive means move values forward, negative means backward. | |
| 1454 */ | |
| 1455 (n)) | |
| 1456 { | |
| 1457 struct device *d = decode_x_device (Qnil); | |
| 1458 Display *display = DEVICE_X_DISPLAY (d); | |
| 1459 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */ | |
| 1460 Atom props [8]; | |
| 1461 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
1462 CHECK_FIXNUM (n); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
1463 if (XFIXNUM (n) == 0) |
| 428 | 1464 return n; |
| 1465 if (! cut_buffers_initialized) | |
| 1466 initialize_cut_buffers (display, window); | |
| 1467 props[0] = XA_CUT_BUFFER0; | |
| 1468 props[1] = XA_CUT_BUFFER1; | |
| 1469 props[2] = XA_CUT_BUFFER2; | |
| 1470 props[3] = XA_CUT_BUFFER3; | |
| 1471 props[4] = XA_CUT_BUFFER4; | |
| 1472 props[5] = XA_CUT_BUFFER5; | |
| 1473 props[6] = XA_CUT_BUFFER6; | |
| 1474 props[7] = XA_CUT_BUFFER7; | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
1475 XRotateWindowProperties (display, window, props, 8, XFIXNUM (n)); |
| 428 | 1476 return n; |
| 1477 } | |
| 1478 | |
| 1479 #endif /* CUT_BUFFER_SUPPORT */ | |
| 1480 | |
| 1481 | |
| 1482 | |
| 1483 /************************************************************************/ | |
| 1484 /* initialization */ | |
| 1485 /************************************************************************/ | |
| 1486 | |
| 1487 void | |
| 440 | 1488 syms_of_select_x (void) |
| 428 | 1489 { |
| 1490 | |
| 1491 #ifdef CUT_BUFFER_SUPPORT | |
| 1492 DEFSUBR (Fx_get_cutbuffer_internal); | |
| 1493 DEFSUBR (Fx_store_cutbuffer_internal); | |
| 1494 DEFSUBR (Fx_rotate_cutbuffers_internal); | |
| 1495 #endif /* CUT_BUFFER_SUPPORT */ | |
| 1496 | |
|
5616
79e9934779c1
Use va_run_hooks_with_args() for x-sent-selection-hooks, lost-selection-hooks
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
1497 DEFSYMBOL (Qx_sent_selection_hooks); |
|
79e9934779c1
Use va_run_hooks_with_args() for x-sent-selection-hooks, lost-selection-hooks
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
1498 |
| 428 | 1499 /* Unfortunately, timeout handlers must be lisp functions. */ |
| 563 | 1500 DEFSYMBOL (Qx_selection_reply_timeout_internal); |
| 428 | 1501 DEFSUBR (Fx_selection_reply_timeout_internal); |
| 1502 | |
| 1503 #ifdef CUT_BUFFER_SUPPORT | |
| 1504 defsymbol (&QCUT_BUFFER0, "CUT_BUFFER0"); | |
| 1505 defsymbol (&QCUT_BUFFER1, "CUT_BUFFER1"); | |
| 1506 defsymbol (&QCUT_BUFFER2, "CUT_BUFFER2"); | |
| 1507 defsymbol (&QCUT_BUFFER3, "CUT_BUFFER3"); | |
| 1508 defsymbol (&QCUT_BUFFER4, "CUT_BUFFER4"); | |
| 1509 defsymbol (&QCUT_BUFFER5, "CUT_BUFFER5"); | |
| 1510 defsymbol (&QCUT_BUFFER6, "CUT_BUFFER6"); | |
| 1511 defsymbol (&QCUT_BUFFER7, "CUT_BUFFER7"); | |
| 1512 #endif /* CUT_BUFFER_SUPPORT */ | |
| 1513 } | |
| 1514 | |
| 1515 void | |
| 1516 console_type_create_select_x (void) | |
| 1517 { | |
| 1518 CONSOLE_HAS_METHOD (x, own_selection); | |
| 1519 CONSOLE_HAS_METHOD (x, disown_selection); | |
| 1520 CONSOLE_HAS_METHOD (x, get_foreign_selection); | |
| 1521 CONSOLE_HAS_METHOD (x, selection_exists_p); | |
| 1522 } | |
| 1523 | |
| 1524 void | |
| 440 | 1525 reinit_vars_of_select_x (void) |
| 428 | 1526 { |
| 1527 reading_selection_reply = 0; | |
| 1528 reading_which_selection = 0; | |
| 1529 selection_reply_timed_out = 0; | |
| 1530 for_whom_the_bell_tolls = 0; | |
| 1531 prop_location_tick = 0; | |
| 1532 } | |
| 1533 | |
| 1534 void | |
| 440 | 1535 vars_of_select_x (void) |
| 428 | 1536 { |
| 1537 #ifdef CUT_BUFFER_SUPPORT | |
| 1538 cut_buffers_initialized = 0; | |
| 1539 Fprovide (intern ("cut-buffer")); | |
| 1540 #endif | |
| 1541 | |
| 1542 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks /* | |
| 1543 A function or functions to be called after we have responded to some | |
| 1544 other client's request for the value of a selection that we own. The | |
| 1545 function(s) will be called with four arguments: | |
| 1546 - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD); | |
| 1547 - the name of the selection-type which we were requested to convert the | |
| 1548 selection into before sending (for example, STRING or LENGTH); | |
| 1549 - and whether we successfully transmitted the selection. | |
| 1550 We might have failed (and declined the request) for any number of reasons, | |
| 1551 including being asked for a selection that we no longer own, or being asked | |
| 1552 to convert into a type that we don't know about or that is inappropriate. | |
| 1553 This hook doesn't let you change the behavior of emacs's selection replies, | |
| 1554 it merely informs you that they have happened. | |
| 1555 */ ); | |
|
5616
79e9934779c1
Use va_run_hooks_with_args() for x-sent-selection-hooks, lost-selection-hooks
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
1556 Vx_sent_selection_hooks = Qnil; |
| 428 | 1557 |
| 1558 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout /* | |
| 1559 If the selection owner doesn't reply in this many seconds, we give up. | |
| 1560 A value of 0 means wait as long as necessary. This is initialized from the | |
| 1561 \"*selectionTimeout\" resource (which is expressed in milliseconds). | |
| 1562 */ ); | |
| 1563 x_selection_timeout = 0; | |
| 456 | 1564 |
| 1565 DEFVAR_BOOL ("x-selection-strict-motif-ownership", &x_selection_strict_motif_ownership /* | |
| 863 | 1566 *If nil and XEmacs already owns the clipboard, don't own it again in the |
| 456 | 1567 Motif way. Owning the selection on the Motif way does a huge amount of |
| 1568 X protocol, and it makes killing text incredibly slow when using an | |
| 1569 X terminal. However, when enabled Motif text fields don't bother to look up | |
| 1570 the new value, and you can't Copy from a buffer, Paste into a text | |
| 1571 field, then Copy something else from the buffer and paste it into the | |
| 1572 text field; it pastes the first thing again. | |
| 1573 */ ); | |
| 1574 x_selection_strict_motif_ownership = 1; | |
| 428 | 1575 } |
| 1576 | |
| 1577 void | |
| 440 | 1578 Xatoms_of_select_x (struct device *d) |
| 428 | 1579 { |
| 1580 Display *D = DEVICE_X_DISPLAY (d); | |
| 1581 | |
| 1582 /* Non-predefined atoms that we might end up using a lot */ | |
| 1583 DEVICE_XATOM_CLIPBOARD (d) = XInternAtom (D, "CLIPBOARD", False); | |
| 1584 DEVICE_XATOM_TIMESTAMP (d) = XInternAtom (D, "TIMESTAMP", False); | |
| 1585 DEVICE_XATOM_TEXT (d) = XInternAtom (D, "TEXT", False); | |
| 1586 DEVICE_XATOM_DELETE (d) = XInternAtom (D, "DELETE", False); | |
| 1587 DEVICE_XATOM_MULTIPLE (d) = XInternAtom (D, "MULTIPLE", False); | |
| 1588 DEVICE_XATOM_INCR (d) = XInternAtom (D, "INCR", False); | |
| 1589 DEVICE_XATOM_TARGETS (d) = XInternAtom (D, "TARGETS", False); | |
| 1590 DEVICE_XATOM_NULL (d) = XInternAtom (D, "NULL", False); | |
| 1591 DEVICE_XATOM_ATOM_PAIR (d) = XInternAtom (D, "ATOM_PAIR", False); | |
| 1592 DEVICE_XATOM_COMPOUND_TEXT (d) = XInternAtom (D, "COMPOUND_TEXT", False); | |
| 442 | 1593 |
| 1594 /* #### I don't like the looks of this... what is it for? - ajh */ | |
| 428 | 1595 DEVICE_XATOM_EMACS_TMP (d) = XInternAtom (D, "_EMACS_TMP_", False); |
| 1596 } |