aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorRichard M. Stallman1993-03-14 20:19:28 +0000
committerRichard M. Stallman1993-03-14 20:19:28 +0000
commita87ed99c5b3fd6bf546e60f507cea013d78c0f88 (patch)
treec09b2c8949eb450e6b423b9ee06a4e928638c5b1 /src
parent3e6580d01d4ce6f5942254a5136f3741d78bd998 (diff)
downloademacs-a87ed99c5b3fd6bf546e60f507cea013d78c0f88.tar.gz
emacs-a87ed99c5b3fd6bf546e60f507cea013d78c0f88.zip
entered into RCS
Diffstat (limited to 'src')
-rw-r--r--src/xselect.c85
1 files changed, 57 insertions, 28 deletions
diff --git a/src/xselect.c b/src/xselect.c
index 99c59cf27f2..20aa5a9ba0e 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -379,7 +379,10 @@ x_get_local_selection (selection_symbol, target_type)
379 379
380 CHECK_SYMBOL (target_type, 0); 380 CHECK_SYMBOL (target_type, 0);
381 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist)); 381 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
382 if (NILP (handler_fn)) return Qnil; 382 if (NILP (handler_fn))
383 Fsignal (Qerror,
384 Fcons (build_string ("missing selection-conversion function"),
385 Fcons (target_type, Fcons (value, Qnil))));
383 value = call3 (handler_fn, 386 value = call3 (handler_fn,
384 selection_symbol, target_type, 387 selection_symbol, target_type,
385 XCONS (XCONS (local_value)->cdr)->car); 388 XCONS (XCONS (local_value)->cdr)->car);
@@ -388,6 +391,7 @@ x_get_local_selection (selection_symbol, target_type)
388 391
389 /* Make sure this value is of a type that we could transmit 392 /* Make sure this value is of a type that we could transmit
390 to another X client. */ 393 to another X client. */
394
391 check = value; 395 check = value;
392 if (CONSP (value) 396 if (CONSP (value)
393 && SYMBOLP (XCONS (value)->car)) 397 && SYMBOLP (XCONS (value)->car))
@@ -400,6 +404,7 @@ x_get_local_selection (selection_symbol, target_type)
400 || INTEGERP (check) 404 || INTEGERP (check)
401 || NILP (value)) 405 || NILP (value))
402 return value; 406 return value;
407 /* Check for a value that cons_to_long could handle. */
403 else if (CONSP (check) 408 else if (CONSP (check)
404 && INTEGERP (XCONS (check)->car) 409 && INTEGERP (XCONS (check)->car)
405 && (INTEGERP (XCONS (check)->cdr) 410 && (INTEGERP (XCONS (check)->cdr)
@@ -411,7 +416,7 @@ x_get_local_selection (selection_symbol, target_type)
411 else 416 else
412 return 417 return
413 Fsignal (Qerror, 418 Fsignal (Qerror,
414 Fcons (build_string ("unrecognised selection-conversion type"), 419 Fcons (build_string ("invalid data returned by selection-conversion function"),
415 Fcons (handler_fn, Fcons (value, Qnil)))); 420 Fcons (handler_fn, Fcons (value, Qnil))));
416} 421}
417 422
@@ -984,6 +989,7 @@ x_get_foreign_selection (selection_symbol, target_type)
984 BLOCK_INPUT; 989 BLOCK_INPUT;
985 XConvertSelection (display, selection_atom, type_atom, target_property, 990 XConvertSelection (display, selection_atom, type_atom, target_property,
986 requestor_window, requestor_time); 991 requestor_window, requestor_time);
992 XFlushQueue ();
987 993
988 /* Prepare to block until the reply has been read. */ 994 /* Prepare to block until the reply has been read. */
989 reading_selection_window = requestor_window; 995 reading_selection_window = requestor_window;
@@ -1377,7 +1383,11 @@ lisp_data_to_selection_data (display, obj,
1377 (*(short **) data_ret) [0] = (short) XINT (obj); 1383 (*(short **) data_ret) [0] = (short) XINT (obj);
1378 if (NILP (type)) type = QINTEGER; 1384 if (NILP (type)) type = QINTEGER;
1379 } 1385 }
1380 else if (INTEGERP (obj) || CONSP (obj)) 1386 else if (INTEGERP (obj)
1387 || (CONSP (obj) && INTEGERP (XCONS (obj)->car)
1388 && (INTEGERP (XCONS (obj)->cdr)
1389 || (CONSP (XCONS (obj)->cdr)
1390 && INTEGERP (XCONS (XCONS (obj)->cdr)->car)))))
1381 { 1391 {
1382 *format_ret = 32; 1392 *format_ret = 32;
1383 *size_ret = 1; 1393 *size_ret = 1;
@@ -1535,7 +1545,7 @@ DEFUN ("x-own-selection-internal",
1535TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\ 1545TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1536\(Those are literal upper-case symbol names, since that's what X expects.)\n\ 1546\(Those are literal upper-case symbol names, since that's what X expects.)\n\
1537VALUE is typically a string, or a cons of two markers, but may be\n\ 1547VALUE is typically a string, or a cons of two markers, but may be\n\
1538anything that the functions on selection-converter-alist know about.") 1548anything that the functions on `selection-converter-alist' know about.")
1539 (selection_name, selection_value) 1549 (selection_name, selection_value)
1540 Lisp_Object selection_name, selection_value; 1550 Lisp_Object selection_name, selection_value;
1541{ 1551{
@@ -1555,7 +1565,7 @@ DEFUN ("x-get-selection-internal",
1555 "Return text selected from some X window.\n\ 1565 "Return text selected from some X window.\n\
1556SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\ 1566SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1557\(Those are literal upper-case symbol names, since that's what X expects.)\n\ 1567\(Those are literal upper-case symbol names, since that's what X expects.)\n\
1558TYPE is the type of data desired, typically STRING.") 1568TYPE is the type of data desired, typically `STRING'.")
1559 (selection_symbol, target_type) 1569 (selection_symbol, target_type)
1560 Lisp_Object selection_symbol, target_type; 1570 Lisp_Object selection_symbol, target_type;
1561{ 1571{
@@ -1599,7 +1609,8 @@ TYPE is the type of data desired, typically STRING.")
1599 1609
1600DEFUN ("x-disown-selection-internal", 1610DEFUN ("x-disown-selection-internal",
1601 Fx_disown_selection_internal, Sx_disown_selection_internal, 1, 2, 0, 1611 Fx_disown_selection_internal, Sx_disown_selection_internal, 1, 2, 0,
1602 "If we own the named selection, then disown it (make there be no selection).") 1612 "If we own the selection SELECTION, disown it.\n\
1613Disowning it means there is no such selection.")
1603 (selection, time) 1614 (selection, time)
1604 Lisp_Object selection; 1615 Lisp_Object selection;
1605 Lisp_Object time; 1616 Lisp_Object time;
@@ -1637,10 +1648,30 @@ DEFUN ("x-disown-selection-internal",
1637 return Qt; 1648 return Qt;
1638} 1649}
1639 1650
1651/* Get rid of all the selections in buffer BUFFER.
1652 This is used when we kill a buffer. */
1653
1654void
1655x_disown_buffer_selections (buffer)
1656 Lisp_Object buffer;
1657{
1658 Lisp_Object tail;
1659 struct buffer *buf = XBUFFER (buffer);
1660
1661 for (tail = Vselection_alist; CONSP (tail); tail = XCONS (tail)->cdr)
1662 {
1663 Lisp_Object elt, value;
1664 elt = XCONS (tail)->car;
1665 value = XCONS (elt)->cdr;
1666 if (CONSP (value) && MARKERP (XCONS (value)->car)
1667 && XMARKER (XCONS (value)->car)->buffer == buf)
1668 Fx_disown_selection_internal (XCONS (elt)->car, Qnil);
1669 }
1670}
1640 1671
1641DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p, 1672DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
1642 0, 1, 0, 1673 0, 1, 0,
1643 "Whether the current emacs process owns the given X Selection.\n\ 1674 "Whether the current Emacs process owns the given X Selection.\n\
1644The arg should be the name of the selection in question, typically one of\n\ 1675The arg should be the name of the selection in question, typically one of\n\
1645the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\ 1676the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1646\(Those are literal upper-case symbol names, since that's what X expects.)\n\ 1677\(Those are literal upper-case symbol names, since that's what X expects.)\n\
@@ -1709,25 +1740,25 @@ initialize_cut_buffers (display, window)
1709} 1740}
1710 1741
1711 1742
1712#define CHECK_CUTBUFFER(symbol,n) \ 1743#define CHECK_CUT_BUFFER(symbol,n) \
1713 { CHECK_SYMBOL ((symbol), (n)); \ 1744 { CHECK_SYMBOL ((symbol), (n)); \
1714 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \ 1745 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
1715 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \ 1746 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
1716 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \ 1747 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
1717 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \ 1748 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
1718 Fsignal (Qerror, \ 1749 Fsignal (Qerror, \
1719 Fcons (build_string ("doesn't name a cutbuffer"), \ 1750 Fcons (build_string ("doesn't name a cut buffer"), \
1720 Fcons ((symbol), Qnil))); \ 1751 Fcons ((symbol), Qnil))); \
1721 } 1752 }
1722 1753
1723DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal, 1754DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
1724 Sx_get_cutbuffer_internal, 1, 1, 0, 1755 Sx_get_cut_buffer_internal, 1, 1, 0,
1725 "Returns the value of the named cutbuffer (typically CUT_BUFFER0).") 1756 "Returns the value of the named cut buffer (typically CUT_BUFFER0).")
1726 (buffer) 1757 (buffer)
1727 Lisp_Object buffer; 1758 Lisp_Object buffer;
1728{ 1759{
1729 Display *display = x_current_display; 1760 Display *display = x_current_display;
1730 Window window = RootWindow (display, 0); /* Cutbuffers are on screen 0 */ 1761 Window window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
1731 Atom buffer_atom; 1762 Atom buffer_atom;
1732 unsigned char *data; 1763 unsigned char *data;
1733 int bytes; 1764 int bytes;
@@ -1736,7 +1767,7 @@ DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal,
1736 unsigned long size; 1767 unsigned long size;
1737 Lisp_Object ret; 1768 Lisp_Object ret;
1738 1769
1739 CHECK_CUTBUFFER (buffer, 0); 1770 CHECK_CUT_BUFFER (buffer, 0);
1740 buffer_atom = symbol_to_x_atom (display, buffer); 1771 buffer_atom = symbol_to_x_atom (display, buffer);
1741 1772
1742 x_get_window_property (display, window, buffer_atom, &data, &bytes, 1773 x_get_window_property (display, window, buffer_atom, &data, &bytes,
@@ -1755,14 +1786,14 @@ DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal,
1755} 1786}
1756 1787
1757 1788
1758DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal, 1789DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal,
1759 Sx_store_cutbuffer_internal, 2, 2, 0, 1790 Sx_store_cut_buffer_internal, 2, 2, 0,
1760 "Sets the value of the named cutbuffer (typically CUT_BUFFER0).") 1791 "Sets the value of the named cut buffer (typically CUT_BUFFER0).")
1761 (buffer, string) 1792 (buffer, string)
1762 Lisp_Object buffer, string; 1793 Lisp_Object buffer, string;
1763{ 1794{
1764 Display *display = x_current_display; 1795 Display *display = x_current_display;
1765 Window window = RootWindow (display, 0); /* Cutbuffers are on screen 0 */ 1796 Window window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
1766 Atom buffer_atom; 1797 Atom buffer_atom;
1767 unsigned char *data; 1798 unsigned char *data;
1768 int bytes; 1799 int bytes;
@@ -1770,7 +1801,7 @@ DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal,
1770 int max_bytes = SELECTION_QUANTUM (display); 1801 int max_bytes = SELECTION_QUANTUM (display);
1771 if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM; 1802 if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM;
1772 1803
1773 CHECK_CUTBUFFER (buffer, 0); 1804 CHECK_CUT_BUFFER (buffer, 0);
1774 CHECK_STRING (string, 0); 1805 CHECK_STRING (string, 0);
1775 buffer_atom = symbol_to_x_atom (display, buffer); 1806 buffer_atom = symbol_to_x_atom (display, buffer);
1776 data = (unsigned char *) XSTRING (string)->data; 1807 data = (unsigned char *) XSTRING (string)->data;
@@ -1797,15 +1828,15 @@ DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal,
1797} 1828}
1798 1829
1799 1830
1800DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal, 1831DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal,
1801 Sx_rotate_cutbuffers_internal, 1, 1, 0, 1832 Sx_rotate_cut_buffers_internal, 1, 1, 0,
1802 "Rotate the values of the cutbuffers by the given number of steps;\n\ 1833 "Rotate the values of the cut buffers by the given number of steps;\n\
1803positive means move values forward, negative means backward.") 1834positive means move values forward, negative means backward.")
1804 (n) 1835 (n)
1805 Lisp_Object n; 1836 Lisp_Object n;
1806{ 1837{
1807 Display *display = x_current_display; 1838 Display *display = x_current_display;
1808 Window window = RootWindow (display, 0); /* Cutbuffers are on screen 0 */ 1839 Window window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
1809 Atom props [8]; 1840 Atom props [8];
1810 1841
1811 CHECK_NUMBER (n, 0); 1842 CHECK_NUMBER (n, 0);
@@ -1850,8 +1881,6 @@ Xatoms_of_xselect ()
1850void 1881void
1851syms_of_xselect () 1882syms_of_xselect ()
1852{ 1883{
1853 atoms_of_xselect ();
1854
1855 defsubr (&Sx_get_selection_internal); 1884 defsubr (&Sx_get_selection_internal);
1856 defsubr (&Sx_own_selection_internal); 1885 defsubr (&Sx_own_selection_internal);
1857 defsubr (&Sx_disown_selection_internal); 1886 defsubr (&Sx_disown_selection_internal);
@@ -1859,9 +1888,9 @@ syms_of_xselect ()
1859 defsubr (&Sx_selection_exists_p); 1888 defsubr (&Sx_selection_exists_p);
1860 1889
1861#ifdef CUT_BUFFER_SUPPORT 1890#ifdef CUT_BUFFER_SUPPORT
1862 defsubr (&Sx_get_cutbuffer_internal); 1891 defsubr (&Sx_get_cut_buffer_internal);
1863 defsubr (&Sx_store_cutbuffer_internal); 1892 defsubr (&Sx_store_cut_buffer_internal);
1864 defsubr (&Sx_rotate_cutbuffers_internal); 1893 defsubr (&Sx_rotate_cut_buffers_internal);
1865 cut_buffers_initialized = 0; 1894 cut_buffers_initialized = 0;
1866#endif 1895#endif
1867 1896