Mercurial > emacs
comparison src/xselect.c @ 2169:2484b562777f
entered into RCS
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sun, 14 Mar 1993 20:19:28 +0000 |
parents | 8ba4fffa6566 |
children | ff870650d188 |
comparison
equal
deleted
inserted
replaced
2168:af8f27940f79 | 2169:2484b562777f |
---|---|
377 count = specpdl_ptr - specpdl; | 377 count = specpdl_ptr - specpdl; |
378 specbind (Qinhibit_quit, Qt); | 378 specbind (Qinhibit_quit, Qt); |
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); |
386 unbind_to (count, Qnil); | 389 unbind_to (count, Qnil); |
387 } | 390 } |
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)) |
394 type = XCONS (value)->car, | 398 type = XCONS (value)->car, |
395 check = XCONS (value)->cdr; | 399 check = XCONS (value)->cdr; |
398 || VECTORP (check) | 402 || VECTORP (check) |
399 || SYMBOLP (check) | 403 || SYMBOLP (check) |
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) |
406 || | 411 || |
407 (CONSP (XCONS (check)->cdr) | 412 (CONSP (XCONS (check)->cdr) |
409 && NILP (XCONS (XCONS (check)->cdr)->cdr)))) | 414 && NILP (XCONS (XCONS (check)->cdr)->cdr)))) |
410 return value; | 415 return value; |
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 |
418 /* Subroutines of x_reply_selection_request. */ | 423 /* Subroutines of x_reply_selection_request. */ |
419 | 424 |
982 type_atom = symbol_to_x_atom (display, target_type); | 987 type_atom = symbol_to_x_atom (display, target_type); |
983 | 988 |
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; |
990 reading_which_selection = selection_atom; | 996 reading_which_selection = selection_atom; |
991 XCONS (reading_selection_reply)->car = Qnil; | 997 XCONS (reading_selection_reply)->car = Qnil; |
1375 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1); | 1381 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1); |
1376 (*data_ret) [sizeof (short)] = 0; | 1382 (*data_ret) [sizeof (short)] = 0; |
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; |
1384 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1); | 1394 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1); |
1385 (*data_ret) [sizeof (long)] = 0; | 1395 (*data_ret) [sizeof (long)] = 0; |
1533 2, 2, 0, | 1543 2, 2, 0, |
1534 "Assert an X selection of the given TYPE with the given VALUE.\n\ | 1544 "Assert an X selection of the given TYPE with the given VALUE.\n\ |
1535 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\ | 1545 TYPE 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\ |
1537 VALUE is typically a string, or a cons of two markers, but may be\n\ | 1547 VALUE is typically a string, or a cons of two markers, but may be\n\ |
1538 anything that the functions on selection-converter-alist know about.") | 1548 anything 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 { |
1542 CHECK_SYMBOL (selection_name, 0); | 1552 CHECK_SYMBOL (selection_name, 0); |
1543 if (NILP (selection_value)) error ("selection-value may not be nil."); | 1553 if (NILP (selection_value)) error ("selection-value may not be nil."); |
1553 DEFUN ("x-get-selection-internal", | 1563 DEFUN ("x-get-selection-internal", |
1554 Fx_get_selection_internal, Sx_get_selection_internal, 2, 2, 0, | 1564 Fx_get_selection_internal, Sx_get_selection_internal, 2, 2, 0, |
1555 "Return text selected from some X window.\n\ | 1565 "Return text selected from some X window.\n\ |
1556 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\ | 1566 SELECTION 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\ |
1558 TYPE is the type of data desired, typically STRING.") | 1568 TYPE 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 { |
1562 Lisp_Object val = Qnil; | 1572 Lisp_Object val = Qnil; |
1563 struct gcpro gcpro1, gcpro2; | 1573 struct gcpro gcpro1, gcpro2; |
1597 return val; | 1607 return val; |
1598 } | 1608 } |
1599 | 1609 |
1600 DEFUN ("x-disown-selection-internal", | 1610 DEFUN ("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\ |
1613 Disowning 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; |
1606 { | 1617 { |
1607 Display *display = x_current_display; | 1618 Display *display = x_current_display; |
1635 x_handle_selection_clear (&event); | 1646 x_handle_selection_clear (&event); |
1636 | 1647 |
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 | |
1654 void | |
1655 x_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 |
1641 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p, | 1672 DEFUN ("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\ |
1644 The arg should be the name of the selection in question, typically one of\n\ | 1675 The arg should be the name of the selection in question, typically one of\n\ |
1645 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\ | 1676 the 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\ |
1647 For convenience, the symbol nil is the same as `PRIMARY',\n\ | 1678 For convenience, the symbol nil is the same as `PRIMARY',\n\ |
1648 and t is the same as `SECONDARY'.)") | 1679 and t is the same as `SECONDARY'.)") |
1707 UNBLOCK_INPUT; | 1738 UNBLOCK_INPUT; |
1708 cut_buffers_initialized = 1; | 1739 cut_buffers_initialized = 1; |
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 |
1723 DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal, | 1754 DEFUN ("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; |
1734 Atom type; | 1765 Atom type; |
1735 int format; | 1766 int format; |
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, |
1743 &type, &format, &size, 0); | 1774 &type, &format, &size, 0); |
1744 if (!data) return Qnil; | 1775 if (!data) return Qnil; |
1753 xfree (data); | 1784 xfree (data); |
1754 return ret; | 1785 return ret; |
1755 } | 1786 } |
1756 | 1787 |
1757 | 1788 |
1758 DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal, | 1789 DEFUN ("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; |
1769 int bytes_remaining; | 1800 int bytes_remaining; |
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; |
1777 bytes = XSTRING (string)->size; | 1808 bytes = XSTRING (string)->size; |
1778 bytes_remaining = bytes; | 1809 bytes_remaining = bytes; |
1795 UNBLOCK_INPUT; | 1826 UNBLOCK_INPUT; |
1796 return string; | 1827 return string; |
1797 } | 1828 } |
1798 | 1829 |
1799 | 1830 |
1800 DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal, | 1831 DEFUN ("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\ |
1803 positive means move values forward, negative means backward.") | 1834 positive 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); |
1812 if (XINT (n) == 0) return n; | 1843 if (XINT (n) == 0) return n; |
1813 if (! cut_buffers_initialized) initialize_cut_buffers (display, window); | 1844 if (! cut_buffers_initialized) initialize_cut_buffers (display, window); |
1848 } | 1879 } |
1849 | 1880 |
1850 void | 1881 void |
1851 syms_of_xselect () | 1882 syms_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); |
1858 defsubr (&Sx_selection_owner_p); | 1887 defsubr (&Sx_selection_owner_p); |
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 |
1868 reading_selection_reply = Fcons (Qnil, Qnil); | 1897 reading_selection_reply = Fcons (Qnil, Qnil); |
1869 staticpro (&reading_selection_reply); | 1898 staticpro (&reading_selection_reply); |