1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 86, 88, 93, 94, 95 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
31 #include "dispextern.h"
34 #endif /* not standalone */
36 #ifdef USE_TEXT_PROPERTIES
37 #include "intervals.h"
40 Lisp_Object Vstandard_output
, Qstandard_output
;
42 #ifdef LISP_FLOAT_TYPE
43 Lisp_Object Vfloat_output_format
, Qfloat_output_format
;
44 #endif /* LISP_FLOAT_TYPE */
46 /* Avoid actual stack overflow in print. */
49 /* Detect most circularities to print finite output. */
50 #define PRINT_CIRCLE 200
51 Lisp_Object being_printed
[PRINT_CIRCLE
];
53 /* Maximum length of list to print in full; noninteger means
54 effectively infinity */
56 Lisp_Object Vprint_length
;
58 /* Maximum depth of list to print in full; noninteger means
59 effectively infinity. */
61 Lisp_Object Vprint_level
;
63 /* Nonzero means print newlines in strings as \n. */
65 int print_escape_newlines
;
67 Lisp_Object Qprint_escape_newlines
;
69 /* Nonzero means print newline to stdout before next minibuffer message.
72 extern int noninteractive_need_newline
;
74 #ifdef MAX_PRINT_CHARS
75 static int print_chars
;
77 #endif /* MAX_PRINT_CHARS */
79 void print_interval ();
82 /* Convert between chars and GLYPHs */
86 register GLYPH
*glyphs
;
96 str_to_glyph_cpy (str
, glyphs
)
100 register GLYPH
*gp
= glyphs
;
101 register char *cp
= str
;
108 str_to_glyph_ncpy (str
, glyphs
, n
)
113 register GLYPH
*gp
= glyphs
;
114 register char *cp
= str
;
121 glyph_to_str_cpy (glyphs
, str
)
125 register GLYPH
*gp
= glyphs
;
126 register char *cp
= str
;
129 *str
++ = *gp
++ & 0377;
133 /* Low level output routines for characters and strings */
135 /* Lisp functions to do output using a stream
136 must have the stream in a variable called printcharfun
137 and must start with PRINTPREPARE and end with PRINTFINISH.
138 Use PRINTCHAR to output one character,
139 or call strout to output a block of characters.
140 Also, each one must have the declarations
141 struct buffer *old = current_buffer;
142 int old_point = -1, start_point;
143 Lisp_Object original;
146 #define PRINTPREPARE \
147 original = printcharfun; \
148 if (NILP (printcharfun)) printcharfun = Qt; \
149 if (BUFFERP (printcharfun)) \
150 { if (XBUFFER (printcharfun) != current_buffer) \
151 Fset_buffer (printcharfun); \
152 printcharfun = Qnil;} \
153 if (MARKERP (printcharfun)) \
154 { if (!(XMARKER (original)->buffer)) \
155 error ("Marker does not point anywhere"); \
156 if (XMARKER (original)->buffer != current_buffer) \
157 set_buffer_internal (XMARKER (original)->buffer); \
159 SET_PT (marker_position (printcharfun)); \
160 start_point = point; \
161 printcharfun = Qnil;}
163 #define PRINTFINISH \
164 if (MARKERP (original)) \
165 Fset_marker (original, make_number (point), Qnil); \
166 if (old_point >= 0) \
167 SET_PT (old_point + (old_point >= start_point \
168 ? point - start_point : 0)); \
169 if (old != current_buffer) \
170 set_buffer_internal (old)
172 #define PRINTCHAR(ch) printchar (ch, printcharfun)
174 /* Index of first unused element of FRAME_MESSAGE_BUF(mini_frame). */
175 static int printbufidx
;
184 #ifdef MAX_PRINT_CHARS
187 #endif /* MAX_PRINT_CHARS */
199 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)));
204 noninteractive_need_newline
= 1;
208 if (echo_area_glyphs
!= FRAME_MESSAGE_BUF (mini_frame
)
209 || !message_buf_print
)
211 message_log_maybe_newline ();
212 echo_area_glyphs
= FRAME_MESSAGE_BUF (mini_frame
);
214 echo_area_glyphs_length
= 0;
215 message_buf_print
= 1;
218 message_dolog (&ch
, 1, 0);
219 if (printbufidx
< FRAME_WIDTH (mini_frame
) - 1)
220 FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
++] = ch
;
221 FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
] = 0;
222 echo_area_glyphs_length
= printbufidx
;
226 #endif /* not standalone */
228 XSETFASTINT (ch1
, ch
);
233 strout (ptr
, size
, printcharfun
)
236 Lisp_Object printcharfun
;
240 if (EQ (printcharfun
, Qnil
))
242 insert (ptr
, size
>= 0 ? size
: strlen (ptr
));
243 #ifdef MAX_PRINT_CHARS
245 print_chars
+= size
>= 0 ? size
: strlen(ptr
);
246 #endif /* MAX_PRINT_CHARS */
249 if (EQ (printcharfun
, Qt
))
252 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)));
254 i
= size
>= 0 ? size
: strlen (ptr
);
255 #ifdef MAX_PRINT_CHARS
258 #endif /* MAX_PRINT_CHARS */
262 fwrite (ptr
, 1, i
, stdout
);
263 noninteractive_need_newline
= 1;
267 if (echo_area_glyphs
!= FRAME_MESSAGE_BUF (mini_frame
)
268 || !message_buf_print
)
270 message_log_maybe_newline ();
271 echo_area_glyphs
= FRAME_MESSAGE_BUF (mini_frame
);
273 echo_area_glyphs_length
= 0;
274 message_buf_print
= 1;
277 message_dolog (ptr
, i
, 0);
278 if (i
> FRAME_WIDTH (mini_frame
) - printbufidx
- 1)
279 i
= FRAME_WIDTH (mini_frame
) - printbufidx
- 1;
280 bcopy (ptr
, &FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
], i
);
282 echo_area_glyphs_length
= printbufidx
;
283 FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
] = 0;
290 PRINTCHAR (ptr
[i
++]);
293 PRINTCHAR (ptr
[i
++]);
296 /* Print the contents of a string STRING using PRINTCHARFUN.
297 It isn't safe to use strout, because printing one char can relocate. */
299 print_string (string
, printcharfun
)
301 Lisp_Object printcharfun
;
303 if (EQ (printcharfun
, Qnil
) || EQ (printcharfun
, Qt
))
304 /* In predictable cases, strout is safe: output to buffer or frame. */
305 strout (XSTRING (string
)->data
, XSTRING (string
)->size
, printcharfun
);
308 /* Otherwise, fetch the string address for each character. */
310 int size
= XSTRING (string
)->size
;
313 for (i
= 0; i
< size
; i
++)
314 PRINTCHAR (XSTRING (string
)->data
[i
]);
319 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
320 "Output character CHAR to stream PRINTCHARFUN.\n\
321 PRINTCHARFUN defaults to the value of `standard-output' (which see).")
323 Lisp_Object ch
, printcharfun
;
325 struct buffer
*old
= current_buffer
;
328 Lisp_Object original
;
330 if (NILP (printcharfun
))
331 printcharfun
= Vstandard_output
;
332 CHECK_NUMBER (ch
, 0);
334 PRINTCHAR (XINT (ch
));
339 /* Used from outside of print.c to print a block of SIZE chars at DATA
340 on the default output stream.
341 Do not use this on the contents of a Lisp string. */
343 write_string (data
, size
)
347 struct buffer
*old
= current_buffer
;
348 Lisp_Object printcharfun
;
351 Lisp_Object original
;
353 printcharfun
= Vstandard_output
;
356 strout (data
, size
, printcharfun
);
360 /* Used from outside of print.c to print a block of SIZE chars at DATA
361 on a specified stream PRINTCHARFUN.
362 Do not use this on the contents of a Lisp string. */
364 write_string_1 (data
, size
, printcharfun
)
367 Lisp_Object printcharfun
;
369 struct buffer
*old
= current_buffer
;
372 Lisp_Object original
;
375 strout (data
, size
, printcharfun
);
383 temp_output_buffer_setup (bufname
)
386 register struct buffer
*old
= current_buffer
;
387 register Lisp_Object buf
;
389 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
391 current_buffer
->directory
= old
->directory
;
392 current_buffer
->read_only
= Qnil
;
395 XSETBUFFER (buf
, current_buffer
);
396 specbind (Qstandard_output
, buf
);
398 set_buffer_internal (old
);
402 internal_with_output_to_temp_buffer (bufname
, function
, args
)
404 Lisp_Object (*function
) ();
407 int count
= specpdl_ptr
- specpdl
;
408 Lisp_Object buf
, val
;
412 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
413 temp_output_buffer_setup (bufname
);
414 buf
= Vstandard_output
;
417 val
= (*function
) (args
);
420 temp_output_buffer_show (buf
);
423 return unbind_to (count
, val
);
426 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
428 "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\
429 The buffer is cleared out initially, and marked as unmodified when done.\n\
430 All output done by BODY is inserted in that buffer by default.\n\
431 The buffer is displayed in another window, but not selected.\n\
432 The value of the last form in BODY is returned.\n\
433 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\n\
434 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
435 to get the buffer displayed. It gets one argument, the buffer to display.")
441 int count
= specpdl_ptr
- specpdl
;
442 Lisp_Object buf
, val
;
445 name
= Feval (Fcar (args
));
448 CHECK_STRING (name
, 0);
449 temp_output_buffer_setup (XSTRING (name
)->data
);
450 buf
= Vstandard_output
;
452 val
= Fprogn (Fcdr (args
));
454 temp_output_buffer_show (buf
);
456 return unbind_to (count
, val
);
458 #endif /* not standalone */
460 static void print ();
462 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
463 "Output a newline to stream PRINTCHARFUN.\n\
464 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.")
466 Lisp_Object printcharfun
;
468 struct buffer
*old
= current_buffer
;
471 Lisp_Object original
;
473 if (NILP (printcharfun
))
474 printcharfun
= Vstandard_output
;
481 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
482 "Output the printed representation of OBJECT, any Lisp object.\n\
483 Quoting characters are printed when needed to make output that `read'\n\
484 can handle, whenever this is possible.\n\
485 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
487 Lisp_Object obj
, printcharfun
;
489 struct buffer
*old
= current_buffer
;
492 Lisp_Object original
;
494 #ifdef MAX_PRINT_CHARS
496 #endif /* MAX_PRINT_CHARS */
497 if (NILP (printcharfun
))
498 printcharfun
= Vstandard_output
;
501 print (obj
, printcharfun
, 1);
506 /* a buffer which is used to hold output being built by prin1-to-string */
507 Lisp_Object Vprin1_to_string_buffer
;
509 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
510 "Return a string containing the printed representation of OBJECT,\n\
511 any Lisp object. Quoting characters are used when needed to make output\n\
512 that `read' can handle, whenever this is possible, unless the optional\n\
513 second argument NOESCAPE is non-nil.")
515 Lisp_Object obj
, noescape
;
517 struct buffer
*old
= current_buffer
;
520 Lisp_Object original
, printcharfun
;
523 printcharfun
= Vprin1_to_string_buffer
;
526 print (obj
, printcharfun
, NILP (noescape
));
527 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
529 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
530 obj
= Fbuffer_string ();
534 set_buffer_internal (old
);
540 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
541 "Output the printed representation of OBJECT, any Lisp object.\n\
542 No quoting characters are used; no delimiters are printed around\n\
543 the contents of strings.\n\
544 Output stream is PRINTCHARFUN, or value of standard-output (which see).")
546 Lisp_Object obj
, printcharfun
;
548 struct buffer
*old
= current_buffer
;
551 Lisp_Object original
;
553 if (NILP (printcharfun
))
554 printcharfun
= Vstandard_output
;
557 print (obj
, printcharfun
, 0);
562 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
563 "Output the printed representation of OBJECT, with newlines around it.\n\
564 Quoting characters are printed when needed to make output that `read'\n\
565 can handle, whenever this is possible.\n\
566 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
568 Lisp_Object obj
, printcharfun
;
570 struct buffer
*old
= current_buffer
;
573 Lisp_Object original
;
576 #ifdef MAX_PRINT_CHARS
578 max_print
= MAX_PRINT_CHARS
;
579 #endif /* MAX_PRINT_CHARS */
580 if (NILP (printcharfun
))
581 printcharfun
= Vstandard_output
;
586 print (obj
, printcharfun
, 1);
589 #ifdef MAX_PRINT_CHARS
592 #endif /* MAX_PRINT_CHARS */
597 /* The subroutine object for external-debugging-output is kept here
598 for the convenience of the debugger. */
599 Lisp_Object Qexternal_debugging_output
;
601 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
602 "Write CHARACTER to stderr.\n\
603 You can call print while debugging emacs, and pass it this function\n\
604 to make it write to the debugging output.\n")
606 Lisp_Object character
;
608 CHECK_NUMBER (character
, 0);
609 putc (XINT (character
), stderr
);
614 /* This is the interface for debugging printing. */
620 Fprin1 (arg
, Qexternal_debugging_output
);
623 #ifdef LISP_FLOAT_TYPE
626 * The buffer should be at least as large as the max string size of the
627 * largest float, printed in the biggest notation. This is undoubtably
628 * 20d float_output_format, with the negative of the C-constant "HUGE"
631 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
633 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
634 * case of -1e307 in 20d float_output_format. What is one to do (short of
635 * re-writing _doprnt to be more sane)?
640 float_to_string (buf
, data
)
647 if (NILP (Vfloat_output_format
)
648 || !STRINGP (Vfloat_output_format
))
651 sprintf (buf
, "%.17g", data
);
656 /* Check that the spec we have is fully valid.
657 This means not only valid for printf,
658 but meant for floats, and reasonable. */
659 cp
= XSTRING (Vfloat_output_format
)->data
;
668 /* Check the width specification. */
670 if ('0' <= *cp
&& *cp
<= '9')
674 width
= (width
* 10) + (*cp
++ - '0');
675 while (*cp
>= '0' && *cp
<= '9');
677 /* A precision of zero is valid only for %f. */
679 || (width
== 0 && *cp
!= 'f'))
683 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
689 sprintf (buf
, XSTRING (Vfloat_output_format
)->data
, data
);
692 /* Make sure there is a decimal point with digit after, or an
693 exponent, so that the value is readable as a float. But don't do
694 this with "%.0f"; it's valid for that not to produce a decimal
695 point. Note that width can be 0 only for %.0f. */
698 for (cp
= buf
; *cp
; cp
++)
699 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
702 if (*cp
== '.' && cp
[1] == 0)
716 #endif /* LISP_FLOAT_TYPE */
719 print (obj
, printcharfun
, escapeflag
)
721 register Lisp_Object printcharfun
;
728 #if 1 /* I'm not sure this is really worth doing. */
729 /* Detect circularities and truncate them.
730 No need to offer any alternative--this is better than an error. */
731 if (CONSP (obj
) || VECTORP (obj
) || COMPILEDP (obj
))
734 for (i
= 0; i
< print_depth
; i
++)
735 if (EQ (obj
, being_printed
[i
]))
737 sprintf (buf
, "#%d", i
);
738 strout (buf
, -1, printcharfun
);
744 being_printed
[print_depth
] = obj
;
747 if (print_depth
> PRINT_CIRCLE
)
748 error ("Apparently circular structure being printed");
749 #ifdef MAX_PRINT_CHARS
750 if (max_print
&& print_chars
> max_print
)
755 #endif /* MAX_PRINT_CHARS */
757 switch (XGCTYPE (obj
))
760 if (sizeof (int) == sizeof (EMACS_INT
))
761 sprintf (buf
, "%d", XINT (obj
));
762 else if (sizeof (long) == sizeof (EMACS_INT
))
763 sprintf (buf
, "%ld", XINT (obj
));
766 strout (buf
, -1, printcharfun
);
769 #ifdef LISP_FLOAT_TYPE
772 char pigbuf
[350]; /* see comments in float_to_string */
774 float_to_string (pigbuf
, XFLOAT(obj
)->data
);
775 strout (pigbuf
, -1, printcharfun
);
782 print_string (obj
, printcharfun
);
786 register unsigned char c
;
791 #ifdef USE_TEXT_PROPERTIES
792 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
800 for (i
= 0; i
< XSTRING (obj
)->size
; i
++)
803 c
= XSTRING (obj
)->data
[i
];
804 if (c
== '\n' && print_escape_newlines
)
809 else if (c
== '\f' && print_escape_newlines
)
816 if (c
== '\"' || c
== '\\')
823 #ifdef USE_TEXT_PROPERTIES
824 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
826 traverse_intervals (XSTRING (obj
)->intervals
,
827 0, 0, print_interval
, printcharfun
);
838 register int confusing
;
839 register unsigned char *p
= XSYMBOL (obj
)->name
->data
;
840 register unsigned char *end
= p
+ XSYMBOL (obj
)->name
->size
;
841 register unsigned char c
;
843 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
848 while (p
!= end
&& *p
>= '0' && *p
<= '9')
850 confusing
= (end
== p
);
853 p
= XSYMBOL (obj
)->name
->data
;
860 if (c
== '\"' || c
== '\\' || c
== '\'' || c
== ';' || c
== '#' ||
861 c
== '(' || c
== ')' || c
== ',' || c
=='.' || c
== '`' ||
862 c
== '[' || c
== ']' || c
== '?' || c
<= 040 || confusing
)
863 PRINTCHAR ('\\'), confusing
= 0;
871 /* If deeper than spec'd depth, print placeholder. */
872 if (INTEGERP (Vprint_level
)
873 && print_depth
> XINT (Vprint_level
))
874 strout ("...", -1, printcharfun
);
880 register int max
= 0;
882 if (INTEGERP (Vprint_length
))
883 max
= XINT (Vprint_length
);
884 /* Could recognize circularities in cdrs here,
885 but that would make printing of long lists quadratic.
886 It's not worth doing. */
893 strout ("...", 3, printcharfun
);
896 print (Fcar (obj
), printcharfun
, escapeflag
);
900 if (!NILP (obj
) && !CONSP (obj
))
902 strout (" . ", 3, printcharfun
);
903 print (obj
, printcharfun
, escapeflag
);
909 case Lisp_Vectorlike
:
914 strout ("#<process ", -1, printcharfun
);
915 print_string (XPROCESS (obj
)->name
, printcharfun
);
919 print_string (XPROCESS (obj
)->name
, printcharfun
);
921 else if (SUBRP (obj
))
923 strout ("#<subr ", -1, printcharfun
);
924 strout (XSUBR (obj
)->symbol_name
, -1, printcharfun
);
928 else if (WINDOWP (obj
))
930 strout ("#<window ", -1, printcharfun
);
931 sprintf (buf
, "%d", XFASTINT (XWINDOW (obj
)->sequence_number
));
932 strout (buf
, -1, printcharfun
);
933 if (!NILP (XWINDOW (obj
)->buffer
))
935 strout (" on ", -1, printcharfun
);
936 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
940 else if (BUFFERP (obj
))
942 if (NILP (XBUFFER (obj
)->name
))
943 strout ("#<killed buffer>", -1, printcharfun
);
946 strout ("#<buffer ", -1, printcharfun
);
947 print_string (XBUFFER (obj
)->name
, printcharfun
);
951 print_string (XBUFFER (obj
)->name
, printcharfun
);
953 else if (WINDOW_CONFIGURATIONP (obj
))
955 strout ("#<window-configuration>", -1, printcharfun
);
958 else if (FRAMEP (obj
))
960 strout ((FRAME_LIVE_P (XFRAME (obj
))
961 ? "#<frame " : "#<dead frame "),
963 print_string (XFRAME (obj
)->name
, printcharfun
);
964 sprintf (buf
, " 0x%lx", (unsigned long) (XFRAME (obj
)));
965 strout (buf
, -1, printcharfun
);
969 #endif /* not standalone */
972 int size
= XVECTOR (obj
)->size
;
976 size
&= PSEUDOVECTOR_SIZE_MASK
;
978 if (size
& PSEUDOVECTOR_FLAG
)
984 register Lisp_Object tem
;
985 for (i
= 0; i
< size
; i
++)
987 if (i
) PRINTCHAR (' ');
988 tem
= XVECTOR (obj
)->contents
[i
];
989 print (tem
, printcharfun
, escapeflag
);
998 switch (XMISCTYPE (obj
))
1000 case Lisp_Misc_Marker
:
1001 strout ("#<marker ", -1, printcharfun
);
1002 if (!(XMARKER (obj
)->buffer
))
1003 strout ("in no buffer", -1, printcharfun
);
1006 sprintf (buf
, "at %d", marker_position (obj
));
1007 strout (buf
, -1, printcharfun
);
1008 strout (" in ", -1, printcharfun
);
1009 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
1014 case Lisp_Misc_Overlay
:
1015 strout ("#<overlay ", -1, printcharfun
);
1016 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
1017 strout ("in no buffer", -1, printcharfun
);
1020 sprintf (buf
, "from %d to %d in ",
1021 marker_position (OVERLAY_START (obj
)),
1022 marker_position (OVERLAY_END (obj
)));
1023 strout (buf
, -1, printcharfun
);
1024 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
1030 /* Remaining cases shouldn't happen in normal usage, but let's print
1031 them anyway for the benefit of the debugger. */
1032 case Lisp_Misc_Free
:
1033 strout ("#<misc free cell>", -1, printcharfun
);
1036 case Lisp_Misc_Intfwd
:
1037 sprintf (buf
, "#<intfwd to %d>", *XINTFWD (obj
)->intvar
);
1038 strout (buf
, -1, printcharfun
);
1041 case Lisp_Misc_Boolfwd
:
1042 sprintf (buf
, "#<boolfwd to %s>",
1043 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
1044 strout (buf
, -1, printcharfun
);
1047 case Lisp_Misc_Objfwd
:
1048 strout (buf
, "#<objfwd to ", -1, printcharfun
);
1049 print (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
1053 case Lisp_Misc_Buffer_Objfwd
:
1054 strout (buf
, "#<buffer_objfwd to ", -1, printcharfun
);
1055 print (*(Lisp_Object
*)((char *)current_buffer
1056 + XBUFFER_OBJFWD (obj
)->offset
),
1057 printcharfun
, escapeflag
);
1061 case Lisp_Misc_Kboard_Objfwd
:
1062 strout (buf
, "#<kboard_objfwd to ", -1, printcharfun
);
1063 print (*(Lisp_Object
*)((char *) current_kboard
1064 + XKBOARD_OBJFWD (obj
)->offset
),
1065 printcharfun
, escapeflag
);
1069 case Lisp_Misc_Buffer_Local_Value
:
1070 strout ("#<buffer_local_value ", -1, printcharfun
);
1071 goto do_buffer_local
;
1072 case Lisp_Misc_Some_Buffer_Local_Value
:
1073 strout ("#<some_buffer_local_value ", -1, printcharfun
);
1075 strout ("[realvalue] ", -1, printcharfun
);
1076 print (XBUFFER_LOCAL_VALUE (obj
)->car
, printcharfun
, escapeflag
);
1077 strout ("[buffer] ", -1, printcharfun
);
1078 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->car
,
1079 printcharfun
, escapeflag
);
1080 strout ("[alist-elt] ", -1, printcharfun
);
1081 print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
)->car
,
1082 printcharfun
, escapeflag
);
1083 strout ("[default-value] ", -1, printcharfun
);
1084 print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
)->cdr
,
1085 printcharfun
, escapeflag
);
1093 #endif /* standalone */
1098 /* We're in trouble if this happens!
1099 Probably should just abort () */
1100 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, printcharfun
);
1102 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
1103 else if (VECTORLIKEP (obj
))
1104 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
1106 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
1107 strout (buf
, -1, printcharfun
);
1108 strout (" Save your buffers immediately and please report this bug>",
1116 #ifdef USE_TEXT_PROPERTIES
1118 /* Print a description of INTERVAL using PRINTCHARFUN.
1119 This is part of printing a string that has text properties. */
1122 print_interval (interval
, printcharfun
)
1124 Lisp_Object printcharfun
;
1127 print (make_number (interval
->position
), printcharfun
, 1);
1129 print (make_number (interval
->position
+ LENGTH (interval
)),
1132 print (interval
->plist
, printcharfun
, 1);
1135 #endif /* USE_TEXT_PROPERTIES */
1140 staticpro (&Qprint_escape_newlines
);
1141 Qprint_escape_newlines
= intern ("print-escape-newlines");
1143 DEFVAR_LISP ("standard-output", &Vstandard_output
,
1144 "Output stream `print' uses by default for outputting a character.\n\
1145 This may be any function of one argument.\n\
1146 It may also be a buffer (output is inserted before point)\n\
1147 or a marker (output is inserted and the marker is advanced)\n\
1148 or the symbol t (output appears in the minibuffer line).");
1149 Vstandard_output
= Qt
;
1150 Qstandard_output
= intern ("standard-output");
1151 staticpro (&Qstandard_output
);
1153 #ifdef LISP_FLOAT_TYPE
1154 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
1155 "The format descriptor string used to print floats.\n\
1156 This is a %-spec like those accepted by `printf' in C,\n\
1157 but with some restrictions. It must start with the two characters `%.'.\n\
1158 After that comes an integer precision specification,\n\
1159 and then a letter which controls the format.\n\
1160 The letters allowed are `e', `f' and `g'.\n\
1161 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
1162 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
1163 Use `g' to choose the shorter of those two formats for the number at hand.\n\
1164 The precision in any of these cases is the number of digits following\n\
1165 the decimal point. With `f', a precision of 0 means to omit the\n\
1166 decimal point. 0 is not allowed with `e' or `g'.\n\n\
1167 A value of nil means to use `%.17g'.");
1168 Vfloat_output_format
= Qnil
;
1169 Qfloat_output_format
= intern ("float-output-format");
1170 staticpro (&Qfloat_output_format
);
1171 #endif /* LISP_FLOAT_TYPE */
1173 DEFVAR_LISP ("print-length", &Vprint_length
,
1174 "Maximum length of list to print before abbreviating.\n\
1175 A value of nil means no limit.");
1176 Vprint_length
= Qnil
;
1178 DEFVAR_LISP ("print-level", &Vprint_level
,
1179 "Maximum depth of list nesting to print before abbreviating.\n\
1180 A value of nil means no limit.");
1181 Vprint_level
= Qnil
;
1183 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
1184 "Non-nil means print newlines in strings as backslash-n.\n\
1185 Also print formfeeds as backslash-f.");
1186 print_escape_newlines
= 0;
1188 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
1189 staticpro (&Vprin1_to_string_buffer
);
1192 defsubr (&Sprin1_to_string
);
1196 defsubr (&Swrite_char
);
1197 defsubr (&Sexternal_debugging_output
);
1199 Qexternal_debugging_output
= intern ("external-debugging-output");
1200 staticpro (&Qexternal_debugging_output
);
1203 defsubr (&Swith_output_to_temp_buffer
);
1204 #endif /* not standalone */