annotate src/select-x.c @ 793:e38acbeb1cae

[xemacs-hg @ 2002-03-29 04:46:17 by ben] lots o' fixes etc/ChangeLog: New file. Separated out all entries for etc/ into their own ChangeLog. Includes entries for the following files: etc/BABYL, etc/BETA, etc/CHARSETS, etc/DISTRIB, etc/Emacs.ad, etc/FTP, etc/GNUS-NEWS, etc/GOATS, etc/HELLO, etc/INSTALL, etc/MACHINES, etc/MAILINGLISTS, etc/MSDOS, etc/MYTHOLOGY, etc/NEWS, etc/OXYMORONS, etc/PACKAGES, etc/README, etc/TUTORIAL, etc/TUTORIAL.de, etc/TUTORIAL.ja, etc/TUTORIAL.ko, etc/TUTORIAL.se, etc/aliases.ksh, etc/altrasoft-logo.xpm, etc/check_cygwin_setup.sh, etc/custom/example-themes/europe-theme.el, etc/custom/example-themes/ex-custom-file, etc/custom/example-themes/example-theme.el, etc/e/eterm.ti, etc/edt-user.doc, etc/enriched.doc, etc/etags.1, etc/gnuserv.1, etc/gnuserv.README, etc/package-index.LATEST.gpg, etc/package-index.LATEST.pgp, etc/photos/jan.png, etc/recycle.xpm, etc/refcard.tex, etc/sample.Xdefaults, etc/sample.emacs, etc/sgml/CATALOG, etc/sgml/HTML32.dtd, etc/skk/SKK.tut.E, etc/smilies/Face_ase.xbm, etc/smilies/Face_ase2.xbm, etc/smilies/Face_ase3.xbm, etc/smilies/Face_smile.xbm, etc/smilies/Face_weep.xbm, etc/sounds, etc/toolbar, etc/toolbar/workshop-cap-up.xpm, etc/xemacs-ja.1, etc/xemacs.1, etc/yow.lines, etc\BETA, etc\NEWS, etc\README, etc\TUTORIAL, etc\TUTORIAL.de, etc\check_cygwin_setup.sh, etc\sample.init.el, etc\unicode\README, etc\unicode\mule-ucs\*, etc\unicode\other\* unicode/unicode-consortium/8859-16.TXT: New file. mule/english.el: Define this charset now, since a bug was fixed that formerly prevented it. mule/ethio-util.el: Fix compile errors involving Unicode `characters', which should be integers. Makefile.in.in: Always include gui.c, to fix compile error when TTY-only. EmacsFrame.c, abbrev.c, alloc.c, buffer.c, buffer.h, bytecode.c, bytecode.h, callint.c, callproc.c, casetab.c, casetab.h, charset.h, chartab.c, chartab.h, cmds.c, console-msw.c, console-msw.h, console-tty.c, console-x.c, console-x.h, console.c, console.h, data.c, database.c, device-gtk.c, device-msw.c, device-x.c, device.c, device.h, dialog-msw.c, doc.c, doprnt.c, dumper.c, dynarr.c, editfns.c, eldap.c, eldap.h, elhash.c, elhash.h, emacs.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, event-tty.c, event-unixoid.c, events.c, events.h, extents.c, extents.h, faces.c, faces.h, file-coding.c, file-coding.h, fileio.c, filelock.c, fns.c, frame-gtk.c, frame-msw.c, frame-tty.c, frame-x.c, frame.c, frame.h, free-hook.c, general-slots.h, glyphs-eimage.c, glyphs-gtk.c, glyphs-msw.c, glyphs-widget.c, glyphs-x.c, glyphs.c, glyphs.h, gpmevent.c, gtk-xemacs.c, gui-msw.c, gui-x.c, gui-x.h, gui.c, gui.h, gutter.c, gutter.h, indent.c, input-method-xlib.c, insdel.c, keymap.c, keymap.h, lisp-disunion.h, lisp-union.h, lisp.h, lread.c, lrecord.h, lstream.c, lstream.h, marker.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, minibuf.c, mule-canna.c, mule-ccl.c, mule-charset.c, mule-wnnfns.c, native-gtk-toolbar.c, objects-msw.c, objects-tty.c, objects-x.c, objects.c, objects.h, opaque.c, opaque.h, postgresql.c, postgresql.h, print.c, process-unix.c, process.c, process.h, rangetab.c, rangetab.h, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-tty.c, redisplay-x.c, redisplay.c, scrollbar-gtk.c, scrollbar-msw.c, scrollbar-x.c, scrollbar.c, scrollbar.h, search.c, select-gtk.c, select-x.c, sound.c, specifier.c, specifier.h, strftime.c, symbols.c, symeval.h, syntax.h, text.c, text.h, toolbar-common.c, toolbar-msw.c, toolbar.c, toolbar.h, tooltalk.c, tooltalk.h, ui-gtk.c, ui-gtk.h, undo.c, vm-limit.c, window.c, window.h: Eliminate XSETFOO. Replace all usages with wrap_foo(). Make symbol->name a Lisp_Object, not Lisp_String *. Eliminate nearly all uses of Lisp_String * in favor of Lisp_Object, and correct macros so most of them favor Lisp_Object. Create new error-behavior ERROR_ME_DEBUG_WARN -- output warnings, but at level `debug' (usually ignored). Use it when instantiating specifiers, so problems can be debugged. Move log-warning-minimum-level into C so that we can optimize ERROR_ME_DEBUG_WARN. Fix warning levels consistent with new definitions. Add default_ and parent fields to char table; not yet implemented. New fun Dynarr_verify(); use for further error checking on Dynarrs. Rearrange code at top of lisp.h in conjunction with dynarr changes. Fix eifree(). Use Eistrings in various places (format_event_object(), where_is_to_char(), and callers thereof) to avoid fixed-size strings buffers. New fun write_eistring(). Reindent and fix GPM code to follow standards. Set default MS Windows font to Lucida Console (same size as Courier New but less interline spacing, so more lines fit). Increase default frame size on Windows to 50 lines. (If that's too big for the workspace, the frame will be shrunk as necessary.) Fix problem with text files with no newlines (). (Change `convert-eol' coding system to use `nil' for autodetect, consistent with make-coding-system.) Correct compile warnings in vm-limit.c. Fix handling of reverse-direction charsets to avoid errors when opening (e.g.) mule-ucs/lisp/reldata/uiso8859-6.el. Recode some object printing methods to use write_fmt_string() instead of a fixed buffer and sprintf. Turn on display of png comments as warnings (level `info'), now that they're unobtrusive. Revamped the sound documentation. Fixed bug in redisplay w.r.t. hscroll/truncation/continuation glyphs causing jumping up and down of the lines, since they're bigger than the line size. (It was seen most obviously when there's a horizontal scroll bar, e.g. do C-h a glyph or something like that.) The problem was that the glyph-contrib-p setting on glyphs was ignored even if it was set properly, which it wasn't until now.
author ben
date Fri, 29 Mar 2002 04:49:13 +0000
parents 943eaba38521
children a5954632b187
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* X Selection processing for XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3 Copyright (C) 2001, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 /* Synched up with: Not synched with FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 /* Rewritten by jwz */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
29 #include "charset.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #include "console-x.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 #include "objects-x.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "frame.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #include "opaque.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #include "systime.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 #include "select.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 int lisp_to_time (Lisp_Object, time_t *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 Lisp_Object time_to_lisp (time_t);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 #ifdef LWLIB_USES_MOTIF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 # define MOTIF_CLIPBOARDS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 #ifdef MOTIF_CLIPBOARDS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 # include <Xm/CutPaste.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 static void hack_motif_clipboard_selection (Atom selection_atom,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 Lisp_Object selection_value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 Time thyme, Display *display,
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
50 Window selecting_window,
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
51 int owned_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 #define CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 Lisp_Object Vx_sent_selection_hooks;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 /* If this is a smaller number than the max-request-size of the display,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 emacs will use INCR selection transfer when the selection is larger
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 than this. The max-request-size is usually around 64k, so if you want
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 emacs to use incremental selection transfers when the selection is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 smaller than that, set this. I added this mostly for debugging the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 incremental transfer stuff, but it might improve server performance.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 #define MAX_SELECTION_QUANTUM 0xFFFFFF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize (dpy) << 2) - 100)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 /* If the selection owner takes too long to reply to a selection request,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 we give up on it. This is in seconds (0 = no timeout).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 */
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
77 Fixnum x_selection_timeout;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
79 /* Enable motif selection optimizations. */
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
80 int x_selection_strict_motif_ownership;
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
81
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 /* Utility functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 static Lisp_Object x_get_window_property_as_lisp_data (Display *,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 Window,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 Atom property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 Lisp_Object target_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 Atom selection_atom);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 static int expect_property_change (Display *, Window, Atom prop, int state);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 static void wait_for_property_change (long);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 static void unexpect_property_change (int);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 static int waiting_for_other_props_on_window (Display *, Window);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 /* This converts a Lisp symbol to a server Atom, avoiding a server
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 roundtrip whenever possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 static Atom
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 symbol_to_x_atom (struct device *d, Lisp_Object sym, int only_if_exists)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 if (NILP (sym)) return XA_PRIMARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 if (EQ (sym, Qt)) return XA_SECONDARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 if (EQ (sym, QPRIMARY)) return XA_PRIMARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 if (EQ (sym, QSTRING)) return XA_STRING;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 if (EQ (sym, QINTEGER)) return XA_INTEGER;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 if (EQ (sym, QATOM)) return XA_ATOM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 if (EQ (sym, QCLIPBOARD)) return DEVICE_XATOM_CLIPBOARD (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 if (EQ (sym, QTIMESTAMP)) return DEVICE_XATOM_TIMESTAMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 if (EQ (sym, QTEXT)) return DEVICE_XATOM_TEXT (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 if (EQ (sym, QDELETE)) return DEVICE_XATOM_DELETE (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 if (EQ (sym, QMULTIPLE)) return DEVICE_XATOM_MULTIPLE (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 if (EQ (sym, QINCR)) return DEVICE_XATOM_INCR (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 if (EQ (sym, QEMACS_TMP)) return DEVICE_XATOM_EMACS_TMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 if (EQ (sym, QTARGETS)) return DEVICE_XATOM_TARGETS (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 if (EQ (sym, QNULL)) return DEVICE_XATOM_NULL (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 if (EQ (sym, QATOM_PAIR)) return DEVICE_XATOM_ATOM_PAIR (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 if (EQ (sym, QCOMPOUND_TEXT)) return DEVICE_XATOM_COMPOUND_TEXT (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 #endif /* CUT_BUFFER_SUPPORT */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
135 const Extbyte *nameext;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
136 LISP_STRING_TO_EXTERNAL (Fsymbol_name (sym), nameext, Qctext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 return XInternAtom (display, nameext, only_if_exists ? True : False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 and calls to intern whenever possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 x_atom_to_symbol (struct device *d, Atom atom)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 if (! atom) return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 if (atom == XA_PRIMARY) return QPRIMARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 if (atom == XA_SECONDARY) return QSECONDARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 if (atom == XA_STRING) return QSTRING;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 if (atom == XA_INTEGER) return QINTEGER;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 if (atom == XA_ATOM) return QATOM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 if (atom == DEVICE_XATOM_CLIPBOARD (d)) return QCLIPBOARD;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 if (atom == DEVICE_XATOM_TIMESTAMP (d)) return QTIMESTAMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 if (atom == DEVICE_XATOM_TEXT (d)) return QTEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 if (atom == DEVICE_XATOM_DELETE (d)) return QDELETE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 if (atom == DEVICE_XATOM_MULTIPLE (d)) return QMULTIPLE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 if (atom == DEVICE_XATOM_INCR (d)) return QINCR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 if (atom == DEVICE_XATOM_EMACS_TMP (d)) return QEMACS_TMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 if (atom == DEVICE_XATOM_TARGETS (d)) return QTARGETS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 if (atom == DEVICE_XATOM_NULL (d)) return QNULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 if (atom == DEVICE_XATOM_ATOM_PAIR (d)) return QATOM_PAIR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 if (atom == DEVICE_XATOM_COMPOUND_TEXT (d)) return QCOMPOUND_TEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 if (atom == XA_CUT_BUFFER0) return QCUT_BUFFER0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 if (atom == XA_CUT_BUFFER1) return QCUT_BUFFER1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 if (atom == XA_CUT_BUFFER2) return QCUT_BUFFER2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 if (atom == XA_CUT_BUFFER3) return QCUT_BUFFER3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 if (atom == XA_CUT_BUFFER4) return QCUT_BUFFER4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 if (atom == XA_CUT_BUFFER5) return QCUT_BUFFER5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 if (atom == XA_CUT_BUFFER6) return QCUT_BUFFER6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 if (atom == XA_CUT_BUFFER7) return QCUT_BUFFER7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
180 Intbyte *intstr;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
181 Extbyte *str = XGetAtomName (display, atom);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 if (! str) return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
185 TO_INTERNAL_FORMAT (C_STRING, str,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
186 C_STRING_ALLOCA, intstr,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
187 Qctext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 XFree (str);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
189 return intern_int (intstr);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
193 #define PROCESSING_X_CODE
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
194 #include "select-common.h"
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
195 #undef PROCESSING_X_CODE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 /* Do protocol to assert ourself as a selection owner.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
200 x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
201 Lisp_Object how_to_add, Lisp_Object selection_type,
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
202 int owned_p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 struct frame *sel_frame = selected_frame ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 Window selecting_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 Lisp_Object selection_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 /* Use the time of the last-read mouse or keyboard event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 For selection purposes, we use this as a sleazy way of knowing what the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 current time is in server-time. This assumes that the most recently read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 mouse or keyboard event has something to do with the assertion of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 selection, which is probably true.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 Time thyme = DEVICE_X_MOUSE_TIMESTAMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 Atom selection_atom;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 CHECK_SYMBOL (selection_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 selection_atom = symbol_to_x_atom (d, selection_name, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 XSetSelectionOwner (display, selection_atom, selecting_window, thyme);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 /* We do NOT use time_to_lisp() here any more, like we used to.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 That assumed equivalence of time_t and Time, which is not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 necessarily the case (e.g. under OSF on the Alphas, where
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 Time is a 64-bit quantity and time_t is a 32-bit quantity).
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
227
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 Opaque pointers are the clean way to go here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
230 selection_time = make_opaque (&thyme, sizeof (thyme));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 #ifdef MOTIF_CLIPBOARDS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 hack_motif_clipboard_selection (selection_atom, selection_value,
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
234 thyme, display, selecting_window, owned_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 return selection_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 #ifdef MOTIF_CLIPBOARDS /* Bend over baby. Take it and like it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 static void motif_clipboard_cb ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 # endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 hack_motif_clipboard_selection (Atom selection_atom,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 Lisp_Object selection_value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 Time thyme,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 Display *display,
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
250 Window selecting_window,
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
251 int owned_p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 struct device *d = get_device_from_display (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 /* Those Motif wankers can't be bothered to follow the ICCCM, and do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 their own non-Xlib non-Xt clipboard processing. So we have to do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 this so that linked-in Motif widgets don't get themselves wedged.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 if (selection_atom == DEVICE_XATOM_CLIPBOARD (d)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 && STRINGP (selection_value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 /* If we already own the clipboard, don't own it again in the Motif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 way. This might lose in some subtle way, since the timestamp won't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 be current, but owning the selection on the Motif way does a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 SHITLOAD of X protocol, and it makes killing text be incredibly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 slow when using an X terminal. ARRRRGGGHHH!!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 /* No, this is no good, because then Motif text fields don't bother
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 to look up the new value, and you can't Copy from a buffer, Paste
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 into a text field, then Copy something else from the buffer and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 paste it into the text field -- it pastes the first thing again. */
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
271 && (!owned_p
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
272 /* Selectively re-enable this because for most users its
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
273 just too painful - especially over a remote link. */
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
274 || x_selection_strict_motif_ownership)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 Widget widget = FRAME_X_TEXT_WIDGET (selected_frame());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 long itemid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 #if XmVersion >= 1002
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 long dataid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 int dataid; /* 1.2 wants long, but 1.1.5 wants int... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 XmString fmh;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 String encoding = "STRING";
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
288 const Intbyte *data = XSTRING_DATA (selection_value);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
289 Bytecount bytes = XSTRING_LENGTH (selection_value);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
294 const Intbyte *ptr = data, *end = ptr + bytes;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 /* Optimize for the common ASCII case */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 while (ptr <= end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 if (BYTE_ASCII_P (*ptr))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 (*ptr) == LEADING_BYTE_CONTROL_1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 chartypes = LATIN_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 ptr += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 chartypes = WORLD;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 if (chartypes == LATIN_1)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
317 TO_EXTERNAL_FORMAT (LISP_STRING, selection_value,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
318 ALLOCA, (data, bytes),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
319 Qbinary);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 else if (chartypes == WORLD)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
322 TO_EXTERNAL_FORMAT (LISP_STRING, selection_value,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
323 ALLOCA, (data, bytes),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
324 Qctext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 encoding = "COMPOUND_TEXT";
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 fmh = XmStringCreateLtoR ("Clipboard", XmSTRING_DEFAULT_CHARSET);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 while (ClipboardSuccess !=
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 XmClipboardStartCopy (display, selecting_window, fmh, thyme,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 widget, motif_clipboard_cb,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 0, NULL,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 &itemid))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 XmStringFree (fmh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 while (ClipboardSuccess !=
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 XmClipboardCopy (display, selecting_window, itemid, encoding,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 /* O'Reilly examples say size can be 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 but this clearly is not the case. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 0, bytes, (int) selecting_window, /* private id */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 #else /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 (XtPointer) data, bytes, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 #endif /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 &dataid))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 while (ClipboardSuccess !=
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 XmClipboardEndCopy (display, selecting_window, itemid))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 /* I tried to treat the clipboard like a real selection, and not send
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 the data until it was requested, but it looks like that just doesn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 work at all unless the selection owner and requestor are in different
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 processes. From reading the Motif source, it looks like they never
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 even considered having two widgets in the same application transfer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 data between each other using "by-name" clipboard values. What a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 bunch of fuckups.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 motif_clipboard_cb (Widget widget, int *data_id, int *private_id, int *reason)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 switch (*reason)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 case XmCR_CLIPBOARD_DATA_REQUEST:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 Display *dpy = XtDisplay (widget);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 Window window = (Window) *private_id;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
376 Lisp_Object selection = select_convert_out (QCLIPBOARD, Qnil, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
377
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
378 /* Whichever lazy git wrote this originally just called abort()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
379 when anything didn't go their way... */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
380
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
381 /* Try some other text types */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
382 if (NILP (selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
383 selection = select_convert_out (QCLIPBOARD, QSTRING, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
384 if (NILP (selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
385 selection = select_convert_out (QCLIPBOARD, QTEXT, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
386 if (NILP (selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
387 selection = select_convert_out (QCLIPBOARD, QCOMPOUND_TEXT, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
388
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
389 if (CONSP (selection) && SYMBOLP (XCAR (selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
390 && (EQ (XCAR (selection), QSTRING)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
391 || EQ (XCAR (selection), QTEXT)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
392 || EQ (XCAR (selection), QCOMPOUND_TEXT)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
393 selection = XCDR (selection);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
394
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
395 if (NILP (selection))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
396 signal_error (Qselection_conversion_error, "no selection",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
397 Qunbound);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
398
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
399 if (!STRINGP (selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
400 signal_error (Qselection_conversion_error,
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
401 "couldn't convert selection to string", Qunbound);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
402
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
403
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 XmClipboardCopyByName (dpy, window, *data_id,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 (char *) XSTRING_DATA (selection),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 XSTRING_LENGTH (selection) + 1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 case XmCR_CLIPBOARD_DATA_DELETE:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 /* don't need to free anything */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 # endif /* MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 #endif /* MOTIF_CLIPBOARDS */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 /* Send a SelectionNotify event to the requestor with property=None, meaning
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 we were unable to do what they wanted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 x_decline_selection_request (XSelectionRequestEvent *event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 XSelectionEvent reply;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 reply.type = SelectionNotify;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 reply.display = event->display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 reply.requestor = event->requestor;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 reply.selection = event->selection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 reply.time = event->time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 reply.target = event->target;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 reply.property = None;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 XFlush (reply.display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 /* Used as an unwind-protect clause so that, if a selection-converter signals
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 an error, we tell the requestor that we were unable to do what they wanted
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 before we throw to top-level or go into the debugger or whatever.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 x_selection_request_lisp_error (Lisp_Object closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 XSelectionRequestEvent *event = (XSelectionRequestEvent *)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 get_opaque_ptr (closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 free_opaque_ptr (closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 if (event->type == 0) /* we set this to mean "completed normally" */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 x_decline_selection_request (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 /* Convert our selection to the requested type, and put that data where the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 requestor wants it. Then tell them whether we've succeeded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 x_reply_selection_request (XSelectionRequestEvent *event, int format,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
465 UChar_Binary *data, Bytecount size, Atom type)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 XSelectionEvent reply;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 Display *display = event->display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 struct device *d = get_device_from_display (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 Window window = event->requestor;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
472 Bytecount bytes_remaining;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 int format_bytes = format/8;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
474 Bytecount max_bytes = SELECTION_QUANTUM (display);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 reply.type = SelectionNotify;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 reply.display = display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 reply.requestor = window;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 reply.selection = event->selection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 reply.time = event->time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 reply.target = event->target;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 reply.property = (event->property == None ? event->target : event->property);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 /* Store the data on the requested property.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 If the selection is large, only store the first N bytes of it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 bytes_remaining = size * format_bytes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 if (bytes_remaining <= max_bytes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 /* Send all the data at once, with minimal handshaking. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 stderr_out ("\nStoring all %d\n", bytes_remaining);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 XChangeProperty (display, window, reply.property, type, format,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 PropModeReplace, data, size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 /* At this point, the selection was successfully stored; ack it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 XFlush (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 /* Send an INCR selection. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 int prop_id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 if (x_window_to_frame (d, window)) /* #### debug */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
509 invalid_operation ("attempt to transfer an INCR to ourself!", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 stderr_out ("\nINCR %d\n", bytes_remaining);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 prop_id = expect_property_change (display, window, reply.property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 PropertyDelete);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 XChangeProperty (display, window, reply.property, DEVICE_XATOM_INCR (d),
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
517 32, PropModeReplace, (UChar_Binary *)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 &bytes_remaining, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 XSelectInput (display, window, PropertyChangeMask);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 /* Tell 'em the INCR data is there... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 XFlush (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 /* First, wait for the requestor to ack by deleting the property.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 This can run random lisp code (process handlers) or signal.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 wait_for_property_change (prop_id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 while (bytes_remaining)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
531 Bytecount i = ((bytes_remaining < max_bytes)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 ? bytes_remaining
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 : max_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 prop_id = expect_property_change (display, window, reply.property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 PropertyDelete);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 stderr_out (" INCR adding %d\n", i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 /* Append the next chunk of data to the property. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 XChangeProperty (display, window, reply.property, type, format,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 PropModeAppend, data, i / format_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 bytes_remaining -= i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 data += i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 /* Now wait for the requestor to ack this chunk by deleting the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 property. This can run random lisp code or signal.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 wait_for_property_change (prop_id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 /* Now write a zero-length chunk to the property to tell the requestor
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 that we're done. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 stderr_out (" INCR done\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 if (! waiting_for_other_props_on_window (display, window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 XSelectInput (display, window, 0L);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 XChangeProperty (display, window, reply.property, type, format,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 PropModeReplace, data, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 /* Called from the event-loop in response to a SelectionRequest event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 x_handle_selection_request (XSelectionRequestEvent *event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 /* This function can GC */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
571 struct gcpro gcpro1, gcpro2;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
572 Lisp_Object temp_obj;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 Lisp_Object selection_symbol;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 Lisp_Object target_symbol = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 Lisp_Object converted_selection = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 Time local_selection_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 Lisp_Object successful_p = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 int count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 struct device *d = get_device_from_display (event->display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
581 GCPRO2 (converted_selection, target_symbol);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 selection_symbol = x_atom_to_symbol (d, event->selection);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
584 target_symbol = x_atom_to_symbol (d, event->target);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
586 #if 0 /* #### MULTIPLE doesn't work yet */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
587 if (EQ (target_symbol, QMULTIPLE))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
588 target_symbol = fetch_multiple_target (event);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
591 temp_obj = Fget_selection_timestamp (selection_symbol);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
592
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
593 if (NILP (temp_obj))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
595 /* We don't appear to have the selection. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 x_decline_selection_request (event);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
597
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 goto DONE_LABEL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
601 local_selection_time = * (Time *) XOPAQUE_DATA (temp_obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 if (event->time != CurrentTime &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 local_selection_time > event->time)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 /* Someone asked for the selection, and we have one, but not the one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 they're looking for. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 x_decline_selection_request (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 goto DONE_LABEL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
612 converted_selection = select_convert_out (selection_symbol,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
613 target_symbol, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
614
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
615 /* #### Is this the right thing to do? I'm no X expert. -- ajh */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
616 if (NILP (converted_selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
617 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
618 /* We don't appear to have a selection in that data type. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
619 x_decline_selection_request (event);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
620 goto DONE_LABEL;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
621 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
622
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 count = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 record_unwind_protect (x_selection_request_lisp_error,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 make_opaque_ptr (event));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
627 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
628 UChar_Binary *data;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
629 Bytecount size;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
630 int format;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
631 Atom type;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
632 lisp_data_to_selection_data (d, converted_selection,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
633 &data, &type, &size, &format);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
635 x_reply_selection_request (event, format, data, size, type);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
636 successful_p = Qt;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
637 /* Tell x_selection_request_lisp_error() it's cool. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
638 event->type = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
639 xfree (data);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
640 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
641
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
642 unbind_to (count);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 DONE_LABEL:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 /* Let random lisp code notice that the selection has been asked for. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 Lisp_Object val = Vx_sent_selection_hooks;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 if (!UNBOUNDP (val) && !NILP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
653 Lisp_Object rest;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 if (CONSP (val) && !EQ (XCAR (val), Qlambda))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 for (rest = val; !NILP (rest); rest = Fcdr (rest))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
656 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 else
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
658 call3 (val, selection_symbol, target_symbol, successful_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 /* Called from the event-loop in response to a SelectionClear event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 x_handle_selection_clear (XSelectionClearEvent *event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 Display *display = event->display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 struct device *d = get_device_from_display (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 Atom selection = event->selection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 Time changed_owner_time = event->time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
674 Lisp_Object selection_symbol, local_selection_time_lisp;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 Time local_selection_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 selection_symbol = x_atom_to_symbol (d, selection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
679 local_selection_time_lisp = Fget_selection_timestamp (selection_symbol);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
681 /* We don't own the selection, so that's fine. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
682 if (NILP (local_selection_time_lisp))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
683 return;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
685 local_selection_time = * (Time *) XOPAQUE_DATA (local_selection_time_lisp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 /* This SelectionClear is for a selection that we no longer own, so we can
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 disregard it. (That is, we have reasserted the selection since this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 request was generated.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 if (changed_owner_time != CurrentTime &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 local_selection_time > changed_owner_time)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 return;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
694
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 handle_selection_clear (selection_symbol);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 /* This stuff is so that INCR selections are reentrant (that is, so we can
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 be servicing multiple INCR selection requests simultaneously). I haven't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 actually tested that yet.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 static int prop_location_tick;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 static struct prop_location {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 int tick;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 Display *display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 Window window;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 Atom property;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 int desired_state;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 struct prop_location *next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 } *for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 property_deleted_p (void *tick)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 struct prop_location *rest = for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 while (rest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 if (rest->tick == (long) tick)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 rest = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 waiting_for_other_props_on_window (Display *display, Window window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 struct prop_location *rest = for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 while (rest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 if (rest->display == display && rest->window == window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 rest = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 expect_property_change (Display *display, Window window,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 Atom property, int state)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 struct prop_location *pl = xnew (struct prop_location);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 pl->tick = ++prop_location_tick;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 pl->display = display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 pl->window = window;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 pl->property = property;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 pl->desired_state = state;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 pl->next = for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 for_whom_the_bell_tolls = pl;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 return pl->tick;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 unexpect_property_change (int tick)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 while (rest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 if (rest->tick == tick)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 if (prev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 prev->next = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 for_whom_the_bell_tolls = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 xfree (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 prev = rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 rest = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 wait_for_property_change (long tick)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 wait_delaying_user_input (property_deleted_p, (void *) tick);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 /* Called from the event-loop in response to a PropertyNotify event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 x_handle_property_notify (XPropertyEvent *event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 while (rest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 if (rest->property == event->atom &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 rest->window == event->window &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 rest->display == event->display &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 rest->desired_state == event->state)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 stderr_out ("Saw expected prop-%s on %s\n",
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
799 (event->state == PropertyDelete ? "delete" : "change"),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
800 XSTRING_DATA
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
801 (XSYMBOL (x_atom_to_symbol
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
802 (get_device_from_display (event->display),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
803 event->atom))->name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 if (prev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 prev->next = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 for_whom_the_bell_tolls = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 xfree (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 prev = rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 rest = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 stderr_out ("Saw UNexpected prop-%s on %s\n",
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
817 (event->state == PropertyDelete ? "delete" : "change"),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
818 XSTRING_DATA (XSYMBOL (x_atom_to_symbol
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
819 (get_device_from_display (event->display),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
820 event->atom))->name));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 #if 0 /* #### MULTIPLE doesn't work yet */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 fetch_multiple_target (XSelectionRequestEvent *event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 Display *display = event->display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 Window window = event->requestor;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 Atom target = event->target;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 Atom selection_atom = event->selection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 int result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 Fcons (QMULTIPLE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 x_get_window_property_as_lisp_data (display, window, target,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 QMULTIPLE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 selection_atom));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 copy_multiple_data (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 Lisp_Object vec;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
849 Elemcount i;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
850 Elemcount len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 if (CONSP (obj))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 CHECK_VECTOR (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 len = XVECTOR_LENGTH (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 vec = make_vector (len, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 for (i = 0; i < len; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 Lisp_Object vec2 = XVECTOR_DATA (obj) [i];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 CHECK_VECTOR (vec2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 if (XVECTOR_LENGTH (vec2) != 2)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
862 sferror ("vectors must be of length 2", vec2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 XVECTOR_DATA (vec) [i] = make_vector (2, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [0] = XVECTOR_DATA (vec2) [0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [1] = XVECTOR_DATA (vec2) [1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 return vec;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 static Window reading_selection_reply;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 static Atom reading_which_selection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 static int selection_reply_timed_out;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 selection_reply_done (void *ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 return !reading_selection_reply;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 static Lisp_Object Qx_selection_reply_timeout_internal;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 DEFUN ("x-selection-reply-timeout-internal", Fx_selection_reply_timeout_internal,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 (arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 selection_reply_timed_out = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 reading_selection_reply = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 /* Do protocol to read selection-data from the server.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 Converts this to lisp data and returns it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 struct frame *sel_frame = selected_frame ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 Window requestor_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 Time requestor_time = DEVICE_X_MOUSE_TIMESTAMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 Atom target_property = DEVICE_XATOM_EMACS_TMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 Atom selection_atom = symbol_to_x_atom (d, selection_symbol, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 int speccount;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 Atom type_atom = symbol_to_x_atom (d, (CONSP (target_type) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 XCAR (target_type) : target_type), 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 XConvertSelection (display, selection_atom, type_atom, target_property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 requestor_window, requestor_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 /* Block until the reply has been read. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 reading_selection_reply = requestor_window;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 reading_which_selection = selection_atom;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 selection_reply_timed_out = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 /* add a timeout handler */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 if (x_selection_timeout > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 Lisp_Object id = Fadd_timeout (make_int (x_selection_timeout),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 Qx_selection_reply_timeout_internal,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 record_unwind_protect (Fdisable_timeout, id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 /* This is ^Gable */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 wait_delaying_user_input (selection_reply_done, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 if (selection_reply_timed_out)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
937 signal_error (Qselection_conversion_error, "timed out waiting for reply from selection owner", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
939 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 /* otherwise, the selection is waiting for us on the requested property. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
942
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
943 return select_convert_in (selection_symbol,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
944 target_type,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
945 x_get_window_property_as_lisp_data(display,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
946 requestor_window,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
947 target_property,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
948 target_type,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
949 selection_atom));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 x_get_window_property (Display *display, Window window, Atom property,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
955 UChar_Binary **data_ret, Bytecount *bytes_ret,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 Atom *actual_type_ret, int *actual_format_ret,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 unsigned long *actual_size_ret, int delete_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
959 Bytecount total_size;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 unsigned long bytes_remaining;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
961 Bytecount offset = 0;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
962 UChar_Binary *tmp_data = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 int result;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
964 Bytecount buffer_size = SELECTION_QUANTUM (display);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 /* First probe the thing to find out how big it is. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 result = XGetWindowProperty (display, window, property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 0, 0, False, AnyPropertyType,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 actual_type_ret, actual_format_ret,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 actual_size_ret,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 &bytes_remaining, &tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 if (result != Success)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 *data_ret = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 *bytes_ret = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 XFree ((char *) tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 if (*actual_type_ret == None || *actual_format_ret == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 if (delete_p) XDeleteProperty (display, window, property);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 *data_ret = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 *bytes_ret = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 total_size = bytes_remaining + 1;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
990 *data_ret = (UChar_Binary *) xmalloc (total_size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 /* Now read, until we've gotten it all. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 while (bytes_remaining)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 #if 0
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
996 Bytecount last = bytes_remaining;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 result =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 XGetWindowProperty (display, window, property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 offset/4, buffer_size/4,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 (delete_p ? True : False),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 AnyPropertyType,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 actual_type_ret, actual_format_ret,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 actual_size_ret, &bytes_remaining, &tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 stderr_out ("<< read %d\n", last-bytes_remaining);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 /* If this doesn't return Success at this point, it means that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 some clod deleted the selection while we were in the midst of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 reading it. Deal with that, I guess....
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 if (result != Success) break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 *actual_size_ret *= *actual_format_ret / 8;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 memcpy ((*data_ret) + offset, tmp_data, *actual_size_ret);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 offset += *actual_size_ret;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 XFree ((char *) tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 *bytes_ret = offset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 receive_incremental_selection (Display *display, Window window, Atom property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 /* this one is for error messages only */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 Lisp_Object target_type,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1026 Bytecount min_size_bytes,
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1027 UChar_Binary **data_ret,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1028 Bytecount *size_bytes_ret,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 Atom *type_ret, int *format_ret,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 unsigned long *size_ret)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1033 Bytecount offset = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 int prop_id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 *size_bytes_ret = min_size_bytes;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1036 *data_ret = (UChar_Binary *) xmalloc (*size_bytes_ret);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 stderr_out ("\nread INCR %d\n", min_size_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 /* At this point, we have read an INCR property, and deleted it (which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 is how we ack its receipt: the sending window will be selecting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 PropertyNotify events on our window to notice this).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 Now, we must loop, waiting for the sending window to put a value on
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 that property, then reading the property, then deleting it to ack.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 We are done when the sender places a property of length 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 prop_id = expect_property_change (display, window, property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 PropertyNewValue);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1052 UChar_Binary *tmp_data;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1053 Bytecount tmp_size_bytes;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 wait_for_property_change (prop_id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 /* expect it again immediately, because x_get_window_property may
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 .. no it won't, I don't get it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 .. Ok, I get it now, the Xt code that implements INCR is broken.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 prop_id = expect_property_change (display, window, property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 PropertyNewValue);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 x_get_window_property (display, window, property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 &tmp_data, &tmp_size_bytes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 type_ret, format_ret, size_ret, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 if (tmp_size_bytes == 0) /* we're done */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 stderr_out (" read INCR done\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 unexpect_property_change (prop_id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 if (tmp_data) xfree (tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 stderr_out (" read INCR %d\n", tmp_size_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 if (*size_bytes_ret < offset + tmp_size_bytes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 stderr_out (" read INCR realloc %d -> %d\n",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 *size_bytes_ret, offset + tmp_size_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 *size_bytes_ret = offset + tmp_size_bytes;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1084 *data_ret = (UChar_Binary *) xrealloc (*data_ret, *size_bytes_ret);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 offset += tmp_size_bytes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 xfree (tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 x_get_window_property_as_lisp_data (Display *display,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 Window window,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 Atom property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 /* next two for error messages only */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 Lisp_Object target_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 Atom selection_atom)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 Atom actual_type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 int actual_format;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 unsigned long actual_size;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1105 UChar_Binary *data = NULL;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1106 Bytecount bytes = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 struct device *d = get_device_from_display (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 x_get_window_property (display, window, property, &data, &bytes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 &actual_type, &actual_format, &actual_size, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 if (! data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 if (XGetSelectionOwner (display, selection_atom))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 /* there is a selection owner */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1116 signal_error (Qselection_conversion_error,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1117 "selection owner couldn't convert",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1118 Fcons (Qunbound,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1119 Fcons (x_atom_to_symbol (d, selection_atom),
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1120 actual_type ?
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1121 list2 (target_type,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1122 x_atom_to_symbol (d, actual_type)) :
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1123 list1 (target_type))));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1125 signal_error (Qselection_conversion_error,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1126 "no selection",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1127 x_atom_to_symbol (d, selection_atom));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 if (actual_type == DEVICE_XATOM_INCR (d))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 /* Ok, that data wasn't *the* data, it was just the beginning. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1134 Bytecount min_size_bytes =
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1135 /* careful here. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1136 (Bytecount) (* ((unsigned int *) data));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 xfree (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 receive_incremental_selection (display, window, property, target_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 min_size_bytes, &data, &bytes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 &actual_type, &actual_format,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 &actual_size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 /* It's been read. Now convert it to a lisp object in some semi-rational
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 manner. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 val = selection_data_to_lisp_data (d, data, bytes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 actual_type, actual_format);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 xfree (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 /* Called from the event loop to handle SelectionNotify events.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 I don't think this needs to be reentrant.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 x_handle_selection_notify (XSelectionEvent *event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 if (! reading_selection_reply)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 message ("received an unexpected SelectionNotify event");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 else if (event->requestor != reading_selection_reply)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 message ("received a SelectionNotify event for the wrong window");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 else if (event->selection != reading_which_selection)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 message ("received the wrong selection type in SelectionNotify!");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 reading_selection_reply = 0; /* we're done now. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 x_disown_selection (Lisp_Object selection, Lisp_Object timeval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 Time timestamp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 Atom selection_atom;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 CHECK_SYMBOL (selection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 if (NILP (timeval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 timestamp = DEVICE_X_MOUSE_TIMESTAMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 /* #### This is bogus. See the comment above about problems
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 on OSF/1 and DEC Alphas. Yet another reason why it sucks
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 to have the implementation (i.e. cons of two 16-bit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 integers) exposed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 time_t the_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 lisp_to_time (timeval, &the_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 timestamp = (Time) the_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 selection_atom = symbol_to_x_atom (d, selection, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 XSetSelectionOwner (display, selection_atom, None, timestamp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1198 x_selection_exists_p (Lisp_Object selection,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1199 Lisp_Object selection_type)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 Display *dpy = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 return XGetSelectionOwner (dpy, symbol_to_x_atom (d, selection, 0)) != None ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 static int cut_buffers_initialized; /* Whether we're sure they all exist */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 initialize_cut_buffers (Display *display, Window window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1216 static unsigned const char * const data = (unsigned const char *) "";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 PropModeAppend, data, 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 FROB (XA_CUT_BUFFER0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 FROB (XA_CUT_BUFFER1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 FROB (XA_CUT_BUFFER2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 FROB (XA_CUT_BUFFER3);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 FROB (XA_CUT_BUFFER4);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 FROB (XA_CUT_BUFFER5);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 FROB (XA_CUT_BUFFER6);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 FROB (XA_CUT_BUFFER7);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 #undef FROB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 cut_buffers_initialized = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 #define CHECK_CUTBUFFER(symbol) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 CHECK_SYMBOL (symbol); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 if (! (EQ (symbol, QCUT_BUFFER0) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 EQ (symbol, QCUT_BUFFER1) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 EQ (symbol, QCUT_BUFFER2) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 EQ (symbol, QCUT_BUFFER3) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 EQ (symbol, QCUT_BUFFER4) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 EQ (symbol, QCUT_BUFFER5) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 EQ (symbol, QCUT_BUFFER6) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 EQ (symbol, QCUT_BUFFER7))) \
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1241 invalid_constant ("Doesn't name a cutbuffer", symbol); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 Return the value of the named CUTBUFFER (typically CUT_BUFFER0).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 (cutbuffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 Atom cut_buffer_atom;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1253 UChar_Binary *data;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1254 Bytecount bytes;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 Atom type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 int format;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 unsigned long size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 Lisp_Object ret;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 CHECK_CUTBUFFER (cutbuffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 x_get_window_property (display, window, cut_buffer_atom, &data, &bytes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 &type, &format, &size, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 if (!data) return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 if (format != 8 || type != XA_STRING)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1268 invalid_state_2 ("Cut buffer doesn't contain 8-bit STRING data",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1269 x_atom_to_symbol (d, type),
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1270 make_int (format));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 /* We cheat - if the string contains an ESC character, that's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 technically not allowed in a STRING, so we assume it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 COMPOUND_TEXT that we stored there ourselves earlier,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 in x-store-cutbuffer-internal */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 ret = (bytes ?
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1277 make_ext_string ((Extbyte *) data, bytes,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 memchr (data, 0x1b, bytes) ?
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1279 Qctext : Qbinary)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 : Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 xfree (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 return ret;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 Set the value of the named CUTBUFFER (typically CUT_BUFFER0) to STRING.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 (cutbuffer, string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 Atom cut_buffer_atom;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1295 const Intbyte *data = XSTRING_DATA (string);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1296 Bytecount bytes = XSTRING_LENGTH (string);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1297 Bytecount bytes_remaining;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1298 Bytecount max_bytes = SELECTION_QUANTUM (display);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 #ifdef MULE
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1300 const Intbyte *ptr, *end;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 if (max_bytes > MAX_SELECTION_QUANTUM)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 max_bytes = MAX_SELECTION_QUANTUM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 CHECK_CUTBUFFER (cutbuffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 if (! cut_buffers_initialized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 initialize_cut_buffers (display, window);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 /* We use the STRING encoding (Latin-1 only) if we can, else COMPOUND_TEXT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 We cheat and use type = `STRING' even when using COMPOUND_TEXT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 The ICCCM requires that this be so, and other clients assume it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 as we do ourselves in initialize_cut_buffers. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 /* Optimize for the common ASCII case */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 for (ptr = data, end = ptr + bytes; ptr <= end; )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 if (BYTE_ASCII_P (*ptr))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 (*ptr) == LEADING_BYTE_CONTROL_1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 chartypes = LATIN_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 ptr += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 chartypes = WORLD;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 if (chartypes == LATIN_1)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1342 TO_EXTERNAL_FORMAT (LISP_STRING, string,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1343 ALLOCA, (data, bytes),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1344 Qbinary);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 else if (chartypes == WORLD)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1346 TO_EXTERNAL_FORMAT (LISP_STRING, string,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1347 ALLOCA, (data, bytes),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1348 Qctext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 bytes_remaining = bytes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 while (bytes_remaining)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1355 Bytecount chunk =
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1356 bytes_remaining < max_bytes ? bytes_remaining : max_bytes;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 XChangeProperty (display, window, cut_buffer_atom, XA_STRING, 8,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 (bytes_remaining == bytes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 ? PropModeReplace : PropModeAppend),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 data, chunk);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 data += chunk;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 bytes_remaining -= chunk;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 return string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 Rotate the values of the cutbuffers by the given number of steps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 positive means move values forward, negative means backward.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 (n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 Atom props [8];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 CHECK_INT (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 if (XINT (n) == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 return n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 if (! cut_buffers_initialized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 initialize_cut_buffers (display, window);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 props[0] = XA_CUT_BUFFER0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 props[1] = XA_CUT_BUFFER1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 props[2] = XA_CUT_BUFFER2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 props[3] = XA_CUT_BUFFER3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 props[4] = XA_CUT_BUFFER4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 props[5] = XA_CUT_BUFFER5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 props[6] = XA_CUT_BUFFER6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 props[7] = XA_CUT_BUFFER7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392 XRotateWindowProperties (display, window, props, 8, XINT (n));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 return n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 #endif /* CUT_BUFFER_SUPPORT */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 /* initialization */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1405 syms_of_select_x (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 DEFSUBR (Fx_get_cutbuffer_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 DEFSUBR (Fx_store_cutbuffer_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 DEFSUBR (Fx_rotate_cutbuffers_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 #endif /* CUT_BUFFER_SUPPORT */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 /* Unfortunately, timeout handlers must be lisp functions. */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1415 DEFSYMBOL (Qx_selection_reply_timeout_internal);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 DEFSUBR (Fx_selection_reply_timeout_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 defsymbol (&QCUT_BUFFER0, "CUT_BUFFER0");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 defsymbol (&QCUT_BUFFER1, "CUT_BUFFER1");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 defsymbol (&QCUT_BUFFER2, "CUT_BUFFER2");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 defsymbol (&QCUT_BUFFER3, "CUT_BUFFER3");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 defsymbol (&QCUT_BUFFER4, "CUT_BUFFER4");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 defsymbol (&QCUT_BUFFER5, "CUT_BUFFER5");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 defsymbol (&QCUT_BUFFER6, "CUT_BUFFER6");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 defsymbol (&QCUT_BUFFER7, "CUT_BUFFER7");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 #endif /* CUT_BUFFER_SUPPORT */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 console_type_create_select_x (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 CONSOLE_HAS_METHOD (x, own_selection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 CONSOLE_HAS_METHOD (x, disown_selection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 CONSOLE_HAS_METHOD (x, get_foreign_selection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 CONSOLE_HAS_METHOD (x, selection_exists_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1440 reinit_vars_of_select_x (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 reading_selection_reply = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 reading_which_selection = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 selection_reply_timed_out = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 for_whom_the_bell_tolls = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 prop_location_tick = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1450 vars_of_select_x (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1452 reinit_vars_of_select_x ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 cut_buffers_initialized = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 Fprovide (intern ("cut-buffer"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 A function or functions to be called after we have responded to some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 other client's request for the value of a selection that we own. The
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 function(s) will be called with four arguments:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 - the name of the selection-type which we were requested to convert the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 selection into before sending (for example, STRING or LENGTH);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 - and whether we successfully transmitted the selection.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 We might have failed (and declined the request) for any number of reasons,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 including being asked for a selection that we no longer own, or being asked
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 to convert into a type that we don't know about or that is inappropriate.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 This hook doesn't let you change the behavior of emacs's selection replies,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 it merely informs you that they have happened.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 Vx_sent_selection_hooks = Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 If the selection owner doesn't reply in this many seconds, we give up.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 A value of 0 means wait as long as necessary. This is initialized from the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 \"*selectionTimeout\" resource (which is expressed in milliseconds).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 x_selection_timeout = 0;
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1481
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1482 DEFVAR_BOOL ("x-selection-strict-motif-ownership", &x_selection_strict_motif_ownership /*
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1483 *If true and XEmacs already owns the clipboard, don't own it again in the
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1484 Motif way. Owning the selection on the Motif way does a huge amount of
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1485 X protocol, and it makes killing text incredibly slow when using an
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1486 X terminal. However, when enabled Motif text fields don't bother to look up
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1487 the new value, and you can't Copy from a buffer, Paste into a text
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1488 field, then Copy something else from the buffer and paste it into the
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1489 text field; it pastes the first thing again.
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1490 */ );
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1491 x_selection_strict_motif_ownership = 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1495 Xatoms_of_select_x (struct device *d)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 Display *D = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 /* Non-predefined atoms that we might end up using a lot */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 DEVICE_XATOM_CLIPBOARD (d) = XInternAtom (D, "CLIPBOARD", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 DEVICE_XATOM_TIMESTAMP (d) = XInternAtom (D, "TIMESTAMP", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 DEVICE_XATOM_TEXT (d) = XInternAtom (D, "TEXT", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 DEVICE_XATOM_DELETE (d) = XInternAtom (D, "DELETE", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 DEVICE_XATOM_MULTIPLE (d) = XInternAtom (D, "MULTIPLE", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 DEVICE_XATOM_INCR (d) = XInternAtom (D, "INCR", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 DEVICE_XATOM_TARGETS (d) = XInternAtom (D, "TARGETS", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 DEVICE_XATOM_NULL (d) = XInternAtom (D, "NULL", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 DEVICE_XATOM_ATOM_PAIR (d) = XInternAtom (D, "ATOM_PAIR", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 DEVICE_XATOM_COMPOUND_TEXT (d) = XInternAtom (D, "COMPOUND_TEXT", False);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1510
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1511 /* #### I don't like the looks of this... what is it for? - ajh */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 DEVICE_XATOM_EMACS_TMP (d) = XInternAtom (D, "_EMACS_TMP_", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 }