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