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