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"
33 #endif /* not standalone */
35 #ifdef USE_TEXT_PROPERTIES
36 #include "intervals.h"
39 Lisp_Object Vstandard_output
, Qstandard_output
;
41 #ifdef LISP_FLOAT_TYPE
42 Lisp_Object Vfloat_output_format
, Qfloat_output_format
;
43 #endif /* LISP_FLOAT_TYPE */
45 /* Avoid actual stack overflow in print. */
48 /* Detect most circularities to print finite output. */
49 #define PRINT_CIRCLE 200
50 Lisp_Object being_printed
[PRINT_CIRCLE
];
52 /* Maximum length of list to print in full; noninteger means
53 effectively infinity */
55 Lisp_Object Vprint_length
;
57 /* Maximum depth of list to print in full; noninteger means
58 effectively infinity. */
60 Lisp_Object Vprint_level
;
62 /* Nonzero means print newlines in strings as \n. */
64 int print_escape_newlines
;
66 Lisp_Object Qprint_escape_newlines
;
68 /* Nonzero means print newline to stdout before next minibuffer message.
71 extern int noninteractive_need_newline
;
73 #ifdef MAX_PRINT_CHARS
74 static int print_chars
;
76 #endif /* MAX_PRINT_CHARS */
78 void print_interval ();
81 /* Convert between chars and GLYPHs */
85 register GLYPH
*glyphs
;
95 str_to_glyph_cpy (str
, glyphs
)
99 register GLYPH
*gp
= glyphs
;
100 register char *cp
= str
;
107 str_to_glyph_ncpy (str
, glyphs
, n
)
112 register GLYPH
*gp
= glyphs
;
113 register char *cp
= str
;
120 glyph_to_str_cpy (glyphs
, str
)
124 register GLYPH
*gp
= glyphs
;
125 register char *cp
= str
;
128 *str
++ = *gp
++ & 0377;
132 /* Low level output routines for characters and strings */
134 /* Lisp functions to do output using a stream
135 must have the stream in a variable called printcharfun
136 and must start with PRINTPREPARE and end with PRINTFINISH.
137 Use PRINTCHAR to output one character,
138 or call strout to output a block of characters.
139 Also, each one must have the declarations
140 struct buffer *old = current_buffer;
141 int old_point = -1, start_point;
142 Lisp_Object original;
145 #define PRINTPREPARE \
146 original = printcharfun; \
147 if (NILP (printcharfun)) printcharfun = Qt; \
148 if (BUFFERP (printcharfun)) \
149 { if (XBUFFER (printcharfun) != current_buffer) \
150 Fset_buffer (printcharfun); \
151 printcharfun = Qnil;} \
152 if (MARKERP (printcharfun)) \
153 { if (!(XMARKER (original)->buffer)) \
154 error ("Marker does not point anywhere"); \
155 if (XMARKER (original)->buffer != current_buffer) \
156 set_buffer_internal (XMARKER (original)->buffer); \
158 SET_PT (marker_position (printcharfun)); \
159 start_point = point; \
160 printcharfun = Qnil;}
162 #define PRINTFINISH \
163 if (MARKERP (original)) \
164 Fset_marker (original, make_number (point), Qnil); \
165 if (old_point >= 0) \
166 SET_PT (old_point + (old_point >= start_point \
167 ? point - start_point : 0)); \
168 if (old != current_buffer) \
169 set_buffer_internal (old)
171 #define PRINTCHAR(ch) printchar (ch, printcharfun)
173 /* Index of first unused element of FRAME_MESSAGE_BUF(mini_frame). */
174 static int printbufidx
;
183 #ifdef MAX_PRINT_CHARS
186 #endif /* MAX_PRINT_CHARS */
198 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)));
203 noninteractive_need_newline
= 1;
207 if (echo_area_glyphs
!= FRAME_MESSAGE_BUF (mini_frame
)
208 || !message_buf_print
)
210 message_log_maybe_newline ();
211 echo_area_glyphs
= FRAME_MESSAGE_BUF (mini_frame
);
213 echo_area_glyphs_length
= 0;
214 message_buf_print
= 1;
217 message_dolog (&ch
, 1, 0);
218 if (printbufidx
< FRAME_WIDTH (mini_frame
) - 1)
219 FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
++] = ch
;
220 FRAME_MESSAGE_BUF (mini_frame
)[printbufidx
] = 0;
221 echo_area_glyphs_length
= printbufidx
;
225 #endif /* not standalone */
227 XSETFASTINT (ch1
, ch
);
232 strout (ptr
, size
, printcharfun
)
235 Lisp_Object printcharfun
;
239 if (EQ (printcharfun
, Qnil
))
241 insert (ptr
, size
>= 0 ? size
: strlen (ptr
));
242 #ifdef MAX_PRINT_CHARS
244 print_chars
+= size
>= 0 ? size
: strlen(ptr
);
245 #endif /* MAX_PRINT_CHARS */
248 if (EQ (printcharfun
, Qt
))
251 = XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window
)));
253 i
= size
>= 0 ? size
: strlen (ptr
);
254 #ifdef MAX_PRINT_CHARS
257 #endif /* MAX_PRINT_CHARS */
261 fwrite (ptr
, 1, i
, stdout
);
262 noninteractive_need_newline
= 1;
266 if (echo_area_glyphs
!= FRAME_MESSAGE_BUF (mini_frame
)
267 || !message_buf_print
)
269 message_log_maybe_newline ();
270 echo_area_glyphs
= FRAME_MESSAGE_BUF (mini_frame
);
272 echo_area_glyphs_length
= 0;
273 message_buf_print
= 1;
276 message_dolog (ptr
, i
, 0);
277 if (i
> FRAME_WIDTH (mini_frame
) - printbufidx
- 1)
278 i
= FRAME_WIDTH (mini_frame
) - printbufidx
- 1;
279 bcopy (ptr
, &FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
], i
);
281 echo_area_glyphs_length
= printbufidx
;
282 FRAME_MESSAGE_BUF (mini_frame
) [printbufidx
] = 0;
289 PRINTCHAR (ptr
[i
++]);
292 PRINTCHAR (ptr
[i
++]);
295 /* Print the contents of a string STRING using PRINTCHARFUN.
296 It isn't safe to use strout, because printing one char can relocate. */
298 print_string (string
, printcharfun
)
300 Lisp_Object printcharfun
;
302 if (EQ (printcharfun
, Qnil
) || EQ (printcharfun
, Qt
))
303 /* In predictable cases, strout is safe: output to buffer or frame. */
304 strout (XSTRING (string
)->data
, XSTRING (string
)->size
, printcharfun
);
307 /* Otherwise, fetch the string address for each character. */
309 int size
= XSTRING (string
)->size
;
312 for (i
= 0; i
< size
; i
++)
313 PRINTCHAR (XSTRING (string
)->data
[i
]);
318 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
319 "Output character CHAR to stream PRINTCHARFUN.\n\
320 PRINTCHARFUN defaults to the value of `standard-output' (which see).")
322 Lisp_Object ch
, printcharfun
;
324 struct buffer
*old
= current_buffer
;
327 Lisp_Object original
;
329 if (NILP (printcharfun
))
330 printcharfun
= Vstandard_output
;
331 CHECK_NUMBER (ch
, 0);
333 PRINTCHAR (XINT (ch
));
338 /* Used from outside of print.c to print a block of SIZE chars at DATA
339 on the default output stream.
340 Do not use this on the contents of a Lisp string. */
342 write_string (data
, size
)
346 struct buffer
*old
= current_buffer
;
347 Lisp_Object printcharfun
;
350 Lisp_Object original
;
352 printcharfun
= Vstandard_output
;
355 strout (data
, size
, printcharfun
);
359 /* Used from outside of print.c to print a block of SIZE chars at DATA
360 on a specified stream PRINTCHARFUN.
361 Do not use this on the contents of a Lisp string. */
363 write_string_1 (data
, size
, printcharfun
)
366 Lisp_Object printcharfun
;
368 struct buffer
*old
= current_buffer
;
371 Lisp_Object original
;
374 strout (data
, size
, printcharfun
);
382 temp_output_buffer_setup (bufname
)
385 register struct buffer
*old
= current_buffer
;
386 register Lisp_Object buf
;
388 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
390 current_buffer
->directory
= old
->directory
;
391 current_buffer
->read_only
= Qnil
;
394 XSETBUFFER (buf
, current_buffer
);
395 specbind (Qstandard_output
, buf
);
397 set_buffer_internal (old
);
401 internal_with_output_to_temp_buffer (bufname
, function
, args
)
403 Lisp_Object (*function
) ();
406 int count
= specpdl_ptr
- specpdl
;
407 Lisp_Object buf
, val
;
411 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
412 temp_output_buffer_setup (bufname
);
413 buf
= Vstandard_output
;
416 val
= (*function
) (args
);
419 temp_output_buffer_show (buf
);
422 return unbind_to (count
, val
);
425 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
427 "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\
428 The buffer is cleared out initially, and marked as unmodified when done.\n\
429 All output done by BODY is inserted in that buffer by default.\n\
430 The buffer is displayed in another window, but not selected.\n\
431 The value of the last form in BODY is returned.\n\
432 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\n\
433 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
434 to get the buffer displayed. It gets one argument, the buffer to display.")
440 int count
= specpdl_ptr
- specpdl
;
441 Lisp_Object buf
, val
;
444 name
= Feval (Fcar (args
));
447 CHECK_STRING (name
, 0);
448 temp_output_buffer_setup (XSTRING (name
)->data
);
449 buf
= Vstandard_output
;
451 val
= Fprogn (Fcdr (args
));
453 temp_output_buffer_show (buf
);
455 return unbind_to (count
, val
);
457 #endif /* not standalone */
459 static void print ();
461 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
462 "Output a newline to stream PRINTCHARFUN.\n\
463 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.")
465 Lisp_Object printcharfun
;
467 struct buffer
*old
= current_buffer
;
470 Lisp_Object original
;
472 if (NILP (printcharfun
))
473 printcharfun
= Vstandard_output
;
480 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
481 "Output the printed representation of OBJECT, any Lisp object.\n\
482 Quoting characters are printed when needed to make output that `read'\n\
483 can handle, whenever this is possible.\n\
484 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
486 Lisp_Object obj
, printcharfun
;
488 struct buffer
*old
= current_buffer
;
491 Lisp_Object original
;
493 #ifdef MAX_PRINT_CHARS
495 #endif /* MAX_PRINT_CHARS */
496 if (NILP (printcharfun
))
497 printcharfun
= Vstandard_output
;
500 print (obj
, printcharfun
, 1);
505 /* a buffer which is used to hold output being built by prin1-to-string */
506 Lisp_Object Vprin1_to_string_buffer
;
508 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
509 "Return a string containing the printed representation of OBJECT,\n\
510 any Lisp object. Quoting characters are used when needed to make output\n\
511 that `read' can handle, whenever this is possible, unless the optional\n\
512 second argument NOESCAPE is non-nil.")
514 Lisp_Object obj
, noescape
;
516 struct buffer
*old
= current_buffer
;
519 Lisp_Object original
, printcharfun
;
522 printcharfun
= Vprin1_to_string_buffer
;
525 print (obj
, printcharfun
, NILP (noescape
));
526 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
528 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
529 obj
= Fbuffer_string ();
533 set_buffer_internal (old
);
539 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
540 "Output the printed representation of OBJECT, any Lisp object.\n\
541 No quoting characters are used; no delimiters are printed around\n\
542 the contents of strings.\n\
543 Output stream is PRINTCHARFUN, or value of standard-output (which see).")
545 Lisp_Object obj
, printcharfun
;
547 struct buffer
*old
= current_buffer
;
550 Lisp_Object original
;
552 if (NILP (printcharfun
))
553 printcharfun
= Vstandard_output
;
556 print (obj
, printcharfun
, 0);
561 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
562 "Output the printed representation of OBJECT, with newlines around it.\n\
563 Quoting characters are printed when needed to make output that `read'\n\
564 can handle, whenever this is possible.\n\
565 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
567 Lisp_Object obj
, printcharfun
;
569 struct buffer
*old
= current_buffer
;
572 Lisp_Object original
;
575 #ifdef MAX_PRINT_CHARS
577 max_print
= MAX_PRINT_CHARS
;
578 #endif /* MAX_PRINT_CHARS */
579 if (NILP (printcharfun
))
580 printcharfun
= Vstandard_output
;
585 print (obj
, printcharfun
, 1);
588 #ifdef MAX_PRINT_CHARS
591 #endif /* MAX_PRINT_CHARS */
596 /* The subroutine object for external-debugging-output is kept here
597 for the convenience of the debugger. */
598 Lisp_Object Qexternal_debugging_output
;
600 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
601 "Write CHARACTER to stderr.\n\
602 You can call print while debugging emacs, and pass it this function\n\
603 to make it write to the debugging output.\n")
605 Lisp_Object character
;
607 CHECK_NUMBER (character
, 0);
608 putc (XINT (character
), stderr
);
613 /* This is the interface for debugging printing. */
619 Fprin1 (arg
, Qexternal_debugging_output
);
622 #ifdef LISP_FLOAT_TYPE
625 * The buffer should be at least as large as the max string size of the
626 * largest float, printed in the biggest notation. This is undoubtably
627 * 20d float_output_format, with the negative of the C-constant "HUGE"
630 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
632 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
633 * case of -1e307 in 20d float_output_format. What is one to do (short of
634 * re-writing _doprnt to be more sane)?
639 float_to_string (buf
, data
)
646 if (NILP (Vfloat_output_format
)
647 || !STRINGP (Vfloat_output_format
))
650 sprintf (buf
, "%.17g", data
);
655 /* Check that the spec we have is fully valid.
656 This means not only valid for printf,
657 but meant for floats, and reasonable. */
658 cp
= XSTRING (Vfloat_output_format
)->data
;
667 /* Check the width specification. */
669 if ('0' <= *cp
&& *cp
<= '9')
670 for (width
= 0; (*cp
>= '0' && *cp
<= '9'); cp
++)
671 width
= (width
* 10) + (*cp
- '0');
673 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
676 /* A precision of zero is valid for %f; everything else requires
677 at least one. Width may be omitted anywhere. */
679 && (width
< (*cp
!= 'f')
686 sprintf (buf
, XSTRING (Vfloat_output_format
)->data
, data
);
689 /* Make sure there is a decimal point with digit after, or an
690 exponent, so that the value is readable as a float. But don't do
691 this with "%.0f"; it's valid for that not to produce a decimal
692 point. Note that width can be 0 only for %.0f. */
695 for (cp
= buf
; *cp
; cp
++)
696 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
699 if (*cp
== '.' && cp
[1] == 0)
713 #endif /* LISP_FLOAT_TYPE */
716 print (obj
, printcharfun
, escapeflag
)
718 register Lisp_Object printcharfun
;
725 #if 1 /* I'm not sure this is really worth doing. */
726 /* Detect circularities and truncate them.
727 No need to offer any alternative--this is better than an error. */
728 if (CONSP (obj
) || VECTORP (obj
) || COMPILEDP (obj
))
731 for (i
= 0; i
< print_depth
; i
++)
732 if (EQ (obj
, being_printed
[i
]))
734 sprintf (buf
, "#%d", i
);
735 strout (buf
, -1, printcharfun
);
741 being_printed
[print_depth
] = obj
;
744 if (print_depth
> PRINT_CIRCLE
)
745 error ("Apparently circular structure being printed");
746 #ifdef MAX_PRINT_CHARS
747 if (max_print
&& print_chars
> max_print
)
752 #endif /* MAX_PRINT_CHARS */
754 switch (XGCTYPE (obj
))
757 sprintf (buf
, "%d", XINT (obj
));
758 strout (buf
, -1, printcharfun
);
761 #ifdef LISP_FLOAT_TYPE
764 char pigbuf
[350]; /* see comments in float_to_string */
766 float_to_string (pigbuf
, XFLOAT(obj
)->data
);
767 strout (pigbuf
, -1, printcharfun
);
774 print_string (obj
, printcharfun
);
778 register unsigned char c
;
783 #ifdef USE_TEXT_PROPERTIES
784 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
792 for (i
= 0; i
< XSTRING (obj
)->size
; i
++)
795 c
= XSTRING (obj
)->data
[i
];
796 if (c
== '\n' && print_escape_newlines
)
801 else if (c
== '\f' && print_escape_newlines
)
808 if (c
== '\"' || c
== '\\')
815 #ifdef USE_TEXT_PROPERTIES
816 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
818 traverse_intervals (XSTRING (obj
)->intervals
,
819 0, 0, print_interval
, printcharfun
);
830 register int confusing
;
831 register unsigned char *p
= XSYMBOL (obj
)->name
->data
;
832 register unsigned char *end
= p
+ XSYMBOL (obj
)->name
->size
;
833 register unsigned char c
;
835 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
840 while (p
!= end
&& *p
>= '0' && *p
<= '9')
842 confusing
= (end
== p
);
845 p
= XSYMBOL (obj
)->name
->data
;
852 if (c
== '\"' || c
== '\\' || c
== '\'' || c
== ';' || c
== '#' ||
853 c
== '(' || c
== ')' || c
== ',' || c
=='.' || c
== '`' ||
854 c
== '[' || c
== ']' || c
== '?' || c
<= 040 || confusing
)
855 PRINTCHAR ('\\'), confusing
= 0;
863 /* If deeper than spec'd depth, print placeholder. */
864 if (INTEGERP (Vprint_level
)
865 && print_depth
> XINT (Vprint_level
))
866 strout ("...", -1, printcharfun
);
872 register int max
= 0;
874 if (INTEGERP (Vprint_length
))
875 max
= XINT (Vprint_length
);
876 /* Could recognize circularities in cdrs here,
877 but that would make printing of long lists quadratic.
878 It's not worth doing. */
885 strout ("...", 3, printcharfun
);
888 print (Fcar (obj
), printcharfun
, escapeflag
);
892 if (!NILP (obj
) && !CONSP (obj
))
894 strout (" . ", 3, printcharfun
);
895 print (obj
, printcharfun
, escapeflag
);
901 case Lisp_Vectorlike
:
906 strout ("#<process ", -1, printcharfun
);
907 print_string (XPROCESS (obj
)->name
, printcharfun
);
911 print_string (XPROCESS (obj
)->name
, printcharfun
);
913 else if (SUBRP (obj
))
915 strout ("#<subr ", -1, printcharfun
);
916 strout (XSUBR (obj
)->symbol_name
, -1, printcharfun
);
920 else if (WINDOWP (obj
))
922 strout ("#<window ", -1, printcharfun
);
923 sprintf (buf
, "%d", XFASTINT (XWINDOW (obj
)->sequence_number
));
924 strout (buf
, -1, printcharfun
);
925 if (!NILP (XWINDOW (obj
)->buffer
))
927 strout (" on ", -1, printcharfun
);
928 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
932 else if (BUFFERP (obj
))
934 if (NILP (XBUFFER (obj
)->name
))
935 strout ("#<killed buffer>", -1, printcharfun
);
938 strout ("#<buffer ", -1, printcharfun
);
939 print_string (XBUFFER (obj
)->name
, printcharfun
);
943 print_string (XBUFFER (obj
)->name
, printcharfun
);
945 else if (WINDOW_CONFIGURATIONP (obj
))
947 strout ("#<window-configuration>", -1, printcharfun
);
950 else if (FRAMEP (obj
))
952 strout ((FRAME_LIVE_P (XFRAME (obj
))
953 ? "#<frame " : "#<dead frame "),
955 print_string (XFRAME (obj
)->name
, printcharfun
);
956 sprintf (buf
, " 0x%lx", (unsigned long) (XFRAME (obj
)));
957 strout (buf
, -1, printcharfun
);
961 #endif /* not standalone */
964 int size
= XVECTOR (obj
)->size
;
968 size
&= PSEUDOVECTOR_SIZE_MASK
;
970 if (size
& PSEUDOVECTOR_FLAG
)
976 register Lisp_Object tem
;
977 for (i
= 0; i
< size
; i
++)
979 if (i
) PRINTCHAR (' ');
980 tem
= XVECTOR (obj
)->contents
[i
];
981 print (tem
, printcharfun
, escapeflag
);
990 switch (XMISCTYPE (obj
))
992 case Lisp_Misc_Marker
:
993 strout ("#<marker ", -1, printcharfun
);
994 if (!(XMARKER (obj
)->buffer
))
995 strout ("in no buffer", -1, printcharfun
);
998 sprintf (buf
, "at %d", marker_position (obj
));
999 strout (buf
, -1, printcharfun
);
1000 strout (" in ", -1, printcharfun
);
1001 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
1006 case Lisp_Misc_Overlay
:
1007 strout ("#<overlay ", -1, printcharfun
);
1008 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
1009 strout ("in no buffer", -1, printcharfun
);
1012 sprintf (buf
, "from %d to %d in ",
1013 marker_position (OVERLAY_START (obj
)),
1014 marker_position (OVERLAY_END (obj
)));
1015 strout (buf
, -1, printcharfun
);
1016 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
1022 /* Remaining cases shouldn't happen in normal usage, but let's print
1023 them anyway for the benefit of the debugger. */
1024 case Lisp_Misc_Free
:
1025 strout ("#<misc free cell>", -1, printcharfun
);
1028 case Lisp_Misc_Intfwd
:
1029 sprintf (buf
, "#<intfwd to %d>", *XINTFWD (obj
)->intvar
);
1030 strout (buf
, -1, printcharfun
);
1033 case Lisp_Misc_Boolfwd
:
1034 sprintf (buf
, "#<boolfwd to %s>",
1035 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
1036 strout (buf
, -1, printcharfun
);
1039 case Lisp_Misc_Objfwd
:
1040 strout (buf
, "#<objfwd to ", -1, printcharfun
);
1041 print (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
1045 case Lisp_Misc_Buffer_Objfwd
:
1046 strout (buf
, "#<buffer_objfwd to ", -1, printcharfun
);
1047 print (*(Lisp_Object
*)((char *)current_buffer
1048 + XBUFFER_OBJFWD (obj
)->offset
),
1049 printcharfun
, escapeflag
);
1053 case Lisp_Misc_Kboard_Objfwd
:
1054 strout (buf
, "#<kboard_objfwd to ", -1, printcharfun
);
1055 print (*(Lisp_Object
*)((char *) current_kboard
1056 + XKBOARD_OBJFWD (obj
)->offset
),
1057 printcharfun
, escapeflag
);
1061 case Lisp_Misc_Buffer_Local_Value
:
1062 strout ("#<buffer_local_value ", -1, printcharfun
);
1063 goto do_buffer_local
;
1064 case Lisp_Misc_Some_Buffer_Local_Value
:
1065 strout ("#<some_buffer_local_value ", -1, printcharfun
);
1067 strout ("[realvalue] ", -1, printcharfun
);
1068 print (XBUFFER_LOCAL_VALUE (obj
)->car
, printcharfun
, escapeflag
);
1069 strout ("[buffer] ", -1, printcharfun
);
1070 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->car
,
1071 printcharfun
, escapeflag
);
1072 strout ("[alist-elt] ", -1, printcharfun
);
1073 print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
)->car
,
1074 printcharfun
, escapeflag
);
1075 strout ("[default-value] ", -1, printcharfun
);
1076 print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
)->cdr
,
1077 printcharfun
, escapeflag
);
1085 #endif /* standalone */
1090 /* We're in trouble if this happens!
1091 Probably should just abort () */
1092 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, printcharfun
);
1094 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
1095 else if (VECTORLIKEP (obj
))
1096 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
1098 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
1099 strout (buf
, -1, printcharfun
);
1100 strout (" Save your buffers immediately and please report this bug>",
1108 #ifdef USE_TEXT_PROPERTIES
1110 /* Print a description of INTERVAL using PRINTCHARFUN.
1111 This is part of printing a string that has text properties. */
1114 print_interval (interval
, printcharfun
)
1116 Lisp_Object printcharfun
;
1119 print (make_number (interval
->position
), printcharfun
, 1);
1121 print (make_number (interval
->position
+ LENGTH (interval
)),
1124 print (interval
->plist
, printcharfun
, 1);
1127 #endif /* USE_TEXT_PROPERTIES */
1132 staticpro (&Qprint_escape_newlines
);
1133 Qprint_escape_newlines
= intern ("print-escape-newlines");
1135 DEFVAR_LISP ("standard-output", &Vstandard_output
,
1136 "Output stream `print' uses by default for outputting a character.\n\
1137 This may be any function of one argument.\n\
1138 It may also be a buffer (output is inserted before point)\n\
1139 or a marker (output is inserted and the marker is advanced)\n\
1140 or the symbol t (output appears in the minibuffer line).");
1141 Vstandard_output
= Qt
;
1142 Qstandard_output
= intern ("standard-output");
1143 staticpro (&Qstandard_output
);
1145 #ifdef LISP_FLOAT_TYPE
1146 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
1147 "The format descriptor string used to print floats.\n\
1148 This is a %-spec like those accepted by `printf' in C,\n\
1149 but with some restrictions. It must start with the two characters `%.'.\n\
1150 After that comes an integer precision specification,\n\
1151 and then a letter which controls the format.\n\
1152 The letters allowed are `e', `f' and `g'.\n\
1153 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
1154 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
1155 Use `g' to choose the shorter of those two formats for the number at hand.\n\
1156 The precision in any of these cases is the number of digits following\n\
1157 the decimal point. With `f', a precision of 0 means to omit the\n\
1158 decimal point. 0 is not allowed with `e' or `g'.\n\n\
1159 A value of nil means to use `%.17g'.");
1160 Vfloat_output_format
= Qnil
;
1161 Qfloat_output_format
= intern ("float-output-format");
1162 staticpro (&Qfloat_output_format
);
1163 #endif /* LISP_FLOAT_TYPE */
1165 DEFVAR_LISP ("print-length", &Vprint_length
,
1166 "Maximum length of list to print before abbreviating.\n\
1167 A value of nil means no limit.");
1168 Vprint_length
= Qnil
;
1170 DEFVAR_LISP ("print-level", &Vprint_level
,
1171 "Maximum depth of list nesting to print before abbreviating.\n\
1172 A value of nil means no limit.");
1173 Vprint_level
= Qnil
;
1175 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
1176 "Non-nil means print newlines in strings as backslash-n.\n\
1177 Also print formfeeds as backslash-f.");
1178 print_escape_newlines
= 0;
1180 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
1181 staticpro (&Vprin1_to_string_buffer
);
1184 defsubr (&Sprin1_to_string
);
1188 defsubr (&Swrite_char
);
1189 defsubr (&Sexternal_debugging_output
);
1191 Qexternal_debugging_output
= intern ("external-debugging-output");
1192 staticpro (&Qexternal_debugging_output
);
1195 defsubr (&Swith_output_to_temp_buffer
);
1196 #endif /* not standalone */