annotate src/select-x.c @ 1315:70921960b980

[xemacs-hg @ 2003-02-20 08:19:28 by ben] check in makefile fixes et al Makefile.in.in: Major surgery. Move all stuff related to building anything in the src/ directory into src/. Simplify the dependencies -- everything in src/ is dependent on the single entry `src' in MAKE_SUBDIRS. Remove weirdo targets like `all-elc[s]', dump-elc[s], etc. mule/mule-msw-init.el: Removed. Delete this file. mule/mule-win32-init.el: New file, with stuff from mule-msw-init.el -- not just for MS Windows native, boys and girls! bytecomp.el: Change code inserted to catch trying to load a Mule-only .elc file in a non-Mule XEmacs. Formerly you got the rather cryptic "The required feature `mule' cannot be provided". Now you get "Loading this file requires Mule support". finder.el: Remove dependency on which directory this function is invoked from. update-elc.el: Don't mess around with ../src/BYTECOMPILE_CHANGE. Now that Makefile.in.in and xemacs.mak are in sync, both of them use NEEDTODUMP and the other one isn't used. dumped-lisp.el: Rewrite in terms of `list' and `nconc' instead of assemble-list, so we can have arbitrary forms, not just `when-feature'. very-early-lisp.el: Nuke this file. finder-inf.el, packages.el, update-elc.el, update-elc-2.el, loadup.el, make-docfile.el: Eliminate references to very-early-lisp. msw-glyphs.el: Comment clarification. xemacs.mak: Add macros DO_TEMACS, DO_XEMACS, and a few others; this macro section is now completely in sync with src/Makefile.in.in. Copy check-features, load-shadows, and rebuilding finder-inf.el from src/Makefile.in.in. The main build/dump/recompile process is now synchronized with src/Makefile.in.in. Change `WARNING' to `NOTE' and `error checking' to `error-checking' TO avoid tripping faux warnings and errors in the VC++ IDE. Makefile.in.in: Major surgery. Move all stuff related to building anything in the src/ directory from top-level Makefile.in.in to here. Simplify the dependencies. Rearrange into logical subsections. Synchronize the main compile/dump/build-elcs section with xemacs.mak, which is already clean and in good working order. Remove weirdo targets like `all-elc[s]', dump-elc[s], etc. Add additional levels of macros \(e.g. DO_TEMACS, DO_XEMACS, TEMACS_BATCH, XEMACS_BATCH, XEMACS_BATCH_PACKAGES) to factor out duplicated stuff. Clean up handling of "HEAP_IN_DATA" (Cygwin) so it doesn't need to ignore the return value from dumping. Add .NO_PARALLEL since various aspects of building and dumping must be serialized but do not always have dependencies between them (this is impossible in some cases). Everything related to src/ now gets built in one pass in this directory by just running `make' (except the Makefiles themselves and config.h, paths.h, Emacs.ad.h, and other generated .h files). console.c: Update list of possibly valid console types. emacs.c: Rationalize the specifying and handling of the type of the first frame. This was originally prompted by a workspace in which I got GTK to compile under C++ and in the process fixed it so it could coexist with X in the same build -- hence, a combined TTY/X/MS-Windows/GTK build is now possible under Cygwin. (However, you can't simultaneously *display* more than one kind of device connection -- but getting that to work is not that difficult. Perhaps a project for a bored grad student. I (ben) would do it but don't see the use.) To make sense of this, I added new switches that can be used to specifically indicate the window system: -x [aka --use-x], -tty \[aka --use-tty], -msw [aka --use-ms-windows], -gtk [aka --use-gtk], and -gnome [aka --use-gnome, same as --use-gtk]. -nw continues as an alias for -tty. When none have been given, XEmacs checks for other parameters implying particular device types (-t -> tty, -display -> x [or should it have same treatment as DISPLAY below?]), and has ad-hoc logic afterwards: if env var DISPLAY is set, use x (or gtk? perhaps should check whether gnome is running), else MS Windows if it exsits, else TTY if it exists, else stream, and you must be running in batch mode. This also fixes an existing bug whereby compiling with no x, no mswin, no tty, when running non- interactively (e.g. to dump) I get "sorry, must have TTY support". emacs.c: Turn on Vstack_trace_on_error so that errors are debuggable even when occurring extremely early in reinitialization. emacs.c: Try to make sure that the user can see message output under Windows (i.e. it doesn't just disappear right away) regardless of when it occurs, e.g. in the middle of creating the first frame. emacs.c: Define new function `emacs-run-status', indicating whether XEmacs is noninteractive or interactive, whether raw, post-dump/pdump-load or run-temacs, whether we are dumping, whether pdump is in effect. event-stream.c: It's "mommas are fat", not "momas are fat". Fix other typo. event-stream.c: Conditionalize in_menu_callback check on HAVE_MENUBARS, because it won't exist on w/o menubar support, lisp.h: More hackery on RETURN_NOT_REACHED. Cygwin v3.2 DOES complain here if RETURN_NOT_REACHED() is blank, as it is for GCC 2.5+. So make it blank only for GCC 2.5 through 2.999999999999999. Declare Vstack_trace_on_error. profile.c: Need to include "profile.h" to fix warnings. sheap.c: Don't fatal() when need to rerun Make, just stderr_out() and exit(0). That way we can distinguish between a dumping failing expectedly (due to lack of stack space, triggering another dump) and unexpectedly, in which case, we want to stop building. (or go on, if -K is given) syntax.c, syntax.h: Use ints where they belong, and enum syntaxcode's where they belong, and fix warnings thereby. syntax.h: Fix crash caused by an edge condition in the syntax-cache macros. text.h: Spacing fixes. xmotif.h: New file, to get around shadowing warnings. EmacsManager.c, event-Xt.c, glyphs-x.c, gui-x.c, input-method-motif.c, xmmanagerp.h, xmprimitivep.h: Include xmotif.h. alloc.c: Conditionalize in_malloc on ERROR_CHECK_MALLOC. config.h.in, file-coding.h, fileio.c, getloadavg.c, select-x.c, signal.c, sysdep.c, sysfile.h, systime.h, text.c, unicode.c: Eliminate HAVE_WIN32_CODING_SYSTEMS, use WIN32_ANY instead. Replace defined (WIN32_NATIVE) || defined (CYGWIN) with WIN32_ANY. lisp.h: More futile attempts to walk and chew gum at the same time when dealing with subr's that don't return.
author ben
date Thu, 20 Feb 2003 08:19:44 +0000
parents 79c6ff3eef26
children a8d8f419b459
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"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
30 #include "device-impl.h"
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
31 #include "frame-impl.h"
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
32 #include "opaque.h"
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
33 #include "select.h"
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
34
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
35 #include "console-x-impl.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 #include "objects-x.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 #include "systime.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 int lisp_to_time (Lisp_Object, time_t *);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 Lisp_Object time_to_lisp (time_t);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 #ifdef LWLIB_USES_MOTIF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 # define MOTIF_CLIPBOARDS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #ifdef MOTIF_CLIPBOARDS
1315
70921960b980 [xemacs-hg @ 2003-02-20 08:19:28 by ben]
ben
parents: 872
diff changeset
48 # include "xmotif.h"
70921960b980 [xemacs-hg @ 2003-02-20 08:19:28 by ben]
ben
parents: 872
diff changeset
49 /* Kludge around shadowing warnings */
70921960b980 [xemacs-hg @ 2003-02-20 08:19:28 by ben]
ben
parents: 872
diff changeset
50 # define index index_
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 # include <Xm/CutPaste.h>
1315
70921960b980 [xemacs-hg @ 2003-02-20 08:19:28 by ben]
ben
parents: 872
diff changeset
52 # undef index
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 static void hack_motif_clipboard_selection (Atom selection_atom,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 Lisp_Object selection_value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 Time thyme, Display *display,
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
56 Window selecting_window,
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
57 int owned_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 #define CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 Lisp_Object Vx_sent_selection_hooks;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 /* 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
70 emacs will use INCR selection transfer when the selection is larger
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 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
72 emacs to use incremental selection transfers when the selection is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 smaller than that, set this. I added this mostly for debugging the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 incremental transfer stuff, but it might improve server performance.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 #define MAX_SELECTION_QUANTUM 0xFFFFFF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize (dpy) << 2) - 100)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 /* 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
81 we give up on it. This is in seconds (0 = no timeout).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 */
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 456
diff changeset
83 Fixnum x_selection_timeout;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
85 /* Enable motif selection optimizations. */
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
86 int x_selection_strict_motif_ownership;
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
87
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 /* Utility functions */
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 Lisp_Object x_get_window_property_as_lisp_data (Display *,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 Window,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 Atom property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 Lisp_Object target_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 Atom selection_atom);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 static int expect_property_change (Display *, Window, Atom prop, int state);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 static void wait_for_property_change (long);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 static void unexpect_property_change (int);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 static int waiting_for_other_props_on_window (Display *, Window);
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 /* This converts a Lisp symbol to a server Atom, avoiding a server
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 roundtrip whenever possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 static Atom
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 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
107 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 if (NILP (sym)) return XA_PRIMARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 if (EQ (sym, Qt)) return XA_SECONDARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 if (EQ (sym, QPRIMARY)) return XA_PRIMARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 if (EQ (sym, QSTRING)) return XA_STRING;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 if (EQ (sym, QINTEGER)) return XA_INTEGER;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 if (EQ (sym, QATOM)) return XA_ATOM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 if (EQ (sym, QCLIPBOARD)) return DEVICE_XATOM_CLIPBOARD (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 if (EQ (sym, QTIMESTAMP)) return DEVICE_XATOM_TIMESTAMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 if (EQ (sym, QTEXT)) return DEVICE_XATOM_TEXT (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 if (EQ (sym, QDELETE)) return DEVICE_XATOM_DELETE (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 if (EQ (sym, QMULTIPLE)) return DEVICE_XATOM_MULTIPLE (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 if (EQ (sym, QINCR)) return DEVICE_XATOM_INCR (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 if (EQ (sym, QEMACS_TMP)) return DEVICE_XATOM_EMACS_TMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 if (EQ (sym, QTARGETS)) return DEVICE_XATOM_TARGETS (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 if (EQ (sym, QNULL)) return DEVICE_XATOM_NULL (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 if (EQ (sym, QATOM_PAIR)) return DEVICE_XATOM_ATOM_PAIR (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 if (EQ (sym, QCOMPOUND_TEXT)) return DEVICE_XATOM_COMPOUND_TEXT (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 #endif /* CUT_BUFFER_SUPPORT */
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 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
141 const Extbyte *nameext;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
142 LISP_STRING_TO_EXTERNAL (Fsymbol_name (sym), nameext, Qctext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 return XInternAtom (display, nameext, only_if_exists ? True : False);
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146
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 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 and calls to intern whenever possible.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 x_atom_to_symbol (struct device *d, Atom atom)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 if (! atom) return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 if (atom == XA_PRIMARY) return QPRIMARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 if (atom == XA_SECONDARY) return QSECONDARY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 if (atom == XA_STRING) return QSTRING;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 if (atom == XA_INTEGER) return QINTEGER;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 if (atom == XA_ATOM) return QATOM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 if (atom == DEVICE_XATOM_CLIPBOARD (d)) return QCLIPBOARD;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 if (atom == DEVICE_XATOM_TIMESTAMP (d)) return QTIMESTAMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 if (atom == DEVICE_XATOM_TEXT (d)) return QTEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 if (atom == DEVICE_XATOM_DELETE (d)) return QDELETE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 if (atom == DEVICE_XATOM_MULTIPLE (d)) return QMULTIPLE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 if (atom == DEVICE_XATOM_INCR (d)) return QINCR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 if (atom == DEVICE_XATOM_EMACS_TMP (d)) return QEMACS_TMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 if (atom == DEVICE_XATOM_TARGETS (d)) return QTARGETS;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 if (atom == DEVICE_XATOM_NULL (d)) return QNULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 if (atom == DEVICE_XATOM_ATOM_PAIR (d)) return QATOM_PAIR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 if (atom == DEVICE_XATOM_COMPOUND_TEXT (d)) return QCOMPOUND_TEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 if (atom == XA_CUT_BUFFER0) return QCUT_BUFFER0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 if (atom == XA_CUT_BUFFER1) return QCUT_BUFFER1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 if (atom == XA_CUT_BUFFER2) return QCUT_BUFFER2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 if (atom == XA_CUT_BUFFER3) return QCUT_BUFFER3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 if (atom == XA_CUT_BUFFER4) return QCUT_BUFFER4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 if (atom == XA_CUT_BUFFER5) return QCUT_BUFFER5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 if (atom == XA_CUT_BUFFER6) return QCUT_BUFFER6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 if (atom == XA_CUT_BUFFER7) return QCUT_BUFFER7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 863
diff changeset
186 Ibyte *intstr;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
187 Extbyte *str = XGetAtomName (display, atom);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 if (! str) return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
191 TO_INTERNAL_FORMAT (C_STRING, str,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
192 C_STRING_ALLOCA, intstr,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
193 Qctext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 XFree (str);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
195 return intern_int (intstr);
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
199 #define PROCESSING_X_CODE
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
200 #include "select-common.h"
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
201 #undef PROCESSING_X_CODE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 /* Do protocol to assert ourself as a selection owner.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
206 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
207 Lisp_Object how_to_add, Lisp_Object selection_type,
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
208 int owned_p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 struct frame *sel_frame = selected_frame ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 Window selecting_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 Lisp_Object selection_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 /* Use the time of the last-read mouse or keyboard event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 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
217 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
218 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
219 selection, which is probably true.
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 Time thyme = DEVICE_X_MOUSE_TIMESTAMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 Atom selection_atom;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 CHECK_SYMBOL (selection_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 selection_atom = symbol_to_x_atom (d, selection_name, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 XSetSelectionOwner (display, selection_atom, selecting_window, thyme);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 /* 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
230 That assumed equivalence of time_t and Time, which is not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 necessarily the case (e.g. under OSF on the Alphas, where
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 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
233
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 Opaque pointers are the clean way to go here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
236 selection_time = make_opaque (&thyme, sizeof (thyme));
428
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 #ifdef MOTIF_CLIPBOARDS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 hack_motif_clipboard_selection (selection_atom, selection_value,
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
240 thyme, display, selecting_window, owned_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 return selection_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 }
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 #ifdef MOTIF_CLIPBOARDS /* Bend over baby. Take it and like it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 static void motif_clipboard_cb ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 # endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 hack_motif_clipboard_selection (Atom selection_atom,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 Lisp_Object selection_value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 Time thyme,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 Display *display,
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
256 Window selecting_window,
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
257 int owned_p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 struct device *d = get_device_from_display (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 /* 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
261 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
262 this so that linked-in Motif widgets don't get themselves wedged.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 if (selection_atom == DEVICE_XATOM_CLIPBOARD (d)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 && STRINGP (selection_value)
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 /* 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
268 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
269 be current, but owning the selection on the Motif way does a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 SHITLOAD of X protocol, and it makes killing text be incredibly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 slow when using an X terminal. ARRRRGGGHHH!!!!
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 /* 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
274 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
275 into a text field, then Copy something else from the buffer and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 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
277 && (!owned_p
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
278 /* Selectively re-enable this because for most users its
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
279 just too painful - especially over a remote link. */
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
280 || x_selection_strict_motif_ownership)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 Widget widget = FRAME_X_TEXT_WIDGET (selected_frame());
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 long itemid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 #if XmVersion >= 1002
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 long dataid;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 int dataid; /* 1.2 wants long, but 1.1.5 wants int... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 XmString fmh;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 String encoding = "STRING";
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 863
diff changeset
294 const Ibyte *data = XSTRING_DATA (selection_value);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
295 Bytecount bytes = XSTRING_LENGTH (selection_value);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 863
diff changeset
300 const Ibyte *ptr = data, *end = ptr + bytes;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 /* Optimize for the common ASCII case */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 while (ptr <= end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
304 if (byte_ascii_p (*ptr))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 (*ptr) == LEADING_BYTE_CONTROL_1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 chartypes = LATIN_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 ptr += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 chartypes = WORLD;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 if (chartypes == LATIN_1)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
323 TO_EXTERNAL_FORMAT (LISP_STRING, selection_value,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
324 ALLOCA, (data, bytes),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
325 Qbinary);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 else if (chartypes == WORLD)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
328 TO_EXTERNAL_FORMAT (LISP_STRING, selection_value,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
329 ALLOCA, (data, bytes),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
330 Qctext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 encoding = "COMPOUND_TEXT";
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 fmh = XmStringCreateLtoR ("Clipboard", XmSTRING_DEFAULT_CHARSET);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 while (ClipboardSuccess !=
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 XmClipboardStartCopy (display, selecting_window, fmh, thyme,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 widget, motif_clipboard_cb,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 0, NULL,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 &itemid))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 XmStringFree (fmh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 while (ClipboardSuccess !=
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 XmClipboardCopy (display, selecting_window, itemid, encoding,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 /* O'Reilly examples say size can be 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 but this clearly is not the case. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 0, bytes, (int) selecting_window, /* private id */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 #else /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 (XtPointer) data, bytes, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 #endif /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 &dataid))
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 while (ClipboardSuccess !=
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 XmClipboardEndCopy (display, selecting_window, itemid))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 /* 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
366 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
367 work at all unless the selection owner and requestor are in different
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 processes. From reading the Motif source, it looks like they never
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 even considered having two widgets in the same application transfer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 data between each other using "by-name" clipboard values. What a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 bunch of fuckups.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 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
375 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 switch (*reason)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 case XmCR_CLIPBOARD_DATA_REQUEST:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 Display *dpy = XtDisplay (widget);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 Window window = (Window) *private_id;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
382 Lisp_Object selection = select_convert_out (QCLIPBOARD, Qnil, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
383
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
384 /* Whichever lazy git wrote this originally just called abort()
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
385 when anything didn't go their way... */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
386
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
387 /* Try some other text types */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
388 if (NILP (selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
389 selection = select_convert_out (QCLIPBOARD, QSTRING, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
390 if (NILP (selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
391 selection = select_convert_out (QCLIPBOARD, QTEXT, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
392 if (NILP (selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
393 selection = select_convert_out (QCLIPBOARD, QCOMPOUND_TEXT, Qnil);
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 (CONSP (selection) && SYMBOLP (XCAR (selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
396 && (EQ (XCAR (selection), QSTRING)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
397 || EQ (XCAR (selection), QTEXT)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
398 || EQ (XCAR (selection), QCOMPOUND_TEXT)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
399 selection = XCDR (selection);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
400
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
401 if (NILP (selection))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
402 signal_error (Qselection_conversion_error, "no selection",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
403 Qunbound);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
404
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
405 if (!STRINGP (selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
406 signal_error (Qselection_conversion_error,
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
407 "couldn't convert selection to string", Qunbound);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
408
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
409
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 XmClipboardCopyByName (dpy, window, *data_id,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 (char *) XSTRING_DATA (selection),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 XSTRING_LENGTH (selection) + 1,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 0);
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 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 case XmCR_CLIPBOARD_DATA_DELETE:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 /* don't need to free anything */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 break;
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 # endif /* MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 #endif /* MOTIF_CLIPBOARDS */
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426
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 /* Send a SelectionNotify event to the requestor with property=None, meaning
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 we were unable to do what they wanted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 x_decline_selection_request (XSelectionRequestEvent *event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 XSelectionEvent reply;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 reply.type = SelectionNotify;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 reply.display = event->display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 reply.requestor = event->requestor;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 reply.selection = event->selection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 reply.time = event->time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 reply.target = event->target;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 reply.property = None;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 XFlush (reply.display);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 /* 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
449 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
450 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
451 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 x_selection_request_lisp_error (Lisp_Object closure)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 XSelectionRequestEvent *event = (XSelectionRequestEvent *)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 get_opaque_ptr (closure);
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 free_opaque_ptr (closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 if (event->type == 0) /* we set this to mean "completed normally" */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 x_decline_selection_request (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 /* 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
467 requestor wants it. Then tell them whether we've succeeded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 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
471 UChar_Binary *data, Bytecount size, Atom type)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 XSelectionEvent reply;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 Display *display = event->display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 struct device *d = get_device_from_display (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 Window window = event->requestor;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
478 Bytecount bytes_remaining;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 int format_bytes = format/8;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
480 Bytecount max_bytes = SELECTION_QUANTUM (display);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 reply.type = SelectionNotify;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 reply.display = display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 reply.requestor = window;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 reply.selection = event->selection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 reply.time = event->time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 reply.target = event->target;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 reply.property = (event->property == None ? event->target : event->property);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
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 /* Store the data on the requested property.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 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
495 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 bytes_remaining = size * format_bytes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 if (bytes_remaining <= max_bytes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 /* Send all the data at once, with minimal handshaking. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 stderr_out ("\nStoring all %d\n", bytes_remaining);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 XChangeProperty (display, window, reply.property, type, format,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 PropModeReplace, data, size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 /* At this point, the selection was successfully stored; ack it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 XFlush (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 /* Send an INCR selection. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 int prop_id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 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
515 invalid_operation ("attempt to transfer an INCR to ourself!", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 stderr_out ("\nINCR %d\n", bytes_remaining);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 prop_id = expect_property_change (display, window, reply.property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 PropertyDelete);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 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
523 32, PropModeReplace, (UChar_Binary *)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 &bytes_remaining, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 XSelectInput (display, window, PropertyChangeMask);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 /* Tell 'em the INCR data is there... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 XFlush (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 /* First, wait for the requestor to ack by deleting the property.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 This can run random lisp code (process handlers) or signal.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 wait_for_property_change (prop_id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 while (bytes_remaining)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
537 Bytecount i = ((bytes_remaining < max_bytes)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 ? bytes_remaining
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 : max_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 prop_id = expect_property_change (display, window, reply.property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 PropertyDelete);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 stderr_out (" INCR adding %d\n", i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 /* Append the next chunk of data to the property. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 XChangeProperty (display, window, reply.property, type, format,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 PropModeAppend, data, i / format_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 bytes_remaining -= i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 data += i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 /* Now wait for the requestor to ack this chunk by deleting the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 property. This can run random lisp code or signal.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 wait_for_property_change (prop_id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 /* 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
557 that we're done. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 stderr_out (" INCR done\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 if (! waiting_for_other_props_on_window (display, window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 XSelectInput (display, window, 0L);
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 XChangeProperty (display, window, reply.property, type, format,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 PropModeReplace, data, 0);
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 /* Called from the event-loop in response to a SelectionRequest event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 x_handle_selection_request (XSelectionRequestEvent *event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 /* This function can GC */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
577 struct gcpro gcpro1, gcpro2;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
578 Lisp_Object temp_obj;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 Lisp_Object selection_symbol;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 Lisp_Object target_symbol = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 Lisp_Object converted_selection = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 Time local_selection_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 Lisp_Object successful_p = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 int count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 struct device *d = get_device_from_display (event->display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
587 GCPRO2 (converted_selection, target_symbol);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 selection_symbol = x_atom_to_symbol (d, event->selection);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
590 target_symbol = x_atom_to_symbol (d, event->target);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
592 #if 0 /* #### MULTIPLE doesn't work yet */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
593 if (EQ (target_symbol, QMULTIPLE))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
594 target_symbol = fetch_multiple_target (event);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
597 temp_obj = Fget_selection_timestamp (selection_symbol);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
598
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
599 if (NILP (temp_obj))
428
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 /* We don't appear to have the selection. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 x_decline_selection_request (event);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
603
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 goto DONE_LABEL;
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
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
607 local_selection_time = * (Time *) XOPAQUE_DATA (temp_obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 if (event->time != CurrentTime &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 local_selection_time > event->time)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 /* 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
613 they're looking for. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 x_decline_selection_request (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 goto DONE_LABEL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
618 converted_selection = select_convert_out (selection_symbol,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
619 target_symbol, Qnil);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
620
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
621 /* #### 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
622 if (NILP (converted_selection))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
623 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
624 /* 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
625 x_decline_selection_request (event);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
626 goto DONE_LABEL;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
627 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
628
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 count = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 record_unwind_protect (x_selection_request_lisp_error,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 make_opaque_ptr (event));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
633 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
634 UChar_Binary *data;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
635 Bytecount size;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
636 int format;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
637 Atom type;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
638 lisp_data_to_selection_data (d, converted_selection,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
639 &data, &type, &size, &format);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
641 x_reply_selection_request (event, format, data, size, type);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
642 successful_p = Qt;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
643 /* Tell x_selection_request_lisp_error() it's cool. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
644 event->type = 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
645 xfree (data);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
646 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
647
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
648 unbind_to (count);
428
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 DONE_LABEL:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 /* Let random lisp code notice that the selection has been asked for. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 Lisp_Object val = Vx_sent_selection_hooks;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 if (!UNBOUNDP (val) && !NILP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
659 Lisp_Object rest;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 if (CONSP (val) && !EQ (XCAR (val), Qlambda))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 for (rest = val; !NILP (rest); rest = Fcdr (rest))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
662 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 else
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
664 call3 (val, selection_symbol, target_symbol, successful_p);
428
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 /* Called from the event-loop in response to a SelectionClear event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 x_handle_selection_clear (XSelectionClearEvent *event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 Display *display = event->display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 struct device *d = get_device_from_display (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 Atom selection = event->selection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 Time changed_owner_time = event->time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
680 Lisp_Object selection_symbol, local_selection_time_lisp;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 Time local_selection_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 selection_symbol = x_atom_to_symbol (d, selection);
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_lisp = Fget_selection_timestamp (selection_symbol);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
687 /* We don't own the selection, so that's fine. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
688 if (NILP (local_selection_time_lisp))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
689 return;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
691 local_selection_time = * (Time *) XOPAQUE_DATA (local_selection_time_lisp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 /* 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
694 disregard it. (That is, we have reasserted the selection since this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 request was generated.)
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 if (changed_owner_time != CurrentTime &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 local_selection_time > changed_owner_time)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 return;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
700
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 handle_selection_clear (selection_symbol);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 /* 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
706 be servicing multiple INCR selection requests simultaneously). I haven't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 actually tested that yet.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 static int prop_location_tick;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 static struct prop_location {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 int tick;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 Display *display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 Window window;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 Atom property;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 int desired_state;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 struct prop_location *next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 } *for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 property_deleted_p (void *tick)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 struct prop_location *rest = for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 while (rest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 if (rest->tick == (long) tick)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 rest = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 waiting_for_other_props_on_window (Display *display, Window window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 struct prop_location *rest = for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 while (rest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 if (rest->display == display && rest->window == window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 rest = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 return 0;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 expect_property_change (Display *display, Window window,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 Atom property, int state)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 struct prop_location *pl = xnew (struct prop_location);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 pl->tick = ++prop_location_tick;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 pl->display = display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 pl->window = window;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 pl->property = property;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 pl->desired_state = state;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 pl->next = for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 for_whom_the_bell_tolls = pl;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 return pl->tick;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 }
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 unexpect_property_change (int tick)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 while (rest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 if (rest->tick == tick)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 if (prev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 prev->next = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 for_whom_the_bell_tolls = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 xfree (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 prev = rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 rest = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 }
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 wait_for_property_change (long tick)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 wait_delaying_user_input (property_deleted_p, (void *) tick);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 /* Called from the event-loop in response to a PropertyNotify event.
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 x_handle_property_notify (XPropertyEvent *event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 while (rest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 if (rest->property == event->atom &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 rest->window == event->window &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 rest->display == event->display &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 rest->desired_state == event->state)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 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
805 (event->state == PropertyDelete ? "delete" : "change"),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
806 XSTRING_DATA
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
807 (XSYMBOL (x_atom_to_symbol
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
808 (get_device_from_display (event->display),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
809 event->atom))->name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 if (prev)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 prev->next = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 for_whom_the_bell_tolls = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 xfree (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 prev = rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 rest = rest->next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 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
823 (event->state == PropertyDelete ? "delete" : "change"),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
824 XSTRING_DATA (XSYMBOL (x_atom_to_symbol
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
825 (get_device_from_display (event->display),
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
826 event->atom))->name));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 #if 0 /* #### MULTIPLE doesn't work yet */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 fetch_multiple_target (XSelectionRequestEvent *event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 Display *display = event->display;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 Window window = event->requestor;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 Atom target = event->target;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 Atom selection_atom = event->selection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 int result;
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 return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 Fcons (QMULTIPLE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 x_get_window_property_as_lisp_data (display, window, target,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 QMULTIPLE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 selection_atom));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 copy_multiple_data (Lisp_Object 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 Lisp_Object vec;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
855 Elemcount i;
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
856 Elemcount len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 if (CONSP (obj))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 CHECK_VECTOR (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 len = XVECTOR_LENGTH (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 vec = make_vector (len, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 for (i = 0; i < len; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 Lisp_Object vec2 = XVECTOR_DATA (obj) [i];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 CHECK_VECTOR (vec2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 if (XVECTOR_LENGTH (vec2) != 2)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
868 sferror ("vectors must be of length 2", vec2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 XVECTOR_DATA (vec) [i] = make_vector (2, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [0] = XVECTOR_DATA (vec2) [0];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [1] = XVECTOR_DATA (vec2) [1];
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 return vec;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 static Window reading_selection_reply;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 static Atom reading_which_selection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 static int selection_reply_timed_out;
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 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 selection_reply_done (void *ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 return !reading_selection_reply;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 static Lisp_Object Qx_selection_reply_timeout_internal;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 DEFUN ("x-selection-reply-timeout-internal", Fx_selection_reply_timeout_internal,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 1, 1, 0, /*
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 (arg))
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 selection_reply_timed_out = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 reading_selection_reply = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900
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 /* Do protocol to read selection-data from the server.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 Converts this to lisp data and returns it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 struct frame *sel_frame = selected_frame ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 Window requestor_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 Time requestor_time = DEVICE_X_MOUSE_TIMESTAMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 Atom target_property = DEVICE_XATOM_EMACS_TMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 Atom selection_atom = symbol_to_x_atom (d, selection_symbol, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 int speccount;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 Atom type_atom = symbol_to_x_atom (d, (CONSP (target_type) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 XCAR (target_type) : target_type), 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 XConvertSelection (display, selection_atom, type_atom, target_property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 requestor_window, requestor_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 /* Block until the reply has been read. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 reading_selection_reply = requestor_window;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 reading_which_selection = selection_atom;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 selection_reply_timed_out = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 /* add a timeout handler */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 if (x_selection_timeout > 0)
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 Lisp_Object id = Fadd_timeout (make_int (x_selection_timeout),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 Qx_selection_reply_timeout_internal,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 record_unwind_protect (Fdisable_timeout, id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 /* This is ^Gable */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 wait_delaying_user_input (selection_reply_done, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 if (selection_reply_timed_out)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
943 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
944
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
945 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 /* 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
948
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
949 return select_convert_in (selection_symbol,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
950 target_type,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
951 x_get_window_property_as_lisp_data(display,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
952 requestor_window,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
953 target_property,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
954 target_type,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
955 selection_atom));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 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
961 UChar_Binary **data_ret, Bytecount *bytes_ret,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 Atom *actual_type_ret, int *actual_format_ret,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 unsigned long *actual_size_ret, int delete_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
965 Bytecount total_size;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 unsigned long bytes_remaining;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
967 Bytecount offset = 0;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
968 UChar_Binary *tmp_data = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 int result;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
970 Bytecount buffer_size = SELECTION_QUANTUM (display);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 /* First probe the thing to find out how big it is. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 result = XGetWindowProperty (display, window, property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 0, 0, False, AnyPropertyType,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 actual_type_ret, actual_format_ret,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 actual_size_ret,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 &bytes_remaining, &tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 if (result != Success)
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 *data_ret = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 *bytes_ret = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 XFree ((char *) tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 if (*actual_type_ret == None || *actual_format_ret == 0)
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 if (delete_p) XDeleteProperty (display, window, property);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 *data_ret = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 *bytes_ret = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 }
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 total_size = bytes_remaining + 1;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
996 *data_ret = (UChar_Binary *) xmalloc (total_size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 /* Now read, until we've gotten it all. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 while (bytes_remaining)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 #if 0
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1002 Bytecount last = bytes_remaining;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 result =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 XGetWindowProperty (display, window, property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 offset/4, buffer_size/4,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 (delete_p ? True : False),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 AnyPropertyType,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 actual_type_ret, actual_format_ret,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 actual_size_ret, &bytes_remaining, &tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 stderr_out ("<< read %d\n", last-bytes_remaining);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 /* If this doesn't return Success at this point, it means that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 some clod deleted the selection while we were in the midst of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 reading it. Deal with that, I guess....
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 if (result != Success) break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 *actual_size_ret *= *actual_format_ret / 8;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 memcpy ((*data_ret) + offset, tmp_data, *actual_size_ret);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 offset += *actual_size_ret;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 XFree ((char *) tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 *bytes_ret = offset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 receive_incremental_selection (Display *display, Window window, Atom property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 /* this one is for error messages only */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 Lisp_Object target_type,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1032 Bytecount min_size_bytes,
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1033 UChar_Binary **data_ret,
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1034 Bytecount *size_bytes_ret,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 Atom *type_ret, int *format_ret,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 unsigned long *size_ret)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 /* This function can GC */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1039 Bytecount offset = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 int prop_id;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 *size_bytes_ret = min_size_bytes;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1042 *data_ret = (UChar_Binary *) xmalloc (*size_bytes_ret);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 stderr_out ("\nread INCR %d\n", min_size_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 /* 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
1047 is how we ack its receipt: the sending window will be selecting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 PropertyNotify events on our window to notice this).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 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
1051 that property, then reading the property, then deleting it to ack.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 We are done when the sender places a property of length 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 prop_id = expect_property_change (display, window, property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 PropertyNewValue);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1058 UChar_Binary *tmp_data;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1059 Bytecount tmp_size_bytes;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 wait_for_property_change (prop_id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 /* expect it again immediately, because x_get_window_property may
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 .. no it won't, I don't get it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 .. 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
1064 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 prop_id = expect_property_change (display, window, property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 PropertyNewValue);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 x_get_window_property (display, window, property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 &tmp_data, &tmp_size_bytes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 type_ret, format_ret, size_ret, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 if (tmp_size_bytes == 0) /* we're done */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 stderr_out (" read INCR done\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 unexpect_property_change (prop_id);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 if (tmp_data) xfree (tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 stderr_out (" read INCR %d\n", 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 if (*size_bytes_ret < offset + tmp_size_bytes)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 stderr_out (" read INCR realloc %d -> %d\n",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 *size_bytes_ret, offset + tmp_size_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 *size_bytes_ret = offset + tmp_size_bytes;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1090 *data_ret = (UChar_Binary *) xrealloc (*data_ret, *size_bytes_ret);
428
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 memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 offset += tmp_size_bytes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 xfree (tmp_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 x_get_window_property_as_lisp_data (Display *display,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 Window window,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 Atom property,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 /* next two for error messages only */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 Lisp_Object target_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 Atom selection_atom)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 Atom actual_type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 int actual_format;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 unsigned long actual_size;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1111 UChar_Binary *data = NULL;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1112 Bytecount bytes = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 struct device *d = get_device_from_display (display);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 x_get_window_property (display, window, property, &data, &bytes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 &actual_type, &actual_format, &actual_size, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 if (! data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 if (XGetSelectionOwner (display, selection_atom))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 /* there is a selection owner */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1122 signal_error (Qselection_conversion_error,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1123 "selection owner couldn't convert",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1124 Fcons (Qunbound,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1125 Fcons (x_atom_to_symbol (d, selection_atom),
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1126 actual_type ?
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1127 list2 (target_type,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1128 x_atom_to_symbol (d, actual_type)) :
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1129 list1 (target_type))));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1131 signal_error (Qselection_conversion_error,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1132 "no selection",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1133 x_atom_to_symbol (d, selection_atom));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 if (actual_type == DEVICE_XATOM_INCR (d))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 /* Ok, that data wasn't *the* data, it was just the beginning. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1140 Bytecount min_size_bytes =
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1141 /* careful here. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1142 (Bytecount) (* ((unsigned int *) data));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 xfree (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 receive_incremental_selection (display, window, property, target_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 min_size_bytes, &data, &bytes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 &actual_type, &actual_format,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 &actual_size);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 /* 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
1151 manner. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 val = selection_data_to_lisp_data (d, data, bytes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 actual_type, actual_format);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 xfree (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158
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 /* Called from the event loop to handle SelectionNotify events.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 I don't think this needs to be reentrant.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 x_handle_selection_notify (XSelectionEvent *event)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 if (! reading_selection_reply)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 message ("received an unexpected SelectionNotify event");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 else if (event->requestor != reading_selection_reply)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 message ("received a SelectionNotify event for the wrong window");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 else if (event->selection != reading_which_selection)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 message ("received the wrong selection type in SelectionNotify!");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 reading_selection_reply = 0; /* we're done now. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 x_disown_selection (Lisp_Object selection, Lisp_Object timeval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 Time timestamp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 Atom selection_atom;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 CHECK_SYMBOL (selection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 if (NILP (timeval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 timestamp = DEVICE_X_MOUSE_TIMESTAMP (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 /* #### This is bogus. See the comment above about problems
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 on OSF/1 and DEC Alphas. Yet another reason why it sucks
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 to have the implementation (i.e. cons of two 16-bit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 integers) exposed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 time_t the_time;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 lisp_to_time (timeval, &the_time);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 timestamp = (Time) the_time;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 selection_atom = symbol_to_x_atom (d, selection, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 XSetSelectionOwner (display, selection_atom, None, timestamp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1204 x_selection_exists_p (Lisp_Object selection,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1205 Lisp_Object selection_type)
428
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 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 Display *dpy = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 return XGetSelectionOwner (dpy, symbol_to_x_atom (d, selection, 0)) != None ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 Qt : Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 static int cut_buffers_initialized; /* Whether we're sure they all exist */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 initialize_cut_buffers (Display *display, Window window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1222 static unsigned const char * const data = (unsigned const char *) "";
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 PropModeAppend, data, 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 FROB (XA_CUT_BUFFER0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 FROB (XA_CUT_BUFFER1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 FROB (XA_CUT_BUFFER2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 FROB (XA_CUT_BUFFER3);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 FROB (XA_CUT_BUFFER4);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 FROB (XA_CUT_BUFFER5);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 FROB (XA_CUT_BUFFER6);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 FROB (XA_CUT_BUFFER7);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 #undef FROB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 cut_buffers_initialized = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 #define CHECK_CUTBUFFER(symbol) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 CHECK_SYMBOL (symbol); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 if (! (EQ (symbol, QCUT_BUFFER0) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 EQ (symbol, QCUT_BUFFER1) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 EQ (symbol, QCUT_BUFFER2) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 EQ (symbol, QCUT_BUFFER3) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 EQ (symbol, QCUT_BUFFER4) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 EQ (symbol, QCUT_BUFFER5) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 EQ (symbol, QCUT_BUFFER6) || \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 EQ (symbol, QCUT_BUFFER7))) \
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1247 invalid_constant ("Doesn't name a cutbuffer", symbol); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 Return the value of the named CUTBUFFER (typically CUT_BUFFER0).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 (cutbuffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 Atom cut_buffer_atom;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1259 UChar_Binary *data;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1260 Bytecount bytes;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 Atom type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 int format;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 unsigned long size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 Lisp_Object ret;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 CHECK_CUTBUFFER (cutbuffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 x_get_window_property (display, window, cut_buffer_atom, &data, &bytes,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 &type, &format, &size, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 if (!data) return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 if (format != 8 || type != XA_STRING)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1274 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
1275 x_atom_to_symbol (d, type),
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1276 make_int (format));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 /* We cheat - if the string contains an ESC character, that's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 technically not allowed in a STRING, so we assume it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 COMPOUND_TEXT that we stored there ourselves earlier,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 in x-store-cutbuffer-internal */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 ret = (bytes ?
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1283 make_ext_string ((Extbyte *) data, bytes,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 memchr (data, 0x1b, bytes) ?
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1285 Qctext : Qbinary)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 : Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 xfree (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 return ret;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 Set the value of the named CUTBUFFER (typically CUT_BUFFER0) to STRING.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 (cutbuffer, string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 Atom cut_buffer_atom;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 863
diff changeset
1301 const Ibyte *data = XSTRING_DATA (string);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1302 Bytecount bytes = XSTRING_LENGTH (string);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1303 Bytecount bytes_remaining;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1304 Bytecount max_bytes = SELECTION_QUANTUM (display);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 #ifdef MULE
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 863
diff changeset
1306 const Ibyte *ptr, *end;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 if (max_bytes > MAX_SELECTION_QUANTUM)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 max_bytes = MAX_SELECTION_QUANTUM;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 CHECK_CUTBUFFER (cutbuffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 CHECK_STRING (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 if (! cut_buffers_initialized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 initialize_cut_buffers (display, window);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 /* 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
1321 We cheat and use type = `STRING' even when using COMPOUND_TEXT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 The ICCCM requires that this be so, and other clients assume it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 as we do ourselves in initialize_cut_buffers. */
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 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 /* Optimize for the common ASCII case */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 for (ptr = data, end = ptr + bytes; ptr <= end; )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
1329 if (byte_ascii_p (*ptr))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 (*ptr) == LEADING_BYTE_CONTROL_1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 chartypes = LATIN_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 ptr += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 continue;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 chartypes = WORLD;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 if (chartypes == LATIN_1)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1348 TO_EXTERNAL_FORMAT (LISP_STRING, string,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1349 ALLOCA, (data, bytes),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1350 Qbinary);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 else if (chartypes == WORLD)
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1352 TO_EXTERNAL_FORMAT (LISP_STRING, string,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1353 ALLOCA, (data, bytes),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1354 Qctext);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 bytes_remaining = bytes;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 while (bytes_remaining)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1361 Bytecount chunk =
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
1362 bytes_remaining < max_bytes ? bytes_remaining : max_bytes;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 XChangeProperty (display, window, cut_buffer_atom, XA_STRING, 8,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 (bytes_remaining == bytes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 ? PropModeReplace : PropModeAppend),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 data, chunk);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 data += chunk;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 bytes_remaining -= chunk;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 return string;
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
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 DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 Rotate the values of the cutbuffers by the given number of steps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 positive means move values forward, negative means backward.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 (n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 struct device *d = decode_x_device (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 Display *display = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 Atom props [8];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 CHECK_INT (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 if (XINT (n) == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 return n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 if (! cut_buffers_initialized)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 initialize_cut_buffers (display, window);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 props[0] = XA_CUT_BUFFER0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 props[1] = XA_CUT_BUFFER1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392 props[2] = XA_CUT_BUFFER2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 props[3] = XA_CUT_BUFFER3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 props[4] = XA_CUT_BUFFER4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 props[5] = XA_CUT_BUFFER5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 props[6] = XA_CUT_BUFFER6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 props[7] = XA_CUT_BUFFER7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 XRotateWindowProperties (display, window, props, 8, XINT (n));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 return n;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 #endif /* CUT_BUFFER_SUPPORT */
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405
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 /* initialization */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1411 syms_of_select_x (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 {
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 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 DEFSUBR (Fx_get_cutbuffer_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 DEFSUBR (Fx_store_cutbuffer_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 DEFSUBR (Fx_rotate_cutbuffers_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 #endif /* CUT_BUFFER_SUPPORT */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 /* Unfortunately, timeout handlers must be lisp functions. */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1421 DEFSYMBOL (Qx_selection_reply_timeout_internal);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 DEFSUBR (Fx_selection_reply_timeout_internal);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 defsymbol (&QCUT_BUFFER0, "CUT_BUFFER0");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 defsymbol (&QCUT_BUFFER1, "CUT_BUFFER1");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 defsymbol (&QCUT_BUFFER2, "CUT_BUFFER2");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 defsymbol (&QCUT_BUFFER3, "CUT_BUFFER3");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 defsymbol (&QCUT_BUFFER4, "CUT_BUFFER4");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 defsymbol (&QCUT_BUFFER5, "CUT_BUFFER5");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 defsymbol (&QCUT_BUFFER6, "CUT_BUFFER6");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 defsymbol (&QCUT_BUFFER7, "CUT_BUFFER7");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 #endif /* CUT_BUFFER_SUPPORT */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 console_type_create_select_x (void)
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 CONSOLE_HAS_METHOD (x, own_selection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 CONSOLE_HAS_METHOD (x, disown_selection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 CONSOLE_HAS_METHOD (x, get_foreign_selection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 CONSOLE_HAS_METHOD (x, selection_exists_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1446 reinit_vars_of_select_x (void)
428
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 reading_selection_reply = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 reading_which_selection = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 selection_reply_timed_out = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 for_whom_the_bell_tolls = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 prop_location_tick = 0;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1456 vars_of_select_x (void)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1458 reinit_vars_of_select_x ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 #ifdef CUT_BUFFER_SUPPORT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 cut_buffers_initialized = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 Fprovide (intern ("cut-buffer"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 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
1467 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
1468 function(s) will be called with four arguments:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 - 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
1471 selection into before sending (for example, STRING or LENGTH);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 - and whether we successfully transmitted the selection.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 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
1474 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
1475 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
1476 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
1477 it merely informs you that they have happened.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 Vx_sent_selection_hooks = Qunbound;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 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
1483 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
1484 \"*selectionTimeout\" resource (which is expressed in milliseconds).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 x_selection_timeout = 0;
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1487
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1488 DEFVAR_BOOL ("x-selection-strict-motif-ownership", &x_selection_strict_motif_ownership /*
863
42375619fa45 [xemacs-hg @ 2002-06-04 06:03:59 by andyp]
andyp
parents: 826
diff changeset
1489 *If nil and XEmacs already owns the clipboard, don't own it again in the
456
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1490 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
1491 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
1492 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
1493 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
1494 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
1495 text field; it pastes the first thing again.
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1496 */ );
e7ef97881643 Import from CVS: tag r21-2-43
cvs
parents: 444
diff changeset
1497 x_selection_strict_motif_ownership = 1;
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1501 Xatoms_of_select_x (struct device *d)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 Display *D = DEVICE_X_DISPLAY (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 /* Non-predefined atoms that we might end up using a lot */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 DEVICE_XATOM_CLIPBOARD (d) = XInternAtom (D, "CLIPBOARD", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 DEVICE_XATOM_TIMESTAMP (d) = XInternAtom (D, "TIMESTAMP", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 DEVICE_XATOM_TEXT (d) = XInternAtom (D, "TEXT", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 DEVICE_XATOM_DELETE (d) = XInternAtom (D, "DELETE", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 DEVICE_XATOM_MULTIPLE (d) = XInternAtom (D, "MULTIPLE", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 DEVICE_XATOM_INCR (d) = XInternAtom (D, "INCR", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 DEVICE_XATOM_TARGETS (d) = XInternAtom (D, "TARGETS", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 DEVICE_XATOM_NULL (d) = XInternAtom (D, "NULL", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 DEVICE_XATOM_ATOM_PAIR (d) = XInternAtom (D, "ATOM_PAIR", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 DEVICE_XATOM_COMPOUND_TEXT (d) = XInternAtom (D, "COMPOUND_TEXT", False);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1516
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1517 /* #### 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
1518 DEVICE_XATOM_EMACS_TMP (d) = XInternAtom (D, "_EMACS_TMP_", False);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 }