annotate src/xselect.c @ 14570:ca1ee2b8394e

(hanoi): Don't show line and column numbers. Compute height and width of the window in the correct way, give the correct error message if the window is too small. Make rings only with numerical characters. Set default number of rings to 7 (was 3 before).
author Karl Heuer <kwzh@gnu.org>
date Fri, 16 Feb 1996 00:12:27 +0000
parents 81c67c7d1655
children 335aa5c3ce34
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
9617
3ea6ce042453 Log omitted from previous checkin:
Richard M. Stallman <rms@gnu.org>
parents: 9616
diff changeset
1 /* X Selection processing for Emacs.
14372
81c67c7d1655 (xfree): Macro deleted.
Richard M. Stallman <rms@gnu.org>
parents: 14371
diff changeset
2 Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation.
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
3
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
4 This file is part of GNU Emacs.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
5
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
6 GNU Emacs is free software; you can redistribute it and/or modify
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
7 it under the terms of the GNU General Public License as published by
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
8 the Free Software Foundation; either version 2, or (at your option)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
9 any later version.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
10
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
11 GNU Emacs is distributed in the hope that it will be useful,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
14 GNU General Public License for more details.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
15
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
16 You should have received a copy of the GNU General Public License
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
17 along with GNU Emacs; see the file COPYING. If not, write to
14186
ee40177f6c68 Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents: 14134
diff changeset
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
ee40177f6c68 Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents: 14134
diff changeset
19 Boston, MA 02111-1307, USA. */
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
20
2961
e94a593c3952 Updated copyright years.
Jim Blandy <jimb@redhat.com>
parents: 2797
diff changeset
21
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
22 /* Rewritten by jwz */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
23
4696
1fc792473491 Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents: 4636
diff changeset
24 #include <config.h>
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
25 #include "lisp.h"
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
26 #include "xterm.h" /* for all of the X includes */
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
27 #include "dispextern.h" /* frame.h seems to want this */
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
28 #include "frame.h" /* Need this to get the X window of selected_frame */
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2372
diff changeset
29 #include "blockinput.h"
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
30
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
31 #define CUT_BUFFER_SUPPORT
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
32
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
33 Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
34 QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
35 QATOM_PAIR;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
36
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
37 #ifdef CUT_BUFFER_SUPPORT
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
38 Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
39 QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
40 #endif
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
41
11702
afad0099d14b (Vx_sent_selection_hooks, Vx_lost_selection_hooks, Vselection_alist)
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
42 static Lisp_Object Vx_lost_selection_hooks;
afad0099d14b (Vx_sent_selection_hooks, Vx_lost_selection_hooks, Vselection_alist)
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
43 static Lisp_Object Vx_sent_selection_hooks;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
44
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
45 /* If this is a smaller number than the max-request-size of the display,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
46 emacs will use INCR selection transfer when the selection is larger
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
47 than this. The max-request-size is usually around 64k, so if you want
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
48 emacs to use incremental selection transfers when the selection is
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
49 smaller than that, set this. I added this mostly for debugging the
11702
afad0099d14b (Vx_sent_selection_hooks, Vx_lost_selection_hooks, Vselection_alist)
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
50 incremental transfer stuff, but it might improve server performance. */
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
51 #define MAX_SELECTION_QUANTUM 0xFFFFFF
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
52
2372
ad7cb938ae08 * xselect.c (SELECTION_QUANTUM): Don't use XMaxRequestSize on R3;
Jim Blandy <jimb@redhat.com>
parents: 2255
diff changeset
53 #ifdef HAVE_X11R4
ad7cb938ae08 * xselect.c (SELECTION_QUANTUM): Don't use XMaxRequestSize on R3;
Jim Blandy <jimb@redhat.com>
parents: 2255
diff changeset
54 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
ad7cb938ae08 * xselect.c (SELECTION_QUANTUM): Don't use XMaxRequestSize on R3;
Jim Blandy <jimb@redhat.com>
parents: 2255
diff changeset
55 #else
ad7cb938ae08 * xselect.c (SELECTION_QUANTUM): Don't use XMaxRequestSize on R3;
Jim Blandy <jimb@redhat.com>
parents: 2255
diff changeset
56 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
ad7cb938ae08 * xselect.c (SELECTION_QUANTUM): Don't use XMaxRequestSize on R3;
Jim Blandy <jimb@redhat.com>
parents: 2255
diff changeset
57 #endif
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
58
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
59 /* The timestamp of the last input event Emacs received from the X server. */
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
60 unsigned long last_event_timestamp;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
61
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
62 /* This is an association list whose elements are of the form
8101
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
63 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
64 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
65 SELECTION-VALUE is the value that emacs owns for that selection.
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
66 It may be any kind of Lisp object.
8101
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
67 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
68 as a cons of two 16-bit numbers (making a 32 bit time.)
8101
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
69 FRAME is the frame for which we made the selection.
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
70 If there is an entry in this alist, then it can be assumed that Emacs owns
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
71 that selection.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
72 The only (eq) parts of this list that are visible from Lisp are the
11702
afad0099d14b (Vx_sent_selection_hooks, Vx_lost_selection_hooks, Vselection_alist)
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
73 selection-values. */
afad0099d14b (Vx_sent_selection_hooks, Vx_lost_selection_hooks, Vselection_alist)
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
74 static Lisp_Object Vselection_alist;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
75
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
76 /* This is an alist whose CARs are selection-types (whose names are the same
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
77 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
78 call to convert the given Emacs selection value to a string representing
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
79 the given selection type. This is for Lisp-level extension of the emacs
11702
afad0099d14b (Vx_sent_selection_hooks, Vx_lost_selection_hooks, Vselection_alist)
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
80 selection handling. */
afad0099d14b (Vx_sent_selection_hooks, Vx_lost_selection_hooks, Vselection_alist)
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
81 static Lisp_Object Vselection_converter_alist;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
82
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
83 /* If the selection owner takes too long to reply to a selection request,
11702
afad0099d14b (Vx_sent_selection_hooks, Vx_lost_selection_hooks, Vselection_alist)
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
84 we give up on it. This is in milliseconds (0 = no timeout.) */
afad0099d14b (Vx_sent_selection_hooks, Vx_lost_selection_hooks, Vselection_alist)
Richard M. Stallman <rms@gnu.org>
parents: 11235
diff changeset
85 static int x_selection_timeout;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
86
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
87 /* Utility functions */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
88
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
89 static void lisp_data_to_selection_data ();
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
90 static Lisp_Object selection_data_to_lisp_data ();
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
91 static Lisp_Object x_get_window_property_as_lisp_data ();
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
92
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
93 /* This converts a Lisp symbol to a server Atom, avoiding a server
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
94 roundtrip whenever possible. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
95
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
96 static Atom
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
97 symbol_to_x_atom (dpyinfo, display, sym)
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
98 struct x_display_info *dpyinfo;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
99 Display *display;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
100 Lisp_Object sym;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
101 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
102 Atom val;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
103 if (NILP (sym)) return 0;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
104 if (EQ (sym, QPRIMARY)) return XA_PRIMARY;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
105 if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
106 if (EQ (sym, QSTRING)) return XA_STRING;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
107 if (EQ (sym, QINTEGER)) return XA_INTEGER;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
108 if (EQ (sym, QATOM)) return XA_ATOM;
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
109 if (EQ (sym, QCLIPBOARD)) return dpyinfo->Xatom_CLIPBOARD;
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
110 if (EQ (sym, QTIMESTAMP)) return dpyinfo->Xatom_TIMESTAMP;
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
111 if (EQ (sym, QTEXT)) return dpyinfo->Xatom_TEXT;
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
112 if (EQ (sym, QDELETE)) return dpyinfo->Xatom_DELETE;
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
113 if (EQ (sym, QMULTIPLE)) return dpyinfo->Xatom_MULTIPLE;
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
114 if (EQ (sym, QINCR)) return dpyinfo->Xatom_INCR;
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
115 if (EQ (sym, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP;
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
116 if (EQ (sym, QTARGETS)) return dpyinfo->Xatom_TARGETS;
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
117 if (EQ (sym, QNULL)) return dpyinfo->Xatom_NULL;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
118 #ifdef CUT_BUFFER_SUPPORT
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
119 if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
120 if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
121 if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
122 if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
123 if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
124 if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
125 if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
126 if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
127 #endif
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
128 if (!SYMBOLP (sym)) abort ();
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
129
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
130 #if 0
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
131 fprintf (stderr, " XInternAtom %s\n", (char *) XSYMBOL (sym)->name->data);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
132 #endif
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
133 BLOCK_INPUT;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
134 val = XInternAtom (display, (char *) XSYMBOL (sym)->name->data, False);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
135 UNBLOCK_INPUT;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
136 return val;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
137 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
138
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
139
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
140 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
141 and calls to intern whenever possible. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
142
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
143 static Lisp_Object
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
144 x_atom_to_symbol (dpyinfo, display, atom)
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
145 struct x_display_info *dpyinfo;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
146 Display *display;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
147 Atom atom;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
148 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
149 char *str;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
150 Lisp_Object val;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
151 if (! atom) return Qnil;
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
152 switch (atom)
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
153 {
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
154 case XA_PRIMARY:
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
155 return QPRIMARY;
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
156 case XA_SECONDARY:
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
157 return QSECONDARY;
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
158 case XA_STRING:
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
159 return QSTRING;
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
160 case XA_INTEGER:
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
161 return QINTEGER;
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
162 case XA_ATOM:
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
163 return QATOM;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
164 #ifdef CUT_BUFFER_SUPPORT
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
165 case XA_CUT_BUFFER0:
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
166 return QCUT_BUFFER0;
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
167 case XA_CUT_BUFFER1:
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
168 return QCUT_BUFFER1;
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
169 case XA_CUT_BUFFER2:
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
170 return QCUT_BUFFER2;
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
171 case XA_CUT_BUFFER3:
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
172 return QCUT_BUFFER3;
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
173 case XA_CUT_BUFFER4:
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
174 return QCUT_BUFFER4;
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
175 case XA_CUT_BUFFER5:
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
176 return QCUT_BUFFER5;
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
177 case XA_CUT_BUFFER6:
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
178 return QCUT_BUFFER6;
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
179 case XA_CUT_BUFFER7:
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
180 return QCUT_BUFFER7;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
181 #endif
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
182 }
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
183
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
184 if (atom == dpyinfo->Xatom_CLIPBOARD)
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
185 return QCLIPBOARD;
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
186 if (atom == dpyinfo->Xatom_TIMESTAMP)
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
187 return QTIMESTAMP;
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
188 if (atom == dpyinfo->Xatom_TEXT)
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
189 return QTEXT;
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
190 if (atom == dpyinfo->Xatom_DELETE)
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
191 return QDELETE;
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
192 if (atom == dpyinfo->Xatom_MULTIPLE)
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
193 return QMULTIPLE;
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
194 if (atom == dpyinfo->Xatom_INCR)
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
195 return QINCR;
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
196 if (atom == dpyinfo->Xatom_EMACS_TMP)
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
197 return QEMACS_TMP;
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
198 if (atom == dpyinfo->Xatom_TARGETS)
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
199 return QTARGETS;
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
200 if (atom == dpyinfo->Xatom_NULL)
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
201 return QNULL;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
202
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
203 BLOCK_INPUT;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
204 str = XGetAtomName (display, atom);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
205 UNBLOCK_INPUT;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
206 #if 0
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
207 fprintf (stderr, " XGetAtomName --> %s\n", str);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
208 #endif
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
209 if (! str) return Qnil;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
210 val = intern (str);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
211 BLOCK_INPUT;
14371
dfeae392adcd (x_get_window_property_as_lisp_data): Use xfree, not XFree.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
212 /* This was allocated by Xlib, so use XFree. */
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
213 XFree (str);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
214 UNBLOCK_INPUT;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
215 return val;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
216 }
2255
ff870650d188 (cons_to_long, long_to_cons): No longer static.
Richard M. Stallman <rms@gnu.org>
parents: 2169
diff changeset
217
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
218 /* Do protocol to assert ourself as a selection owner.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
219 Update the Vselection_alist so that we can reply to later requests for
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
220 our selection. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
221
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
222 static void
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
223 x_own_selection (selection_name, selection_value)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
224 Lisp_Object selection_name, selection_value;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
225 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
226 Window selecting_window = FRAME_X_WINDOW (selected_frame);
9616
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
227 Display *display = FRAME_X_DISPLAY (selected_frame);
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
228 Time time = last_event_timestamp;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
229 Atom selection_atom;
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
230 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
231
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
232 CHECK_SYMBOL (selection_name, 0);
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
233 selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
234
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
235 BLOCK_INPUT;
9701
26a60dd57b6e (x_own_selection, x_get_foreign_selection): Change calls
Richard M. Stallman <rms@gnu.org>
parents: 9691
diff changeset
236 x_catch_errors (display);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
237 XSetSelectionOwner (display, selection_atom, selecting_window, time);
9701
26a60dd57b6e (x_own_selection, x_get_foreign_selection): Change calls
Richard M. Stallman <rms@gnu.org>
parents: 9691
diff changeset
238 x_check_errors (display, "Can't set selection: %s");
26a60dd57b6e (x_own_selection, x_get_foreign_selection): Change calls
Richard M. Stallman <rms@gnu.org>
parents: 9691
diff changeset
239 x_uncatch_errors (display);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
240 UNBLOCK_INPUT;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
241
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
242 /* Now update the local cache */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
243 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
244 Lisp_Object selection_time;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
245 Lisp_Object selection_data;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
246 Lisp_Object prev_value;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
247
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
248 selection_time = long_to_cons ((unsigned long) time);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
249 selection_data = Fcons (selection_name,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
250 Fcons (selection_value,
8101
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
251 Fcons (selection_time,
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
252 Fcons (Fselected_frame (), Qnil))));
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
253 prev_value = assq_no_quit (selection_name, Vselection_alist);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
254
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
255 Vselection_alist = Fcons (selection_data, Vselection_alist);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
256
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
257 /* If we already owned the selection, remove the old selection data.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
258 Perhaps we should destructively modify it instead.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
259 Don't use Fdelq as that may QUIT. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
260 if (!NILP (prev_value))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
261 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
262 Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
263 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
264 if (EQ (prev_value, Fcar (XCONS (rest)->cdr)))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
265 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
266 XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
267 break;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
268 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
269 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
270 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
271 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
272
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
273 /* Given a selection-name and desired type, look up our local copy of
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
274 the selection value and convert it to the type.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
275 The value is nil or a string.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
276 This function is used both for remote requests
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
277 and for local x-get-selection-internal.
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
278
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
279 This calls random Lisp code, and may signal or gc. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
280
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
281 static Lisp_Object
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
282 x_get_local_selection (selection_symbol, target_type)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
283 Lisp_Object selection_symbol, target_type;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
284 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
285 Lisp_Object local_value;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
286 Lisp_Object handler_fn, value, type, check;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
287 int count;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
288
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
289 local_value = assq_no_quit (selection_symbol, Vselection_alist);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
290
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
291 if (NILP (local_value)) return Qnil;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
292
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
293 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
294 if (EQ (target_type, QTIMESTAMP))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
295 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
296 handler_fn = Qnil;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
297 value = XCONS (XCONS (XCONS (local_value)->cdr)->cdr)->car;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
298 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
299 #if 0
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
300 else if (EQ (target_type, QDELETE))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
301 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
302 handler_fn = Qnil;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
303 Fx_disown_selection_internal
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
304 (selection_symbol,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
305 XCONS (XCONS (XCONS (local_value)->cdr)->cdr)->car);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
306 value = QNULL;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
307 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
308 #endif
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
309
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
310 #if 0 /* #### MULTIPLE doesn't work yet */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
311 else if (CONSP (target_type)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
312 && XCONS (target_type)->car == QMULTIPLE)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
313 {
6520
bbde44df8b9d (x_get_local_selection, x_handle_selection_request): Use assignment, not
Karl Heuer <kwzh@gnu.org>
parents: 5947
diff changeset
314 Lisp_Object pairs;
bbde44df8b9d (x_get_local_selection, x_handle_selection_request): Use assignment, not
Karl Heuer <kwzh@gnu.org>
parents: 5947
diff changeset
315 int size;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
316 int i;
6520
bbde44df8b9d (x_get_local_selection, x_handle_selection_request): Use assignment, not
Karl Heuer <kwzh@gnu.org>
parents: 5947
diff changeset
317 pairs = XCONS (target_type)->cdr;
bbde44df8b9d (x_get_local_selection, x_handle_selection_request): Use assignment, not
Karl Heuer <kwzh@gnu.org>
parents: 5947
diff changeset
318 size = XVECTOR (pairs)->size;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
319 /* If the target is MULTIPLE, then target_type looks like
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
320 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
321 We modify the second element of each pair in the vector and
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
322 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
323 */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
324 for (i = 0; i < size; i++)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
325 {
6520
bbde44df8b9d (x_get_local_selection, x_handle_selection_request): Use assignment, not
Karl Heuer <kwzh@gnu.org>
parents: 5947
diff changeset
326 Lisp_Object pair;
bbde44df8b9d (x_get_local_selection, x_handle_selection_request): Use assignment, not
Karl Heuer <kwzh@gnu.org>
parents: 5947
diff changeset
327 pair = XVECTOR (pairs)->contents [i];
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
328 XVECTOR (pair)->contents [1]
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
329 = x_get_local_selection (XVECTOR (pair)->contents [0],
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
330 XVECTOR (pair)->contents [1]);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
331 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
332 return pairs;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
333 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
334 #endif
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
335 else
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
336 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
337 /* Don't allow a quit within the converter.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
338 When the user types C-g, he would be surprised
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
339 if by luck it came during a converter. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
340 count = specpdl_ptr - specpdl;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
341 specbind (Qinhibit_quit, Qt);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
342
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
343 CHECK_SYMBOL (target_type, 0);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
344 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
3166
419d3bf1cb2b (x_get_local_selection): If no conversion function
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
345 if (!NILP (handler_fn))
419d3bf1cb2b (x_get_local_selection): If no conversion function
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
346 value = call3 (handler_fn,
419d3bf1cb2b (x_get_local_selection): If no conversion function
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
347 selection_symbol, target_type,
419d3bf1cb2b (x_get_local_selection): If no conversion function
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
348 XCONS (XCONS (local_value)->cdr)->car);
419d3bf1cb2b (x_get_local_selection): If no conversion function
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
349 else
419d3bf1cb2b (x_get_local_selection): If no conversion function
Richard M. Stallman <rms@gnu.org>
parents: 2961
diff changeset
350 value = Qnil;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
351 unbind_to (count, Qnil);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
352 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
353
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
354 /* Make sure this value is of a type that we could transmit
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
355 to another X client. */
2169
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
356
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
357 check = value;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
358 if (CONSP (value)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
359 && SYMBOLP (XCONS (value)->car))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
360 type = XCONS (value)->car,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
361 check = XCONS (value)->cdr;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
362
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
363 if (STRINGP (check)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
364 || VECTORP (check)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
365 || SYMBOLP (check)
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
366 || INTEGERP (check)
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
367 || NILP (value))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
368 return value;
2169
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
369 /* Check for a value that cons_to_long could handle. */
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
370 else if (CONSP (check)
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
371 && INTEGERP (XCONS (check)->car)
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
372 && (INTEGERP (XCONS (check)->cdr)
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
373 ||
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
374 (CONSP (XCONS (check)->cdr)
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
375 && INTEGERP (XCONS (XCONS (check)->cdr)->car)
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
376 && NILP (XCONS (XCONS (check)->cdr)->cdr))))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
377 return value;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
378 else
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
379 return
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
380 Fsignal (Qerror,
2169
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
381 Fcons (build_string ("invalid data returned by selection-conversion function"),
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
382 Fcons (handler_fn, Fcons (value, Qnil))));
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
383 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
384
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
385 /* Subroutines of x_reply_selection_request. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
386
14031
51c6f601f42b Undo previous change, except for comments and doc strings.
Richard M. Stallman <rms@gnu.org>
parents: 13942
diff changeset
387 /* Send a SelectionNotify event to the requestor with property=None,
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
388 meaning we were unable to do what they wanted. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
389
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
390 static void
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
391 x_decline_selection_request (event)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
392 struct input_event *event;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
393 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
394 XSelectionEvent reply;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
395 reply.type = SelectionNotify;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
396 reply.display = SELECTION_EVENT_DISPLAY (event);
14031
51c6f601f42b Undo previous change, except for comments and doc strings.
Richard M. Stallman <rms@gnu.org>
parents: 13942
diff changeset
397 reply.requestor = SELECTION_EVENT_REQUESTOR (event);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
398 reply.selection = SELECTION_EVENT_SELECTION (event);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
399 reply.time = SELECTION_EVENT_TIME (event);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
400 reply.target = SELECTION_EVENT_TARGET (event);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
401 reply.property = None;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
402
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
403 BLOCK_INPUT;
14031
51c6f601f42b Undo previous change, except for comments and doc strings.
Richard M. Stallman <rms@gnu.org>
parents: 13942
diff changeset
404 XSendEvent (reply.display, reply.requestor, False, 0L,
6804
dcbde04df85c (x_decline_selection_request): Call XFlushQueue.
Richard M. Stallman <rms@gnu.org>
parents: 6520
diff changeset
405 (XEvent *) &reply);
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
406 XFlush (reply.display);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
407 UNBLOCK_INPUT;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
408 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
409
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
410 /* This is the selection request currently being processed.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
411 It is set to zero when the request is fully processed. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
412 static struct input_event *x_selection_current_request;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
413
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
414 /* Used as an unwind-protect clause so that, if a selection-converter signals
13942
b01288cb5fc8 (x_get_foreign_selection): Renamed local variables
Karl Heuer <kwzh@gnu.org>
parents: 13557
diff changeset
415 an error, we tell the requester that we were unable to do what they wanted
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
416 before we throw to top-level or go into the debugger or whatever. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
417
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
418 static Lisp_Object
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
419 x_selection_request_lisp_error (ignore)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
420 Lisp_Object ignore;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
421 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
422 if (x_selection_current_request != 0)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
423 x_decline_selection_request (x_selection_current_request);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
424 return Qnil;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
425 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
426
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
427
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
428 /* This stuff is so that INCR selections are reentrant (that is, so we can
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
429 be servicing multiple INCR selection requests simultaneously.) I haven't
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
430 actually tested that yet. */
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
431
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
432 /* Keep a list of the property changes that are awaited. */
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
433
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
434 struct prop_location
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
435 {
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
436 int identifier;
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
437 Display *display;
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
438 Window window;
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
439 Atom property;
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
440 int desired_state;
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
441 int arrived;
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
442 struct prop_location *next;
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
443 };
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
444
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
445 static struct prop_location *expect_property_change ();
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
446 static void wait_for_property_change ();
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
447 static void unexpect_property_change ();
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
448 static int waiting_for_other_props_on_window ();
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
449
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
450 static int prop_location_identifier;
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
451
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
452 static Lisp_Object property_change_reply;
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
453
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
454 static struct prop_location *property_change_reply_object;
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
455
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
456 static struct prop_location *property_change_wait_list;
10674
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
457
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
458 static Lisp_Object
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
459 queue_selection_requests_unwind (frame)
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
460 Lisp_Object frame;
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
461 {
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
462 FRAME_PTR f = XFRAME (frame);
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
463
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
464 if (! NILP (frame))
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
465 x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f));
11908
4f4034f45cbf (queue_selection_requests_unwind): Add return value.
Karl Heuer <kwzh@gnu.org>
parents: 11881
diff changeset
466 return Qnil;
10674
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
467 }
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
468
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
469 /* Return some frame whose display info is DPYINFO.
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
470 Return nil if there is none. */
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
471
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
472 static Lisp_Object
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
473 some_frame_on_display (dpyinfo)
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
474 struct x_display_info *dpyinfo;
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
475 {
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
476 Lisp_Object list, frame;
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
477
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
478 FOR_EACH_FRAME (list, frame)
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
479 {
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
480 if (FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo)
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
481 return frame;
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
482 }
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
483
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
484 return Qnil;
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
485 }
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
486
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
487 /* Send the reply to a selection request event EVENT.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
488 TYPE is the type of selection data requested.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
489 DATA and SIZE describe the data to send, already converted.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
490 FORMAT is the unit-size (in bits) of the data to be transmitted. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
491
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
492 static void
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
493 x_reply_selection_request (event, format, data, size, type)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
494 struct input_event *event;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
495 int format, size;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
496 unsigned char *data;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
497 Atom type;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
498 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
499 XSelectionEvent reply;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
500 Display *display = SELECTION_EVENT_DISPLAY (event);
14031
51c6f601f42b Undo previous change, except for comments and doc strings.
Richard M. Stallman <rms@gnu.org>
parents: 13942
diff changeset
501 Window window = SELECTION_EVENT_REQUESTOR (event);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
502 int bytes_remaining;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
503 int format_bytes = format/8;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
504 int max_bytes = SELECTION_QUANTUM (display);
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
505 struct x_display_info *dpyinfo = x_display_info_for_display (display);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
506
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
507 if (max_bytes > MAX_SELECTION_QUANTUM)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
508 max_bytes = MAX_SELECTION_QUANTUM;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
509
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
510 reply.type = SelectionNotify;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
511 reply.display = display;
14031
51c6f601f42b Undo previous change, except for comments and doc strings.
Richard M. Stallman <rms@gnu.org>
parents: 13942
diff changeset
512 reply.requestor = window;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
513 reply.selection = SELECTION_EVENT_SELECTION (event);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
514 reply.time = SELECTION_EVENT_TIME (event);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
515 reply.target = SELECTION_EVENT_TARGET (event);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
516 reply.property = SELECTION_EVENT_PROPERTY (event);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
517 if (reply.property == None)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
518 reply.property = reply.target;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
519
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
520 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
10633
70ee88d09615 (wait_for_property_change): Avoid unlikely timing error.
Richard M. Stallman <rms@gnu.org>
parents: 9960
diff changeset
521 BLOCK_INPUT;
70ee88d09615 (wait_for_property_change): Avoid unlikely timing error.
Richard M. Stallman <rms@gnu.org>
parents: 9960
diff changeset
522 x_catch_errors (display);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
523
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
524 /* Store the data on the requested property.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
525 If the selection is large, only store the first N bytes of it.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
526 */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
527 bytes_remaining = size * format_bytes;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
528 if (bytes_remaining <= max_bytes)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
529 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
530 /* Send all the data at once, with minimal handshaking. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
531 #if 0
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
532 fprintf (stderr,"\nStoring all %d\n", bytes_remaining);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
533 #endif
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
534 XChangeProperty (display, window, reply.property, type, format,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
535 PropModeReplace, data, size);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
536 /* At this point, the selection was successfully stored; ack it. */
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
537 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
538 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
539 else
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
540 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
541 /* Send an INCR selection. */
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
542 struct prop_location *wait_object;
10633
70ee88d09615 (wait_for_property_change): Avoid unlikely timing error.
Richard M. Stallman <rms@gnu.org>
parents: 9960
diff changeset
543 int had_errors;
10674
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
544 int count = specpdl_ptr - specpdl;
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
545 Lisp_Object frame;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
546
10674
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
547 frame = some_frame_on_display (dpyinfo);
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
548
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
549 /* If the display no longer has frames, we can't expect
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
550 to get many more selection requests from it, so don't
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
551 bother trying to queue them. */
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
552 if (!NILP (frame))
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
553 {
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
554 x_start_queuing_selection_requests (display);
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
555
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
556 record_unwind_protect (queue_selection_requests_unwind,
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
557 frame);
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
558 }
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
559
11198
571306c7b038 New arg DPYINFO to all callers of x_window_to_frame, x_any_window_to_frame,
Karl Heuer <kwzh@gnu.org>
parents: 11161
diff changeset
560 if (x_window_to_frame (dpyinfo, window)) /* #### debug */
14134
a1ebbdb060b8 (x_handle_selection_notify): Give an indication
Karl Heuer <kwzh@gnu.org>
parents: 14031
diff changeset
561 error ("Attempt to transfer an INCR to ourself!");
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
562 #if 0
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
563 fprintf (stderr, "\nINCR %d\n", bytes_remaining);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
564 #endif
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
565 wait_object = expect_property_change (display, window, reply.property,
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
566 PropertyDelete);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
567
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
568 XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
10674
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
569 32, PropModeReplace,
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
570 (unsigned char *) &bytes_remaining, 1);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
571 XSelectInput (display, window, PropertyChangeMask);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
572 /* Tell 'em the INCR data is there... */
10674
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
573 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
574 XFlush (display);
10633
70ee88d09615 (wait_for_property_change): Avoid unlikely timing error.
Richard M. Stallman <rms@gnu.org>
parents: 9960
diff changeset
575
70ee88d09615 (wait_for_property_change): Avoid unlikely timing error.
Richard M. Stallman <rms@gnu.org>
parents: 9960
diff changeset
576 had_errors = x_had_errors_p (display);
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
577 UNBLOCK_INPUT;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
578
13942
b01288cb5fc8 (x_get_foreign_selection): Renamed local variables
Karl Heuer <kwzh@gnu.org>
parents: 13557
diff changeset
579 /* First, wait for the requester to ack by deleting the property.
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
580 This can run random lisp code (process handlers) or signal. */
10633
70ee88d09615 (wait_for_property_change): Avoid unlikely timing error.
Richard M. Stallman <rms@gnu.org>
parents: 9960
diff changeset
581 if (! had_errors)
70ee88d09615 (wait_for_property_change): Avoid unlikely timing error.
Richard M. Stallman <rms@gnu.org>
parents: 9960
diff changeset
582 wait_for_property_change (wait_object);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
583
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
584 while (bytes_remaining)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
585 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
586 int i = ((bytes_remaining < max_bytes)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
587 ? bytes_remaining
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
588 : max_bytes);
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
589
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
590 BLOCK_INPUT;
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
591
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
592 wait_object
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
593 = expect_property_change (display, window, reply.property,
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
594 PropertyDelete);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
595 #if 0
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
596 fprintf (stderr," INCR adding %d\n", i);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
597 #endif
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
598 /* Append the next chunk of data to the property. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
599 XChangeProperty (display, window, reply.property, type, format,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
600 PropModeAppend, data, i / format_bytes);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
601 bytes_remaining -= i;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
602 data += i;
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
603 XFlush (display);
10633
70ee88d09615 (wait_for_property_change): Avoid unlikely timing error.
Richard M. Stallman <rms@gnu.org>
parents: 9960
diff changeset
604 had_errors = x_had_errors_p (display);
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
605 UNBLOCK_INPUT;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
606
10633
70ee88d09615 (wait_for_property_change): Avoid unlikely timing error.
Richard M. Stallman <rms@gnu.org>
parents: 9960
diff changeset
607 if (had_errors)
70ee88d09615 (wait_for_property_change): Avoid unlikely timing error.
Richard M. Stallman <rms@gnu.org>
parents: 9960
diff changeset
608 break;
70ee88d09615 (wait_for_property_change): Avoid unlikely timing error.
Richard M. Stallman <rms@gnu.org>
parents: 9960
diff changeset
609
13942
b01288cb5fc8 (x_get_foreign_selection): Renamed local variables
Karl Heuer <kwzh@gnu.org>
parents: 13557
diff changeset
610 /* Now wait for the requester to ack this chunk by deleting the
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
611 property. This can run random lisp code or signal.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
612 */
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
613 wait_for_property_change (wait_object);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
614 }
13942
b01288cb5fc8 (x_get_foreign_selection): Renamed local variables
Karl Heuer <kwzh@gnu.org>
parents: 13557
diff changeset
615 /* Now write a zero-length chunk to the property to tell the requester
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
616 that we're done. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
617 #if 0
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
618 fprintf (stderr," INCR done\n");
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
619 #endif
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
620 BLOCK_INPUT;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
621 if (! waiting_for_other_props_on_window (display, window))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
622 XSelectInput (display, window, 0L);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
623
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
624 XChangeProperty (display, window, reply.property, type, format,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
625 PropModeReplace, data, 0);
10674
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
626
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
627 unbind_to (count, Qnil);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
628 }
10633
70ee88d09615 (wait_for_property_change): Avoid unlikely timing error.
Richard M. Stallman <rms@gnu.org>
parents: 9960
diff changeset
629
70ee88d09615 (wait_for_property_change): Avoid unlikely timing error.
Richard M. Stallman <rms@gnu.org>
parents: 9960
diff changeset
630 XFlush (display);
70ee88d09615 (wait_for_property_change): Avoid unlikely timing error.
Richard M. Stallman <rms@gnu.org>
parents: 9960
diff changeset
631 x_uncatch_errors (display);
70ee88d09615 (wait_for_property_change): Avoid unlikely timing error.
Richard M. Stallman <rms@gnu.org>
parents: 9960
diff changeset
632 UNBLOCK_INPUT;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
633 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
634
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
635 /* Handle a SelectionRequest event EVENT.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
636 This is called from keyboard.c when such an event is found in the queue. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
637
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
638 void
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
639 x_handle_selection_request (event)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
640 struct input_event *event;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
641 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
642 struct gcpro gcpro1, gcpro2, gcpro3;
6520
bbde44df8b9d (x_get_local_selection, x_handle_selection_request): Use assignment, not
Karl Heuer <kwzh@gnu.org>
parents: 5947
diff changeset
643 Lisp_Object local_selection_data;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
644 Lisp_Object selection_symbol;
6520
bbde44df8b9d (x_get_local_selection, x_handle_selection_request): Use assignment, not
Karl Heuer <kwzh@gnu.org>
parents: 5947
diff changeset
645 Lisp_Object target_symbol;
bbde44df8b9d (x_get_local_selection, x_handle_selection_request): Use assignment, not
Karl Heuer <kwzh@gnu.org>
parents: 5947
diff changeset
646 Lisp_Object converted_selection;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
647 Time local_selection_time;
6520
bbde44df8b9d (x_get_local_selection, x_handle_selection_request): Use assignment, not
Karl Heuer <kwzh@gnu.org>
parents: 5947
diff changeset
648 Lisp_Object successful_p;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
649 int count;
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
650 struct x_display_info *dpyinfo
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
651 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event));
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
652
6520
bbde44df8b9d (x_get_local_selection, x_handle_selection_request): Use assignment, not
Karl Heuer <kwzh@gnu.org>
parents: 5947
diff changeset
653 local_selection_data = Qnil;
bbde44df8b9d (x_get_local_selection, x_handle_selection_request): Use assignment, not
Karl Heuer <kwzh@gnu.org>
parents: 5947
diff changeset
654 target_symbol = Qnil;
bbde44df8b9d (x_get_local_selection, x_handle_selection_request): Use assignment, not
Karl Heuer <kwzh@gnu.org>
parents: 5947
diff changeset
655 converted_selection = Qnil;
bbde44df8b9d (x_get_local_selection, x_handle_selection_request): Use assignment, not
Karl Heuer <kwzh@gnu.org>
parents: 5947
diff changeset
656 successful_p = Qnil;
bbde44df8b9d (x_get_local_selection, x_handle_selection_request): Use assignment, not
Karl Heuer <kwzh@gnu.org>
parents: 5947
diff changeset
657
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
658 GCPRO3 (local_selection_data, converted_selection, target_symbol);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
659
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
660 selection_symbol = x_atom_to_symbol (dpyinfo,
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
661 SELECTION_EVENT_DISPLAY (event),
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
662 SELECTION_EVENT_SELECTION (event));
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
663
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
664 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
665
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
666 if (NILP (local_selection_data))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
667 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
668 /* Someone asked for the selection, but we don't have it any more.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
669 */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
670 x_decline_selection_request (event);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
671 goto DONE;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
672 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
673
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
674 local_selection_time = (Time)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
675 cons_to_long (XCONS (XCONS (XCONS (local_selection_data)->cdr)->cdr)->car);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
676
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
677 if (SELECTION_EVENT_TIME (event) != CurrentTime
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
678 && local_selection_time > SELECTION_EVENT_TIME (event))
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
679 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
680 /* Someone asked for the selection, and we have one, but not the one
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
681 they're looking for.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
682 */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
683 x_decline_selection_request (event);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
684 goto DONE;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
685 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
686
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
687 count = specpdl_ptr - specpdl;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
688 x_selection_current_request = event;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
689 record_unwind_protect (x_selection_request_lisp_error, Qnil);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
690
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
691 target_symbol = x_atom_to_symbol (dpyinfo, SELECTION_EVENT_DISPLAY (event),
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
692 SELECTION_EVENT_TARGET (event));
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
693
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
694 #if 0 /* #### MULTIPLE doesn't work yet */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
695 if (EQ (target_symbol, QMULTIPLE))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
696 target_symbol = fetch_multiple_target (event);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
697 #endif
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
698
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
699 /* Convert lisp objects back into binary data */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
700
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
701 converted_selection
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
702 = x_get_local_selection (selection_symbol, target_symbol);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
703
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
704 if (! NILP (converted_selection))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
705 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
706 unsigned char *data;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
707 unsigned int size;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
708 int format;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
709 Atom type;
4278
889d81e3f507 (lisp_data_to_selection_data): New arg NOFREE_RET.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
710 int nofree;
889d81e3f507 (lisp_data_to_selection_data): New arg NOFREE_RET.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
711
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
712 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
713 converted_selection,
4278
889d81e3f507 (lisp_data_to_selection_data): New arg NOFREE_RET.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
714 &data, &type, &size, &format, &nofree);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
715
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
716 x_reply_selection_request (event, format, data, size, type);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
717 successful_p = Qt;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
718
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
719 /* Indicate we have successfully processed this event. */
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
720 x_selection_current_request = 0;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
721
14372
81c67c7d1655 (xfree): Macro deleted.
Richard M. Stallman <rms@gnu.org>
parents: 14371
diff changeset
722 /* Use free, not XFree, because lisp_data_to_selection_data
14371
dfeae392adcd (x_get_window_property_as_lisp_data): Use xfree, not XFree.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
723 calls xmalloc itself. */
4278
889d81e3f507 (lisp_data_to_selection_data): New arg NOFREE_RET.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
724 if (!nofree)
14372
81c67c7d1655 (xfree): Macro deleted.
Richard M. Stallman <rms@gnu.org>
parents: 14371
diff changeset
725 free (data);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
726 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
727 unbind_to (count, Qnil);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
728
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
729 DONE:
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
730
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
731 UNGCPRO;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
732
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
733 /* Let random lisp code notice that the selection has been asked for. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
734 {
6520
bbde44df8b9d (x_get_local_selection, x_handle_selection_request): Use assignment, not
Karl Heuer <kwzh@gnu.org>
parents: 5947
diff changeset
735 Lisp_Object rest;
bbde44df8b9d (x_get_local_selection, x_handle_selection_request): Use assignment, not
Karl Heuer <kwzh@gnu.org>
parents: 5947
diff changeset
736 rest = Vx_sent_selection_hooks;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
737 if (!EQ (rest, Qunbound))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
738 for (; CONSP (rest); rest = Fcdr (rest))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
739 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
740 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
741 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
742
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
743 /* Handle a SelectionClear event EVENT, which indicates that some other
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
744 client cleared out our previously asserted selection.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
745 This is called from keyboard.c when such an event is found in the queue. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
746
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
747 void
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
748 x_handle_selection_clear (event)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
749 struct input_event *event;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
750 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
751 Display *display = SELECTION_EVENT_DISPLAY (event);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
752 Atom selection = SELECTION_EVENT_SELECTION (event);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
753 Time changed_owner_time = SELECTION_EVENT_TIME (event);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
754
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
755 Lisp_Object selection_symbol, local_selection_data;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
756 Time local_selection_time;
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
757 struct x_display_info *dpyinfo = x_display_info_for_display (display);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
758
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
759 selection_symbol = x_atom_to_symbol (dpyinfo, display, selection);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
760
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
761 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
762
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
763 /* Well, we already believe that we don't own it, so that's just fine. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
764 if (NILP (local_selection_data)) return;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
765
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
766 local_selection_time = (Time)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
767 cons_to_long (XCONS (XCONS (XCONS (local_selection_data)->cdr)->cdr)->car);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
768
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
769 /* This SelectionClear is for a selection that we no longer own, so we can
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
770 disregard it. (That is, we have reasserted the selection since this
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
771 request was generated.) */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
772
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
773 if (changed_owner_time != CurrentTime
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
774 && local_selection_time > changed_owner_time)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
775 return;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
776
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
777 /* Otherwise, we're really honest and truly being told to drop it.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
778 Don't use Fdelq as that may QUIT;. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
779
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
780 if (EQ (local_selection_data, Fcar (Vselection_alist)))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
781 Vselection_alist = Fcdr (Vselection_alist);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
782 else
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
783 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
784 Lisp_Object rest;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
785 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
786 if (EQ (local_selection_data, Fcar (XCONS (rest)->cdr)))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
787 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
788 XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
789 break;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
790 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
791 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
792
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
793 /* Let random lisp code notice that the selection has been stolen. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
794
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
795 {
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
796 Lisp_Object rest;
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
797 rest = Vx_lost_selection_hooks;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
798 if (!EQ (rest, Qunbound))
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
799 {
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
800 for (; CONSP (rest); rest = Fcdr (rest))
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
801 call1 (Fcar (rest), selection_symbol);
5244
c0bd54986550 (x_get_foreign_selection): Use x_catch_errors.
Richard M. Stallman <rms@gnu.org>
parents: 5131
diff changeset
802 prepare_menu_bars ();
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
803 redisplay_preserve_echo_area ();
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
804 }
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
805 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
806 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
807
8101
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
808 /* Clear all selections that were made from frame F.
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
809 We do this when about to delete a frame. */
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
810
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
811 void
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
812 x_clear_frame_selections (f)
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
813 FRAME_PTR f;
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
814 {
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
815 Lisp_Object frame;
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
816 Lisp_Object rest;
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
817
9286
2accc8da0793 (x_clear_frame_selections, wait_for_property_change): Use new accessor macros
Karl Heuer <kwzh@gnu.org>
parents: 8355
diff changeset
818 XSETFRAME (frame, f);
8101
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
819
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
820 /* Otherwise, we're really honest and truly being told to drop it.
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
821 Don't use Fdelq as that may QUIT;. */
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
822
13555
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
823 /* Delete elements from the beginning of Vselection_alist. */
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
824 while (!NILP (Vselection_alist)
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
825 && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
826 {
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
827 /* Let random Lisp code notice that the selection has been stolen. */
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
828 Lisp_Object hooks, selection_symbol;
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
829
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
830 hooks = Vx_lost_selection_hooks;
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
831 selection_symbol = Fcar (Fcar (Vselection_alist));
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
832
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
833 if (!EQ (hooks, Qunbound))
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
834 {
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
835 for (; CONSP (hooks); hooks = Fcdr (hooks))
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
836 call1 (Fcar (hooks), selection_symbol);
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
837 redisplay_preserve_echo_area ();
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
838 }
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
839
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
840 Vselection_alist = Fcdr (Vselection_alist);
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
841 }
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
842
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
843 /* Delete elements after the beginning of Vselection_alist. */
8101
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
844 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
845 if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCONS (rest)->cdr)))))))
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
846 {
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
847 /* Let random Lisp code notice that the selection has been stolen. */
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
848 Lisp_Object hooks, selection_symbol;
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
849
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
850 hooks = Vx_lost_selection_hooks;
13555
e640f6afb190 (x_clear_frame_selections): Get selection_symbol properly.
Richard M. Stallman <rms@gnu.org>
parents: 12531
diff changeset
851 selection_symbol = Fcar (Fcar (XCONS (rest)->cdr));
8101
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
852
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
853 if (!EQ (hooks, Qunbound))
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
854 {
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
855 for (; CONSP (hooks); hooks = Fcdr (hooks))
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
856 call1 (Fcar (hooks), selection_symbol);
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
857 redisplay_preserve_echo_area ();
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
858 }
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
859 XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
860 break;
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
861 }
77d5b5c8a71f (x_own_selection, x_get_foreign_selection):
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
862 }
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
863
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
864 /* Nonzero if any properties for DISPLAY and WINDOW
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
865 are on the list of what we are waiting for. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
866
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
867 static int
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
868 waiting_for_other_props_on_window (display, window)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
869 Display *display;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
870 Window window;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
871 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
872 struct prop_location *rest = property_change_wait_list;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
873 while (rest)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
874 if (rest->display == display && rest->window == window)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
875 return 1;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
876 else
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
877 rest = rest->next;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
878 return 0;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
879 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
880
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
881 /* Add an entry to the list of property changes we are waiting for.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
882 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
883 The return value is a number that uniquely identifies
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
884 this awaited property change. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
885
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
886 static struct prop_location *
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
887 expect_property_change (display, window, property, state)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
888 Display *display;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
889 Window window;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
890 Lisp_Object property;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
891 int state;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
892 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
893 struct prop_location *pl
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
894 = (struct prop_location *) xmalloc (sizeof (struct prop_location));
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
895 pl->identifier = ++prop_location_identifier;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
896 pl->display = display;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
897 pl->window = window;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
898 pl->property = property;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
899 pl->desired_state = state;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
900 pl->next = property_change_wait_list;
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
901 pl->arrived = 0;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
902 property_change_wait_list = pl;
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
903 return pl;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
904 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
905
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
906 /* Delete an entry from the list of property changes we are waiting for.
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
907 IDENTIFIER is the number that uniquely identifies the entry. */
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
908
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
909 static void
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
910 unexpect_property_change (location)
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
911 struct prop_location *location;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
912 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
913 struct prop_location *prev = 0, *rest = property_change_wait_list;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
914 while (rest)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
915 {
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
916 if (rest == location)
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
917 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
918 if (prev)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
919 prev->next = rest->next;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
920 else
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
921 property_change_wait_list = rest->next;
14372
81c67c7d1655 (xfree): Macro deleted.
Richard M. Stallman <rms@gnu.org>
parents: 14371
diff changeset
922 free (rest);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
923 return;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
924 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
925 prev = rest;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
926 rest = rest->next;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
927 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
928 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
929
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
930 /* Remove the property change expectation element for IDENTIFIER. */
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
931
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
932 static Lisp_Object
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
933 wait_for_property_change_unwind (identifierval)
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
934 Lisp_Object identifierval;
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
935 {
9960
d7735c829d73 (wait_for_property_change): Encode location as a cons of two integers instead
Karl Heuer <kwzh@gnu.org>
parents: 9701
diff changeset
936 unexpect_property_change ((struct prop_location *)
d7735c829d73 (wait_for_property_change): Encode location as a cons of two integers instead
Karl Heuer <kwzh@gnu.org>
parents: 9701
diff changeset
937 (XFASTINT (XCONS (identifierval)->car) << 16
d7735c829d73 (wait_for_property_change): Encode location as a cons of two integers instead
Karl Heuer <kwzh@gnu.org>
parents: 9701
diff changeset
938 | XFASTINT (XCONS (identifierval)->cdr)));
11908
4f4034f45cbf (queue_selection_requests_unwind): Add return value.
Karl Heuer <kwzh@gnu.org>
parents: 11881
diff changeset
939 return Qnil;
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
940 }
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
941
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
942 /* Actually wait for a property change.
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
943 IDENTIFIER should be the value that expect_property_change returned. */
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
944
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
945 static void
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
946 wait_for_property_change (location)
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
947 struct prop_location *location;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
948 {
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
949 int secs, usecs;
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
950 int count = specpdl_ptr - specpdl;
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
951 Lisp_Object tem;
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
952
9960
d7735c829d73 (wait_for_property_change): Encode location as a cons of two integers instead
Karl Heuer <kwzh@gnu.org>
parents: 9701
diff changeset
953 tem = Fcons (Qnil, Qnil);
d7735c829d73 (wait_for_property_change): Encode location as a cons of two integers instead
Karl Heuer <kwzh@gnu.org>
parents: 9701
diff changeset
954 XSETFASTINT (XCONS (tem)->car, (EMACS_UINT)location >> 16);
d7735c829d73 (wait_for_property_change): Encode location as a cons of two integers instead
Karl Heuer <kwzh@gnu.org>
parents: 9701
diff changeset
955 XSETFASTINT (XCONS (tem)->cdr, (EMACS_UINT)location & 0xffff);
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
956
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
957 /* Make sure to do unexpect_property_change if we quit or err. */
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
958 record_unwind_protect (wait_for_property_change_unwind, tem);
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
959
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
960 XCONS (property_change_reply)->car = Qnil;
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
961
10633
70ee88d09615 (wait_for_property_change): Avoid unlikely timing error.
Richard M. Stallman <rms@gnu.org>
parents: 9960
diff changeset
962 property_change_reply_object = location;
70ee88d09615 (wait_for_property_change): Avoid unlikely timing error.
Richard M. Stallman <rms@gnu.org>
parents: 9960
diff changeset
963 /* If the event we are waiting for arrives beyond here, it will set
70ee88d09615 (wait_for_property_change): Avoid unlikely timing error.
Richard M. Stallman <rms@gnu.org>
parents: 9960
diff changeset
964 property_change_reply, because property_change_reply_object says so. */
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
965 if (! location->arrived)
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
966 {
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
967 secs = x_selection_timeout / 1000;
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
968 usecs = (x_selection_timeout % 1000) * 1000;
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
969 wait_reading_process_input (secs, usecs, property_change_reply, 0);
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
970
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
971 if (NILP (XCONS (property_change_reply)->car))
14134
a1ebbdb060b8 (x_handle_selection_notify): Give an indication
Karl Heuer <kwzh@gnu.org>
parents: 14031
diff changeset
972 error ("Timed out waiting for property-notify event");
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
973 }
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
974
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
975 unbind_to (count, Qnil);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
976 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
977
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
978 /* Called from XTread_socket in response to a PropertyNotify event. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
979
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
980 void
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
981 x_handle_property_notify (event)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
982 XPropertyEvent *event;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
983 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
984 struct prop_location *prev = 0, *rest = property_change_wait_list;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
985 while (rest)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
986 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
987 if (rest->property == event->atom
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
988 && rest->window == event->window
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
989 && rest->display == event->display
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
990 && rest->desired_state == event->state)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
991 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
992 #if 0
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
993 fprintf (stderr, "Saw expected prop-%s on %s\n",
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
994 (event->state == PropertyDelete ? "delete" : "change"),
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
995 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo, event->display,
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
996 event->atom))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
997 ->name->data);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
998 #endif
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
999
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
1000 rest->arrived = 1;
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
1001
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1002 /* If this is the one wait_for_property_change is waiting for,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1003 tell it to wake up. */
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
1004 if (rest == property_change_reply_object)
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1005 XCONS (property_change_reply)->car = Qt;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1006
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1007 if (prev)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1008 prev->next = rest->next;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1009 else
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1010 property_change_wait_list = rest->next;
14372
81c67c7d1655 (xfree): Macro deleted.
Richard M. Stallman <rms@gnu.org>
parents: 14371
diff changeset
1011 free (rest);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1012 return;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1013 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1014 prev = rest;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1015 rest = rest->next;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1016 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1017 #if 0
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1018 fprintf (stderr, "Saw UNexpected prop-%s on %s\n",
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1019 (event->state == PropertyDelete ? "delete" : "change"),
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1020 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo,
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1021 event->display, event->atom))
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1022 ->name->data);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1023 #endif
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1024 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1025
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1026
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1027
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1028 #if 0 /* #### MULTIPLE doesn't work yet */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1029
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1030 static Lisp_Object
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1031 fetch_multiple_target (event)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1032 XSelectionRequestEvent *event;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1033 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1034 Display *display = event->display;
14031
51c6f601f42b Undo previous change, except for comments and doc strings.
Richard M. Stallman <rms@gnu.org>
parents: 13942
diff changeset
1035 Window window = event->requestor;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1036 Atom target = event->target;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1037 Atom selection_atom = event->selection;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1038 int result;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1039
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1040 return
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1041 Fcons (QMULTIPLE,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1042 x_get_window_property_as_lisp_data (display, window, target,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1043 QMULTIPLE, selection_atom));
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1044 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1045
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1046 static Lisp_Object
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1047 copy_multiple_data (obj)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1048 Lisp_Object obj;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1049 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1050 Lisp_Object vec;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1051 int i;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1052 int size;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1053 if (CONSP (obj))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1054 return Fcons (XCONS (obj)->car, copy_multiple_data (XCONS (obj)->cdr));
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1055
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1056 CHECK_VECTOR (obj, 0);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1057 vec = Fmake_vector (size = XVECTOR (obj)->size, Qnil);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1058 for (i = 0; i < size; i++)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1059 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1060 Lisp_Object vec2 = XVECTOR (obj)->contents [i];
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1061 CHECK_VECTOR (vec2, 0);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1062 if (XVECTOR (vec2)->size != 2)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1063 /* ??? Confusing error message */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1064 Fsignal (Qerror, Fcons (build_string ("vectors must be of length 2"),
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1065 Fcons (vec2, Qnil)));
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1066 XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1067 XVECTOR (XVECTOR (vec)->contents [i])->contents [0]
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1068 = XVECTOR (vec2)->contents [0];
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1069 XVECTOR (XVECTOR (vec)->contents [i])->contents [1]
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1070 = XVECTOR (vec2)->contents [1];
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1071 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1072 return vec;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1073 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1074
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1075 #endif
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1076
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1077
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1078 /* Variables for communication with x_handle_selection_notify. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1079 static Atom reading_which_selection;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1080 static Lisp_Object reading_selection_reply;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1081 static Window reading_selection_window;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1082
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1083 /* Do protocol to read selection-data from the server.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1084 Converts this to Lisp data and returns it. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1085
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1086 static Lisp_Object
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1087 x_get_foreign_selection (selection_symbol, target_type)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1088 Lisp_Object selection_symbol, target_type;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1089 {
14031
51c6f601f42b Undo previous change, except for comments and doc strings.
Richard M. Stallman <rms@gnu.org>
parents: 13942
diff changeset
1090 Window requestor_window = FRAME_X_WINDOW (selected_frame);
9616
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
1091 Display *display = FRAME_X_DISPLAY (selected_frame);
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1092 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
14031
51c6f601f42b Undo previous change, except for comments and doc strings.
Richard M. Stallman <rms@gnu.org>
parents: 13942
diff changeset
1093 Time requestor_time = last_event_timestamp;
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1094 Atom target_property = dpyinfo->Xatom_EMACS_TMP;
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1095 Atom selection_atom = symbol_to_x_atom (dpyinfo, display, selection_symbol);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1096 Atom type_atom;
3492
3e75726d76c7 (x_get_foreign_selection): Handle x_selection_timeout
Richard M. Stallman <rms@gnu.org>
parents: 3473
diff changeset
1097 int secs, usecs;
10674
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
1098 int count = specpdl_ptr - specpdl;
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
1099 Lisp_Object frame;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1100
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1101 if (CONSP (target_type))
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1102 type_atom = symbol_to_x_atom (dpyinfo, display, XCONS (target_type)->car);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1103 else
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1104 type_atom = symbol_to_x_atom (dpyinfo, display, target_type);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1105
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1106 BLOCK_INPUT;
9701
26a60dd57b6e (x_own_selection, x_get_foreign_selection): Change calls
Richard M. Stallman <rms@gnu.org>
parents: 9691
diff changeset
1107 x_catch_errors (display);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1108 XConvertSelection (display, selection_atom, type_atom, target_property,
14031
51c6f601f42b Undo previous change, except for comments and doc strings.
Richard M. Stallman <rms@gnu.org>
parents: 13942
diff changeset
1109 requestor_window, requestor_time);
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1110 XFlush (display);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1111
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1112 /* Prepare to block until the reply has been read. */
14031
51c6f601f42b Undo previous change, except for comments and doc strings.
Richard M. Stallman <rms@gnu.org>
parents: 13942
diff changeset
1113 reading_selection_window = requestor_window;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1114 reading_which_selection = selection_atom;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1115 XCONS (reading_selection_reply)->car = Qnil;
10674
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
1116
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
1117 frame = some_frame_on_display (dpyinfo);
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
1118
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
1119 /* If the display no longer has frames, we can't expect
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
1120 to get many more selection requests from it, so don't
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
1121 bother trying to queue them. */
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
1122 if (!NILP (frame))
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
1123 {
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
1124 x_start_queuing_selection_requests (display);
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
1125
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
1126 record_unwind_protect (queue_selection_requests_unwind,
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
1127 frame);
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
1128 }
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1129 UNBLOCK_INPUT;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1130
3492
3e75726d76c7 (x_get_foreign_selection): Handle x_selection_timeout
Richard M. Stallman <rms@gnu.org>
parents: 3473
diff changeset
1131 /* This allows quits. Also, don't wait forever. */
3e75726d76c7 (x_get_foreign_selection): Handle x_selection_timeout
Richard M. Stallman <rms@gnu.org>
parents: 3473
diff changeset
1132 secs = x_selection_timeout / 1000;
3e75726d76c7 (x_get_foreign_selection): Handle x_selection_timeout
Richard M. Stallman <rms@gnu.org>
parents: 3473
diff changeset
1133 usecs = (x_selection_timeout % 1000) * 1000;
3e75726d76c7 (x_get_foreign_selection): Handle x_selection_timeout
Richard M. Stallman <rms@gnu.org>
parents: 3473
diff changeset
1134 wait_reading_process_input (secs, usecs, reading_selection_reply, 0);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1135
5244
c0bd54986550 (x_get_foreign_selection): Use x_catch_errors.
Richard M. Stallman <rms@gnu.org>
parents: 5131
diff changeset
1136 BLOCK_INPUT;
9701
26a60dd57b6e (x_own_selection, x_get_foreign_selection): Change calls
Richard M. Stallman <rms@gnu.org>
parents: 9691
diff changeset
1137 x_check_errors (display, "Cannot get selection: %s");
26a60dd57b6e (x_own_selection, x_get_foreign_selection): Change calls
Richard M. Stallman <rms@gnu.org>
parents: 9691
diff changeset
1138 x_uncatch_errors (display);
10674
ba12df743888 (x_get_foreign_selection, x_reply_selection_request):
Richard M. Stallman <rms@gnu.org>
parents: 10633
diff changeset
1139 unbind_to (count, Qnil);
5244
c0bd54986550 (x_get_foreign_selection): Use x_catch_errors.
Richard M. Stallman <rms@gnu.org>
parents: 5131
diff changeset
1140 UNBLOCK_INPUT;
c0bd54986550 (x_get_foreign_selection): Use x_catch_errors.
Richard M. Stallman <rms@gnu.org>
parents: 5131
diff changeset
1141
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1142 if (NILP (XCONS (reading_selection_reply)->car))
14134
a1ebbdb060b8 (x_handle_selection_notify): Give an indication
Karl Heuer <kwzh@gnu.org>
parents: 14031
diff changeset
1143 error ("Timed out waiting for reply from selection owner");
a1ebbdb060b8 (x_handle_selection_notify): Give an indication
Karl Heuer <kwzh@gnu.org>
parents: 14031
diff changeset
1144 if (EQ (XCONS (reading_selection_reply)->car, Qlambda))
a1ebbdb060b8 (x_handle_selection_notify): Give an indication
Karl Heuer <kwzh@gnu.org>
parents: 14031
diff changeset
1145 error ("No `%s' selection", XSYMBOL (selection_symbol)->name->data);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1146
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1147 /* Otherwise, the selection is waiting for us on the requested property. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1148 return
14031
51c6f601f42b Undo previous change, except for comments and doc strings.
Richard M. Stallman <rms@gnu.org>
parents: 13942
diff changeset
1149 x_get_window_property_as_lisp_data (display, requestor_window,
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1150 target_property, target_type,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1151 selection_atom);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1152 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1153
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1154 /* Subroutines of x_get_window_property_as_lisp_data */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1155
14372
81c67c7d1655 (xfree): Macro deleted.
Richard M. Stallman <rms@gnu.org>
parents: 14371
diff changeset
1156 /* Use free, not XFree, to free the data obtained with this function. */
14371
dfeae392adcd (x_get_window_property_as_lisp_data): Use xfree, not XFree.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
1157
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1158 static void
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1159 x_get_window_property (display, window, property, data_ret, bytes_ret,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1160 actual_type_ret, actual_format_ret, actual_size_ret,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1161 delete_p)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1162 Display *display;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1163 Window window;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1164 Atom property;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1165 unsigned char **data_ret;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1166 int *bytes_ret;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1167 Atom *actual_type_ret;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1168 int *actual_format_ret;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1169 unsigned long *actual_size_ret;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1170 int delete_p;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1171 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1172 int total_size;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1173 unsigned long bytes_remaining;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1174 int offset = 0;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1175 unsigned char *tmp_data = 0;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1176 int result;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1177 int buffer_size = SELECTION_QUANTUM (display);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1178 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1179
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1180 BLOCK_INPUT;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1181 /* First probe the thing to find out how big it is. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1182 result = XGetWindowProperty (display, window, property,
11881
3c292d5eed59 (x_get_window_property): Cast args of XGetWindowProperty.
Karl Heuer <kwzh@gnu.org>
parents: 11702
diff changeset
1183 0L, 0L, False, AnyPropertyType,
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1184 actual_type_ret, actual_format_ret,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1185 actual_size_ret,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1186 &bytes_remaining, &tmp_data);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1187 if (result != Success)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1188 {
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1189 UNBLOCK_INPUT;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1190 *data_ret = 0;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1191 *bytes_ret = 0;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1192 return;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1193 }
14371
dfeae392adcd (x_get_window_property_as_lisp_data): Use xfree, not XFree.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
1194 /* This was allocated by Xlib, so use XFree. */
dfeae392adcd (x_get_window_property_as_lisp_data): Use xfree, not XFree.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
1195 XFree ((char *) tmp_data);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1196
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1197 if (*actual_type_ret == None || *actual_format_ret == 0)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1198 {
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1199 UNBLOCK_INPUT;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1200 return;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1201 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1202
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1203 total_size = bytes_remaining + 1;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1204 *data_ret = (unsigned char *) xmalloc (total_size);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1205
13942
b01288cb5fc8 (x_get_foreign_selection): Renamed local variables
Karl Heuer <kwzh@gnu.org>
parents: 13557
diff changeset
1206 /* Now read, until we've gotten it all. */
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1207 while (bytes_remaining)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1208 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1209 #if 0
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1210 int last = bytes_remaining;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1211 #endif
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1212 result
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1213 = XGetWindowProperty (display, window, property,
11881
3c292d5eed59 (x_get_window_property): Cast args of XGetWindowProperty.
Karl Heuer <kwzh@gnu.org>
parents: 11702
diff changeset
1214 (long)offset/4, (long)buffer_size/4,
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1215 False,
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1216 AnyPropertyType,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1217 actual_type_ret, actual_format_ret,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1218 actual_size_ret, &bytes_remaining, &tmp_data);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1219 #if 0
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1220 fprintf (stderr, "<< read %d\n", last-bytes_remaining);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1221 #endif
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1222 /* If this doesn't return Success at this point, it means that
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1223 some clod deleted the selection while we were in the midst of
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1224 reading it. Deal with that, I guess....
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1225 */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1226 if (result != Success) break;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1227 *actual_size_ret *= *actual_format_ret / 8;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1228 bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1229 offset += *actual_size_ret;
14371
dfeae392adcd (x_get_window_property_as_lisp_data): Use xfree, not XFree.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
1230 /* This was allocated by Xlib, so use XFree. */
dfeae392adcd (x_get_window_property_as_lisp_data): Use xfree, not XFree.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
1231 XFree ((char *) tmp_data);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1232 }
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1233
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1234 XFlush (display);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1235 UNBLOCK_INPUT;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1236 *bytes_ret = offset;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1237 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1238
14372
81c67c7d1655 (xfree): Macro deleted.
Richard M. Stallman <rms@gnu.org>
parents: 14371
diff changeset
1239 /* Use free, not XFree, to free the data obtained with this function. */
14371
dfeae392adcd (x_get_window_property_as_lisp_data): Use xfree, not XFree.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
1240
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1241 static void
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1242 receive_incremental_selection (display, window, property, target_type,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1243 min_size_bytes, data_ret, size_bytes_ret,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1244 type_ret, format_ret, size_ret)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1245 Display *display;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1246 Window window;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1247 Atom property;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1248 Lisp_Object target_type; /* for error messages only */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1249 unsigned int min_size_bytes;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1250 unsigned char **data_ret;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1251 int *size_bytes_ret;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1252 Atom *type_ret;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1253 unsigned long *size_ret;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1254 int *format_ret;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1255 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1256 int offset = 0;
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
1257 struct prop_location *wait_object;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1258 *size_bytes_ret = min_size_bytes;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1259 *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1260 #if 0
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1261 fprintf (stderr, "\nread INCR %d\n", min_size_bytes);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1262 #endif
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1263
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1264 /* At this point, we have read an INCR property.
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1265 Delete the property to ack it.
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1266 (But first, prepare to receive the next event in this handshake.)
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1267
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1268 Now, we must loop, waiting for the sending window to put a value on
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1269 that property, then reading the property, then deleting it to ack.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1270 We are done when the sender places a property of length 0.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1271 */
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1272 BLOCK_INPUT;
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1273 XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1274 XDeleteProperty (display, window, property);
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
1275 wait_object = expect_property_change (display, window, property,
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
1276 PropertyNewValue);
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1277 XFlush (display);
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1278 UNBLOCK_INPUT;
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1279
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1280 while (1)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1281 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1282 unsigned char *tmp_data;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1283 int tmp_size_bytes;
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
1284 wait_for_property_change (wait_object);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1285 /* expect it again immediately, because x_get_window_property may
13942
b01288cb5fc8 (x_get_foreign_selection): Renamed local variables
Karl Heuer <kwzh@gnu.org>
parents: 13557
diff changeset
1286 .. no it won't, I don't get it.
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1287 .. Ok, I get it now, the Xt code that implements INCR is broken.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1288 */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1289 x_get_window_property (display, window, property,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1290 &tmp_data, &tmp_size_bytes,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1291 type_ret, format_ret, size_ret, 1);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1292
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1293 if (tmp_size_bytes == 0) /* we're done */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1294 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1295 #if 0
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1296 fprintf (stderr, " read INCR done\n");
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1297 #endif
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1298 if (! waiting_for_other_props_on_window (display, window))
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1299 XSelectInput (display, window, STANDARD_EVENT_SET);
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
1300 unexpect_property_change (wait_object);
14372
81c67c7d1655 (xfree): Macro deleted.
Richard M. Stallman <rms@gnu.org>
parents: 14371
diff changeset
1301 /* Use free, not XFree, because x_get_window_property
14371
dfeae392adcd (x_get_window_property_as_lisp_data): Use xfree, not XFree.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
1302 calls xmalloc itself. */
14372
81c67c7d1655 (xfree): Macro deleted.
Richard M. Stallman <rms@gnu.org>
parents: 14371
diff changeset
1303 if (tmp_data) free (tmp_data);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1304 break;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1305 }
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1306
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1307 BLOCK_INPUT;
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1308 XDeleteProperty (display, window, property);
4636
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
1309 wait_object = expect_property_change (display, window, property,
bb0ec6a82089 (struct property_change): New field `arrived'.
Richard M. Stallman <rms@gnu.org>
parents: 4547
diff changeset
1310 PropertyNewValue);
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1311 XFlush (display);
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1312 UNBLOCK_INPUT;
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1313
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1314 #if 0
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1315 fprintf (stderr, " read INCR %d\n", tmp_size_bytes);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1316 #endif
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1317 if (*size_bytes_ret < offset + tmp_size_bytes)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1318 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1319 #if 0
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1320 fprintf (stderr, " read INCR realloc %d -> %d\n",
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1321 *size_bytes_ret, offset + tmp_size_bytes);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1322 #endif
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1323 *size_bytes_ret = offset + tmp_size_bytes;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1324 *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1325 }
4547
3bd8248cc191 (receive_incremental_selection): Use bcopy, not memcpy.
Richard M. Stallman <rms@gnu.org>
parents: 4373
diff changeset
1326 bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1327 offset += tmp_size_bytes;
14372
81c67c7d1655 (xfree): Macro deleted.
Richard M. Stallman <rms@gnu.org>
parents: 14371
diff changeset
1328 /* Use free, not XFree, because x_get_window_property
14371
dfeae392adcd (x_get_window_property_as_lisp_data): Use xfree, not XFree.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
1329 calls xmalloc itself. */
14372
81c67c7d1655 (xfree): Macro deleted.
Richard M. Stallman <rms@gnu.org>
parents: 14371
diff changeset
1330 free (tmp_data);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1331 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1332 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1333
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1334 /* Once a requested selection is "ready" (we got a SelectionNotify event),
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1335 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1336 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1337
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1338 static Lisp_Object
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1339 x_get_window_property_as_lisp_data (display, window, property, target_type,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1340 selection_atom)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1341 Display *display;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1342 Window window;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1343 Atom property;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1344 Lisp_Object target_type; /* for error messages only */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1345 Atom selection_atom; /* for error messages only */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1346 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1347 Atom actual_type;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1348 int actual_format;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1349 unsigned long actual_size;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1350 unsigned char *data = 0;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1351 int bytes = 0;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1352 Lisp_Object val;
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1353 struct x_display_info *dpyinfo = x_display_info_for_display (display);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1354
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1355 x_get_window_property (display, window, property, &data, &bytes,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1356 &actual_type, &actual_format, &actual_size, 1);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1357 if (! data)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1358 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1359 int there_is_a_selection_owner;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1360 BLOCK_INPUT;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1361 there_is_a_selection_owner
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1362 = XGetSelectionOwner (display, selection_atom);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1363 UNBLOCK_INPUT;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1364 while (1) /* Note debugger can no longer return, so this is obsolete */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1365 Fsignal (Qerror,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1366 there_is_a_selection_owner ?
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1367 Fcons (build_string ("selection owner couldn't convert"),
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1368 actual_type
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1369 ? Fcons (target_type,
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1370 Fcons (x_atom_to_symbol (dpyinfo, display,
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1371 actual_type),
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1372 Qnil))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1373 : Fcons (target_type, Qnil))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1374 : Fcons (build_string ("no selection"),
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1375 Fcons (x_atom_to_symbol (dpyinfo, display,
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1376 selection_atom),
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1377 Qnil)));
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1378 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1379
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1380 if (actual_type == dpyinfo->Xatom_INCR)
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1381 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1382 /* That wasn't really the data, just the beginning. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1383
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1384 unsigned int min_size_bytes = * ((unsigned int *) data);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1385 BLOCK_INPUT;
14372
81c67c7d1655 (xfree): Macro deleted.
Richard M. Stallman <rms@gnu.org>
parents: 14371
diff changeset
1386 /* Use free, not XFree, because x_get_window_property
14371
dfeae392adcd (x_get_window_property_as_lisp_data): Use xfree, not XFree.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
1387 calls xmalloc itself. */
14372
81c67c7d1655 (xfree): Macro deleted.
Richard M. Stallman <rms@gnu.org>
parents: 14371
diff changeset
1388 free ((char *) data);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1389 UNBLOCK_INPUT;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1390 receive_incremental_selection (display, window, property, target_type,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1391 min_size_bytes, &data, &bytes,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1392 &actual_type, &actual_format,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1393 &actual_size);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1394 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1395
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1396 BLOCK_INPUT;
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1397 XDeleteProperty (display, window, property);
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1398 XFlush (display);
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1399 UNBLOCK_INPUT;
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
1400
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1401 /* It's been read. Now convert it to a lisp object in some semi-rational
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1402 manner. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1403 val = selection_data_to_lisp_data (display, data, bytes,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1404 actual_type, actual_format);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1405
14372
81c67c7d1655 (xfree): Macro deleted.
Richard M. Stallman <rms@gnu.org>
parents: 14371
diff changeset
1406 /* Use free, not XFree, because x_get_window_property
14371
dfeae392adcd (x_get_window_property_as_lisp_data): Use xfree, not XFree.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
1407 calls xmalloc itself. */
14372
81c67c7d1655 (xfree): Macro deleted.
Richard M. Stallman <rms@gnu.org>
parents: 14371
diff changeset
1408 free ((char *) data);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1409 return val;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1410 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1411
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1412 /* These functions convert from the selection data read from the server into
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1413 something that we can use from Lisp, and vice versa.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1414
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1415 Type: Format: Size: Lisp Type:
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1416 ----- ------- ----- -----------
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1417 * 8 * String
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1418 ATOM 32 1 Symbol
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1419 ATOM 32 > 1 Vector of Symbols
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1420 * 16 1 Integer
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1421 * 16 > 1 Vector of Integers
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1422 * 32 1 if <=16 bits: Integer
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1423 if > 16 bits: Cons of top16, bot16
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1424 * 32 > 1 Vector of the above
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1425
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1426 When converting a Lisp number to C, it is assumed to be of format 16 if
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1427 it is an integer, and of format 32 if it is a cons of two integers.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1428
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1429 When converting a vector of numbers from Lisp to C, it is assumed to be
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1430 of format 16 if every element in the vector is an integer, and is assumed
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1431 to be of format 32 if any element is a cons of two integers.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1432
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1433 When converting an object to C, it may be of the form (SYMBOL . <data>)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1434 where SYMBOL is what we should claim that the type is. Format and
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1435 representation are as above. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1436
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1437
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1438
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1439 static Lisp_Object
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1440 selection_data_to_lisp_data (display, data, size, type, format)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1441 Display *display;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1442 unsigned char *data;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1443 Atom type;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1444 int size, format;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1445 {
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1446 struct x_display_info *dpyinfo = x_display_info_for_display (display);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1447
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1448 if (type == dpyinfo->Xatom_NULL)
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1449 return QNULL;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1450
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1451 /* Convert any 8-bit data to a string, for compactness. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1452 else if (format == 8)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1453 return make_string ((char *) data, size);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1454
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1455 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1456 a vector of symbols.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1457 */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1458 else if (type == XA_ATOM)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1459 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1460 int i;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1461 if (size == sizeof (Atom))
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1462 return x_atom_to_symbol (dpyinfo, display, *((Atom *) data));
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1463 else
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1464 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1465 Lisp_Object v = Fmake_vector (size / sizeof (Atom), 0);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1466 for (i = 0; i < size / sizeof (Atom); i++)
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1467 Faset (v, i, x_atom_to_symbol (dpyinfo, display,
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1468 ((Atom *) data) [i]));
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1469 return v;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1470 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1471 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1472
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1473 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1474 If the number is > 16 bits, convert it to a cons of integers,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1475 16 bits in each half.
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1476 */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1477 else if (format == 32 && size == sizeof (long))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1478 return long_to_cons (((unsigned long *) data) [0]);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1479 else if (format == 16 && size == sizeof (short))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1480 return make_number ((int) (((unsigned short *) data) [0]));
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1481
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1482 /* Convert any other kind of data to a vector of numbers, represented
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1483 as above (as an integer, or a cons of two 16 bit integers.)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1484 */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1485 else if (format == 16)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1486 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1487 int i;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1488 Lisp_Object v = Fmake_vector (size / 4, 0);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1489 for (i = 0; i < size / 4; i++)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1490 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1491 int j = (int) ((unsigned short *) data) [i];
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1492 Faset (v, i, make_number (j));
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1493 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1494 return v;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1495 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1496 else
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1497 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1498 int i;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1499 Lisp_Object v = Fmake_vector (size / 4, 0);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1500 for (i = 0; i < size / 4; i++)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1501 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1502 unsigned long j = ((unsigned long *) data) [i];
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1503 Faset (v, i, long_to_cons (j));
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1504 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1505 return v;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1506 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1507 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1508
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1509
14372
81c67c7d1655 (xfree): Macro deleted.
Richard M. Stallman <rms@gnu.org>
parents: 14371
diff changeset
1510 /* Use free, not XFree, to free the data obtained with this function. */
14371
dfeae392adcd (x_get_window_property_as_lisp_data): Use xfree, not XFree.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
1511
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1512 static void
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1513 lisp_data_to_selection_data (display, obj,
4278
889d81e3f507 (lisp_data_to_selection_data): New arg NOFREE_RET.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
1514 data_ret, type_ret, size_ret,
889d81e3f507 (lisp_data_to_selection_data): New arg NOFREE_RET.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
1515 format_ret, nofree_ret)
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1516 Display *display;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1517 Lisp_Object obj;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1518 unsigned char **data_ret;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1519 Atom *type_ret;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1520 unsigned int *size_ret;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1521 int *format_ret;
4278
889d81e3f507 (lisp_data_to_selection_data): New arg NOFREE_RET.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
1522 int *nofree_ret;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1523 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1524 Lisp_Object type = Qnil;
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1525 struct x_display_info *dpyinfo = x_display_info_for_display (display);
4278
889d81e3f507 (lisp_data_to_selection_data): New arg NOFREE_RET.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
1526
889d81e3f507 (lisp_data_to_selection_data): New arg NOFREE_RET.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
1527 *nofree_ret = 0;
889d81e3f507 (lisp_data_to_selection_data): New arg NOFREE_RET.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
1528
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1529 if (CONSP (obj) && SYMBOLP (XCONS (obj)->car))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1530 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1531 type = XCONS (obj)->car;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1532 obj = XCONS (obj)->cdr;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1533 if (CONSP (obj) && NILP (XCONS (obj)->cdr))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1534 obj = XCONS (obj)->car;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1535 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1536
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1537 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1538 { /* This is not the same as declining */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1539 *format_ret = 32;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1540 *size_ret = 0;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1541 *data_ret = 0;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1542 type = QNULL;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1543 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1544 else if (STRINGP (obj))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1545 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1546 *format_ret = 8;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1547 *size_ret = XSTRING (obj)->size;
4278
889d81e3f507 (lisp_data_to_selection_data): New arg NOFREE_RET.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
1548 *data_ret = XSTRING (obj)->data;
889d81e3f507 (lisp_data_to_selection_data): New arg NOFREE_RET.
Richard M. Stallman <rms@gnu.org>
parents: 3591
diff changeset
1549 *nofree_ret = 1;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1550 if (NILP (type)) type = QSTRING;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1551 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1552 else if (SYMBOLP (obj))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1553 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1554 *format_ret = 32;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1555 *size_ret = 1;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1556 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1557 (*data_ret) [sizeof (Atom)] = 0;
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1558 (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, display, obj);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1559 if (NILP (type)) type = QATOM;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1560 }
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
1561 else if (INTEGERP (obj)
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1562 && XINT (obj) < 0xFFFF
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1563 && XINT (obj) > -0xFFFF)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1564 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1565 *format_ret = 16;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1566 *size_ret = 1;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1567 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1568 (*data_ret) [sizeof (short)] = 0;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1569 (*(short **) data_ret) [0] = (short) XINT (obj);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1570 if (NILP (type)) type = QINTEGER;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1571 }
2169
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1572 else if (INTEGERP (obj)
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1573 || (CONSP (obj) && INTEGERP (XCONS (obj)->car)
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1574 && (INTEGERP (XCONS (obj)->cdr)
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1575 || (CONSP (XCONS (obj)->cdr)
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1576 && INTEGERP (XCONS (XCONS (obj)->cdr)->car)))))
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1577 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1578 *format_ret = 32;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1579 *size_ret = 1;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1580 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1581 (*data_ret) [sizeof (long)] = 0;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1582 (*(unsigned long **) data_ret) [0] = cons_to_long (obj);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1583 if (NILP (type)) type = QINTEGER;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1584 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1585 else if (VECTORP (obj))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1586 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1587 /* Lisp_Vectors may represent a set of ATOMs;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1588 a set of 16 or 32 bit INTEGERs;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1589 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1590 */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1591 int i;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1592
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1593 if (SYMBOLP (XVECTOR (obj)->contents [0]))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1594 /* This vector is an ATOM set */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1595 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1596 if (NILP (type)) type = QATOM;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1597 *size_ret = XVECTOR (obj)->size;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1598 *format_ret = 32;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1599 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1600 for (i = 0; i < *size_ret; i++)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1601 if (SYMBOLP (XVECTOR (obj)->contents [i]))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1602 (*(Atom **) data_ret) [i]
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1603 = symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1604 else
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1605 Fsignal (Qerror, /* Qselection_error */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1606 Fcons (build_string
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1607 ("all elements of selection vector must have same type"),
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1608 Fcons (obj, Qnil)));
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1609 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1610 #if 0 /* #### MULTIPLE doesn't work yet */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1611 else if (VECTORP (XVECTOR (obj)->contents [0]))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1612 /* This vector is an ATOM_PAIR set */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1613 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1614 if (NILP (type)) type = QATOM_PAIR;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1615 *size_ret = XVECTOR (obj)->size;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1616 *format_ret = 32;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1617 *data_ret = (unsigned char *)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1618 xmalloc ((*size_ret) * sizeof (Atom) * 2);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1619 for (i = 0; i < *size_ret; i++)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1620 if (VECTORP (XVECTOR (obj)->contents [i]))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1621 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1622 Lisp_Object pair = XVECTOR (obj)->contents [i];
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1623 if (XVECTOR (pair)->size != 2)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1624 Fsignal (Qerror,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1625 Fcons (build_string
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1626 ("elements of the vector must be vectors of exactly two elements"),
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1627 Fcons (pair, Qnil)));
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1628
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1629 (*(Atom **) data_ret) [i * 2]
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1630 = symbol_to_x_atom (dpyinfo, display,
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1631 XVECTOR (pair)->contents [0]);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1632 (*(Atom **) data_ret) [(i * 2) + 1]
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1633 = symbol_to_x_atom (dpyinfo, display,
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1634 XVECTOR (pair)->contents [1]);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1635 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1636 else
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1637 Fsignal (Qerror,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1638 Fcons (build_string
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1639 ("all elements of the vector must be of the same type"),
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1640 Fcons (obj, Qnil)));
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1641
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1642 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1643 #endif
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1644 else
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1645 /* This vector is an INTEGER set, or something like it */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1646 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1647 *size_ret = XVECTOR (obj)->size;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1648 if (NILP (type)) type = QINTEGER;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1649 *format_ret = 16;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1650 for (i = 0; i < *size_ret; i++)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1651 if (CONSP (XVECTOR (obj)->contents [i]))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1652 *format_ret = 32;
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
1653 else if (!INTEGERP (XVECTOR (obj)->contents [i]))
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1654 Fsignal (Qerror, /* Qselection_error */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1655 Fcons (build_string
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1656 ("elements of selection vector must be integers or conses of integers"),
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1657 Fcons (obj, Qnil)));
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1658
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1659 *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1660 for (i = 0; i < *size_ret; i++)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1661 if (*format_ret == 32)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1662 (*((unsigned long **) data_ret)) [i]
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1663 = cons_to_long (XVECTOR (obj)->contents [i]);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1664 else
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1665 (*((unsigned short **) data_ret)) [i]
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1666 = (unsigned short) cons_to_long (XVECTOR (obj)->contents [i]);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1667 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1668 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1669 else
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1670 Fsignal (Qerror, /* Qselection_error */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1671 Fcons (build_string ("unrecognised selection data"),
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1672 Fcons (obj, Qnil)));
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1673
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1674 *type_ret = symbol_to_x_atom (dpyinfo, display, type);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1675 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1676
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1677 static Lisp_Object
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1678 clean_local_selection_data (obj)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1679 Lisp_Object obj;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1680 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1681 if (CONSP (obj)
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
1682 && INTEGERP (XCONS (obj)->car)
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1683 && CONSP (XCONS (obj)->cdr)
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
1684 && INTEGERP (XCONS (XCONS (obj)->cdr)->car)
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1685 && NILP (XCONS (XCONS (obj)->cdr)->cdr))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1686 obj = Fcons (XCONS (obj)->car, XCONS (obj)->cdr);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1687
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1688 if (CONSP (obj)
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
1689 && INTEGERP (XCONS (obj)->car)
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
1690 && INTEGERP (XCONS (obj)->cdr))
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1691 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1692 if (XINT (XCONS (obj)->car) == 0)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1693 return XCONS (obj)->cdr;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1694 if (XINT (XCONS (obj)->car) == -1)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1695 return make_number (- XINT (XCONS (obj)->cdr));
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1696 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1697 if (VECTORP (obj))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1698 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1699 int i;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1700 int size = XVECTOR (obj)->size;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1701 Lisp_Object copy;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1702 if (size == 1)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1703 return clean_local_selection_data (XVECTOR (obj)->contents [0]);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1704 copy = Fmake_vector (size, Qnil);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1705 for (i = 0; i < size; i++)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1706 XVECTOR (copy)->contents [i]
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1707 = clean_local_selection_data (XVECTOR (obj)->contents [i]);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1708 return copy;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1709 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1710 return obj;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1711 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1712
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1713 /* Called from XTread_socket to handle SelectionNotify events.
14134
a1ebbdb060b8 (x_handle_selection_notify): Give an indication
Karl Heuer <kwzh@gnu.org>
parents: 14031
diff changeset
1714 If it's the selection we are waiting for, stop waiting
a1ebbdb060b8 (x_handle_selection_notify): Give an indication
Karl Heuer <kwzh@gnu.org>
parents: 14031
diff changeset
1715 by setting the car of reading_selection_reply to non-nil.
a1ebbdb060b8 (x_handle_selection_notify): Give an indication
Karl Heuer <kwzh@gnu.org>
parents: 14031
diff changeset
1716 We store t there if the reply is successful, lambda if not. */
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1717
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1718 void
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1719 x_handle_selection_notify (event)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1720 XSelectionEvent *event;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1721 {
14031
51c6f601f42b Undo previous change, except for comments and doc strings.
Richard M. Stallman <rms@gnu.org>
parents: 13942
diff changeset
1722 if (event->requestor != reading_selection_window)
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1723 return;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1724 if (event->selection != reading_which_selection)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1725 return;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1726
14134
a1ebbdb060b8 (x_handle_selection_notify): Give an indication
Karl Heuer <kwzh@gnu.org>
parents: 14031
diff changeset
1727 XCONS (reading_selection_reply)->car
a1ebbdb060b8 (x_handle_selection_notify): Give an indication
Karl Heuer <kwzh@gnu.org>
parents: 14031
diff changeset
1728 = (event->property != 0 ? Qt : Qlambda);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1729 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1730
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1731
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1732 DEFUN ("x-own-selection-internal",
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1733 Fx_own_selection_internal, Sx_own_selection_internal,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1734 2, 2, 0,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1735 "Assert an X selection of the given TYPE with the given VALUE.\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1736 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1737 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1738 VALUE is typically a string, or a cons of two markers, but may be\n\
2169
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1739 anything that the functions on `selection-converter-alist' know about.")
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1740 (selection_name, selection_value)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1741 Lisp_Object selection_name, selection_value;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1742 {
5947
9ff439565145 (x-own-selection-internal, x-get-selection-internal,
Karl Heuer <kwzh@gnu.org>
parents: 5244
diff changeset
1743 check_x ();
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1744 CHECK_SYMBOL (selection_name, 0);
14134
a1ebbdb060b8 (x_handle_selection_notify): Give an indication
Karl Heuer <kwzh@gnu.org>
parents: 14031
diff changeset
1745 if (NILP (selection_value)) error ("selection-value may not be nil");
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1746 x_own_selection (selection_name, selection_value);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1747 return selection_value;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1748 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1749
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1750
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1751 /* Request the selection value from the owner. If we are the owner,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1752 simply return our selection value. If we are not the owner, this
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1753 will block until all of the data has arrived. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1754
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1755 DEFUN ("x-get-selection-internal",
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1756 Fx_get_selection_internal, Sx_get_selection_internal, 2, 2, 0,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1757 "Return text selected from some X window.\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1758 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1759 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
2169
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1760 TYPE is the type of data desired, typically `STRING'.")
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1761 (selection_symbol, target_type)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1762 Lisp_Object selection_symbol, target_type;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1763 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1764 Lisp_Object val = Qnil;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1765 struct gcpro gcpro1, gcpro2;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1766 GCPRO2 (target_type, val); /* we store newly consed data into these */
5947
9ff439565145 (x-own-selection-internal, x-get-selection-internal,
Karl Heuer <kwzh@gnu.org>
parents: 5244
diff changeset
1767 check_x ();
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1768 CHECK_SYMBOL (selection_symbol, 0);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1769
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1770 #if 0 /* #### MULTIPLE doesn't work yet */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1771 if (CONSP (target_type)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1772 && XCONS (target_type)->car == QMULTIPLE)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1773 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1774 CHECK_VECTOR (XCONS (target_type)->cdr, 0);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1775 /* So we don't destructively modify this... */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1776 target_type = copy_multiple_data (target_type);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1777 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1778 else
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1779 #endif
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1780 CHECK_SYMBOL (target_type, 0);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1781
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1782 val = x_get_local_selection (selection_symbol, target_type);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1783
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1784 if (NILP (val))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1785 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1786 val = x_get_foreign_selection (selection_symbol, target_type);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1787 goto DONE;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1788 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1789
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1790 if (CONSP (val)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1791 && SYMBOLP (XCONS (val)->car))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1792 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1793 val = XCONS (val)->cdr;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1794 if (CONSP (val) && NILP (XCONS (val)->cdr))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1795 val = XCONS (val)->car;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1796 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1797 val = clean_local_selection_data (val);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1798 DONE:
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1799 UNGCPRO;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1800 return val;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1801 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1802
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1803 DEFUN ("x-disown-selection-internal",
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1804 Fx_disown_selection_internal, Sx_disown_selection_internal, 1, 2, 0,
2169
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1805 "If we own the selection SELECTION, disown it.\n\
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1806 Disowning it means there is no such selection.")
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1807 (selection, time)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1808 Lisp_Object selection;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1809 Lisp_Object time;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1810 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1811 Time timestamp;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1812 Atom selection_atom;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1813 XSelectionClearEvent event;
9616
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
1814 Display *display;
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1815 struct x_display_info *dpyinfo;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1816
5947
9ff439565145 (x-own-selection-internal, x-get-selection-internal,
Karl Heuer <kwzh@gnu.org>
parents: 5244
diff changeset
1817 check_x ();
9616
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
1818 display = FRAME_X_DISPLAY (selected_frame);
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1819 dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1820 CHECK_SYMBOL (selection, 0);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1821 if (NILP (time))
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
1822 timestamp = last_event_timestamp;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1823 else
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1824 timestamp = cons_to_long (time);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1825
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1826 if (NILP (assq_no_quit (selection, Vselection_alist)))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1827 return Qnil; /* Don't disown the selection when we're not the owner. */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1828
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1829 selection_atom = symbol_to_x_atom (dpyinfo, display, selection);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1830
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1831 BLOCK_INPUT;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1832 XSetSelectionOwner (display, selection_atom, None, timestamp);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1833 UNBLOCK_INPUT;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1834
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 3492
diff changeset
1835 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1836 generated for a window which owns the selection when that window sets
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1837 the selection owner to None. The NCD server does, the MIT Sun4 server
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1838 doesn't. So we synthesize one; this means we might get two, but
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1839 that's ok, because the second one won't have any effect. */
5131
69078817ec92 (Fx_disown_selection_internal): When making the fake
Richard M. Stallman <rms@gnu.org>
parents: 4696
diff changeset
1840 SELECTION_EVENT_DISPLAY (&event) = display;
69078817ec92 (Fx_disown_selection_internal): When making the fake
Richard M. Stallman <rms@gnu.org>
parents: 4696
diff changeset
1841 SELECTION_EVENT_SELECTION (&event) = selection_atom;
69078817ec92 (Fx_disown_selection_internal): When making the fake
Richard M. Stallman <rms@gnu.org>
parents: 4696
diff changeset
1842 SELECTION_EVENT_TIME (&event) = timestamp;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1843 x_handle_selection_clear (&event);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1844
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1845 return Qt;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1846 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1847
2169
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1848 /* Get rid of all the selections in buffer BUFFER.
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1849 This is used when we kill a buffer. */
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1850
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1851 void
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1852 x_disown_buffer_selections (buffer)
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1853 Lisp_Object buffer;
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1854 {
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1855 Lisp_Object tail;
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1856 struct buffer *buf = XBUFFER (buffer);
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1857
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1858 for (tail = Vselection_alist; CONSP (tail); tail = XCONS (tail)->cdr)
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1859 {
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1860 Lisp_Object elt, value;
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1861 elt = XCONS (tail)->car;
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1862 value = XCONS (elt)->cdr;
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1863 if (CONSP (value) && MARKERP (XCONS (value)->car)
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1864 && XMARKER (XCONS (value)->car)->buffer == buf)
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1865 Fx_disown_selection_internal (XCONS (elt)->car, Qnil);
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1866 }
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1867 }
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1868
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1869 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1870 0, 1, 0,
2169
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1871 "Whether the current Emacs process owns the given X Selection.\n\
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1872 The arg should be the name of the selection in question, typically one of\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1873 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1874 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1875 For convenience, the symbol nil is the same as `PRIMARY',\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1876 and t is the same as `SECONDARY'.)")
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1877 (selection)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1878 Lisp_Object selection;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1879 {
5947
9ff439565145 (x-own-selection-internal, x-get-selection-internal,
Karl Heuer <kwzh@gnu.org>
parents: 5244
diff changeset
1880 check_x ();
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1881 CHECK_SYMBOL (selection, 0);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1882 if (EQ (selection, Qnil)) selection = QPRIMARY;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1883 if (EQ (selection, Qt)) selection = QSECONDARY;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1884
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1885 if (NILP (Fassq (selection, Vselection_alist)))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1886 return Qnil;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1887 return Qt;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1888 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1889
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1890 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1891 0, 1, 0,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1892 "Whether there is an owner for the given X Selection.\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1893 The arg should be the name of the selection in question, typically one of\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1894 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1895 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1896 For convenience, the symbol nil is the same as `PRIMARY',\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1897 and t is the same as `SECONDARY'.)")
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1898 (selection)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1899 Lisp_Object selection;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1900 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1901 Window owner;
2797
ae18dabac465 (Fx_selection_exists_p): Handle nil, t as SELECTION arg.
Richard M. Stallman <rms@gnu.org>
parents: 2515
diff changeset
1902 Atom atom;
9616
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
1903 Display *dpy;
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
1904
9680
14a8113d8a8b (Fx_selection_exists_p): If selected_frame isn't an x frame, return nil.
Richard M. Stallman <rms@gnu.org>
parents: 9670
diff changeset
1905 /* It should be safe to call this before we have an X frame. */
9691
eea337e3af4e (Fx_selection_exists_p): Fix backwards if.
Richard M. Stallman <rms@gnu.org>
parents: 9680
diff changeset
1906 if (! FRAME_X_P (selected_frame))
9680
14a8113d8a8b (Fx_selection_exists_p): If selected_frame isn't an x frame, return nil.
Richard M. Stallman <rms@gnu.org>
parents: 9670
diff changeset
1907 return Qnil;
14a8113d8a8b (Fx_selection_exists_p): If selected_frame isn't an x frame, return nil.
Richard M. Stallman <rms@gnu.org>
parents: 9670
diff changeset
1908
9616
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
1909 dpy = FRAME_X_DISPLAY (selected_frame);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1910 CHECK_SYMBOL (selection, 0);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1911 if (!NILP (Fx_selection_owner_p (selection)))
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1912 return Qt;
2797
ae18dabac465 (Fx_selection_exists_p): Handle nil, t as SELECTION arg.
Richard M. Stallman <rms@gnu.org>
parents: 2515
diff changeset
1913 if (EQ (selection, Qnil)) selection = QPRIMARY;
ae18dabac465 (Fx_selection_exists_p): Handle nil, t as SELECTION arg.
Richard M. Stallman <rms@gnu.org>
parents: 2515
diff changeset
1914 if (EQ (selection, Qt)) selection = QSECONDARY;
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1915 atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame),
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1916 dpy, selection);
2797
ae18dabac465 (Fx_selection_exists_p): Handle nil, t as SELECTION arg.
Richard M. Stallman <rms@gnu.org>
parents: 2515
diff changeset
1917 if (atom == 0)
ae18dabac465 (Fx_selection_exists_p): Handle nil, t as SELECTION arg.
Richard M. Stallman <rms@gnu.org>
parents: 2515
diff changeset
1918 return Qnil;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1919 BLOCK_INPUT;
2797
ae18dabac465 (Fx_selection_exists_p): Handle nil, t as SELECTION arg.
Richard M. Stallman <rms@gnu.org>
parents: 2515
diff changeset
1920 owner = XGetSelectionOwner (dpy, atom);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1921 UNBLOCK_INPUT;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1922 return (owner ? Qt : Qnil);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1923 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1924
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1925
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1926 #ifdef CUT_BUFFER_SUPPORT
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1927
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1928 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1929 static void
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1930 initialize_cut_buffers (display, window)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1931 Display *display;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1932 Window window;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1933 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1934 unsigned char *data = (unsigned char *) "";
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1935 BLOCK_INPUT;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1936 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1937 PropModeAppend, data, 0)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1938 FROB (XA_CUT_BUFFER0);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1939 FROB (XA_CUT_BUFFER1);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1940 FROB (XA_CUT_BUFFER2);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1941 FROB (XA_CUT_BUFFER3);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1942 FROB (XA_CUT_BUFFER4);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1943 FROB (XA_CUT_BUFFER5);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1944 FROB (XA_CUT_BUFFER6);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1945 FROB (XA_CUT_BUFFER7);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1946 #undef FROB
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1947 UNBLOCK_INPUT;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1948 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1949
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1950
2169
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1951 #define CHECK_CUT_BUFFER(symbol,n) \
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1952 { CHECK_SYMBOL ((symbol), (n)); \
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1953 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1954 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1955 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1956 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1957 Fsignal (Qerror, \
2169
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1958 Fcons (build_string ("doesn't name a cut buffer"), \
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1959 Fcons ((symbol), Qnil))); \
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1960 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1961
2169
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1962 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1963 Sx_get_cut_buffer_internal, 1, 1, 0,
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1964 "Returns the value of the named cut buffer (typically CUT_BUFFER0).")
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1965 (buffer)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1966 Lisp_Object buffer;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1967 {
9616
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
1968 Window window;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1969 Atom buffer_atom;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1970 unsigned char *data;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1971 int bytes;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1972 Atom type;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1973 int format;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1974 unsigned long size;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1975 Lisp_Object ret;
9616
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
1976 Display *display;
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1977 struct x_display_info *dpyinfo;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1978
5947
9ff439565145 (x-own-selection-internal, x-get-selection-internal,
Karl Heuer <kwzh@gnu.org>
parents: 5244
diff changeset
1979 check_x ();
9616
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
1980 display = FRAME_X_DISPLAY (selected_frame);
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1981 dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
9616
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
1982 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2169
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
1983 CHECK_CUT_BUFFER (buffer, 0);
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1984 buffer_atom = symbol_to_x_atom (dpyinfo, display, buffer);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1985
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1986 x_get_window_property (display, window, buffer_atom, &data, &bytes,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1987 &type, &format, &size, 0);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1988 if (!data) return Qnil;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1989
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1990 if (format != 8 || type != XA_STRING)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1991 Fsignal (Qerror,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1992 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
1993 Fcons (x_atom_to_symbol (dpyinfo, display, type),
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1994 Fcons (make_number (format), Qnil))));
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1995
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
1996 ret = (bytes ? make_string ((char *) data, bytes) : Qnil);
14372
81c67c7d1655 (xfree): Macro deleted.
Richard M. Stallman <rms@gnu.org>
parents: 14371
diff changeset
1997 /* Use free, not XFree, because x_get_window_property
14371
dfeae392adcd (x_get_window_property_as_lisp_data): Use xfree, not XFree.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
1998 calls xmalloc itself. */
14372
81c67c7d1655 (xfree): Macro deleted.
Richard M. Stallman <rms@gnu.org>
parents: 14371
diff changeset
1999 free (data);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2000 return ret;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2001 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2002
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2003
2169
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
2004 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal,
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
2005 Sx_store_cut_buffer_internal, 2, 2, 0,
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
2006 "Sets the value of the named cut buffer (typically CUT_BUFFER0).")
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2007 (buffer, string)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2008 Lisp_Object buffer, string;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2009 {
9616
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
2010 Window window;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2011 Atom buffer_atom;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2012 unsigned char *data;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2013 int bytes;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2014 int bytes_remaining;
9616
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
2015 int max_bytes;
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
2016 Display *display;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2017
5947
9ff439565145 (x-own-selection-internal, x-get-selection-internal,
Karl Heuer <kwzh@gnu.org>
parents: 5244
diff changeset
2018 check_x ();
9616
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
2019 display = FRAME_X_DISPLAY (selected_frame);
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
2020 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
2021
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
2022 max_bytes = SELECTION_QUANTUM (display);
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
2023 if (max_bytes > MAX_SELECTION_QUANTUM)
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
2024 max_bytes = MAX_SELECTION_QUANTUM;
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
2025
2169
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
2026 CHECK_CUT_BUFFER (buffer, 0);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2027 CHECK_STRING (string, 0);
9670
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
2028 buffer_atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame),
a03e0a600f3f Use XFlush, not XFlushQueue, throughout.
Richard M. Stallman <rms@gnu.org>
parents: 9617
diff changeset
2029 display, buffer);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2030 data = (unsigned char *) XSTRING (string)->data;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2031 bytes = XSTRING (string)->size;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2032 bytes_remaining = bytes;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2033
11161
3e309e3f0ad5 (Fx_store_cut_buffer_internal): Use the flag in the
Karl Heuer <kwzh@gnu.org>
parents: 10674
diff changeset
2034 if (! FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized)
3e309e3f0ad5 (Fx_store_cut_buffer_internal): Use the flag in the
Karl Heuer <kwzh@gnu.org>
parents: 10674
diff changeset
2035 {
3e309e3f0ad5 (Fx_store_cut_buffer_internal): Use the flag in the
Karl Heuer <kwzh@gnu.org>
parents: 10674
diff changeset
2036 initialize_cut_buffers (display, window);
3e309e3f0ad5 (Fx_store_cut_buffer_internal): Use the flag in the
Karl Heuer <kwzh@gnu.org>
parents: 10674
diff changeset
2037 FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized = 1;
3e309e3f0ad5 (Fx_store_cut_buffer_internal): Use the flag in the
Karl Heuer <kwzh@gnu.org>
parents: 10674
diff changeset
2038 }
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2039
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2040 BLOCK_INPUT;
3473
e1d043cb2f1a (Fx_store_cut_buffer_internal): Handle empty string right.
Richard M. Stallman <rms@gnu.org>
parents: 3348
diff changeset
2041
e1d043cb2f1a (Fx_store_cut_buffer_internal): Handle empty string right.
Richard M. Stallman <rms@gnu.org>
parents: 3348
diff changeset
2042 /* Don't mess up with an empty value. */
e1d043cb2f1a (Fx_store_cut_buffer_internal): Handle empty string right.
Richard M. Stallman <rms@gnu.org>
parents: 3348
diff changeset
2043 if (!bytes_remaining)
e1d043cb2f1a (Fx_store_cut_buffer_internal): Handle empty string right.
Richard M. Stallman <rms@gnu.org>
parents: 3348
diff changeset
2044 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
e1d043cb2f1a (Fx_store_cut_buffer_internal): Handle empty string right.
Richard M. Stallman <rms@gnu.org>
parents: 3348
diff changeset
2045 PropModeReplace, data, 0);
e1d043cb2f1a (Fx_store_cut_buffer_internal): Handle empty string right.
Richard M. Stallman <rms@gnu.org>
parents: 3348
diff changeset
2046
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2047 while (bytes_remaining)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2048 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2049 int chunk = (bytes_remaining < max_bytes
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2050 ? bytes_remaining : max_bytes);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2051 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2052 (bytes_remaining == bytes
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2053 ? PropModeReplace
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2054 : PropModeAppend),
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2055 data, chunk);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2056 data += chunk;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2057 bytes_remaining -= chunk;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2058 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2059 UNBLOCK_INPUT;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2060 return string;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2061 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2062
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2063
2169
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
2064 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal,
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
2065 Sx_rotate_cut_buffers_internal, 1, 1, 0,
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
2066 "Rotate the values of the cut buffers by the given number of steps;\n\
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2067 positive means move values forward, negative means backward.")
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2068 (n)
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2069 Lisp_Object n;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2070 {
9616
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
2071 Window window;
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
2072 Atom props[8];
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
2073 Display *display;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2074
5947
9ff439565145 (x-own-selection-internal, x-get-selection-internal,
Karl Heuer <kwzh@gnu.org>
parents: 5244
diff changeset
2075 check_x ();
9616
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
2076 display = FRAME_X_DISPLAY (selected_frame);
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
2077 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
2078 CHECK_NUMBER (n, 0);
9616
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
2079 if (XINT (n) == 0)
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
2080 return n;
11161
3e309e3f0ad5 (Fx_store_cut_buffer_internal): Use the flag in the
Karl Heuer <kwzh@gnu.org>
parents: 10674
diff changeset
2081 if (! FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized)
3e309e3f0ad5 (Fx_store_cut_buffer_internal): Use the flag in the
Karl Heuer <kwzh@gnu.org>
parents: 10674
diff changeset
2082 {
3e309e3f0ad5 (Fx_store_cut_buffer_internal): Use the flag in the
Karl Heuer <kwzh@gnu.org>
parents: 10674
diff changeset
2083 initialize_cut_buffers (display, window);
3e309e3f0ad5 (Fx_store_cut_buffer_internal): Use the flag in the
Karl Heuer <kwzh@gnu.org>
parents: 10674
diff changeset
2084 FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized = 1;
3e309e3f0ad5 (Fx_store_cut_buffer_internal): Use the flag in the
Karl Heuer <kwzh@gnu.org>
parents: 10674
diff changeset
2085 }
9616
1008823e2e1a (x_get_foreign_selection): Get display from
Richard M. Stallman <rms@gnu.org>
parents: 9286
diff changeset
2086
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2087 props[0] = XA_CUT_BUFFER0;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2088 props[1] = XA_CUT_BUFFER1;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2089 props[2] = XA_CUT_BUFFER2;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2090 props[3] = XA_CUT_BUFFER3;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2091 props[4] = XA_CUT_BUFFER4;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2092 props[5] = XA_CUT_BUFFER5;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2093 props[6] = XA_CUT_BUFFER6;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2094 props[7] = XA_CUT_BUFFER7;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2095 BLOCK_INPUT;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2096 XRotateWindowProperties (display, window, props, 8, XINT (n));
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2097 UNBLOCK_INPUT;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2098 return n;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2099 }
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2100
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2101 #endif
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2102
2163
8ba4fffa6566 *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 2161
diff changeset
2103 void
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2104 syms_of_xselect ()
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2105 {
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2106 defsubr (&Sx_get_selection_internal);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2107 defsubr (&Sx_own_selection_internal);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2108 defsubr (&Sx_disown_selection_internal);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2109 defsubr (&Sx_selection_owner_p);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2110 defsubr (&Sx_selection_exists_p);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2111
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2112 #ifdef CUT_BUFFER_SUPPORT
2169
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
2113 defsubr (&Sx_get_cut_buffer_internal);
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
2114 defsubr (&Sx_store_cut_buffer_internal);
2484b562777f entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 2163
diff changeset
2115 defsubr (&Sx_rotate_cut_buffers_internal);
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2116 #endif
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2117
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2118 reading_selection_reply = Fcons (Qnil, Qnil);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2119 staticpro (&reading_selection_reply);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2120 reading_selection_window = 0;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2121 reading_which_selection = 0;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2122
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2123 property_change_wait_list = 0;
4373
02a515f35abc (prop_location_identifier): Was named prop_location_tick.
Richard M. Stallman <rms@gnu.org>
parents: 4278
diff changeset
2124 prop_location_identifier = 0;
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2125 property_change_reply = Fcons (Qnil, Qnil);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2126 staticpro (&property_change_reply);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2127
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2128 Vselection_alist = Qnil;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2129 staticpro (&Vselection_alist);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2130
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2131 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2132 "An alist associating X Windows selection-types with functions.\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2133 These functions are called to convert the selection, with three args:\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2134 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2135 a desired type to which the selection should be converted;\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2136 and the local selection value (whatever was given to `x-own-selection').\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2137 \n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2138 The function should return the value to send to the X server\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2139 \(typically a string). A return value of nil\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2140 means that the conversion could not be done.\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2141 A return value which is the symbol `NULL'\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2142 means that a side-effect was executed,\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2143 and there is no meaningful selection value.");
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2144 Vselection_converter_alist = Qnil;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2145
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2146 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2147 "A list of functions to be called when Emacs loses an X selection.\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2148 \(This happens when some other X client makes its own selection\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2149 or when a Lisp program explicitly clears the selection.)\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2150 The functions are called with one argument, the selection type\n\
13557
037f27af8c7b (syms_of_xselect): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 13555
diff changeset
2151 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD').");
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2152 Vx_lost_selection_hooks = Qnil;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2153
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2154 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks,
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2155 "A list of functions to be called when Emacs answers a selection request.\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2156 The functions are called with four arguments:\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2157 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2158 - the selection-type which Emacs was asked to convert the\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2159 selection into before sending (for example, `STRING' or `LENGTH');\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2160 - a flag indicating success or failure for responding to the request.\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2161 We might have failed (and declined the request) for any number of reasons,\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2162 including being asked for a selection that we no longer own, or being asked\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2163 to convert into a type that we don't know about or that is inappropriate.\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2164 This hook doesn't let you change the behavior of Emacs's selection replies,\n\
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2165 it merely informs you that they have happened.");
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2166 Vx_sent_selection_hooks = Qnil;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2167
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2168 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout,
3492
3e75726d76c7 (x_get_foreign_selection): Handle x_selection_timeout
Richard M. Stallman <rms@gnu.org>
parents: 3473
diff changeset
2169 "Number of milliseconds to wait for a selection reply.\n\
13942
b01288cb5fc8 (x_get_foreign_selection): Renamed local variables
Karl Heuer <kwzh@gnu.org>
parents: 13557
diff changeset
2170 If the selection owner doesn't reply in this time, we give up.\n\
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2171 A value of 0 means wait as long as necessary. This is initialized from the\n\
3492
3e75726d76c7 (x_get_foreign_selection): Handle x_selection_timeout
Richard M. Stallman <rms@gnu.org>
parents: 3473
diff changeset
2172 \"*selectionTimeout\" resource.");
2161
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2173 x_selection_timeout = 0;
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2174
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2175 QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2176 QSECONDARY = intern ("SECONDARY"); staticpro (&QSECONDARY);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2177 QSTRING = intern ("STRING"); staticpro (&QSTRING);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2178 QINTEGER = intern ("INTEGER"); staticpro (&QINTEGER);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2179 QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2180 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2181 QTEXT = intern ("TEXT"); staticpro (&QTEXT);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2182 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2183 QDELETE = intern ("DELETE"); staticpro (&QDELETE);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2184 QMULTIPLE = intern ("MULTIPLE"); staticpro (&QMULTIPLE);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2185 QINCR = intern ("INCR"); staticpro (&QINCR);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2186 QEMACS_TMP = intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2187 QTARGETS = intern ("TARGETS"); staticpro (&QTARGETS);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2188 QATOM = intern ("ATOM"); staticpro (&QATOM);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2189 QATOM_PAIR = intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2190 QNULL = intern ("NULL"); staticpro (&QNULL);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2191
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2192 #ifdef CUT_BUFFER_SUPPORT
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2193 QCUT_BUFFER0 = intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2194 QCUT_BUFFER1 = intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2195 QCUT_BUFFER2 = intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2196 QCUT_BUFFER3 = intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2197 QCUT_BUFFER4 = intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2198 QCUT_BUFFER5 = intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2199 QCUT_BUFFER6 = intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2200 QCUT_BUFFER7 = intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7);
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2201 #endif
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2202
533cca1014e1 Initial revision
Richard M. Stallman <rms@gnu.org>
parents:
diff changeset
2203 }