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