Mercurial > hg > xemacs-beta

comparison src/print.c @ 424:11054d720c21 r21-2-20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-20
author cvs
date Mon, 13 Aug 2007 11:26:11 +0200
parents da8ed4261e83
children
comparison
equal deleted inserted replaced
423:28d9c139be4c 424:11054d720c21
49 Lisp_Object Vstandard_output, Qstandard_output; 49 Lisp_Object Vstandard_output, Qstandard_output;
50 50
51 /* The subroutine object for external-debugging-output is kept here 51 /* The subroutine object for external-debugging-output is kept here
52 for the convenience of the debugger. */ 52 for the convenience of the debugger. */
53 Lisp_Object Qexternal_debugging_output; 53 Lisp_Object Qexternal_debugging_output;
54 Lisp_Object Qalternate_debugging_output;
55 54
56 /* Avoid actual stack overflow in print. */ 55 /* Avoid actual stack overflow in print. */
57 static int print_depth; 56 static int print_depth;
58 57
59 /* Detect most circularities to print finite output. */ 58 /* Detect most circularities to print finite output. */
60 #define PRINT_CIRCLE 200 59 #define PRINT_CIRCLE 200
61 Lisp_Object being_printed[PRINT_CIRCLE]; 60 static Lisp_Object being_printed[PRINT_CIRCLE];
62 61
63 /* Maximum length of list or vector to print in full; noninteger means 62 /* Maximum length of list or vector to print in full; noninteger means
64 effectively infinity */ 63 effectively infinity */
65 64
66 Lisp_Object Vprint_length; 65 Lisp_Object Vprint_length;
89 /* Non-nil means print #: before uninterned symbols. 88 /* Non-nil means print #: before uninterned symbols.
90 Neither t nor nil means so that and don't clear Vprint_gensym_alist 89 Neither t nor nil means so that and don't clear Vprint_gensym_alist
91 on entry to and exit from print functions. */ 90 on entry to and exit from print functions. */
92 Lisp_Object Vprint_gensym; 91 Lisp_Object Vprint_gensym;
93 Lisp_Object Vprint_gensym_alist; 92 Lisp_Object Vprint_gensym_alist;
94
95 Lisp_Object Qprint_escape_newlines;
96 Lisp_Object Qprint_readably;
97 93
98 Lisp_Object Qdisplay_error; 94 Lisp_Object Qdisplay_error;
99 Lisp_Object Qprint_message_label; 95 Lisp_Object Qprint_message_label;
100 96
101 /* Force immediate output of all printed data. Used for debugging. */ 97 /* Force immediate output of all printed data. Used for debugging. */
709 705
710 706
711 #ifdef LISP_FLOAT_TYPE 707 #ifdef LISP_FLOAT_TYPE
712 708
713 Lisp_Object Vfloat_output_format; 709 Lisp_Object Vfloat_output_format;
714 Lisp_Object Qfloat_output_format;
715 710
716 /* 711 /*
717 * This buffer should be at least as large as the max string size of the 712 * This buffer should be at least as large as the max string size of the
718 * largest float, printed in the biggest notation. This is undoubtably 713 * largest float, printed in the biggest notation. This is undoubtably
719 * 20d float_output_format, with the negative of the C-constant "HUGE" 714 * 20d float_output_format, with the negative of the C-constant "HUGE"
1360 alternate-debugging-output @ 429542' -slb */ 1355 alternate-debugging-output @ 429542' -slb */
1361 /* #### Eek! Any clue how to get rid of it? In fact, how about 1356 /* #### Eek! Any clue how to get rid of it? In fact, how about
1362 getting rid of this function altogether? Does anything actually 1357 getting rid of this function altogether? Does anything actually
1363 *use* it? --hniksic */ 1358 *use* it? --hniksic */
1364 1359
1365 int alternate_do_pointer; 1360 static int alternate_do_pointer;
1366 char alternate_do_string[5000]; 1361 static char alternate_do_string[5000];
1367 1362
1368 DEFUN ("alternate-debugging-output", Falternate_debugging_output, 1, 1, 0, /* 1363 DEFUN ("alternate-debugging-output", Falternate_debugging_output, 1, 1, 0, /*
1369 Append CHARACTER to the array `alternate_do_string'. 1364 Append CHARACTER to the array `alternate_do_string'.
1370 This can be used in place of `external-debugging-output' as a function 1365 This can be used in place of `external-debugging-output' as a function
1371 to be passed to `print'. Before calling `print', set `alternate_do_pointer' 1366 to be passed to `print'. Before calling `print', set `alternate_do_pointer'
1465 1460
1466 #if 1 1461 #if 1
1467 /* Debugging kludge -- unbuffered */ 1462 /* Debugging kludge -- unbuffered */
1468 static int debug_print_length = 50; 1463 static int debug_print_length = 50;
1469 static int debug_print_level = 15; 1464 static int debug_print_level = 15;
1470 Lisp_Object debug_temp;
1471 1465
1472 static void 1466 static void
1473 debug_print_no_newline (Lisp_Object debug_print_obj) 1467 debug_print_no_newline (Lisp_Object debug_print_obj)
1474 { 1468 {
1475 /* This function can GC */ 1469 /* This function can GC */
1602 1596
1603 1597
1604 void 1598 void
1605 syms_of_print (void) 1599 syms_of_print (void)
1606 { 1600 {
1607 defsymbol (&Qprint_escape_newlines, "print-escape-newlines");
1608 defsymbol (&Qprint_readably, "print-readably");
1609
1610 defsymbol (&Qstandard_output, "standard-output"); 1601 defsymbol (&Qstandard_output, "standard-output");
1611
1612 #ifdef LISP_FLOAT_TYPE
1613 defsymbol (&Qfloat_output_format, "float-output-format");
1614 #endif
1615 1602
1616 defsymbol (&Qprint_length, "print-length"); 1603 defsymbol (&Qprint_length, "print-length");
1617 1604
1618 defsymbol (&Qprint_string_length, "print-string-length"); 1605 defsymbol (&Qprint_string_length, "print-string-length");
1619 1606
1627 DEFSUBR (Ferror_message_string); 1614 DEFSUBR (Ferror_message_string);
1628 DEFSUBR (Fdisplay_error); 1615 DEFSUBR (Fdisplay_error);
1629 DEFSUBR (Fterpri); 1616 DEFSUBR (Fterpri);
1630 DEFSUBR (Fwrite_char); 1617 DEFSUBR (Fwrite_char);
1631 DEFSUBR (Falternate_debugging_output); 1618 DEFSUBR (Falternate_debugging_output);
1632 defsymbol (&Qalternate_debugging_output, "alternate-debugging-output");
1633 DEFSUBR (Fexternal_debugging_output); 1619 DEFSUBR (Fexternal_debugging_output);
1634 DEFSUBR (Fopen_termscript); 1620 DEFSUBR (Fopen_termscript);
1635 defsymbol (&Qexternal_debugging_output, "external-debugging-output"); 1621 defsymbol (&Qexternal_debugging_output, "external-debugging-output");
1636 DEFSUBR (Fwith_output_to_temp_buffer); 1622 DEFSUBR (Fwith_output_to_temp_buffer);
1637 } 1623 }
1638 1624
1639 void 1625 void
1626 reinit_vars_of_print (void)
1627 {
1628 alternate_do_pointer = 0;
1629 }
1630
1631 void
1640 vars_of_print (void) 1632 vars_of_print (void)
1641 { 1633 {
1642 alternate_do_pointer = 0; 1634 reinit_vars_of_print ();
1643 1635
1644 DEFVAR_LISP ("standard-output", &Vstandard_output /* 1636 DEFVAR_LISP ("standard-output", &Vstandard_output /*
1645 Output stream `print' uses by default for outputting a character. 1637 Output stream `print' uses by default for outputting a character.
1646 This may be any function of one argument. 1638 This may be any function of one argument.
1647 It may also be a buffer (output is inserted before point) 1639 It may also be a buffer (output is inserted before point)