comparison src/xselect.c @ 2163:8ba4fffa6566

*** empty log message ***
author Richard M. Stallman <rms@gnu.org>
date Sat, 13 Mar 1993 21:25:55 +0000
parents 533cca1014e1
children 2484b562777f
comparison
equal deleted inserted replaced
2162:1dcc4e12b8dd 2163:8ba4fffa6566
24 24
25 /* Rewritten by jwz */ 25 /* Rewritten by jwz */
26 26
27 #include "config.h" 27 #include "config.h"
28 #include "lisp.h" 28 #include "lisp.h"
29 #if 0
30 #include <stdio.h> /* termhooks.h needs this */
31 #include "termhooks.h"
32 #endif
29 #include "xterm.h" /* for all of the X includes */ 33 #include "xterm.h" /* for all of the X includes */
30 #include "dispextern.h" /* screen.h seems to want this */ 34 #include "dispextern.h" /* frame.h seems to want this */
31 #include "screen.h" /* Need this to get the X window of selected_screen */ 35 #include "frame.h" /* Need this to get the X window of selected_frame */
36
37 #define xfree free
32 38
33 #define CUT_BUFFER_SUPPORT 39 #define CUT_BUFFER_SUPPORT
34 40
35 static Atom Xatom_CLIPBOARD, Xatom_TIMESTAMP, Xatom_TEXT, Xatom_DELETE, 41 static Atom Xatom_CLIPBOARD, Xatom_TIMESTAMP, Xatom_TEXT, Xatom_DELETE,
36 Xatom_MULTIPLE, Xatom_INCR, Xatom_EMACS_TMP, Xatom_TARGETS, Xatom_NULL, 42 Xatom_MULTIPLE, Xatom_INCR, Xatom_EMACS_TMP, Xatom_TARGETS, Xatom_NULL,
58 #define MAX_SELECTION_QUANTUM 0xFFFFFF 64 #define MAX_SELECTION_QUANTUM 0xFFFFFF
59 65
60 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize (dpy) << 2) - 100) 66 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize (dpy) << 2) - 100)
61 67
62 68
63 /* The time of the last-read mouse or keyboard event. 69 /* The timestamp of the last input event Emacs received from the X server. */
64 For selection purposes, we use this as a sleazy way of knowing what the 70 unsigned long last_event_timestamp;
65 current time is in server-time. This assumes that the most recently read
66 mouse or keyboard event has something to do with the assertion of the
67 selection, which is probably true.
68 */
69 extern Time mouse_timestamp;
70
71 71
72 /* This is an association list whose elements are of the form 72 /* This is an association list whose elements are of the form
73 ( selection-name selection-value selection-timestamp ) 73 ( selection-name selection-value selection-timestamp )
74 selection-name is a lisp symbol, whose name is the name of an X Atom. 74 selection-name is a lisp symbol, whose name is the name of an X Atom.
75 selection-value is the value that emacs owns for that selection. 75 selection-value is the value that emacs owns for that selection.
163 Atom atom; 163 Atom atom;
164 { 164 {
165 char *str; 165 char *str;
166 Lisp_Object val; 166 Lisp_Object val;
167 if (! atom) return Qnil; 167 if (! atom) return Qnil;
168 case XA_PRIMARY: 168 switch (atom)
169 return QPRIMARY; 169 {
170 case XA_SECONDARY: 170 case XA_PRIMARY:
171 return QSECONDARY; 171 return QPRIMARY;
172 case XA_STRING: 172 case XA_SECONDARY:
173 return QSTRING; 173 return QSECONDARY;
174 case XA_INTEGER: 174 case XA_STRING:
175 return QINTEGER; 175 return QSTRING;
176 case XA_ATOM: 176 case XA_INTEGER:
177 return QATOM; 177 return QINTEGER;
178 case Xatom_CLIPBOARD: 178 case XA_ATOM:
179 return QCLIPBOARD; 179 return QATOM;
180 case Xatom_TIMESTAMP:
181 return QTIMESTAMP;
182 case Xatom_TEXT:
183 return QTEXT;
184 case Xatom_DELETE:
185 return QDELETE;
186 case Xatom_MULTIPLE:
187 return QMULTIPLE;
188 case Xatom_INCR:
189 return QINCR;
190 case Xatom_EMACS_TMP:
191 return QEMACS_TMP;
192 case Xatom_TARGETS:
193 return QTARGETS;
194 case Xatom_NULL:
195 return QNULL;
196 #ifdef CUT_BUFFER_SUPPORT 180 #ifdef CUT_BUFFER_SUPPORT
197 case XA_CUT_BUFFER0: 181 case XA_CUT_BUFFER0:
198 return QCUT_BUFFER0; 182 return QCUT_BUFFER0;
199 case XA_CUT_BUFFER1: 183 case XA_CUT_BUFFER1:
200 return QCUT_BUFFER1; 184 return QCUT_BUFFER1;
201 case XA_CUT_BUFFER2: 185 case XA_CUT_BUFFER2:
202 return QCUT_BUFFER2; 186 return QCUT_BUFFER2;
203 case XA_CUT_BUFFER3: 187 case XA_CUT_BUFFER3:
204 return QCUT_BUFFER3; 188 return QCUT_BUFFER3;
205 case XA_CUT_BUFFER4: 189 case XA_CUT_BUFFER4:
206 return QCUT_BUFFER4; 190 return QCUT_BUFFER4;
207 case XA_CUT_BUFFER5: 191 case XA_CUT_BUFFER5:
208 return QCUT_BUFFER5; 192 return QCUT_BUFFER5;
209 case XA_CUT_BUFFER6: 193 case XA_CUT_BUFFER6:
210 return QCUT_BUFFER6; 194 return QCUT_BUFFER6;
211 case XA_CUT_BUFFER7: 195 case XA_CUT_BUFFER7:
212 return QCUT_BUFFER7; 196 return QCUT_BUFFER7;
213 #endif 197 #endif
198 }
199
200 if (atom == Xatom_CLIPBOARD)
201 return QCLIPBOARD;
202 if (atom == Xatom_TIMESTAMP)
203 return QTIMESTAMP;
204 if (atom == Xatom_TEXT)
205 return QTEXT;
206 if (atom == Xatom_DELETE)
207 return QDELETE;
208 if (atom == Xatom_MULTIPLE)
209 return QMULTIPLE;
210 if (atom == Xatom_INCR)
211 return QINCR;
212 if (atom == Xatom_EMACS_TMP)
213 return QEMACS_TMP;
214 if (atom == Xatom_TARGETS)
215 return QTARGETS;
216 if (atom == Xatom_NULL)
217 return QNULL;
214 218
215 BLOCK_INPUT; 219 BLOCK_INPUT;
216 str = XGetAtomName (display, atom); 220 str = XGetAtomName (display, atom);
217 UNBLOCK_INPUT; 221 UNBLOCK_INPUT;
218 #if 0 222 #if 0
241 static unsigned long 245 static unsigned long
242 cons_to_long (c) 246 cons_to_long (c)
243 Lisp_Object c; 247 Lisp_Object c;
244 { 248 {
245 int top, bot; 249 int top, bot;
246 if (FIXNUMP (c)) return XINT (c); 250 if (INTEGERP (c)) return XINT (c);
247 top = XCONS (c)->car; 251 top = XCONS (c)->car;
248 bot = XCONS (c)->cdr; 252 bot = XCONS (c)->cdr;
249 if (CONSP (bot)) bot = XCONS (bot)->car; 253 if (CONSP (bot)) bot = XCONS (bot)->car;
250 return ((XINT (top) << 16) | XINT (bot)); 254 return ((XINT (top) << 16) | XINT (bot));
251 } 255 }
264 #ifdef X_TOOLKIT 268 #ifdef X_TOOLKIT
265 Window selecting_window = XtWindow (selected_screen->display.x->edit_widget); 269 Window selecting_window = XtWindow (selected_screen->display.x->edit_widget);
266 #else 270 #else
267 Window selecting_window = FRAME_X_WINDOW (selected_frame); 271 Window selecting_window = FRAME_X_WINDOW (selected_frame);
268 #endif 272 #endif
269 Time time = mouse_timestamp; 273 Time time = last_event_timestamp;
270 Atom selection_atom; 274 Atom selection_atom;
271 275
272 CHECK_SYMBOL (selection_name, 0); 276 CHECK_SYMBOL (selection_name, 0);
273 selection_atom = symbol_to_x_atom (display, selection_name); 277 selection_atom = symbol_to_x_atom (display, selection_name);
274 278
308 312
309 /* Given a selection-name and desired type, look up our local copy of 313 /* Given a selection-name and desired type, look up our local copy of
310 the selection value and convert it to the type. 314 the selection value and convert it to the type.
311 The value is nil or a string. 315 The value is nil or a string.
312 This function is used both for remote requests 316 This function is used both for remote requests
313 and for local x-get-selection-internal. */ 317 and for local x-get-selection-internal.
314 318
315 This calls random Lisp code, and may signal or gc. */ 319 This calls random Lisp code, and may signal or gc. */
316 320
317 static Lisp_Object 321 static Lisp_Object
318 x_get_local_selection (selection_symbol, target_type) 322 x_get_local_selection (selection_symbol, target_type)
391 check = XCONS (value)->cdr; 395 check = XCONS (value)->cdr;
392 396
393 if (STRINGP (check) 397 if (STRINGP (check)
394 || VECTORP (check) 398 || VECTORP (check)
395 || SYMBOLP (check) 399 || SYMBOLP (check)
396 || FIXNUMP (check) 400 || INTEGERP (check)
397 || NILP (value)) 401 || NILP (value))
398 return value; 402 return value;
399 else if (CONSP (check) 403 else if (CONSP (check)
400 && FIXNUMP (XCONS (check)->car) 404 && INTEGERP (XCONS (check)->car)
401 && (FIXNUMP (XCONS (check)->cdr) 405 && (INTEGERP (XCONS (check)->cdr)
402 || 406 ||
403 (CONSP (XCONS (check)->cdr) 407 (CONSP (XCONS (check)->cdr)
404 && FIXNUMP (XCONS (XCONS (check)->cdr)->car) 408 && INTEGERP (XCONS (XCONS (check)->cdr)->car)
405 && NILP (XCONS (XCONS (check)->cdr)->cdr)))) 409 && NILP (XCONS (XCONS (check)->cdr)->cdr))))
406 return value; 410 return value;
407 else 411 else
408 return 412 return
409 Fsignal (Qerror, 413 Fsignal (Qerror,
505 else 509 else
506 { 510 {
507 /* Send an INCR selection. */ 511 /* Send an INCR selection. */
508 int prop_id; 512 int prop_id;
509 513
510 if (x_window_to_screen (window)) /* #### debug */ 514 if (x_window_to_frame (window)) /* #### debug */
511 error ("attempt to transfer an INCR to ourself!"); 515 error ("attempt to transfer an INCR to ourself!");
512 #if 0 516 #if 0
513 fprintf (stderr, "\nINCR %d\n", bytes_remaining); 517 fprintf (stderr, "\nINCR %d\n", bytes_remaining);
514 #endif 518 #endif
515 prop_id = expect_property_change (display, window, reply.property, 519 prop_id = expect_property_change (display, window, reply.property,
602 if (!CONSP (local_selection_data)) abort (); 606 if (!CONSP (local_selection_data)) abort ();
603 if (!CONSP (CDR (local_selection_data))) abort (); 607 if (!CONSP (CDR (local_selection_data))) abort ();
604 if (!CONSP (CDR (CDR (local_selection_data)))) abort (); 608 if (!CONSP (CDR (CDR (local_selection_data)))) abort ();
605 if (!NILP (CDR (CDR (CDR (local_selection_data))))) abort (); 609 if (!NILP (CDR (CDR (CDR (local_selection_data))))) abort ();
606 if (!CONSP (CAR (CDR (CDR (local_selection_data))))) abort (); 610 if (!CONSP (CAR (CDR (CDR (local_selection_data))))) abort ();
607 if (!FIXNUMP (CAR (CAR (CDR (CDR (local_selection_data)))))) abort (); 611 if (!INTEGERP (CAR (CAR (CDR (CDR (local_selection_data)))))) abort ();
608 if (!FIXNUMP (CDR (CAR (CDR (CDR (local_selection_data)))))) abort (); 612 if (!INTEGERP (CDR (CAR (CDR (CDR (local_selection_data)))))) abort ();
609 # undef CAR 613 # undef CAR
610 # undef CDR 614 # undef CDR
611 #endif 615 #endif
612 616
613 if (NILP (local_selection_data)) 617 if (NILP (local_selection_data))
620 624
621 local_selection_time = (Time) 625 local_selection_time = (Time)
622 cons_to_long (XCONS (XCONS (XCONS (local_selection_data)->cdr)->cdr)->car); 626 cons_to_long (XCONS (XCONS (XCONS (local_selection_data)->cdr)->cdr)->car);
623 627
624 if (SELECTION_EVENT_TIME (event) != CurrentTime 628 if (SELECTION_EVENT_TIME (event) != CurrentTime
625 && local_selection_time > event->time) 629 && local_selection_time > SELECTION_EVENT_TIME (event))
626 { 630 {
627 /* Someone asked for the selection, and we have one, but not the one 631 /* Someone asked for the selection, and we have one, but not the one
628 they're looking for. 632 they're looking for.
629 */ 633 */
630 x_decline_selection_request (event); 634 x_decline_selection_request (event);
659 663
660 x_reply_selection_request (event, format, data, size, type); 664 x_reply_selection_request (event, format, data, size, type);
661 successful_p = Qt; 665 successful_p = Qt;
662 666
663 /* Indicate we have successfully processed this event. */ 667 /* Indicate we have successfully processed this event. */
664 x_selection_current_event = 0; 668 x_selection_current_request = 0;
665 669
666 xfree (data); 670 xfree (data);
667 } 671 }
668 unbind_to (count, Qnil); 672 unbind_to (count, Qnil);
669 673
961 x_get_foreign_selection (selection_symbol, target_type) 965 x_get_foreign_selection (selection_symbol, target_type)
962 Lisp_Object selection_symbol, target_type; 966 Lisp_Object selection_symbol, target_type;
963 { 967 {
964 Display *display = x_current_display; 968 Display *display = x_current_display;
965 #ifdef X_TOOLKIT 969 #ifdef X_TOOLKIT
966 Window selecting_window = XtWindow (selected_screen->display.x->edit_widget); 970 Window requestor_window = XtWindow (selected_screen->display.x->edit_widget);
967 #else 971 #else
968 Window selecting_window = FRAME_X_WINDOW (selected_frame); 972 Window requestor_window = FRAME_X_WINDOW (selected_frame);
969 #endif 973 #endif
970 Time requestor_time = mouse_timestamp; 974 Time requestor_time = last_event_timestamp;
971 Atom target_property = Xatom_EMACS_TMP; 975 Atom target_property = Xatom_EMACS_TMP;
972 Atom selection_atom = symbol_to_x_atom (display, selection_symbol); 976 Atom selection_atom = symbol_to_x_atom (display, selection_symbol);
973 Atom type_atom; 977 Atom type_atom;
974 978
975 if (CONSP (target_type)) 979 if (CONSP (target_type))
1360 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1); 1364 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
1361 (*data_ret) [sizeof (Atom)] = 0; 1365 (*data_ret) [sizeof (Atom)] = 0;
1362 (*(Atom **) data_ret) [0] = symbol_to_x_atom (display, obj); 1366 (*(Atom **) data_ret) [0] = symbol_to_x_atom (display, obj);
1363 if (NILP (type)) type = QATOM; 1367 if (NILP (type)) type = QATOM;
1364 } 1368 }
1365 else if (FIXNUMP (obj) 1369 else if (INTEGERP (obj)
1366 && XINT (obj) < 0xFFFF 1370 && XINT (obj) < 0xFFFF
1367 && XINT (obj) > -0xFFFF) 1371 && XINT (obj) > -0xFFFF)
1368 { 1372 {
1369 *format_ret = 16; 1373 *format_ret = 16;
1370 *size_ret = 1; 1374 *size_ret = 1;
1371 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1); 1375 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
1372 (*data_ret) [sizeof (short)] = 0; 1376 (*data_ret) [sizeof (short)] = 0;
1373 (*(short **) data_ret) [0] = (short) XINT (obj); 1377 (*(short **) data_ret) [0] = (short) XINT (obj);
1374 if (NILP (type)) type = QINTEGER; 1378 if (NILP (type)) type = QINTEGER;
1375 } 1379 }
1376 else if (FIXNUMP (obj) || CONSP (obj)) 1380 else if (INTEGERP (obj) || CONSP (obj))
1377 { 1381 {
1378 *format_ret = 32; 1382 *format_ret = 32;
1379 *size_ret = 1; 1383 *size_ret = 1;
1380 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1); 1384 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
1381 (*data_ret) [sizeof (long)] = 0; 1385 (*data_ret) [sizeof (long)] = 0;
1446 if (NILP (type)) type = QINTEGER; 1450 if (NILP (type)) type = QINTEGER;
1447 *format_ret = 16; 1451 *format_ret = 16;
1448 for (i = 0; i < *size_ret; i++) 1452 for (i = 0; i < *size_ret; i++)
1449 if (CONSP (XVECTOR (obj)->contents [i])) 1453 if (CONSP (XVECTOR (obj)->contents [i]))
1450 *format_ret = 32; 1454 *format_ret = 32;
1451 else if (!FIXNUMP (XVECTOR (obj)->contents [i])) 1455 else if (!INTEGERP (XVECTOR (obj)->contents [i]))
1452 Fsignal (Qerror, /* Qselection_error */ 1456 Fsignal (Qerror, /* Qselection_error */
1453 Fcons (build_string 1457 Fcons (build_string
1454 ("elements of selection vector must be integers or conses of integers"), 1458 ("elements of selection vector must be integers or conses of integers"),
1455 Fcons (obj, Qnil))); 1459 Fcons (obj, Qnil)));
1456 1460
1475 static Lisp_Object 1479 static Lisp_Object
1476 clean_local_selection_data (obj) 1480 clean_local_selection_data (obj)
1477 Lisp_Object obj; 1481 Lisp_Object obj;
1478 { 1482 {
1479 if (CONSP (obj) 1483 if (CONSP (obj)
1480 && FIXNUMP (XCONS (obj)->car) 1484 && INTEGERP (XCONS (obj)->car)
1481 && CONSP (XCONS (obj)->cdr) 1485 && CONSP (XCONS (obj)->cdr)
1482 && FIXNUMP (XCONS (XCONS (obj)->cdr)->car) 1486 && INTEGERP (XCONS (XCONS (obj)->cdr)->car)
1483 && NILP (XCONS (XCONS (obj)->cdr)->cdr)) 1487 && NILP (XCONS (XCONS (obj)->cdr)->cdr))
1484 obj = Fcons (XCONS (obj)->car, XCONS (obj)->cdr); 1488 obj = Fcons (XCONS (obj)->car, XCONS (obj)->cdr);
1485 1489
1486 if (CONSP (obj) 1490 if (CONSP (obj)
1487 && FIXNUMP (XCONS (obj)->car) 1491 && INTEGERP (XCONS (obj)->car)
1488 && FIXNUMP (XCONS (obj)->cdr)) 1492 && INTEGERP (XCONS (obj)->cdr))
1489 { 1493 {
1490 if (XINT (XCONS (obj)->car) == 0) 1494 if (XINT (XCONS (obj)->car) == 0)
1491 return XCONS (obj)->cdr; 1495 return XCONS (obj)->cdr;
1492 if (XINT (XCONS (obj)->car) == -1) 1496 if (XINT (XCONS (obj)->car) == -1)
1493 return make_number (- XINT (XCONS (obj)->cdr)); 1497 return make_number (- XINT (XCONS (obj)->cdr));
1605 Atom selection_atom; 1609 Atom selection_atom;
1606 XSelectionClearEvent event; 1610 XSelectionClearEvent event;
1607 1611
1608 CHECK_SYMBOL (selection, 0); 1612 CHECK_SYMBOL (selection, 0);
1609 if (NILP (time)) 1613 if (NILP (time))
1610 timestamp = mouse_timestamp; 1614 timestamp = last_event_timestamp;
1611 else 1615 else
1612 timestamp = cons_to_long (time); 1616 timestamp = cons_to_long (time);
1613 1617
1614 if (NILP (assq_no_quit (selection, Vselection_alist))) 1618 if (NILP (assq_no_quit (selection, Vselection_alist)))
1615 return Qnil; /* Don't disown the selection when we're not the owner. */ 1619 return Qnil; /* Don't disown the selection when we're not the owner. */
1802 { 1806 {
1803 Display *display = x_current_display; 1807 Display *display = x_current_display;
1804 Window window = RootWindow (display, 0); /* Cutbuffers are on screen 0 */ 1808 Window window = RootWindow (display, 0); /* Cutbuffers are on screen 0 */
1805 Atom props [8]; 1809 Atom props [8];
1806 1810
1807 CHECK_FIXNUM (n, 0); 1811 CHECK_NUMBER (n, 0);
1808 if (XINT (n) == 0) return n; 1812 if (XINT (n) == 0) return n;
1809 if (! cut_buffers_initialized) initialize_cut_buffers (display, window); 1813 if (! cut_buffers_initialized) initialize_cut_buffers (display, window);
1810 props[0] = XA_CUT_BUFFER0; 1814 props[0] = XA_CUT_BUFFER0;
1811 props[1] = XA_CUT_BUFFER1; 1815 props[1] = XA_CUT_BUFFER1;
1812 props[2] = XA_CUT_BUFFER2; 1816 props[2] = XA_CUT_BUFFER2;
1821 return n; 1825 return n;
1822 } 1826 }
1823 1827
1824 #endif 1828 #endif
1825 1829
1826 static void 1830 void
1827 atoms_of_xselect () 1831 Xatoms_of_xselect ()
1828 { 1832 {
1829 #define ATOM(x) XInternAtom (x_current_display, (x), False) 1833 #define ATOM(x) XInternAtom (x_current_display, (x), False)
1830 1834
1831 BLOCK_INPUT; 1835 BLOCK_INPUT;
1832 /* Non-predefined atoms that we might end up using a lot */ 1836 /* Non-predefined atoms that we might end up using a lot */
1844 } 1848 }
1845 1849
1846 void 1850 void
1847 syms_of_xselect () 1851 syms_of_xselect ()
1848 { 1852 {
1849 atoms_of_select (); 1853 atoms_of_xselect ();
1850 1854
1851 defsubr (&Sx_get_selection_internal); 1855 defsubr (&Sx_get_selection_internal);
1852 defsubr (&Sx_own_selection_internal); 1856 defsubr (&Sx_own_selection_internal);
1853 defsubr (&Sx_disown_selection_internal); 1857 defsubr (&Sx_disown_selection_internal);
1854 defsubr (&Sx_selection_owner_p); 1858 defsubr (&Sx_selection_owner_p);