aboutsummaryrefslogtreecommitdiffstats
path: root/src/print.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/print.c')
-rw-r--r--src/print.c131
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
274static void 274static void
275strout (const char *ptr, EMACS_INT size, EMACS_INT size_byte, 275strout (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