Mercurial > hg > xemacs-beta
comparison src/print.c @ 440:8de8e3f6228a r21-2-28
Import from CVS: tag r21-2-28
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:33:38 +0200 |
parents | 84b14dcb0985 |
children | abe6d1db359e |
comparison
equal
deleted
inserted
replaced
439:357dd071b03c | 440:8de8e3f6228a |
---|---|
107 | 107 |
108 void | 108 void |
109 write_string_to_stdio_stream (FILE *stream, struct console *con, | 109 write_string_to_stdio_stream (FILE *stream, struct console *con, |
110 CONST Bufbyte *str, | 110 CONST Bufbyte *str, |
111 Bytecount offset, Bytecount len, | 111 Bytecount offset, Bytecount len, |
112 enum external_data_format fmt) | 112 Lisp_Object coding_system) |
113 { | 113 { |
114 int extlen; | 114 Extcount extlen; |
115 CONST Extbyte *extptr; | 115 CONST Extbyte *extptr; |
116 | 116 |
117 GET_CHARPTR_EXT_DATA_ALLOCA (str + offset, len, fmt, extptr, extlen); | 117 TO_EXTERNAL_FORMAT (DATA, (str + offset, len), |
118 ALLOCA, (extptr, extlen), | |
119 coding_system); | |
118 if (stream) | 120 if (stream) |
119 { | 121 { |
120 fwrite (extptr, 1, extlen, stream); | 122 fwrite (extptr, 1, extlen, stream); |
121 #ifdef WINDOWSNT | 123 #ifdef WINDOWSNT |
122 /* Q122442 says that pipes are "treated as files, not as | 124 /* Q122442 says that pipes are "treated as files, not as |
234 echo_area_append (f, nonreloc, reloc, offset, len, Vprint_message_label); | 236 echo_area_append (f, nonreloc, reloc, offset, len, Vprint_message_label); |
235 } | 237 } |
236 else if (EQ (function, Qt) || EQ (function, Qnil)) | 238 else if (EQ (function, Qt) || EQ (function, Qnil)) |
237 { | 239 { |
238 write_string_to_stdio_stream (stdout, 0, newnonreloc, offset, len, | 240 write_string_to_stdio_stream (stdout, 0, newnonreloc, offset, len, |
239 FORMAT_TERMINAL); | 241 Qterminal); |
240 } | 242 } |
241 else | 243 else |
242 { | 244 { |
243 Charcount ccoff = bytecount_to_charcount (newnonreloc, offset); | 245 Charcount ccoff = bytecount_to_charcount (newnonreloc, offset); |
244 Charcount iii; | 246 Charcount iii; |
715 | 717 |
716 Lisp_Object Vfloat_output_format; | 718 Lisp_Object Vfloat_output_format; |
717 | 719 |
718 /* | 720 /* |
719 * This buffer should be at least as large as the max string size of the | 721 * This buffer should be at least as large as the max string size of the |
720 * largest float, printed in the biggest notation. This is undoubtably | 722 * largest float, printed in the biggest notation. This is undoubtedly |
721 * 20d float_output_format, with the negative of the C-constant "HUGE" | 723 * 20d float_output_format, with the negative of the C-constant "HUGE" |
722 * from <math.h>. | 724 * from <math.h>. |
723 * | 725 * |
724 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes. | 726 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes. |
725 * | 727 * |
962 } | 964 } |
963 | 965 |
964 void | 966 void |
965 print_string (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) | 967 print_string (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) |
966 { | 968 { |
967 struct Lisp_String *s = XSTRING (obj); | 969 Lisp_String *s = XSTRING (obj); |
968 /* We distinguish between Bytecounts and Charcounts, to make | 970 /* We distinguish between Bytecounts and Charcounts, to make |
969 Vprint_string_length work correctly under Mule. */ | 971 Vprint_string_length work correctly under Mule. */ |
970 Charcount size = string_char_length (s); | 972 Charcount size = string_char_length (s); |
971 Charcount max = size; | 973 Charcount max = size; |
972 Bytecount bcmax = string_length (s); | 974 Bytecount bcmax = string_length (s); |
1178 } | 1180 } |
1179 else | 1181 else |
1180 { | 1182 { |
1181 p += set_charptr_emchar ((Bufbyte *) p, ch); | 1183 p += set_charptr_emchar ((Bufbyte *) p, ch); |
1182 } | 1184 } |
1183 | 1185 |
1184 output_string (printcharfun, (Bufbyte *) buf, Qnil, 0, p - buf); | 1186 output_string (printcharfun, (Bufbyte *) buf, Qnil, 0, p - buf); |
1185 | 1187 |
1186 break; | 1188 break; |
1187 } | 1189 } |
1188 | 1190 |
1255 print_symbol (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) | 1257 print_symbol (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) |
1256 { | 1258 { |
1257 /* This function can GC */ | 1259 /* This function can GC */ |
1258 /* #### Bug!! (intern "") isn't printed in some distinguished way */ | 1260 /* #### Bug!! (intern "") isn't printed in some distinguished way */ |
1259 /* #### (the reader also loses on it) */ | 1261 /* #### (the reader also loses on it) */ |
1260 struct Lisp_String *name = symbol_name (XSYMBOL (obj)); | 1262 Lisp_String *name = symbol_name (XSYMBOL (obj)); |
1261 Bytecount size = string_length (name); | 1263 Bytecount size = string_length (name); |
1262 struct gcpro gcpro1, gcpro2; | 1264 struct gcpro gcpro1, gcpro2; |
1263 | 1265 |
1264 if (!escapeflag) | 1266 if (!escapeflag) |
1265 { | 1267 { |
1407 int extlen; | 1409 int extlen; |
1408 CONST Extbyte *extptr; | 1410 CONST Extbyte *extptr; |
1409 | 1411 |
1410 CHECK_CHAR_COERCE_INT (character); | 1412 CHECK_CHAR_COERCE_INT (character); |
1411 len = set_charptr_emchar (str, XCHAR (character)); | 1413 len = set_charptr_emchar (str, XCHAR (character)); |
1412 GET_CHARPTR_EXT_DATA_ALLOCA (str, len, FORMAT_TERMINAL, extptr, extlen); | 1414 TO_EXTERNAL_FORMAT (DATA, (str, len), |
1415 ALLOCA, (extptr, extlen), | |
1416 Qterminal); | |
1413 memcpy (alternate_do_string + alternate_do_pointer, extptr, extlen); | 1417 memcpy (alternate_do_string + alternate_do_pointer, extptr, extlen); |
1414 alternate_do_pointer += extlen; | 1418 alternate_do_pointer += extlen; |
1415 alternate_do_string[alternate_do_pointer] = 0; | 1419 alternate_do_string[alternate_do_pointer] = 0; |
1416 return character; | 1420 return character; |
1417 } | 1421 } |
1455 | 1459 |
1456 if (STRINGP (char_or_string)) | 1460 if (STRINGP (char_or_string)) |
1457 write_string_to_stdio_stream (file, con, | 1461 write_string_to_stdio_stream (file, con, |
1458 XSTRING_DATA (char_or_string), | 1462 XSTRING_DATA (char_or_string), |
1459 0, XSTRING_LENGTH (char_or_string), | 1463 0, XSTRING_LENGTH (char_or_string), |
1460 FORMAT_TERMINAL); | 1464 Qterminal); |
1461 else | 1465 else |
1462 { | 1466 { |
1463 Bufbyte str[MAX_EMCHAR_LEN]; | 1467 Bufbyte str[MAX_EMCHAR_LEN]; |
1464 Bytecount len; | 1468 Bytecount len; |
1465 | 1469 |
1466 CHECK_CHAR_COERCE_INT (char_or_string); | 1470 CHECK_CHAR_COERCE_INT (char_or_string); |
1467 len = set_charptr_emchar (str, XCHAR (char_or_string)); | 1471 len = set_charptr_emchar (str, XCHAR (char_or_string)); |
1468 write_string_to_stdio_stream (file, con, str, 0, len, FORMAT_TERMINAL); | 1472 write_string_to_stdio_stream (file, con, str, 0, len, Qterminal); |
1469 } | 1473 } |
1470 | 1474 |
1471 return char_or_string; | 1475 return char_or_string; |
1472 } | 1476 } |
1473 | 1477 |
1492 return Qnil; | 1496 return Qnil; |
1493 } | 1497 } |
1494 | 1498 |
1495 #if 1 | 1499 #if 1 |
1496 /* Debugging kludge -- unbuffered */ | 1500 /* Debugging kludge -- unbuffered */ |
1497 static int debug_print_length = 50; | 1501 static int debug_print_length = 50; |
1498 static int debug_print_level = 15; | 1502 static int debug_print_level = 15; |
1503 static int debug_print_readably = -1; | |
1499 | 1504 |
1500 static void | 1505 static void |
1501 debug_print_no_newline (Lisp_Object debug_print_obj) | 1506 debug_print_no_newline (Lisp_Object debug_print_obj) |
1502 { | 1507 { |
1503 /* This function can GC */ | 1508 /* This function can GC */ |
1504 int old_print_readably = print_readably; | 1509 int save_print_readably = print_readably; |
1505 int old_print_depth = print_depth; | 1510 int save_print_depth = print_depth; |
1506 Lisp_Object old_print_length = Vprint_length; | 1511 Lisp_Object save_Vprint_length = Vprint_length; |
1507 Lisp_Object old_print_level = Vprint_level; | 1512 Lisp_Object save_Vprint_level = Vprint_level; |
1508 Lisp_Object old_inhibit_quit = Vinhibit_quit; | 1513 Lisp_Object save_Vinhibit_quit = Vinhibit_quit; |
1509 struct gcpro gcpro1, gcpro2, gcpro3; | 1514 struct gcpro gcpro1, gcpro2, gcpro3; |
1510 GCPRO3 (old_print_level, old_print_length, old_inhibit_quit); | 1515 GCPRO3 (save_Vprint_level, save_Vprint_length, save_Vinhibit_quit); |
1511 | 1516 |
1512 if (gc_in_progress) | 1517 if (gc_in_progress) |
1513 stderr_out ("** gc-in-progress! Bad idea to print anything! **\n"); | 1518 stderr_out ("** gc-in-progress! Bad idea to print anything! **\n"); |
1514 | 1519 |
1515 print_depth = 0; | 1520 print_depth = 0; |
1516 print_readably = 0; | 1521 print_readably = debug_print_readably != -1 ? debug_print_readably : 0; |
1517 print_unbuffered++; | 1522 print_unbuffered++; |
1518 /* Could use unwind-protect, but why bother? */ | 1523 /* Could use unwind-protect, but why bother? */ |
1519 if (debug_print_length > 0) | 1524 if (debug_print_length > 0) |
1520 Vprint_length = make_int (debug_print_length); | 1525 Vprint_length = make_int (debug_print_length); |
1521 if (debug_print_level > 0) | 1526 if (debug_print_level > 0) |
1522 Vprint_level = make_int (debug_print_level); | 1527 Vprint_level = make_int (debug_print_level); |
1528 | |
1523 print_internal (debug_print_obj, Qexternal_debugging_output, 1); | 1529 print_internal (debug_print_obj, Qexternal_debugging_output, 1); |
1524 Vinhibit_quit = old_inhibit_quit; | 1530 |
1525 Vprint_level = old_print_level; | 1531 Vinhibit_quit = save_Vinhibit_quit; |
1526 Vprint_length = old_print_length; | 1532 Vprint_level = save_Vprint_level; |
1527 print_depth = old_print_depth; | 1533 Vprint_length = save_Vprint_length; |
1528 print_readably = old_print_readably; | 1534 print_depth = save_print_depth; |
1535 print_readably = save_print_readably; | |
1529 print_unbuffered--; | 1536 print_unbuffered--; |
1530 UNGCPRO; | 1537 UNGCPRO; |
1531 } | 1538 } |
1532 | 1539 |
1533 void | 1540 void |