diff options
Diffstat (limited to 'src/print.c')
| -rw-r--r-- | src/print.c | 131 |
1 files changed, 64 insertions, 67 deletions
diff --git a/src/print.c b/src/print.c index b8266422473..17a896bba8d 100644 --- a/src/print.c +++ b/src/print.c | |||
| @@ -273,7 +273,7 @@ printchar (unsigned int ch, Lisp_Object fun) | |||
| 273 | 273 | ||
| 274 | static void | 274 | static void |
| 275 | strout (const char *ptr, EMACS_INT size, EMACS_INT size_byte, | 275 | strout (const char *ptr, EMACS_INT size, EMACS_INT size_byte, |
| 276 | Lisp_Object printcharfun, int multibyte) | 276 | Lisp_Object printcharfun) |
| 277 | { | 277 | { |
| 278 | if (size < 0) | 278 | if (size < 0) |
| 279 | size_byte = size = strlen (ptr); | 279 | size_byte = size = strlen (ptr); |
| @@ -406,16 +406,13 @@ print_string (Lisp_Object string, Lisp_Object printcharfun) | |||
| 406 | SAFE_ALLOCA (buffer, char *, nbytes); | 406 | SAFE_ALLOCA (buffer, char *, nbytes); |
| 407 | memcpy (buffer, SDATA (string), nbytes); | 407 | memcpy (buffer, SDATA (string), nbytes); |
| 408 | 408 | ||
| 409 | strout (buffer, chars, SBYTES (string), | 409 | strout (buffer, chars, SBYTES (string), printcharfun); |
| 410 | printcharfun, STRING_MULTIBYTE (string)); | ||
| 411 | 410 | ||
| 412 | SAFE_FREE (); | 411 | SAFE_FREE (); |
| 413 | } | 412 | } |
| 414 | else | 413 | else |
| 415 | /* No need to copy, since output to print_buffer can't GC. */ | 414 | /* No need to copy, since output to print_buffer can't GC. */ |
| 416 | strout (SSDATA (string), | 415 | strout (SSDATA (string), chars, SBYTES (string), printcharfun); |
| 417 | chars, SBYTES (string), | ||
| 418 | printcharfun, STRING_MULTIBYTE (string)); | ||
| 419 | } | 416 | } |
| 420 | else | 417 | else |
| 421 | { | 418 | { |
| @@ -472,7 +469,7 @@ write_string (const char *data, int size) | |||
| 472 | printcharfun = Vstandard_output; | 469 | printcharfun = Vstandard_output; |
| 473 | 470 | ||
| 474 | PRINTPREPARE; | 471 | PRINTPREPARE; |
| 475 | strout (data, size, size, printcharfun, 0); | 472 | strout (data, size, size, printcharfun); |
| 476 | PRINTFINISH; | 473 | PRINTFINISH; |
| 477 | } | 474 | } |
| 478 | 475 | ||
| @@ -486,7 +483,7 @@ write_string_1 (const char *data, int size, Lisp_Object printcharfun) | |||
| 486 | PRINTDECLARE; | 483 | PRINTDECLARE; |
| 487 | 484 | ||
| 488 | PRINTPREPARE; | 485 | PRINTPREPARE; |
| 489 | strout (data, size, size, printcharfun, 0); | 486 | strout (data, size, size, printcharfun); |
| 490 | PRINTFINISH; | 487 | PRINTFINISH; |
| 491 | } | 488 | } |
| 492 | 489 | ||
| @@ -1351,7 +1348,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1351 | if (EQ (obj, being_printed[i])) | 1348 | if (EQ (obj, being_printed[i])) |
| 1352 | { | 1349 | { |
| 1353 | sprintf (buf, "#%d", i); | 1350 | sprintf (buf, "#%d", i); |
| 1354 | strout (buf, -1, -1, printcharfun, 0); | 1351 | strout (buf, -1, -1, printcharfun); |
| 1355 | return; | 1352 | return; |
| 1356 | } | 1353 | } |
| 1357 | being_printed[print_depth] = obj; | 1354 | being_printed[print_depth] = obj; |
| @@ -1367,7 +1364,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1367 | { /* Add a prefix #n= if OBJ has not yet been printed; | 1364 | { /* Add a prefix #n= if OBJ has not yet been printed; |
| 1368 | that is, its status field is nil. */ | 1365 | that is, its status field is nil. */ |
| 1369 | sprintf (buf, "#%d=", -n); | 1366 | sprintf (buf, "#%d=", -n); |
| 1370 | strout (buf, -1, -1, printcharfun, 0); | 1367 | strout (buf, -1, -1, printcharfun); |
| 1371 | /* OBJ is going to be printed. Remember that fact. */ | 1368 | /* OBJ is going to be printed. Remember that fact. */ |
| 1372 | Fputhash (obj, make_number (- n), Vprint_number_table); | 1369 | Fputhash (obj, make_number (- n), Vprint_number_table); |
| 1373 | } | 1370 | } |
| @@ -1375,7 +1372,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1375 | { | 1372 | { |
| 1376 | /* Just print #n# if OBJ has already been printed. */ | 1373 | /* Just print #n# if OBJ has already been printed. */ |
| 1377 | sprintf (buf, "#%d#", n); | 1374 | sprintf (buf, "#%d#", n); |
| 1378 | strout (buf, -1, -1, printcharfun, 0); | 1375 | strout (buf, -1, -1, printcharfun); |
| 1379 | return; | 1376 | return; |
| 1380 | } | 1377 | } |
| 1381 | } | 1378 | } |
| @@ -1393,7 +1390,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1393 | sprintf (buf, "%ld", (long) XINT (obj)); | 1390 | sprintf (buf, "%ld", (long) XINT (obj)); |
| 1394 | else | 1391 | else |
| 1395 | abort (); | 1392 | abort (); |
| 1396 | strout (buf, -1, -1, printcharfun, 0); | 1393 | strout (buf, -1, -1, printcharfun); |
| 1397 | break; | 1394 | break; |
| 1398 | 1395 | ||
| 1399 | case Lisp_Float: | 1396 | case Lisp_Float: |
| @@ -1401,7 +1398,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1401 | char pigbuf[FLOAT_TO_STRING_BUFSIZE]; | 1398 | char pigbuf[FLOAT_TO_STRING_BUFSIZE]; |
| 1402 | 1399 | ||
| 1403 | float_to_string (pigbuf, XFLOAT_DATA (obj)); | 1400 | float_to_string (pigbuf, XFLOAT_DATA (obj)); |
| 1404 | strout (pigbuf, -1, -1, printcharfun, 0); | 1401 | strout (pigbuf, -1, -1, printcharfun); |
| 1405 | } | 1402 | } |
| 1406 | break; | 1403 | break; |
| 1407 | 1404 | ||
| @@ -1479,7 +1476,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1479 | sprintf (outbuf, "\\x%04x", c); | 1476 | sprintf (outbuf, "\\x%04x", c); |
| 1480 | need_nonhex = 1; | 1477 | need_nonhex = 1; |
| 1481 | } | 1478 | } |
| 1482 | strout (outbuf, -1, -1, printcharfun, 0); | 1479 | strout (outbuf, -1, -1, printcharfun); |
| 1483 | } | 1480 | } |
| 1484 | else if (! multibyte | 1481 | else if (! multibyte |
| 1485 | && SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c) | 1482 | && SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c) |
| @@ -1491,7 +1488,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1491 | using octal escapes. */ | 1488 | using octal escapes. */ |
| 1492 | char outbuf[5]; | 1489 | char outbuf[5]; |
| 1493 | sprintf (outbuf, "\\%03o", c); | 1490 | sprintf (outbuf, "\\%03o", c); |
| 1494 | strout (outbuf, -1, -1, printcharfun, 0); | 1491 | strout (outbuf, -1, -1, printcharfun); |
| 1495 | } | 1492 | } |
| 1496 | else | 1493 | else |
| 1497 | { | 1494 | { |
| @@ -1504,7 +1501,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1504 | if ((c >= 'a' && c <= 'f') | 1501 | if ((c >= 'a' && c <= 'f') |
| 1505 | || (c >= 'A' && c <= 'F') | 1502 | || (c >= 'A' && c <= 'F') |
| 1506 | || (c >= '0' && c <= '9')) | 1503 | || (c >= '0' && c <= '9')) |
| 1507 | strout ("\\ ", -1, -1, printcharfun, 0); | 1504 | strout ("\\ ", -1, -1, printcharfun); |
| 1508 | } | 1505 | } |
| 1509 | 1506 | ||
| 1510 | if (c == '\"' || c == '\\') | 1507 | if (c == '\"' || c == '\\') |
| @@ -1592,7 +1589,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1592 | /* If deeper than spec'd depth, print placeholder. */ | 1589 | /* If deeper than spec'd depth, print placeholder. */ |
| 1593 | if (INTEGERP (Vprint_level) | 1590 | if (INTEGERP (Vprint_level) |
| 1594 | && print_depth > XINT (Vprint_level)) | 1591 | && print_depth > XINT (Vprint_level)) |
| 1595 | strout ("...", -1, -1, printcharfun, 0); | 1592 | strout ("...", -1, -1, printcharfun); |
| 1596 | else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj))) | 1593 | else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj))) |
| 1597 | && (EQ (XCAR (obj), Qquote))) | 1594 | && (EQ (XCAR (obj), Qquote))) |
| 1598 | { | 1595 | { |
| @@ -1652,7 +1649,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1652 | if (i != 0 && EQ (obj, halftail)) | 1649 | if (i != 0 && EQ (obj, halftail)) |
| 1653 | { | 1650 | { |
| 1654 | sprintf (buf, " . #%d", i / 2); | 1651 | sprintf (buf, " . #%d", i / 2); |
| 1655 | strout (buf, -1, -1, printcharfun, 0); | 1652 | strout (buf, -1, -1, printcharfun); |
| 1656 | goto end_of_list; | 1653 | goto end_of_list; |
| 1657 | } | 1654 | } |
| 1658 | } | 1655 | } |
| @@ -1664,7 +1661,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1664 | Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil); | 1661 | Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil); |
| 1665 | if (INTEGERP (num)) | 1662 | if (INTEGERP (num)) |
| 1666 | { | 1663 | { |
| 1667 | strout (" . ", 3, 3, printcharfun, 0); | 1664 | strout (" . ", 3, 3, printcharfun); |
| 1668 | print_object (obj, printcharfun, escapeflag); | 1665 | print_object (obj, printcharfun, escapeflag); |
| 1669 | goto end_of_list; | 1666 | goto end_of_list; |
| 1670 | } | 1667 | } |
| @@ -1676,7 +1673,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1676 | 1673 | ||
| 1677 | if (print_length && i > print_length) | 1674 | if (print_length && i > print_length) |
| 1678 | { | 1675 | { |
| 1679 | strout ("...", 3, 3, printcharfun, 0); | 1676 | strout ("...", 3, 3, printcharfun); |
| 1680 | goto end_of_list; | 1677 | goto end_of_list; |
| 1681 | } | 1678 | } |
| 1682 | 1679 | ||
| @@ -1691,7 +1688,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1691 | /* OBJ non-nil here means it's the end of a dotted list. */ | 1688 | /* OBJ non-nil here means it's the end of a dotted list. */ |
| 1692 | if (!NILP (obj)) | 1689 | if (!NILP (obj)) |
| 1693 | { | 1690 | { |
| 1694 | strout (" . ", 3, 3, printcharfun, 0); | 1691 | strout (" . ", 3, 3, printcharfun); |
| 1695 | print_object (obj, printcharfun, escapeflag); | 1692 | print_object (obj, printcharfun, escapeflag); |
| 1696 | } | 1693 | } |
| 1697 | 1694 | ||
| @@ -1705,7 +1702,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1705 | { | 1702 | { |
| 1706 | if (escapeflag) | 1703 | if (escapeflag) |
| 1707 | { | 1704 | { |
| 1708 | strout ("#<process ", -1, -1, printcharfun, 0); | 1705 | strout ("#<process ", -1, -1, printcharfun); |
| 1709 | print_string (XPROCESS (obj)->name, printcharfun); | 1706 | print_string (XPROCESS (obj)->name, printcharfun); |
| 1710 | PRINTCHAR ('>'); | 1707 | PRINTCHAR ('>'); |
| 1711 | } | 1708 | } |
| @@ -1726,7 +1723,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1726 | PRINTCHAR ('#'); | 1723 | PRINTCHAR ('#'); |
| 1727 | PRINTCHAR ('&'); | 1724 | PRINTCHAR ('&'); |
| 1728 | sprintf (buf, "%ld", (long) XBOOL_VECTOR (obj)->size); | 1725 | sprintf (buf, "%ld", (long) XBOOL_VECTOR (obj)->size); |
| 1729 | strout (buf, -1, -1, printcharfun, 0); | 1726 | strout (buf, -1, -1, printcharfun); |
| 1730 | PRINTCHAR ('\"'); | 1727 | PRINTCHAR ('\"'); |
| 1731 | 1728 | ||
| 1732 | /* Don't print more characters than the specified maximum. | 1729 | /* Don't print more characters than the specified maximum. |
| @@ -1771,18 +1768,18 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1771 | } | 1768 | } |
| 1772 | else if (SUBRP (obj)) | 1769 | else if (SUBRP (obj)) |
| 1773 | { | 1770 | { |
| 1774 | strout ("#<subr ", -1, -1, printcharfun, 0); | 1771 | strout ("#<subr ", -1, -1, printcharfun); |
| 1775 | strout (XSUBR (obj)->symbol_name, -1, -1, printcharfun, 0); | 1772 | strout (XSUBR (obj)->symbol_name, -1, -1, printcharfun); |
| 1776 | PRINTCHAR ('>'); | 1773 | PRINTCHAR ('>'); |
| 1777 | } | 1774 | } |
| 1778 | else if (WINDOWP (obj)) | 1775 | else if (WINDOWP (obj)) |
| 1779 | { | 1776 | { |
| 1780 | strout ("#<window ", -1, -1, printcharfun, 0); | 1777 | strout ("#<window ", -1, -1, printcharfun); |
| 1781 | sprintf (buf, "%ld", (long) XFASTINT (XWINDOW (obj)->sequence_number)); | 1778 | sprintf (buf, "%ld", (long) XFASTINT (XWINDOW (obj)->sequence_number)); |
| 1782 | strout (buf, -1, -1, printcharfun, 0); | 1779 | strout (buf, -1, -1, printcharfun); |
| 1783 | if (!NILP (XWINDOW (obj)->buffer)) | 1780 | if (!NILP (XWINDOW (obj)->buffer)) |
| 1784 | { | 1781 | { |
| 1785 | strout (" on ", -1, -1, printcharfun, 0); | 1782 | strout (" on ", -1, -1, printcharfun); |
| 1786 | print_string (BVAR (XBUFFER (XWINDOW (obj)->buffer), name), printcharfun); | 1783 | print_string (BVAR (XBUFFER (XWINDOW (obj)->buffer), name), printcharfun); |
| 1787 | } | 1784 | } |
| 1788 | PRINTCHAR ('>'); | 1785 | PRINTCHAR ('>'); |
| @@ -1790,13 +1787,13 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1790 | else if (TERMINALP (obj)) | 1787 | else if (TERMINALP (obj)) |
| 1791 | { | 1788 | { |
| 1792 | struct terminal *t = XTERMINAL (obj); | 1789 | struct terminal *t = XTERMINAL (obj); |
| 1793 | strout ("#<terminal ", -1, -1, printcharfun, 0); | 1790 | strout ("#<terminal ", -1, -1, printcharfun); |
| 1794 | sprintf (buf, "%d", t->id); | 1791 | sprintf (buf, "%d", t->id); |
| 1795 | strout (buf, -1, -1, printcharfun, 0); | 1792 | strout (buf, -1, -1, printcharfun); |
| 1796 | if (t->name) | 1793 | if (t->name) |
| 1797 | { | 1794 | { |
| 1798 | strout (" on ", -1, -1, printcharfun, 0); | 1795 | strout (" on ", -1, -1, printcharfun); |
| 1799 | strout (t->name, -1, -1, printcharfun, 0); | 1796 | strout (t->name, -1, -1, printcharfun); |
| 1800 | } | 1797 | } |
| 1801 | PRINTCHAR ('>'); | 1798 | PRINTCHAR ('>'); |
| 1802 | } | 1799 | } |
| @@ -1806,21 +1803,21 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1806 | int i; | 1803 | int i; |
| 1807 | EMACS_INT real_size, size; | 1804 | EMACS_INT real_size, size; |
| 1808 | #if 0 | 1805 | #if 0 |
| 1809 | strout ("#<hash-table", -1, -1, printcharfun, 0); | 1806 | strout ("#<hash-table", -1, -1, printcharfun); |
| 1810 | if (SYMBOLP (h->test)) | 1807 | if (SYMBOLP (h->test)) |
| 1811 | { | 1808 | { |
| 1812 | PRINTCHAR (' '); | 1809 | PRINTCHAR (' '); |
| 1813 | PRINTCHAR ('\''); | 1810 | PRINTCHAR ('\''); |
| 1814 | strout (SDATA (SYMBOL_NAME (h->test)), -1, -1, printcharfun, 0); | 1811 | strout (SDATA (SYMBOL_NAME (h->test)), -1, -1, printcharfun); |
| 1815 | PRINTCHAR (' '); | 1812 | PRINTCHAR (' '); |
| 1816 | strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun, 0); | 1813 | strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun); |
| 1817 | PRINTCHAR (' '); | 1814 | PRINTCHAR (' '); |
| 1818 | sprintf (buf, "%ld/%ld", (long) h->count, | 1815 | sprintf (buf, "%ld/%ld", (long) h->count, |
| 1819 | (long) XVECTOR (h->next)->size); | 1816 | (long) XVECTOR (h->next)->size); |
| 1820 | strout (buf, -1, -1, printcharfun, 0); | 1817 | strout (buf, -1, -1, printcharfun); |
| 1821 | } | 1818 | } |
| 1822 | sprintf (buf, " 0x%lx", (unsigned long) h); | 1819 | sprintf (buf, " 0x%lx", (unsigned long) h); |
| 1823 | strout (buf, -1, -1, printcharfun, 0); | 1820 | strout (buf, -1, -1, printcharfun); |
| 1824 | PRINTCHAR ('>'); | 1821 | PRINTCHAR ('>'); |
| 1825 | #endif | 1822 | #endif |
| 1826 | /* Implement a readable output, e.g.: | 1823 | /* Implement a readable output, e.g.: |
| @@ -1828,33 +1825,33 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1828 | /* Always print the size. */ | 1825 | /* Always print the size. */ |
| 1829 | sprintf (buf, "#s(hash-table size %ld", | 1826 | sprintf (buf, "#s(hash-table size %ld", |
| 1830 | (long) XVECTOR (h->next)->size); | 1827 | (long) XVECTOR (h->next)->size); |
| 1831 | strout (buf, -1, -1, printcharfun, 0); | 1828 | strout (buf, -1, -1, printcharfun); |
| 1832 | 1829 | ||
| 1833 | if (!NILP (h->test)) | 1830 | if (!NILP (h->test)) |
| 1834 | { | 1831 | { |
| 1835 | strout (" test ", -1, -1, printcharfun, 0); | 1832 | strout (" test ", -1, -1, printcharfun); |
| 1836 | print_object (h->test, printcharfun, escapeflag); | 1833 | print_object (h->test, printcharfun, escapeflag); |
| 1837 | } | 1834 | } |
| 1838 | 1835 | ||
| 1839 | if (!NILP (h->weak)) | 1836 | if (!NILP (h->weak)) |
| 1840 | { | 1837 | { |
| 1841 | strout (" weakness ", -1, -1, printcharfun, 0); | 1838 | strout (" weakness ", -1, -1, printcharfun); |
| 1842 | print_object (h->weak, printcharfun, escapeflag); | 1839 | print_object (h->weak, printcharfun, escapeflag); |
| 1843 | } | 1840 | } |
| 1844 | 1841 | ||
| 1845 | if (!NILP (h->rehash_size)) | 1842 | if (!NILP (h->rehash_size)) |
| 1846 | { | 1843 | { |
| 1847 | strout (" rehash-size ", -1, -1, printcharfun, 0); | 1844 | strout (" rehash-size ", -1, -1, printcharfun); |
| 1848 | print_object (h->rehash_size, printcharfun, escapeflag); | 1845 | print_object (h->rehash_size, printcharfun, escapeflag); |
| 1849 | } | 1846 | } |
| 1850 | 1847 | ||
| 1851 | if (!NILP (h->rehash_threshold)) | 1848 | if (!NILP (h->rehash_threshold)) |
| 1852 | { | 1849 | { |
| 1853 | strout (" rehash-threshold ", -1, -1, printcharfun, 0); | 1850 | strout (" rehash-threshold ", -1, -1, printcharfun); |
| 1854 | print_object (h->rehash_threshold, printcharfun, escapeflag); | 1851 | print_object (h->rehash_threshold, printcharfun, escapeflag); |
| 1855 | } | 1852 | } |
| 1856 | 1853 | ||
| 1857 | strout (" data ", -1, -1, printcharfun, 0); | 1854 | strout (" data ", -1, -1, printcharfun); |
| 1858 | 1855 | ||
| 1859 | /* Print the data here as a plist. */ | 1856 | /* Print the data here as a plist. */ |
| 1860 | real_size = HASH_TABLE_SIZE (h); | 1857 | real_size = HASH_TABLE_SIZE (h); |
| @@ -1876,7 +1873,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1876 | } | 1873 | } |
| 1877 | 1874 | ||
| 1878 | if (size < real_size) | 1875 | if (size < real_size) |
| 1879 | strout (" ...", 4, 4, printcharfun, 0); | 1876 | strout (" ...", 4, 4, printcharfun); |
| 1880 | 1877 | ||
| 1881 | PRINTCHAR (')'); | 1878 | PRINTCHAR (')'); |
| 1882 | PRINTCHAR (')'); | 1879 | PRINTCHAR (')'); |
| @@ -1885,10 +1882,10 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1885 | else if (BUFFERP (obj)) | 1882 | else if (BUFFERP (obj)) |
| 1886 | { | 1883 | { |
| 1887 | if (NILP (BVAR (XBUFFER (obj), name))) | 1884 | if (NILP (BVAR (XBUFFER (obj), name))) |
| 1888 | strout ("#<killed buffer>", -1, -1, printcharfun, 0); | 1885 | strout ("#<killed buffer>", -1, -1, printcharfun); |
| 1889 | else if (escapeflag) | 1886 | else if (escapeflag) |
| 1890 | { | 1887 | { |
| 1891 | strout ("#<buffer ", -1, -1, printcharfun, 0); | 1888 | strout ("#<buffer ", -1, -1, printcharfun); |
| 1892 | print_string (BVAR (XBUFFER (obj), name), printcharfun); | 1889 | print_string (BVAR (XBUFFER (obj), name), printcharfun); |
| 1893 | PRINTCHAR ('>'); | 1890 | PRINTCHAR ('>'); |
| 1894 | } | 1891 | } |
| @@ -1897,16 +1894,16 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1897 | } | 1894 | } |
| 1898 | else if (WINDOW_CONFIGURATIONP (obj)) | 1895 | else if (WINDOW_CONFIGURATIONP (obj)) |
| 1899 | { | 1896 | { |
| 1900 | strout ("#<window-configuration>", -1, -1, printcharfun, 0); | 1897 | strout ("#<window-configuration>", -1, -1, printcharfun); |
| 1901 | } | 1898 | } |
| 1902 | else if (FRAMEP (obj)) | 1899 | else if (FRAMEP (obj)) |
| 1903 | { | 1900 | { |
| 1904 | strout ((FRAME_LIVE_P (XFRAME (obj)) | 1901 | strout ((FRAME_LIVE_P (XFRAME (obj)) |
| 1905 | ? "#<frame " : "#<dead frame "), | 1902 | ? "#<frame " : "#<dead frame "), |
| 1906 | -1, -1, printcharfun, 0); | 1903 | -1, -1, printcharfun); |
| 1907 | print_string (XFRAME (obj)->name, printcharfun); | 1904 | print_string (XFRAME (obj)->name, printcharfun); |
| 1908 | sprintf (buf, " 0x%lx", (unsigned long) (XFRAME (obj))); | 1905 | sprintf (buf, " 0x%lx", (unsigned long) (XFRAME (obj))); |
| 1909 | strout (buf, -1, -1, printcharfun, 0); | 1906 | strout (buf, -1, -1, printcharfun); |
| 1910 | PRINTCHAR ('>'); | 1907 | PRINTCHAR ('>'); |
| 1911 | } | 1908 | } |
| 1912 | else if (FONTP (obj)) | 1909 | else if (FONTP (obj)) |
| @@ -1916,9 +1913,9 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1916 | if (! FONT_OBJECT_P (obj)) | 1913 | if (! FONT_OBJECT_P (obj)) |
| 1917 | { | 1914 | { |
| 1918 | if (FONT_SPEC_P (obj)) | 1915 | if (FONT_SPEC_P (obj)) |
| 1919 | strout ("#<font-spec", -1, -1, printcharfun, 0); | 1916 | strout ("#<font-spec", -1, -1, printcharfun); |
| 1920 | else | 1917 | else |
| 1921 | strout ("#<font-entity", -1, -1, printcharfun, 0); | 1918 | strout ("#<font-entity", -1, -1, printcharfun); |
| 1922 | for (i = 0; i < FONT_SPEC_MAX; i++) | 1919 | for (i = 0; i < FONT_SPEC_MAX; i++) |
| 1923 | { | 1920 | { |
| 1924 | PRINTCHAR (' '); | 1921 | PRINTCHAR (' '); |
| @@ -1931,7 +1928,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1931 | } | 1928 | } |
| 1932 | else | 1929 | else |
| 1933 | { | 1930 | { |
| 1934 | strout ("#<font-object ", -1, -1, printcharfun, 0); | 1931 | strout ("#<font-object ", -1, -1, printcharfun); |
| 1935 | print_object (AREF (obj, FONT_NAME_INDEX), printcharfun, | 1932 | print_object (AREF (obj, FONT_NAME_INDEX), printcharfun, |
| 1936 | escapeflag); | 1933 | escapeflag); |
| 1937 | } | 1934 | } |
| @@ -1984,7 +1981,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1984 | print_object (tem, printcharfun, escapeflag); | 1981 | print_object (tem, printcharfun, escapeflag); |
| 1985 | } | 1982 | } |
| 1986 | if (size < real_size) | 1983 | if (size < real_size) |
| 1987 | strout (" ...", 4, 4, printcharfun, 0); | 1984 | strout (" ...", 4, 4, printcharfun); |
| 1988 | } | 1985 | } |
| 1989 | PRINTCHAR (']'); | 1986 | PRINTCHAR (']'); |
| 1990 | } | 1987 | } |
| @@ -1994,32 +1991,32 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 1994 | switch (XMISCTYPE (obj)) | 1991 | switch (XMISCTYPE (obj)) |
| 1995 | { | 1992 | { |
| 1996 | case Lisp_Misc_Marker: | 1993 | case Lisp_Misc_Marker: |
| 1997 | strout ("#<marker ", -1, -1, printcharfun, 0); | 1994 | strout ("#<marker ", -1, -1, printcharfun); |
| 1998 | /* Do you think this is necessary? */ | 1995 | /* Do you think this is necessary? */ |
| 1999 | if (XMARKER (obj)->insertion_type != 0) | 1996 | if (XMARKER (obj)->insertion_type != 0) |
| 2000 | strout ("(moves after insertion) ", -1, -1, printcharfun, 0); | 1997 | strout ("(moves after insertion) ", -1, -1, printcharfun); |
| 2001 | if (! XMARKER (obj)->buffer) | 1998 | if (! XMARKER (obj)->buffer) |
| 2002 | strout ("in no buffer", -1, -1, printcharfun, 0); | 1999 | strout ("in no buffer", -1, -1, printcharfun); |
| 2003 | else | 2000 | else |
| 2004 | { | 2001 | { |
| 2005 | sprintf (buf, "at %ld", (long)marker_position (obj)); | 2002 | sprintf (buf, "at %ld", (long)marker_position (obj)); |
| 2006 | strout (buf, -1, -1, printcharfun, 0); | 2003 | strout (buf, -1, -1, printcharfun); |
| 2007 | strout (" in ", -1, -1, printcharfun, 0); | 2004 | strout (" in ", -1, -1, printcharfun); |
| 2008 | print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun); | 2005 | print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun); |
| 2009 | } | 2006 | } |
| 2010 | PRINTCHAR ('>'); | 2007 | PRINTCHAR ('>'); |
| 2011 | break; | 2008 | break; |
| 2012 | 2009 | ||
| 2013 | case Lisp_Misc_Overlay: | 2010 | case Lisp_Misc_Overlay: |
| 2014 | strout ("#<overlay ", -1, -1, printcharfun, 0); | 2011 | strout ("#<overlay ", -1, -1, printcharfun); |
| 2015 | if (! XMARKER (OVERLAY_START (obj))->buffer) | 2012 | if (! XMARKER (OVERLAY_START (obj))->buffer) |
| 2016 | strout ("in no buffer", -1, -1, printcharfun, 0); | 2013 | strout ("in no buffer", -1, -1, printcharfun); |
| 2017 | else | 2014 | else |
| 2018 | { | 2015 | { |
| 2019 | sprintf (buf, "from %ld to %ld in ", | 2016 | sprintf (buf, "from %ld to %ld in ", |
| 2020 | (long)marker_position (OVERLAY_START (obj)), | 2017 | (long)marker_position (OVERLAY_START (obj)), |
| 2021 | (long)marker_position (OVERLAY_END (obj))); | 2018 | (long)marker_position (OVERLAY_END (obj))); |
| 2022 | strout (buf, -1, -1, printcharfun, 0); | 2019 | strout (buf, -1, -1, printcharfun); |
| 2023 | print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name), | 2020 | print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name), |
| 2024 | printcharfun); | 2021 | printcharfun); |
| 2025 | } | 2022 | } |
| @@ -2029,15 +2026,15 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 2029 | /* Remaining cases shouldn't happen in normal usage, but let's print | 2026 | /* Remaining cases shouldn't happen in normal usage, but let's print |
| 2030 | them anyway for the benefit of the debugger. */ | 2027 | them anyway for the benefit of the debugger. */ |
| 2031 | case Lisp_Misc_Free: | 2028 | case Lisp_Misc_Free: |
| 2032 | strout ("#<misc free cell>", -1, -1, printcharfun, 0); | 2029 | strout ("#<misc free cell>", -1, -1, printcharfun); |
| 2033 | break; | 2030 | break; |
| 2034 | 2031 | ||
| 2035 | case Lisp_Misc_Save_Value: | 2032 | case Lisp_Misc_Save_Value: |
| 2036 | strout ("#<save_value ", -1, -1, printcharfun, 0); | 2033 | strout ("#<save_value ", -1, -1, printcharfun); |
| 2037 | sprintf(buf, "ptr=0x%08lx int=%d", | 2034 | sprintf(buf, "ptr=0x%08lx int=%d", |
| 2038 | (unsigned long) XSAVE_VALUE (obj)->pointer, | 2035 | (unsigned long) XSAVE_VALUE (obj)->pointer, |
| 2039 | XSAVE_VALUE (obj)->integer); | 2036 | XSAVE_VALUE (obj)->integer); |
| 2040 | strout (buf, -1, -1, printcharfun, 0); | 2037 | strout (buf, -1, -1, printcharfun); |
| 2041 | PRINTCHAR ('>'); | 2038 | PRINTCHAR ('>'); |
| 2042 | break; | 2039 | break; |
| 2043 | 2040 | ||
| @@ -2051,16 +2048,16 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag | |||
| 2051 | { | 2048 | { |
| 2052 | /* We're in trouble if this happens! | 2049 | /* We're in trouble if this happens! |
| 2053 | Probably should just abort () */ | 2050 | Probably should just abort () */ |
| 2054 | strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun, 0); | 2051 | strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun); |
| 2055 | if (MISCP (obj)) | 2052 | if (MISCP (obj)) |
| 2056 | sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj)); | 2053 | sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj)); |
| 2057 | else if (VECTORLIKEP (obj)) | 2054 | else if (VECTORLIKEP (obj)) |
| 2058 | sprintf (buf, "(PVEC 0x%08x)", (int) XVECTOR (obj)->size); | 2055 | sprintf (buf, "(PVEC 0x%08x)", (int) XVECTOR (obj)->size); |
| 2059 | else | 2056 | else |
| 2060 | sprintf (buf, "(0x%02x)", (int) XTYPE (obj)); | 2057 | sprintf (buf, "(0x%02x)", (int) XTYPE (obj)); |
| 2061 | strout (buf, -1, -1, printcharfun, 0); | 2058 | strout (buf, -1, -1, printcharfun); |
| 2062 | strout (" Save your buffers immediately and please report this bug>", | 2059 | strout (" Save your buffers immediately and please report this bug>", |
| 2063 | -1, -1, printcharfun, 0); | 2060 | -1, -1, printcharfun); |
| 2064 | } | 2061 | } |
| 2065 | } | 2062 | } |
| 2066 | 2063 | ||