Mercurial > emacs
annotate src/=xselect.c.old @ 1412:6097878fbd46
* intervals.c (traverse_intervals): New parameter `depth'.
Increment this when passing recursively.
author | Joseph Arceneaux <jla@gnu.org> |
---|---|
date | Wed, 14 Oct 1992 23:12:09 +0000 |
parents | 39c6e9d28de2 |
children | d73ee126c15d |
rev | line source |
---|---|
159 | 1 /* X Selection processing for emacs |
648 | 2 Copyright (C) 1990, 1992 Free Software Foundation. |
159 | 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 | |
648 | 8 the Free Software Foundation; either version 2, or (at your option) |
159 | 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 | |
20 #include "config.h" | |
21 #include "lisp.h" | |
22 #include "xterm.h" | |
641 | 23 #include "buffer.h" |
771 | 24 #include "frame.h" |
159 | 25 |
26 #ifdef HAVE_X11 | |
27 | |
28 /* Macros for X Selections */ | |
641 | 29 #define MAX_SELECTION(dpy) (((dpy)->max_request_size << 2) - 100) |
30 #define SELECTION_LENGTH(len,format) ((len) * ((format) >> 2)) | |
159 | 31 |
708 | 32 /* The timestamp of the last input event we received from the X server. */ |
33 unsigned long last_event_timestamp; | |
648 | 34 |
159 | 35 /* t if a mouse button is depressed. */ |
36 extern Lisp_Object Vmouse_grabbed; | |
37 | |
38 /* When emacs became the PRIMARY selection owner. */ | |
39 Time x_begin_selection_own; | |
40 | |
641 | 41 /* When emacs became the SECONDARY selection owner. */ |
42 Time x_begin_secondary_selection_own; | |
43 | |
159 | 44 /* When emacs became the CLIPBOARD selection owner. */ |
45 Time x_begin_clipboard_own; | |
46 | |
47 /* The value of the current CLIPBOARD selection. */ | |
48 Lisp_Object Vx_clipboard_value; | |
49 | |
50 /* The value of the current PRIMARY selection. */ | |
51 Lisp_Object Vx_selection_value; | |
52 | |
641 | 53 /* The value of the current SECONDARY selection. */ |
54 Lisp_Object Vx_secondary_selection_value; | |
55 | |
1268
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
56 /* Types of selections we may make. */ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
57 Lisp_Object Qprimary, Qsecondary, Qclipboard; |
641 | 58 |
59 /* Emacs' selection property identifiers. */ | |
159 | 60 Atom Xatom_emacs_selection; |
641 | 61 Atom Xatom_emacs_secondary_selection; |
159 | 62 |
63 /* Clipboard selection atom. */ | |
64 Atom Xatom_clipboard_selection; | |
65 | |
66 /* Clipboard atom. */ | |
67 Atom Xatom_clipboard; | |
68 | |
69 /* Atom for indicating incremental selection transfer. */ | |
70 Atom Xatom_incremental; | |
71 | |
72 /* Atom for indicating multiple selection request list */ | |
73 Atom Xatom_multiple; | |
74 | |
75 /* Atom for what targets emacs handles. */ | |
76 Atom Xatom_targets; | |
77 | |
78 /* Atom for indicating timstamp selection request */ | |
79 Atom Xatom_timestamp; | |
80 | |
81 /* Atom requesting we delete our selection. */ | |
82 Atom Xatom_delete; | |
83 | |
84 /* Selection magic. */ | |
85 Atom Xatom_insert_selection; | |
86 | |
87 /* Type of property for INSERT_SELECTION. */ | |
88 Atom Xatom_pair; | |
89 | |
90 /* More selection magic. */ | |
91 Atom Xatom_insert_property; | |
92 | |
93 /* Atom for indicating property type TEXT */ | |
94 Atom Xatom_text; | |
95 | |
641 | 96 /* Kinds of protocol things we may receive. */ |
97 Atom Xatom_wm_take_focus; | |
98 Atom Xatom_wm_save_yourself; | |
99 Atom Xatom_wm_delete_window; | |
100 | |
101 /* Communication with window managers. */ | |
102 Atom Xatom_wm_protocols; | |
103 | |
159 | 104 /* These are to handle incremental selection transfer. */ |
105 Window incr_requestor; | |
106 Atom incr_property; | |
107 int incr_nbytes; | |
108 unsigned char *incr_value; | |
109 unsigned char *incr_ptr; | |
110 | |
1268
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
111 /* Declarations for handling cut buffers. |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
112 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
113 Whenever we set a cut buffer or read a cut buffer's value, we cache |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
114 it in cut_buffer_value. We look for PropertyNotify events about |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
115 the CUT_BUFFER properties, and invalidate our cache accordingly. |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
116 We ignore PropertyNotify events that we suspect were caused by our |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
117 own changes to the cut buffers, so we can keep the cache valid |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
118 longer. |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
119 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
120 IS ALL THIS HAIR WORTH IT? Well, these functions get called every |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
121 time an element goes into or is retrieved from the kill ring, and |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
122 those ought to be quick. It's not fun in time or space to wait for |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
123 50k cut buffers to fly back and forth across the net. */ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
124 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
125 /* The number of CUT_BUFFER properties defined under X. */ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
126 #define NUM_CUT_BUFFERS (8) |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
127 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
128 /* cut_buffer_atom[n] is the atom naming the nth cut buffer. */ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
129 static Atom cut_buffer_atom[NUM_CUT_BUFFERS] = { |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
130 XA_CUT_BUFFER0, XA_CUT_BUFFER1, XA_CUT_BUFFER2, XA_CUT_BUFFER3, |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
131 XA_CUT_BUFFER4, XA_CUT_BUFFER5, XA_CUT_BUFFER6, XA_CUT_BUFFER7 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
132 }; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
133 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
134 /* cut_buffer_value is an eight-element vector; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
135 (aref cut_buffer_value n) is the cached value of cut buffer n, or |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
136 Qnil if cut buffer n is unset. */ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
137 static Lisp_Object cut_buffer_value; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
138 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
139 /* Bit N of cut_buffer_cached is true if (aref cut_buffer_value n) is |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
140 known to be valid. This is cleared by PropertyNotify events |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
141 handled by x_invalidate_cut_buffer_cache. It would be wonderful if |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
142 that routine could just set the appropriate element of |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
143 cut_buffer_value to some special value meaning "uncached", but that |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
144 would lose if a GC happened to be in progress. |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
145 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
146 Bit N of cut_buffer_just_set is true if cut buffer N has been set since |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
147 the last PropertyNotify event; since we get an event even when we set |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
148 the property ourselves, we should ignore one event after setting |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
149 a cut buffer, so we don't have to throw away our cache. */ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
150 #ifdef __STDC__ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
151 volatile |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
152 #endif |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
153 static cut_buffer_cached, cut_buffer_just_set; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
154 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
155 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
156 /* Acquiring ownership of a selection. */ |
159 | 157 |
641 | 158 |
159 /* Request selection ownership if we do not already have it. */ | |
160 | |
161 static int | |
162 own_selection (selection_type, time) | |
163 Atom selection_type; | |
164 Time time; | |
165 { | |
166 Window owner_window, selecting_window; | |
167 | |
168 if ((EQ (selection_type, Qprimary) && !NILP (Vx_selection_value)) | |
169 || ((EQ (selection_type, Qsecondary)) && !NILP (Vx_secondary_selection_value)) | |
170 || ((EQ (selection_type, Qclipboard)) && !NILP (Vx_clipboard_value))) | |
171 return 1; | |
172 | |
1053
a411429c4140
* xselect.c: Use the FRAME_X_WINDOW macro, for readability.
Jim Blandy <jimb@redhat.com>
parents:
847
diff
changeset
|
173 selecting_window = FRAME_X_WINDOW (selected_frame); |
641 | 174 XSetSelectionOwner (x_current_display, selection_type, |
175 selecting_window, time); | |
176 owner_window = XGetSelectionOwner (x_current_display, selection_type); | |
177 | |
648 | 178 if (owner_window != selecting_window) |
641 | 179 return 0; |
180 | |
181 return 1; | |
182 } | |
183 | |
159 | 184 /* Become the selection owner and make our data the selection value. |
185 If we are already the owner, merely change data and timestamp values. | |
186 This avoids generating SelectionClear events for ourselves. */ | |
187 | |
188 DEFUN ("x-own-selection", Fx_own_selection, Sx_own_selection, | |
641 | 189 1, 2, "", |
190 "Make STRING the selection value. Default is the primary selection,\n\ | |
708 | 191 but optional second argument TYPE may specify secondary or clipboard.\n\ |
192 \n\ | |
193 TYPE may also be cut-buffer0, indicating that Emacs should set the X\n\ | |
194 cut buffer 0 to STRING. This is for compatibility with older X\n\ | |
195 applications which still use the cut buffers; new applications should\n\ | |
196 use X selections.") | |
641 | 197 (string, type) |
198 register Lisp_Object string, type; | |
159 | 199 { |
641 | 200 Atom selection_type; |
201 Lisp_Object val; | |
708 | 202 Time event_time = last_event_timestamp; |
159 | 203 CHECK_STRING (string, 0); |
204 | |
839 | 205 val = Qnil; |
206 | |
641 | 207 if (NILP (type) || EQ (type, Qprimary)) |
159 | 208 { |
641 | 209 BLOCK_INPUT; |
210 if (own_selection (XA_PRIMARY, event_time)) | |
211 { | |
212 x_begin_selection_own = event_time; | |
213 val = Vx_selection_value = string; | |
214 } | |
708 | 215 UNBLOCK_INPUT; |
641 | 216 } |
217 else if (EQ (type, Qsecondary)) | |
218 { | |
219 BLOCK_INPUT; | |
220 if (own_selection (XA_SECONDARY, event_time)) | |
159 | 221 { |
641 | 222 x_begin_secondary_selection_own = event_time; |
223 val = Vx_secondary_selection_value = string; | |
159 | 224 } |
641 | 225 UNBLOCK_INPUT; |
159 | 226 } |
641 | 227 else if (EQ (type, Qclipboard)) |
228 { | |
229 BLOCK_INPUT; | |
230 if (own_selection (Xatom_clipboard, event_time)) | |
231 { | |
708 | 232 x_begin_clipboard_own = event_time; |
641 | 233 val = Vx_clipboard_value = string; |
234 } | |
708 | 235 UNBLOCK_INPUT; |
236 } | |
1268
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
237 #if 0 |
708 | 238 else if (EQ (type, Qcut_buffer0)) |
239 { | |
847 | 240 /* DECwindows and some other servers don't seem to like setting |
241 properties to values larger than about 20k. For very large | |
242 values, they signal an error, but for intermediate values | |
243 they just seem to hang. | |
244 | |
245 We could just truncate the request, but it's better to let | |
246 the user know that the strategy he/she's using isn't going to | |
247 work than to have it work partially, but incorrectly. */ | |
708 | 248 BLOCK_INPUT; |
847 | 249 if (XSTRING (string)->size > MAX_SELECTION (x_current_display)) |
250 { | |
251 XStoreBytes (x_current_display, (char *) 0, 0); | |
252 val = Qnil; | |
253 } | |
254 else | |
255 { | |
256 XStoreBytes (x_current_display, | |
257 (char *) XSTRING (string)->data, | |
258 XSTRING (string)->size); | |
259 val = string; | |
260 } | |
708 | 261 UNBLOCK_INPUT; |
641 | 262 } |
1268
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
263 #endif |
641 | 264 else |
265 error ("Invalid X selection type"); | |
159 | 266 |
641 | 267 return val; |
159 | 268 } |
269 | |
270 /* Clear our selection ownership data, as some other client has | |
271 become the owner. */ | |
272 | |
273 void | |
274 x_disown_selection (old_owner, selection, changed_owner_time) | |
275 Window *old_owner; | |
276 Atom selection; | |
277 Time changed_owner_time; | |
278 { | |
771 | 279 struct frame *s = x_window_to_frame (old_owner); |
159 | 280 |
281 if (s) /* We are the owner */ | |
282 { | |
283 if (selection == XA_PRIMARY) | |
284 { | |
285 x_begin_selection_own = 0; | |
286 Vx_selection_value = Qnil; | |
287 } | |
641 | 288 else if (selection == XA_SECONDARY) |
289 { | |
290 x_begin_secondary_selection_own = 0; | |
291 Vx_secondary_selection_value = Qnil; | |
292 } | |
159 | 293 else if (selection == Xatom_clipboard) |
294 { | |
295 x_begin_clipboard_own = 0; | |
296 Vx_clipboard_value = Qnil; | |
297 } | |
298 else | |
299 abort (); | |
300 } | |
301 else | |
302 abort (); /* Inconsistent state. */ | |
303 } | |
304 | |
1268
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
305 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
306 /* Answering selection requests. */ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
307 |
159 | 308 int x_selection_alloc_error; |
309 int x_converting_selection; | |
310 | |
1268
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
311 /* Reply to some client's request for our selection data. |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
312 Data is placed in a property supplied by the requesting window. |
159 | 313 |
314 If the data exceeds the maximum amount the server can send, | |
315 then prepare to send it incrementally, and reply to the client with | |
316 the total size of the data. | |
317 | |
318 But first, check for all the other crufty stuff we could get. */ | |
319 | |
320 void | |
321 x_answer_selection_request (event) | |
322 XSelectionRequestEvent event; | |
323 { | |
324 Time emacs_own_time; | |
325 Lisp_Object selection_value; | |
326 XSelectionEvent evt; | |
327 int format = 8; /* We have only byte sized (text) data. */ | |
328 | |
329 evt.type = SelectionNotify; /* Construct reply event */ | |
330 evt.display = event.display; | |
331 evt.requestor = event.requestor; | |
332 evt.selection = event.selection; | |
333 evt.time = event.time; | |
334 evt.target = event.target; | |
335 | |
336 if (event.selection == XA_PRIMARY) | |
337 { | |
338 emacs_own_time = x_begin_selection_own; | |
339 selection_value = Vx_selection_value; | |
340 } | |
641 | 341 else if (event.selection == XA_SECONDARY) |
342 { | |
343 emacs_own_time = x_begin_secondary_selection_own; | |
344 selection_value = Vx_secondary_selection_value; | |
345 } | |
159 | 346 else if (event.selection == Xatom_clipboard) |
347 { | |
348 emacs_own_time = x_begin_clipboard_own; | |
349 selection_value = Vx_clipboard_value; | |
350 } | |
351 else | |
352 abort (); | |
353 | |
354 if (event.time != CurrentTime | |
355 && event.time < emacs_own_time) | |
356 evt.property = None; | |
357 else | |
358 { | |
359 if (event.property == None) /* obsolete client */ | |
360 evt.property = event.target; | |
361 else | |
362 evt.property = event.property; | |
363 } | |
364 | |
365 if (event.target == Xatom_targets) /* Send List of target atoms */ | |
366 { | |
367 } | |
368 else if (event.target == Xatom_multiple) /* Recvd list: <target, prop> */ | |
369 { | |
370 Atom type; | |
371 int return_format; | |
372 unsigned long items, bytes_left; | |
373 unsigned char *data; | |
374 int result, i; | |
375 | |
641 | 376 if (event.property == 0 /* 0 == NILP */ |
159 | 377 || event.property == None) |
378 return; | |
379 | |
380 result = XGetWindowProperty (event.display, event.requestor, | |
381 event.property, 0L, 10000000L, | |
382 True, Xatom_pair, &type, &return_format, | |
383 &items, &bytes_left, &data); | |
384 | |
385 if (result == Success && type == Xatom_pair) | |
386 for (i = items; i > 0; i--) | |
387 { | |
388 /* Convert each element of the list. */ | |
389 } | |
390 | |
391 (void) XSendEvent (x_current_display, evt.requestor, False, | |
392 0L, (XEvent *) &evt); | |
393 return; | |
394 } | |
395 else if (event.target == Xatom_timestamp) /* Send ownership timestamp */ | |
396 { | |
397 if (! emacs_own_time) | |
398 abort (); | |
399 | |
400 format = 32; | |
401 XChangeProperty (evt.display, evt.requestor, evt.property, | |
402 evt.target, format, PropModeReplace, | |
641 | 403 (unsigned char *) &emacs_own_time, 1); |
159 | 404 return; |
405 } | |
406 else if (event.target == Xatom_delete) /* Delete our selection. */ | |
407 { | |
408 if (EQ (Qnil, selection_value)) | |
409 abort (); | |
410 | |
411 x_disown_selection (event.owner, event.selection, event.time); | |
412 | |
641 | 413 /* Now return property of type NILP, length 0. */ |
159 | 414 XChangeProperty (event.display, event.requestor, event.property, |
415 0, format, PropModeReplace, (unsigned char *) 0, 0); | |
416 return; | |
417 } | |
418 else if (event.target == Xatom_insert_selection) | |
419 { | |
420 Atom type; | |
421 int return_format; | |
422 unsigned long items, bytes_left; | |
423 unsigned char *data; | |
424 int result = XGetWindowProperty (event.display, event.requestor, | |
425 event.property, 0L, 10000000L, | |
426 True, Xatom_pair, &type, &return_format, | |
427 &items, &bytes_left, &data); | |
428 if (result == Success && type == Xatom_pair) | |
429 { | |
430 /* Convert the first atom to (a selection) to the target | |
431 indicated by the second atom. */ | |
432 } | |
433 } | |
434 else if (event.target == Xatom_insert_property) | |
435 { | |
436 Atom type; | |
437 int return_format; | |
438 unsigned long items, bytes_left; | |
439 unsigned char *data; | |
440 int result = XGetWindowProperty (event.display, event.requestor, | |
441 event.property, 0L, 10000000L, | |
442 True, XA_STRING, &type, &return_format, | |
443 &items, &bytes_left, &data); | |
444 | |
445 if (result == Success && type == XA_STRING && return_format == 8) | |
446 { | |
447 if (event.selection == Xatom_emacs_selection) | |
448 Vx_selection_value = make_string (data); | |
641 | 449 else if (event.selection == Xatom_emacs_secondary_selection) |
450 Vx_secondary_selection_value = make_string (data); | |
159 | 451 else if (event.selection == Xatom_clipboard_selection) |
452 Vx_clipboard_value = make_string (data); | |
453 else | |
454 abort (); | |
455 } | |
456 | |
457 return; | |
458 } | |
459 else if ((event.target == Xatom_text | |
460 || event.target == XA_STRING)) | |
461 { | |
462 int size = XSTRING (selection_value)->size; | |
463 unsigned char *data = XSTRING (selection_value)->data; | |
464 | |
465 if (EQ (Qnil, selection_value)) | |
466 abort (); | |
467 | |
468 /* Place data on requestor window's property. */ | |
469 if (SELECTION_LENGTH (size, format) | |
470 <= MAX_SELECTION (x_current_display)) | |
471 { | |
472 x_converting_selection = 1; | |
473 XChangeProperty (evt.display, evt.requestor, evt.property, | |
474 evt.target, format, PropModeReplace, | |
475 data, size); | |
476 if (x_selection_alloc_error) | |
477 { | |
478 x_selection_alloc_error = 0; | |
479 abort (); | |
480 } | |
481 x_converting_selection = 0; | |
482 } | |
483 else /* Send incrementally */ | |
484 { | |
485 evt.target = Xatom_incremental; | |
486 incr_requestor = evt.requestor; | |
487 incr_property = evt.property; | |
488 x_converting_selection = 1; | |
489 | |
490 /* Need to handle Alloc errors on these requests. */ | |
491 XChangeProperty (evt.display, incr_requestor, incr_property, | |
492 Xatom_incremental, 32, | |
493 PropModeReplace, | |
494 (unsigned char *) &size, 1); | |
495 if (x_selection_alloc_error) | |
496 { | |
497 x_selection_alloc_error = 0; | |
498 x_converting_selection = 0; | |
499 abort (); | |
500 /* Now abort the send. */ | |
501 } | |
502 | |
503 incr_nbytes = size; | |
504 incr_value = data; | |
505 incr_ptr = data; | |
506 | |
507 /* Ask for notification when requestor deletes property. */ | |
508 XSelectInput (x_current_display, incr_requestor, PropertyChangeMask); | |
509 | |
510 /* If we're sending incrementally, perhaps block here | |
511 until all sent? */ | |
512 } | |
513 } | |
514 else | |
515 evt.property = None; | |
516 | |
517 /* Don't do this if there was an Alloc error: abort the transfer | |
518 by sending None. */ | |
519 (void) XSendEvent (x_current_display, evt.requestor, False, | |
520 0L, (XEvent *) &evt); | |
521 } | |
522 | |
523 /* Send an increment of selection data in response to a PropertyNotify event. | |
524 The increment is placed in a property on the requestor's window. | |
525 When the requestor has processed the increment, it deletes the property, | |
526 which sends us another PropertyNotify event. | |
527 | |
528 When there is no more data to send, we send a zero-length increment. */ | |
529 | |
530 void | |
531 x_send_incremental (event) | |
532 XPropertyEvent event; | |
533 { | |
534 if (incr_requestor | |
535 && incr_requestor == event.window | |
536 && incr_property == event.atom | |
537 && event.state == PropertyDelete) | |
538 { | |
539 int format = 8; | |
540 int length = MAX_SELECTION (x_current_display); | |
541 int bytes_left = (incr_nbytes - (incr_ptr - incr_value)); | |
542 | |
543 if (length > bytes_left) /* Also sends 0 len when finished. */ | |
544 length = bytes_left; | |
545 XChangeProperty (x_current_display, incr_requestor, | |
546 incr_property, XA_STRING, format, | |
547 PropModeAppend, incr_ptr, length); | |
548 if (x_selection_alloc_error) | |
549 { | |
550 x_selection_alloc_error = 0; | |
551 x_converting_selection = 0; | |
552 /* Abandon the transmission. */ | |
553 abort (); | |
554 } | |
555 if (length > 0) | |
556 incr_ptr += length; | |
557 else | |
558 { /* Everything's sent */ | |
559 XSelectInput (x_current_display, incr_requestor, 0L); | |
560 incr_requestor = (Window) 0; | |
561 incr_property = (Atom) 0; | |
562 incr_nbytes = 0; | |
563 incr_value = (unsigned char *) 0; | |
564 incr_ptr = (unsigned char *) 0; | |
565 x_converting_selection = 0; | |
566 } | |
567 } | |
568 } | |
569 | |
1268
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
570 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
571 /* Requesting the value of a selection. */ |
159 | 572 |
573 /* Predicate function used to match a requested event. */ | |
574 | |
575 Bool | |
576 XCheckSelectionEvent (dpy, event, window) | |
577 Display *dpy; | |
578 XEvent *event; | |
579 char *window; | |
580 { | |
581 if (event->type == SelectionNotify) | |
582 if (event->xselection.requestor == (Window) window) | |
583 return True; | |
584 | |
585 return False; | |
586 } | |
587 | |
641 | 588 /* Request a selection value from its owner. This will block until |
589 all the data is arrived. */ | |
159 | 590 |
641 | 591 static Lisp_Object |
592 get_selection_value (type) | |
593 Atom type; | |
159 | 594 { |
595 XEvent event; | |
596 Lisp_Object val; | |
597 Time requestor_time; /* Timestamp of selection request. */ | |
598 Window requestor_window; | |
599 | |
600 BLOCK_INPUT; | |
708 | 601 requestor_time = last_event_timestamp; |
1053
a411429c4140
* xselect.c: Use the FRAME_X_WINDOW macro, for readability.
Jim Blandy <jimb@redhat.com>
parents:
847
diff
changeset
|
602 requestor_window = FRAME_X_WINDOW (selected_frame); |
641 | 603 XConvertSelection (x_current_display, type, XA_STRING, |
159 | 604 Xatom_emacs_selection, requestor_window, requestor_time); |
605 XIfEvent (x_current_display, | |
606 &event, | |
607 XCheckSelectionEvent, | |
608 (char *) requestor_window); | |
609 val = x_selection_arrival (&event, requestor_window, requestor_time); | |
610 UNBLOCK_INPUT; | |
611 | |
612 return val; | |
613 } | |
614 | |
641 | 615 /* Request a selection value from the owner. If we are the owner, |
616 simply return our selection value. If we are not the owner, this | |
617 will block until all of the data has arrived. */ | |
159 | 618 |
641 | 619 DEFUN ("x-selection-value", Fx_selection_value, Sx_selection_value, |
620 0, 1, "", | |
621 "Return the value of one of the selections. Default is the primary\n\ | |
622 selection, but optional argument TYPE may specify secondary or clipboard.") | |
623 (type) | |
624 register Lisp_Object type; | |
159 | 625 { |
641 | 626 Atom selection_type; |
627 | |
628 if (NILP (type) || EQ (type, Qprimary)) | |
629 { | |
630 if (!NILP (Vx_selection_value)) | |
1268
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
631 return Vx_selection_value; |
159 | 632 |
641 | 633 return get_selection_value (XA_PRIMARY); |
634 } | |
635 else if (EQ (type, Qsecondary)) | |
636 { | |
637 if (!NILP (Vx_secondary_selection_value)) | |
638 return Vx_secondary_selection_value; | |
159 | 639 |
641 | 640 return get_selection_value (XA_SECONDARY); |
641 } | |
642 else if (EQ (type, Qclipboard)) | |
643 { | |
644 if (!NILP (Vx_clipboard_value)) | |
645 return Vx_clipboard_value; | |
159 | 646 |
641 | 647 return get_selection_value (Xatom_clipboard); |
648 } | |
1268
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
649 #if 0 |
708 | 650 else if (EQ (type, Qcut_buffer0)) |
651 { | |
652 char *data; | |
653 int size; | |
654 Lisp_Object string; | |
655 | |
656 BLOCK_INPUT; | |
657 data = XFetchBytes (x_current_display, &size); | |
658 if (data == 0) | |
659 string = Qnil; | |
660 else | |
661 string = make_string (data, size); | |
662 UNBLOCK_INPUT; | |
663 | |
664 return string; | |
665 } | |
1268
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
666 #endif |
641 | 667 else |
668 error ("Invalid X selection type"); | |
159 | 669 } |
670 | |
671 Lisp_Object | |
672 x_selection_arrival (event, requestor_window, requestor_time) | |
673 register XSelectionEvent *event; | |
674 Window requestor_window; | |
675 Time requestor_time; | |
676 { | |
677 int result; | |
678 Atom type, selection; | |
679 int format; | |
680 unsigned long items; | |
681 unsigned long bytes_left; | |
682 unsigned char *data = 0; | |
683 int offset = 0; | |
684 | |
685 if (event->selection == XA_PRIMARY) | |
686 selection = Xatom_emacs_selection; | |
641 | 687 else if (event->selection == XA_SECONDARY) |
688 selection = Xatom_emacs_secondary_selection; | |
159 | 689 else if (event->selection == Xatom_clipboard) |
690 selection = Xatom_clipboard_selection; | |
691 else | |
692 abort (); | |
693 | |
694 if (event->requestor == requestor_window | |
695 && event->time == requestor_time | |
696 && event->property != None) | |
697 if (event->target != Xatom_incremental) | |
698 { | |
699 unsigned char *return_string = | |
700 (unsigned char *) alloca (MAX_SELECTION (x_current_display)); | |
701 | |
702 do | |
703 { | |
641 | 704 result = XGetWindowProperty (x_current_display, requestor_window, |
159 | 705 event->property, 0L, |
706 10000000L, True, XA_STRING, | |
707 &type, &format, &items, | |
708 &bytes_left, &data); | |
709 if (result == Success && type == XA_STRING && format == 8 | |
710 && offset < MAX_SELECTION (x_current_display)) | |
711 { | |
712 bcopy (data, return_string + offset, items); | |
713 offset += items; | |
714 } | |
715 XFree ((char *) data); | |
716 } | |
717 while (bytes_left); | |
718 | |
719 return make_string (return_string, offset); | |
720 } | |
721 else /* Prepare incremental transfer. */ | |
722 { | |
723 unsigned char *increment_value; | |
724 unsigned char *increment_ptr; | |
725 int total_size; | |
726 int *increment_nbytes = 0; | |
727 | |
728 result = XGetWindowProperty (x_current_display, requestor_window, | |
729 selection, 0L, 10000000L, False, | |
730 event->property, &type, &format, | |
731 &items, &bytes_left, | |
732 (unsigned char **) &increment_nbytes); | |
733 if (result == Success) | |
734 { | |
735 XPropertyEvent property_event; | |
736 | |
737 total_size = *increment_nbytes; | |
738 increment_value = (unsigned char *) alloca (total_size); | |
739 increment_ptr = increment_value; | |
740 | |
741 XDeleteProperty (x_current_display, event->requestor, | |
742 event->property); | |
743 XFlush (x_current_display); | |
744 XFree ((char *) increment_nbytes); | |
745 | |
746 do | |
747 { /* NOTE: this blocks. */ | |
748 XWindowEvent (x_current_display, requestor_window, | |
749 PropertyChangeMask, | |
750 (XEvent *) &property_event); | |
751 | |
752 if (property_event.atom == selection | |
753 && property_event.state == PropertyNewValue) | |
754 do | |
755 { | |
756 result = XGetWindowProperty (x_current_display, | |
757 requestor_window, | |
758 selection, 0L, | |
759 10000000L, True, | |
760 AnyPropertyType, | |
761 &type, &format, | |
762 &items, &bytes_left, | |
763 &data); | |
764 if (result == Success && type == XA_STRING | |
765 && format == 8) | |
766 { | |
767 bcopy (data, increment_ptr, items); | |
768 increment_ptr += items; | |
769 } | |
770 } | |
771 while (bytes_left); | |
772 | |
773 } | |
774 while (increment_ptr < (increment_value + total_size)); | |
775 | |
776 return make_string (increment_value, | |
777 (increment_ptr - increment_value)); | |
778 } | |
779 } | |
780 | |
781 return Qnil; | |
782 } | |
783 | |
1268
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
784 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
785 /* Cut buffer management. */ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
786 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
787 DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 1, "", |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
788 "Return the value of cut buffer N, or nil if it is unset.\n\ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
789 If N is omitted, it defaults to zero.\n\ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
790 Note that cut buffers have some problems that selections don't; try to\n\ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
791 write your code to use cut buffers only for backward compatibility,\n\ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
792 and use selections for the serious work.") |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
793 (n) |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
794 Lisp_Object n; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
795 { |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
796 int buf_num; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
797 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
798 if (NILP (n)) |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
799 buf_num = 0; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
800 else |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
801 { |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
802 CHECK_NUMBER (n, 0); |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
803 buf_num = XINT (n); |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
804 } |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
805 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
806 if (buf_num < 0 && buf_num > NUM_CUT_BUFFERS) |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
807 error ("cut buffer numbers must be from zero to seven."); |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
808 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
809 { |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
810 Lisp_Object value; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
811 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
812 /* Note that no PropertyNotify events will be processed while |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
813 input is blocked. */ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
814 BLOCK_INPUT; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
815 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
816 if (cut_buffer_cached & (1 << buf_num)) |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
817 value = XVECTOR (cut_buffer_value)->contents[buf_num]; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
818 else |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
819 { |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
820 /* Our cache is invalid; retrieve the property's value from |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
821 the server. */ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
822 int buf_len; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
823 char *buf = XFetchBuffer (x_current_display, &buf_len, buf_num); |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
824 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
825 if (buf_len == 0) |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
826 value = Qnil; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
827 else |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
828 value = make_string (buf, buf_len); |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
829 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
830 XVECTOR (cut_buffer_value)->contents[buf_num] = value; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
831 cut_buffer_cached |= (1 << buf_num); |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
832 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
833 XFree (buf); |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
834 } |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
835 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
836 UNBLOCK_INPUT; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
837 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
838 return value; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
839 } |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
840 } |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
841 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
842 DEFUN ("x-set-cut-buffer", Fx_set_cut_buffer, Sx_set_cut_buffer, 2, 2, "", |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
843 "Set the value of cut buffer N to STRING.\n\ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
844 Note that cut buffers have some problems that selections don't; try to\n\ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
845 write your code to use cut buffers only for backward compatibility,\n\ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
846 and use selections for the serious work.") |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
847 (n, string) |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
848 Lisp_Object n, string; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
849 { |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
850 int buf_num; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
851 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
852 CHECK_NUMBER (n, 0); |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
853 CHECK_STRING (string, 1); |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
854 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
855 buf_num = XINT (n); |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
856 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
857 if (buf_num < 0 || buf_num > 7) |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
858 error ("cut buffer numbers must be from zero to seven."); |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
859 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
860 BLOCK_INPUT; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
861 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
862 /* DECwindows and some other servers don't seem to like setting |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
863 properties to values larger than about 20k. For very large |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
864 values, they signal an error, but for intermediate values they |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
865 just seem to hang. |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
866 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
867 We could just truncate the request, but it's better to let the |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
868 user know that the strategy he/she's using isn't going to work |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
869 than to have it work partially, but incorrectly. */ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
870 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
871 if (XSTRING (string)->size == 0 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
872 || XSTRING (string)->size > MAX_SELECTION (x_current_display)) |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
873 { |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
874 XStoreBuffer (x_current_display, (char *) 0, 0, buf_num); |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
875 string = Qnil; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
876 } |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
877 else |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
878 { |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
879 XStoreBuffer (x_current_display, |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
880 (char *) XSTRING (string)->data, XSTRING (string)->size, |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
881 buf_num); |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
882 } |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
883 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
884 XVECTOR (cut_buffer_value)->contents[buf_num] = string; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
885 cut_buffer_cached |= (1 << buf_num); |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
886 cut_buffer_just_set |= (1 << buf_num); |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
887 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
888 UNBLOCK_INPUT; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
889 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
890 return string; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
891 } |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
892 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
893 /* Ask the server to send us an event if any cut buffer is modified. */ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
894 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
895 void |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
896 x_watch_cut_buffer_cache () |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
897 { |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
898 XSelectInput (x_current_display, ROOT_WINDOW, PropertyChangeMask); |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
899 } |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
900 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
901 /* The server has told us that a cut buffer has been modified; deal with that. |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
902 Note that this function is called at interrupt level. */ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
903 void |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
904 x_invalidate_cut_buffer_cache (XPropertyEvent *event) |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
905 { |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
906 int i; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
907 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
908 /* See which cut buffer this is about, if any. */ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
909 for (i = 0; i < NUM_CUT_BUFFERS; i++) |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
910 if (event->atom == cut_buffer_atom[i]) |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
911 { |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
912 int mask = (1 << i); |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
913 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
914 if (cut_buffer_just_set & mask) |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
915 cut_buffer_just_set &= ~mask; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
916 else |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
917 cut_buffer_cached &= ~mask; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
918 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
919 break; |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
920 } |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
921 } |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
922 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
923 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
924 /* Bureaucracy. */ |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
925 |
159 | 926 void |
927 syms_of_xselect () | |
928 { | |
929 DEFVAR_LISP ("x-selection-value", &Vx_selection_value, | |
930 "The value of emacs' last cut-string."); | |
931 Vx_selection_value = Qnil; | |
932 | |
641 | 933 DEFVAR_LISP ("x-secondary-selection-value", &Vx_secondary_selection_value, |
934 "The value of emacs' last secondary cut-string."); | |
935 Vx_secondary_selection_value = Qnil; | |
936 | |
159 | 937 DEFVAR_LISP ("x-clipboard-value", &Vx_clipboard_value, |
938 "The string emacs last sent to the clipboard."); | |
939 Vx_clipboard_value = Qnil; | |
940 | |
641 | 941 Qprimary = intern ("primary"); |
942 staticpro (&Qprimary); | |
943 Qsecondary = intern ("secondary"); | |
944 staticpro (&Qsecondary); | |
945 Qclipboard = intern ("clipboard"); | |
946 staticpro (&Qclipboard); | |
947 | |
159 | 948 defsubr (&Sx_own_selection); |
641 | 949 defsubr (&Sx_selection_value); |
1268
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
950 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
951 cut_buffer_value = Fmake_vector (make_number (NUM_CUT_BUFFERS), Qnil); |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
952 staticpro (&cut_buffer_value); |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
953 |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
954 defsubr (&Sx_get_cut_buffer); |
39c6e9d28de2
* xselect.c (Qcut_buffer0): Symbol removed; we're using a new
Jim Blandy <jimb@redhat.com>
parents:
1053
diff
changeset
|
955 defsubr (&Sx_set_cut_buffer); |
159 | 956 } |
957 #endif /* X11 */ |