aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1999-09-13 19:26:18 +0000
committerRichard M. Stallman1999-09-13 19:26:18 +0000
commit0f25ecc6ca3476069892ae61c1afaade14e8d90a (patch)
treea4b7fe761291db506103933bcbd07f72afb8f5d4
parent701552ddc8991a1e22e07bd027886b5688c1981a (diff)
downloademacs-0f25ecc6ca3476069892ae61c1afaade14e8d90a.tar.gz
emacs-0f25ecc6ca3476069892ae61c1afaade14e8d90a.zip
Support print-circle and related features.
(Vprint_gensym_alist): Removed. (Vprint_circle, Vprint_continuous_numbering, print_number_index Vprint_number_table): New variables. (PRINT_NUMBER_OBJECT, PRINT_NUMBER_STATUS): New macros. (PRINTPREPARE, PRINTFINISH): Don't set Vprint_gensym_alist. (print, print_preprocess, print_preprocess_string, print_object): New/modified functions with print-circle feature. Use Vprint_number_table instead of Vprint_gensym_alist for print-gensym. (syms_of_print): Defined new Lisp variables `print-circle', `print-continuous-numbering', `print-number-table'.
-rw-r--r--src/print.c384
1 files changed, 283 insertions, 101 deletions
diff --git a/src/print.c b/src/print.c
index 39e450dc0ed..d61557f6333 100644
--- a/src/print.c
+++ b/src/print.c
@@ -143,17 +143,33 @@ Lisp_Object Qprint_escape_multibyte, Qprint_escape_nonascii;
143 143
144int print_quoted; 144int print_quoted;
145 145
146/* Non-nil means print #: before uninterned symbols. 146/* Non-nil means print #: before uninterned symbols. */
147 Neither t nor nil means so that and don't clear Vprint_gensym_alist
148 on entry to and exit from print functions. */
149 147
150Lisp_Object Vprint_gensym; 148Lisp_Object Vprint_gensym;
151 149
152/* Association list of certain objects that are `eq' in the form being 150/* Non-nil means print recursive structures using #n= and #n# syntax. */
153 printed and which should be `eq' when read back in, using the #n=object
154 and #n# reader forms. Each element has the form (object . n). */
155 151
156Lisp_Object Vprint_gensym_alist; 152Lisp_Object Vprint_circle;
153
154/* Non-nil means keep continuous number for #n= and #n# syntax
155 between several print functions. */
156
157Lisp_Object Vprint_continuous_numbering;
158
159/* Vprint_number_table is a vector like [OBJ1 STAT1 OBJ2 STAT2 ...],
160 where OBJn are objects going to be printed, and STATn are their status,
161 which may be different meanings during process. See the comments of
162 the functions print and print_preprocess for details.
163 print_number_index keeps the last position the next object should be added,
164 twice of which is the actual vector position in Vprint_number_table. */
165int print_number_index;
166Lisp_Object Vprint_number_table;
167
168/* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table TABLE.
169 PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE.
170 See the comment of the variable Vprint_number_table. */
171#define PRINT_NUMBER_OBJECT(table,i) XVECTOR ((table))->contents[(i) * 2]
172#define PRINT_NUMBER_STATUS(table,i) XVECTOR ((table))->contents[(i) * 2 + 1]
157 173
158/* Nonzero means print newline to stdout before next minibuffer message. 174/* Nonzero means print newline to stdout before next minibuffer message.
159 Defined in xdisp.c */ 175 Defined in xdisp.c */
@@ -237,9 +253,7 @@ void print_interval ();
237 print_buffer_pos_byte = 0; \ 253 print_buffer_pos_byte = 0; \
238 } \ 254 } \
239 if (EQ (printcharfun, Qt)) \ 255 if (EQ (printcharfun, Qt)) \
240 setup_echo_area_for_printing (multibyte); \ 256 setup_echo_area_for_printing (multibyte);
241 if (!CONSP (Vprint_gensym)) \
242 Vprint_gensym_alist = Qnil
243 257
244#define PRINTFINISH \ 258#define PRINTFINISH \
245 if (NILP (printcharfun)) \ 259 if (NILP (printcharfun)) \
@@ -272,9 +286,7 @@ void print_interval ();
272 old_point_byte + (old_point_byte >= start_point_byte \ 286 old_point_byte + (old_point_byte >= start_point_byte \
273 ? PT_BYTE - start_point_byte : 0)); \ 287 ? PT_BYTE - start_point_byte : 0)); \
274 if (old != current_buffer) \ 288 if (old != current_buffer) \
275 set_buffer_internal (old); \ 289 set_buffer_internal (old);
276 if (!CONSP (Vprint_gensym)) \
277 Vprint_gensym_alist = Qnil
278 290
279#define PRINTCHAR(ch) printchar (ch, printcharfun) 291#define PRINTCHAR(ch) printchar (ch, printcharfun)
280 292
@@ -664,6 +676,11 @@ buffer and calling the hook. It gets one argument, the buffer to display.")
664 676
665 677
666static void print (); 678static void print ();
679static void print_preprocess ();
680#ifdef USE_TEXT_PROPERTIES
681static void print_preprocess_string ();
682#endif /* USE_TEXT_PROPERTIES */
683static void print_object ();
667 684
668DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0, 685DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
669 "Output a newline to stream PRINTCHARFUN.\n\ 686 "Output a newline to stream PRINTCHARFUN.\n\
@@ -697,7 +714,6 @@ Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
697 if (NILP (printcharfun)) 714 if (NILP (printcharfun))
698 printcharfun = Vstandard_output; 715 printcharfun = Vstandard_output;
699 PRINTPREPARE; 716 PRINTPREPARE;
700 print_depth = 0;
701 print (object, printcharfun, 1); 717 print (object, printcharfun, 1);
702 PRINTFINISH; 718 PRINTFINISH;
703 return object; 719 return object;
@@ -727,7 +743,6 @@ second argument NOESCAPE is non-nil.")
727 743
728 printcharfun = Vprin1_to_string_buffer; 744 printcharfun = Vprin1_to_string_buffer;
729 PRINTPREPARE; 745 PRINTPREPARE;
730 print_depth = 0;
731 print (object, printcharfun, NILP (noescape)); 746 print (object, printcharfun, NILP (noescape));
732 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */ 747 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
733 PRINTFINISH; 748 PRINTFINISH;
@@ -756,7 +771,6 @@ Output stream is PRINTCHARFUN, or value of standard-output (which see).")
756 if (NILP (printcharfun)) 771 if (NILP (printcharfun))
757 printcharfun = Vstandard_output; 772 printcharfun = Vstandard_output;
758 PRINTPREPARE; 773 PRINTPREPARE;
759 print_depth = 0;
760 print (object, printcharfun, 0); 774 print (object, printcharfun, 0);
761 PRINTFINISH; 775 PRINTFINISH;
762 return object; 776 return object;
@@ -781,7 +795,6 @@ Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
781 printcharfun = Vstandard_output; 795 printcharfun = Vstandard_output;
782 GCPRO1 (object); 796 GCPRO1 (object);
783 PRINTPREPARE; 797 PRINTPREPARE;
784 print_depth = 0;
785 PRINTCHAR ('\n'); 798 PRINTCHAR ('\n');
786 print (object, printcharfun, 1); 799 print (object, printcharfun, 1);
787 PRINTCHAR ('\n'); 800 PRINTCHAR ('\n');
@@ -1048,27 +1061,182 @@ print (obj, printcharfun, escapeflag)
1048 register Lisp_Object printcharfun; 1061 register Lisp_Object printcharfun;
1049 int escapeflag; 1062 int escapeflag;
1050{ 1063{
1051 char buf[30]; 1064 print_depth = 0;
1052 1065
1053 QUIT; 1066 /* Reset print_number_index and Vprint_number_table only when
1067 the variable Vprint_continuous_numbering is nil. Otherwise,
1068 the values of these variables will be kept between several
1069 print functions. */
1070 if (NILP (Vprint_continuous_numbering))
1071 {
1072 print_number_index = 0;
1073 Vprint_number_table = Qnil;
1074 }
1054 1075
1055#if 1 /* I'm not sure this is really worth doing. */ 1076 /* Construct Vprint_number_table for print-gensym and print-circle. */
1056 /* Detect circularities and truncate them. 1077 if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))
1057 No need to offer any alternative--this is better than an error. */
1058 if (CONSP (obj) || VECTORP (obj) || COMPILEDP (obj))
1059 { 1078 {
1060 int i; 1079 int i, index = 0;
1061 for (i = 0; i < print_depth; i++) 1080 /* Construct Vprint_number_table. */
1062 if (EQ (obj, being_printed[i])) 1081 print_preprocess (obj);
1082 /* Remove unnecessary objects, which appear only once in OBJ;
1083 that is, whose status is Qnil. */
1084 for (i = 0; i < print_number_index; i++)
1085 if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1086 {
1087 PRINT_NUMBER_OBJECT (Vprint_number_table, index)
1088 = PRINT_NUMBER_OBJECT (Vprint_number_table, i);
1089 /* Reset the status field for the next print step. Now this
1090 field means whether the object has already been printed. */
1091 PRINT_NUMBER_STATUS (Vprint_number_table, index) = Qnil;
1092 index++;
1093 }
1094 print_number_index = index;
1095 }
1096
1097 print_object (obj, printcharfun, escapeflag);
1098}
1099
1100/* Construct Vprint_number_table according to the structure of OBJ.
1101 OBJ itself and all its elements will be added to Vprint_number_table
1102 recursively if it is a list, vector, compiled function, char-table,
1103 string (its text properties will be traced), or a symbol that has
1104 no obarray (this is for the print-gensym feature).
1105 The status fields of Vprint_number_table mean whether each object appears
1106 more than once in OBJ: Qnil at the first time, and Qt after that . */
1107static void
1108print_preprocess (obj)
1109 Lisp_Object obj;
1110{
1111 int i, size;
1112
1113 loop:
1114 if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
1115 || COMPILEDP (obj) || CHAR_TABLE_P (obj)
1116 || (! NILP (Vprint_gensym)
1117 && SYMBOLP (obj) && NILP (XSYMBOL (obj)->obarray)))
1118 {
1119 for (i = 0; i < print_number_index; i++)
1120 if (PRINT_NUMBER_OBJECT (Vprint_number_table, i) == obj)
1063 { 1121 {
1064 sprintf (buf, "#%d", i); 1122 /* OBJ appears more than once. Let's remember that. */
1065 strout (buf, -1, -1, printcharfun, 0); 1123 PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
1066 return; 1124 return;
1067 } 1125 }
1126
1127 /* OBJ is not yet recorded. Let's add to the table. */
1128 if (print_number_index == 0)
1129 {
1130 /* Initialize the table. */
1131 Vprint_number_table = Fmake_vector (make_number (40), Qnil);
1132 }
1133 else if (XVECTOR (Vprint_number_table)->size == print_number_index * 2)
1134 {
1135 /* Reallocate the table. */
1136 int i = print_number_index * 4;
1137 Lisp_Object old_table = Vprint_number_table;
1138 Vprint_number_table = Fmake_vector (make_number (i), Qnil);
1139 for (i = 0; i < print_number_index; i++)
1140 {
1141 PRINT_NUMBER_OBJECT (Vprint_number_table, i)
1142 = PRINT_NUMBER_OBJECT (old_table, i);
1143 PRINT_NUMBER_STATUS (Vprint_number_table, i)
1144 = PRINT_NUMBER_STATUS (old_table, i);
1145 }
1146 }
1147 PRINT_NUMBER_OBJECT (Vprint_number_table, print_number_index) = obj;
1148 print_number_index++;
1149
1150 switch (XGCTYPE (obj))
1151 {
1152 case Lisp_String:
1153#ifdef USE_TEXT_PROPERTIES
1154 /* A string may have text properties, which can be circular. */
1155 traverse_intervals (XSTRING (obj)->intervals, 0, 0,
1156 print_preprocess_string, Qnil);
1157#endif /* USE_TEXT_PROPERTIES */
1158 break;
1159
1160 case Lisp_Cons:
1161 print_preprocess (XCAR (obj));
1162 obj = XCDR (obj);
1163 goto loop;
1164
1165 case Lisp_Vectorlike:
1166 size = XVECTOR (obj)->size & PSEUDOVECTOR_SIZE_MASK;
1167 for (i = 0; i < size; i++)
1168 print_preprocess (XVECTOR (obj)->contents[i]);
1169 }
1170 }
1171}
1172
1173#ifdef USE_TEXT_PROPERTIES
1174static void
1175print_preprocess_string (interval, arg)
1176 INTERVAL interval;
1177 Lisp_Object arg;
1178{
1179 print_preprocess (interval->plist);
1180}
1181#endif /* USE_TEXT_PROPERTIES */
1182
1183static void
1184print_object (obj, printcharfun, escapeflag)
1185 Lisp_Object obj;
1186 register Lisp_Object printcharfun;
1187 int escapeflag;
1188{
1189 char buf[30];
1190
1191 QUIT;
1192
1193 /* Detect circularities and truncate them. */
1194 if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
1195 || COMPILEDP (obj) || CHAR_TABLE_P (obj)
1196 || (! NILP (Vprint_gensym)
1197 && SYMBOLP (obj) && NILP (XSYMBOL (obj)->obarray)))
1198 {
1199 if (NILP (Vprint_circle) && NILP (Vprint_gensym))
1200 {
1201 /* Simple but incomplete way. */
1202 int i;
1203 for (i = 0; i < print_depth; i++)
1204 if (EQ (obj, being_printed[i]))
1205 {
1206 sprintf (buf, "#%d", i);
1207 strout (buf, -1, -1, printcharfun, 0);
1208 return;
1209 }
1210 being_printed[print_depth] = obj;
1211 }
1212 else
1213 {
1214 /* With the print-circle feature. */
1215 int i;
1216 for (i = 0; i < print_number_index; i++)
1217 if (PRINT_NUMBER_OBJECT (Vprint_number_table, i) == obj)
1218 {
1219 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1220 {
1221 /* Add a prefix #n= if OBJ has not yet been printed;
1222 that is, its status field is nil. */
1223 sprintf (buf, "#%d=", i + 1);
1224 strout (buf, -1, -1, printcharfun, 0);
1225 /* OBJ is going to be printed. Set the status to t. */
1226 PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
1227 break;
1228 }
1229 else
1230 {
1231 /* Just print #n# if OBJ has already been printed. */
1232 sprintf (buf, "#%d#", i + 1);
1233 strout (buf, -1, -1, printcharfun, 0);
1234 return;
1235 }
1236 }
1237 }
1068 } 1238 }
1069#endif
1070 1239
1071 being_printed[print_depth] = obj;
1072 print_depth++; 1240 print_depth++;
1073 1241
1074 if (print_depth > PRINT_CIRCLE) 1242 if (print_depth > PRINT_CIRCLE)
@@ -1250,35 +1418,8 @@ print (obj, printcharfun, escapeflag)
1250 else 1418 else
1251 confusing = 0; 1419 confusing = 0;
1252 1420
1253 /* If we print an uninterned symbol as part of a complex object and
1254 the flag print-gensym is non-nil, prefix it with #n= to read the
1255 object back with the #n# reader syntax later if needed. */
1256 if (! NILP (Vprint_gensym) && NILP (XSYMBOL (obj)->obarray)) 1421 if (! NILP (Vprint_gensym) && NILP (XSYMBOL (obj)->obarray))
1257 { 1422 {
1258 if (print_depth > 1)
1259 {
1260 Lisp_Object tem;
1261 tem = Fassq (obj, Vprint_gensym_alist);
1262 if (CONSP (tem))
1263 {
1264 PRINTCHAR ('#');
1265 print (XCDR (tem), printcharfun, escapeflag);
1266 PRINTCHAR ('#');
1267 break;
1268 }
1269 else
1270 {
1271 if (CONSP (Vprint_gensym_alist))
1272 XSETFASTINT (tem, XFASTINT (XCDR (XCAR (Vprint_gensym_alist))) + 1);
1273 else
1274 XSETFASTINT (tem, 1);
1275 Vprint_gensym_alist = Fcons (Fcons (obj, tem), Vprint_gensym_alist);
1276
1277 PRINTCHAR ('#');
1278 print (tem, printcharfun, escapeflag);
1279 PRINTCHAR ('=');
1280 }
1281 }
1282 PRINTCHAR ('#'); 1423 PRINTCHAR ('#');
1283 PRINTCHAR (':'); 1424 PRINTCHAR (':');
1284 } 1425 }
@@ -1320,14 +1461,14 @@ print (obj, printcharfun, escapeflag)
1320 && (EQ (XCAR (obj), Qquote))) 1461 && (EQ (XCAR (obj), Qquote)))
1321 { 1462 {
1322 PRINTCHAR ('\''); 1463 PRINTCHAR ('\'');
1323 print (XCAR (XCDR (obj)), printcharfun, escapeflag); 1464 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1324 } 1465 }
1325 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj))) 1466 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1326 && (EQ (XCAR (obj), Qfunction))) 1467 && (EQ (XCAR (obj), Qfunction)))
1327 { 1468 {
1328 PRINTCHAR ('#'); 1469 PRINTCHAR ('#');
1329 PRINTCHAR ('\''); 1470 PRINTCHAR ('\'');
1330 print (XCAR (XCDR (obj)), printcharfun, escapeflag); 1471 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1331 } 1472 }
1332 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj))) 1473 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1333 && ((EQ (XCAR (obj), Qbackquote) 1474 && ((EQ (XCAR (obj), Qbackquote)
@@ -1335,8 +1476,8 @@ print (obj, printcharfun, escapeflag)
1335 || EQ (XCAR (obj), Qcomma_at) 1476 || EQ (XCAR (obj), Qcomma_at)
1336 || EQ (XCAR (obj), Qcomma_dot)))) 1477 || EQ (XCAR (obj), Qcomma_dot))))
1337 { 1478 {
1338 print (XCAR (obj), printcharfun, 0); 1479 print_object (XCAR (obj), printcharfun, 0);
1339 print (XCAR (XCDR (obj)), printcharfun, escapeflag); 1480 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1340 } 1481 }
1341 else 1482 else
1342 { 1483 {
@@ -1351,21 +1492,47 @@ print (obj, printcharfun, escapeflag)
1351 while (CONSP (obj)) 1492 while (CONSP (obj))
1352 { 1493 {
1353 /* Detect circular list. */ 1494 /* Detect circular list. */
1354 if (i != 0 && EQ (obj, halftail)) 1495 if (NILP (Vprint_circle))
1355 { 1496 {
1356 sprintf (buf, " . #%d", i / 2); 1497 /* Simple but imcomplete way. */
1357 strout (buf, -1, -1, printcharfun, 0); 1498 if (i != 0 && EQ (obj, halftail))
1358 obj = Qnil; 1499 {
1359 break; 1500 sprintf (buf, " . #%d", i / 2);
1501 strout (buf, -1, -1, printcharfun, 0);
1502 goto end_of_list;
1503 }
1504 }
1505 else
1506 {
1507 /* With the print-circle feature. */
1508 if (i != 0)
1509 {
1510 int i;
1511 for (i = 0; i < print_number_index; i++)
1512 if (PRINT_NUMBER_OBJECT (Vprint_number_table, i) == obj)
1513 {
1514 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1515 {
1516 strout (" . ", 3, 3, printcharfun, 0);
1517 print_object (obj, printcharfun, escapeflag);
1518 }
1519 else
1520 {
1521 sprintf (buf, " . #%d#", i + 1);
1522 strout (buf, -1, -1, printcharfun, 0);
1523 }
1524 goto end_of_list;
1525 }
1526 }
1360 } 1527 }
1361 if (i++) 1528 if (i++)
1362 PRINTCHAR (' '); 1529 PRINTCHAR (' ');
1363 if (print_length && i > print_length) 1530 if (print_length && i > print_length)
1364 { 1531 {
1365 strout ("...", 3, 3, printcharfun, 0); 1532 strout ("...", 3, 3, printcharfun, 0);
1366 break; 1533 goto end_of_list;
1367 } 1534 }
1368 print (XCAR (obj), printcharfun, escapeflag); 1535 print_object (XCAR (obj), printcharfun, escapeflag);
1369 obj = XCDR (obj); 1536 obj = XCDR (obj);
1370 if (!(i & 1)) 1537 if (!(i & 1))
1371 halftail = XCDR (halftail); 1538 halftail = XCDR (halftail);
@@ -1374,8 +1541,9 @@ print (obj, printcharfun, escapeflag)
1374 if (!NILP (obj)) 1541 if (!NILP (obj))
1375 { 1542 {
1376 strout (" . ", 3, 3, printcharfun, 0); 1543 strout (" . ", 3, 3, printcharfun, 0);
1377 print (obj, printcharfun, escapeflag); 1544 print_object (obj, printcharfun, escapeflag);
1378 } 1545 }
1546 end_of_list:
1379 PRINTCHAR (')'); 1547 PRINTCHAR (')');
1380 } 1548 }
1381 break; 1549 break;
@@ -1539,7 +1707,7 @@ print (obj, printcharfun, escapeflag)
1539 { 1707 {
1540 if (i) PRINTCHAR (' '); 1708 if (i) PRINTCHAR (' ');
1541 tem = XVECTOR (obj)->contents[i]; 1709 tem = XVECTOR (obj)->contents[i];
1542 print (tem, printcharfun, escapeflag); 1710 print_object (tem, printcharfun, escapeflag);
1543 } 1711 }
1544 } 1712 }
1545 PRINTCHAR (']'); 1713 PRINTCHAR (']');
@@ -1601,22 +1769,22 @@ print (obj, printcharfun, escapeflag)
1601 1769
1602 case Lisp_Misc_Objfwd: 1770 case Lisp_Misc_Objfwd:
1603 strout ("#<objfwd to ", -1, -1, printcharfun, 0); 1771 strout ("#<objfwd to ", -1, -1, printcharfun, 0);
1604 print (*XOBJFWD (obj)->objvar, printcharfun, escapeflag); 1772 print_object (*XOBJFWD (obj)->objvar, printcharfun, escapeflag);
1605 PRINTCHAR ('>'); 1773 PRINTCHAR ('>');
1606 break; 1774 break;
1607 1775
1608 case Lisp_Misc_Buffer_Objfwd: 1776 case Lisp_Misc_Buffer_Objfwd:
1609 strout ("#<buffer_objfwd to ", -1, -1, printcharfun, 0); 1777 strout ("#<buffer_objfwd to ", -1, -1, printcharfun, 0);
1610 print (*(Lisp_Object *)((char *)current_buffer 1778 print_object (*(Lisp_Object *)((char *)current_buffer
1611 + XBUFFER_OBJFWD (obj)->offset), 1779 + XBUFFER_OBJFWD (obj)->offset),
1612 printcharfun, escapeflag); 1780 printcharfun, escapeflag);
1613 PRINTCHAR ('>'); 1781 PRINTCHAR ('>');
1614 break; 1782 break;
1615 1783
1616 case Lisp_Misc_Kboard_Objfwd: 1784 case Lisp_Misc_Kboard_Objfwd:
1617 strout ("#<kboard_objfwd to ", -1, -1, printcharfun, 0); 1785 strout ("#<kboard_objfwd to ", -1, -1, printcharfun, 0);
1618 print (*(Lisp_Object *)((char *) current_kboard 1786 print_object (*(Lisp_Object *)((char *) current_kboard
1619 + XKBOARD_OBJFWD (obj)->offset), 1787 + XKBOARD_OBJFWD (obj)->offset),
1620 printcharfun, escapeflag); 1788 printcharfun, escapeflag);
1621 PRINTCHAR ('>'); 1789 PRINTCHAR ('>');
1622 break; 1790 break;
@@ -1628,28 +1796,29 @@ print (obj, printcharfun, escapeflag)
1628 strout ("#<some_buffer_local_value ", -1, -1, printcharfun, 0); 1796 strout ("#<some_buffer_local_value ", -1, -1, printcharfun, 0);
1629 do_buffer_local: 1797 do_buffer_local:
1630 strout ("[realvalue] ", -1, -1, printcharfun, 0); 1798 strout ("[realvalue] ", -1, -1, printcharfun, 0);
1631 print (XBUFFER_LOCAL_VALUE (obj)->realvalue, printcharfun, escapeflag); 1799 print_object (XBUFFER_LOCAL_VALUE (obj)->realvalue,
1800 printcharfun, escapeflag);
1632 if (XBUFFER_LOCAL_VALUE (obj)->found_for_buffer) 1801 if (XBUFFER_LOCAL_VALUE (obj)->found_for_buffer)
1633 strout ("[local in buffer] ", -1, -1, printcharfun, 0); 1802 strout ("[local in buffer] ", -1, -1, printcharfun, 0);
1634 else 1803 else
1635 strout ("[buffer] ", -1, -1, printcharfun, 0); 1804 strout ("[buffer] ", -1, -1, printcharfun, 0);
1636 print (XBUFFER_LOCAL_VALUE (obj)->buffer, 1805 print_object (XBUFFER_LOCAL_VALUE (obj)->buffer,
1637 printcharfun, escapeflag); 1806 printcharfun, escapeflag);
1638 if (XBUFFER_LOCAL_VALUE (obj)->check_frame) 1807 if (XBUFFER_LOCAL_VALUE (obj)->check_frame)
1639 { 1808 {
1640 if (XBUFFER_LOCAL_VALUE (obj)->found_for_frame) 1809 if (XBUFFER_LOCAL_VALUE (obj)->found_for_frame)
1641 strout ("[local in frame] ", -1, -1, printcharfun, 0); 1810 strout ("[local in frame] ", -1, -1, printcharfun, 0);
1642 else 1811 else
1643 strout ("[frame] ", -1, -1, printcharfun, 0); 1812 strout ("[frame] ", -1, -1, printcharfun, 0);
1644 print (XBUFFER_LOCAL_VALUE (obj)->frame, 1813 print_object (XBUFFER_LOCAL_VALUE (obj)->frame,
1645 printcharfun, escapeflag); 1814 printcharfun, escapeflag);
1646 } 1815 }
1647 strout ("[alist-elt] ", -1, -1, printcharfun, 0); 1816 strout ("[alist-elt] ", -1, -1, printcharfun, 0);
1648 print (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->car, 1817 print_object (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->car,
1649 printcharfun, escapeflag); 1818 printcharfun, escapeflag);
1650 strout ("[default-value] ", -1, -1, printcharfun, 0); 1819 strout ("[default-value] ", -1, -1, printcharfun, 0);
1651 print (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->cdr, 1820 print_object (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->cdr,
1652 printcharfun, escapeflag); 1821 printcharfun, escapeflag);
1653 PRINTCHAR ('>'); 1822 PRINTCHAR ('>');
1654 break; 1823 break;
1655 1824
@@ -1690,12 +1859,12 @@ print_interval (interval, printcharfun)
1690 Lisp_Object printcharfun; 1859 Lisp_Object printcharfun;
1691{ 1860{
1692 PRINTCHAR (' '); 1861 PRINTCHAR (' ');
1693 print (make_number (interval->position), printcharfun, 1); 1862 print_object (make_number (interval->position), printcharfun, 1);
1694 PRINTCHAR (' '); 1863 PRINTCHAR (' ');
1695 print (make_number (interval->position + LENGTH (interval)), 1864 print_object (make_number (interval->position + LENGTH (interval)),
1696 printcharfun, 1); 1865 printcharfun, 1);
1697 PRINTCHAR (' '); 1866 PRINTCHAR (' ');
1698 print (interval->plist, printcharfun, 1); 1867 print_object (interval->plist, printcharfun, 1);
1699} 1868}
1700 1869
1701#endif /* USE_TEXT_PROPERTIES */ 1870#endif /* USE_TEXT_PROPERTIES */
@@ -1773,22 +1942,35 @@ forms print in the new syntax.");
1773 DEFVAR_LISP ("print-gensym", &Vprint_gensym, 1942 DEFVAR_LISP ("print-gensym", &Vprint_gensym,
1774 "Non-nil means print uninterned symbols so they will read as uninterned.\n\ 1943 "Non-nil means print uninterned symbols so they will read as uninterned.\n\
1775I.e., the value of (make-symbol \"foobar\") prints as #:foobar.\n\ 1944I.e., the value of (make-symbol \"foobar\") prints as #:foobar.\n\
1776When the uninterned symbol appears within a larger data structure,\n\ 1945When the uninterned symbol appears within a recursive data structure\n\
1777in addition use the #...# and #...= constructs as needed,\n\ 1946and the symbol appears more than once, in addition use the #N# and #N=\n\
1778so that multiple references to the same symbol are shared once again\n\ 1947constructs as needed, so that multiple references to the same symbol are\n\
1779when the text is read back.\n\ 1948shared once again when the text is read back.");
1780\n\
1781If the value of `print-gensym' is a cons cell, then in addition refrain from\n\
1782clearing `print-gensym-alist' on entry to and exit from printing functions,\n\
1783so that the use of #...# and #...= can carry over for several separately\n\
1784printed objects.");
1785 Vprint_gensym = Qnil; 1949 Vprint_gensym = Qnil;
1786 1950
1787 DEFVAR_LISP ("print-gensym-alist", &Vprint_gensym_alist, 1951 DEFVAR_LISP ("print-circle", &Vprint_circle,
1788 "Association list of elements (GENSYM . N) to guide use of #N# and #N=.\n\ 1952 "*Non-nil means print recursive structures using #N= and #N# syntax.\n\
1789In each element, GENSYM is an uninterned symbol that has been associated\n\ 1953If nil, printing proceeds recursively and may lead to\n\
1790with #N= for the specified value of N."); 1954`max-lisp-eval-depth' being exceeded or an error may occur:\n\
1791 Vprint_gensym_alist = Qnil; 1955\"Apparently circular structure being printed.\" Also see\n\
1956`print-length' and `print-level'.\n\
1957If non-nil, shared substructures anywhere in the structure are printed\n\
1958with `#N=' before the first occurrence (in the order of the print\n\
1959representation) and `#N#' in place of each subsequent occurrence,\n\
1960where N is a positive decimal integer.");
1961 Vprint_circle = Qnil;
1962
1963 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering,
1964 "*Non-nil means keep numbering between several print functions.\n\
1965See `print-gensym' nad `print-circle'. See also `print-number-table'.");
1966 Vprint_continuous_numbering = Qnil;
1967
1968 DEFVAR_LISP ("print-number-table", &Vprint_number_table,
1969 "A vector keeping the information of the current printed object.\n\
1970This variable shouldn't be modified in Lisp level, but should be binded\n\
1971with nil using let at the same position with `print-continuous-numbering',\n\
1972so that the value of this variable can be freed after printing.");
1973 Vprint_number_table = Qnil;
1792 1974
1793 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */ 1975 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
1794 staticpro (&Vprin1_to_string_buffer); 1976 staticpro (&Vprin1_to_string_buffer);