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. */
30 #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 in many cases,
297 because printing one char can relocate. */
299 print_string (string
, printcharfun
)
301 Lisp_Object printcharfun
;
303 if (EQ (printcharfun
, Qt
))
304 /* strout is safe for output to a frame (echo area). */
305 strout (XSTRING (string
)->data
, XSTRING (string
)->size
, printcharfun
);
306 else if (EQ (printcharfun
, Qnil
))
308 #ifdef MAX_PRINT_CHARS
310 print_chars
+= XSTRING (string
)->size
;
311 #endif /* MAX_PRINT_CHARS */
312 insert_from_string (string
, 0, XSTRING (string
)->size
, 1);
316 /* Otherwise, fetch the string address for each character. */
318 int size
= XSTRING (string
)->size
;
321 for (i
= 0; i
< size
; i
++)
322 PRINTCHAR (XSTRING (string
)->data
[i
]);
327 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
328 "Output character CHAR to stream PRINTCHARFUN.\n\
329 PRINTCHARFUN defaults to the value of `standard-output' (which see).")
331 Lisp_Object ch
, printcharfun
;
333 struct buffer
*old
= current_buffer
;
336 Lisp_Object original
;
338 if (NILP (printcharfun
))
339 printcharfun
= Vstandard_output
;
340 CHECK_NUMBER (ch
, 0);
342 PRINTCHAR (XINT (ch
));
347 /* Used from outside of print.c to print a block of SIZE chars at DATA
348 on the default output stream.
349 Do not use this on the contents of a Lisp string. */
351 write_string (data
, size
)
355 struct buffer
*old
= current_buffer
;
356 Lisp_Object printcharfun
;
359 Lisp_Object original
;
361 printcharfun
= Vstandard_output
;
364 strout (data
, size
, printcharfun
);
368 /* Used from outside of print.c to print a block of SIZE chars at DATA
369 on a specified stream PRINTCHARFUN.
370 Do not use this on the contents of a Lisp string. */
372 write_string_1 (data
, size
, printcharfun
)
375 Lisp_Object printcharfun
;
377 struct buffer
*old
= current_buffer
;
380 Lisp_Object original
;
383 strout (data
, size
, printcharfun
);
391 temp_output_buffer_setup (bufname
)
394 register struct buffer
*old
= current_buffer
;
395 register Lisp_Object buf
;
397 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
399 current_buffer
->directory
= old
->directory
;
400 current_buffer
->read_only
= Qnil
;
403 XSETBUFFER (buf
, current_buffer
);
404 specbind (Qstandard_output
, buf
);
406 set_buffer_internal (old
);
410 internal_with_output_to_temp_buffer (bufname
, function
, args
)
412 Lisp_Object (*function
) ();
415 int count
= specpdl_ptr
- specpdl
;
416 Lisp_Object buf
, val
;
420 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
421 temp_output_buffer_setup (bufname
);
422 buf
= Vstandard_output
;
425 val
= (*function
) (args
);
428 temp_output_buffer_show (buf
);
431 return unbind_to (count
, val
);
434 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
436 "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\
437 The buffer is cleared out initially, and marked as unmodified when done.\n\
438 All output done by BODY is inserted in that buffer by default.\n\
439 The buffer is displayed in another window, but not selected.\n\
440 The value of the last form in BODY is returned.\n\
441 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\n\
442 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
443 to get the buffer displayed. It gets one argument, the buffer to display.")
449 int count
= specpdl_ptr
- specpdl
;
450 Lisp_Object buf
, val
;
453 name
= Feval (Fcar (args
));
456 CHECK_STRING (name
, 0);
457 temp_output_buffer_setup (XSTRING (name
)->data
);
458 buf
= Vstandard_output
;
460 val
= Fprogn (Fcdr (args
));
462 temp_output_buffer_show (buf
);
464 return unbind_to (count
, val
);
466 #endif /* not standalone */
468 static void print ();
470 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
471 "Output a newline to stream PRINTCHARFUN.\n\
472 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.")
474 Lisp_Object printcharfun
;
476 struct buffer
*old
= current_buffer
;
479 Lisp_Object original
;
481 if (NILP (printcharfun
))
482 printcharfun
= Vstandard_output
;
489 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
490 "Output the printed representation of OBJECT, any Lisp object.\n\
491 Quoting characters are printed when needed to make output that `read'\n\
492 can handle, whenever this is possible.\n\
493 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
495 Lisp_Object obj
, printcharfun
;
497 struct buffer
*old
= current_buffer
;
500 Lisp_Object original
;
502 #ifdef MAX_PRINT_CHARS
504 #endif /* MAX_PRINT_CHARS */
505 if (NILP (printcharfun
))
506 printcharfun
= Vstandard_output
;
509 print (obj
, printcharfun
, 1);
514 /* a buffer which is used to hold output being built by prin1-to-string */
515 Lisp_Object Vprin1_to_string_buffer
;
517 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
518 "Return a string containing the printed representation of OBJECT,\n\
519 any Lisp object. Quoting characters are used when needed to make output\n\
520 that `read' can handle, whenever this is possible, unless the optional\n\
521 second argument NOESCAPE is non-nil.")
523 Lisp_Object obj
, noescape
;
525 struct buffer
*old
= current_buffer
;
528 Lisp_Object original
, printcharfun
;
531 printcharfun
= Vprin1_to_string_buffer
;
534 print (obj
, printcharfun
, NILP (noescape
));
535 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
537 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
538 obj
= Fbuffer_string ();
542 set_buffer_internal (old
);
548 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
549 "Output the printed representation of OBJECT, any Lisp object.\n\
550 No quoting characters are used; no delimiters are printed around\n\
551 the contents of strings.\n\
552 Output stream is PRINTCHARFUN, or value of standard-output (which see).")
554 Lisp_Object obj
, printcharfun
;
556 struct buffer
*old
= current_buffer
;
559 Lisp_Object original
;
561 if (NILP (printcharfun
))
562 printcharfun
= Vstandard_output
;
565 print (obj
, printcharfun
, 0);
570 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
571 "Output the printed representation of OBJECT, with newlines around it.\n\
572 Quoting characters are printed when needed to make output that `read'\n\
573 can handle, whenever this is possible.\n\
574 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
576 Lisp_Object obj
, printcharfun
;
578 struct buffer
*old
= current_buffer
;
581 Lisp_Object original
;
584 #ifdef MAX_PRINT_CHARS
586 max_print
= MAX_PRINT_CHARS
;
587 #endif /* MAX_PRINT_CHARS */
588 if (NILP (printcharfun
))
589 printcharfun
= Vstandard_output
;
594 print (obj
, printcharfun
, 1);
597 #ifdef MAX_PRINT_CHARS
600 #endif /* MAX_PRINT_CHARS */
605 /* The subroutine object for external-debugging-output is kept here
606 for the convenience of the debugger. */
607 Lisp_Object Qexternal_debugging_output
;
609 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
610 "Write CHARACTER to stderr.\n\
611 You can call print while debugging emacs, and pass it this function\n\
612 to make it write to the debugging output.\n")
614 Lisp_Object character
;
616 CHECK_NUMBER (character
, 0);
617 putc (XINT (character
), stderr
);
622 /* This is the interface for debugging printing. */
628 Fprin1 (arg
, Qexternal_debugging_output
);
629 fprintf (stderr
, "\r\n");
632 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
634 "Convert an error value (ERROR-SYMBOL . DATA) to an error message.")
638 struct buffer
*old
= current_buffer
;
639 Lisp_Object original
, printcharfun
, value
;
642 print_error_message (obj
, Vprin1_to_string_buffer
, NULL
);
644 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
645 value
= Fbuffer_string ();
649 set_buffer_internal (old
);
655 /* Print an error message for the error DATA
656 onto Lisp output stream STREAM (suitable for the print functions). */
658 print_error_message (data
, stream
)
659 Lisp_Object data
, stream
;
661 Lisp_Object errname
, errmsg
, file_error
, tail
;
665 errname
= Fcar (data
);
667 if (EQ (errname
, Qerror
))
670 if (!CONSP (data
)) data
= Qnil
;
671 errmsg
= Fcar (data
);
676 errmsg
= Fget (errname
, Qerror_message
);
677 file_error
= Fmemq (Qfile_error
,
678 Fget (errname
, Qerror_conditions
));
681 /* Print an error message including the data items. */
683 tail
= Fcdr_safe (data
);
686 /* For file-error, make error message by concatenating
687 all the data items. They are all strings. */
688 if (!NILP (file_error
) && !NILP (tail
))
689 errmsg
= XCONS (tail
)->car
, tail
= XCONS (tail
)->cdr
;
691 if (STRINGP (errmsg
))
692 Fprinc (errmsg
, stream
);
694 write_string_1 ("peculiar error", -1, stream
);
696 for (i
= 0; CONSP (tail
); tail
= Fcdr (tail
), i
++)
698 write_string_1 (i
? ", " : ": ", 2, stream
);
699 if (!NILP (file_error
))
700 Fprinc (Fcar (tail
), stream
);
702 Fprin1 (Fcar (tail
), stream
);
707 #ifdef LISP_FLOAT_TYPE
710 * The buffer should be at least as large as the max string size of the
711 * largest float, printed in the biggest notation. This is undoubtedly
712 * 20d float_output_format, with the negative of the C-constant "HUGE"
715 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
717 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
718 * case of -1e307 in 20d float_output_format. What is one to do (short of
719 * re-writing _doprnt to be more sane)?
724 float_to_string (buf
, data
)
731 if (NILP (Vfloat_output_format
)
732 || !STRINGP (Vfloat_output_format
))
735 sprintf (buf
, "%.17g", data
);
740 /* Check that the spec we have is fully valid.
741 This means not only valid for printf,
742 but meant for floats, and reasonable. */
743 cp
= XSTRING (Vfloat_output_format
)->data
;
752 /* Check the width specification. */
754 if ('0' <= *cp
&& *cp
<= '9')
758 width
= (width
* 10) + (*cp
++ - '0');
759 while (*cp
>= '0' && *cp
<= '9');
761 /* A precision of zero is valid only for %f. */
763 || (width
== 0 && *cp
!= 'f'))
767 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
773 sprintf (buf
, XSTRING (Vfloat_output_format
)->data
, data
);
776 /* Make sure there is a decimal point with digit after, or an
777 exponent, so that the value is readable as a float. But don't do
778 this with "%.0f"; it's valid for that not to produce a decimal
779 point. Note that width can be 0 only for %.0f. */
782 for (cp
= buf
; *cp
; cp
++)
783 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
786 if (*cp
== '.' && cp
[1] == 0)
800 #endif /* LISP_FLOAT_TYPE */
803 print (obj
, printcharfun
, escapeflag
)
805 register Lisp_Object printcharfun
;
812 #if 1 /* I'm not sure this is really worth doing. */
813 /* Detect circularities and truncate them.
814 No need to offer any alternative--this is better than an error. */
815 if (CONSP (obj
) || VECTORP (obj
) || COMPILEDP (obj
))
818 for (i
= 0; i
< print_depth
; i
++)
819 if (EQ (obj
, being_printed
[i
]))
821 sprintf (buf
, "#%d", i
);
822 strout (buf
, -1, printcharfun
);
828 being_printed
[print_depth
] = obj
;
831 if (print_depth
> PRINT_CIRCLE
)
832 error ("Apparently circular structure being printed");
833 #ifdef MAX_PRINT_CHARS
834 if (max_print
&& print_chars
> max_print
)
839 #endif /* MAX_PRINT_CHARS */
841 switch (XGCTYPE (obj
))
844 if (sizeof (int) == sizeof (EMACS_INT
))
845 sprintf (buf
, "%d", XINT (obj
));
846 else if (sizeof (long) == sizeof (EMACS_INT
))
847 sprintf (buf
, "%ld", XINT (obj
));
850 strout (buf
, -1, printcharfun
);
853 #ifdef LISP_FLOAT_TYPE
856 char pigbuf
[350]; /* see comments in float_to_string */
858 float_to_string (pigbuf
, XFLOAT(obj
)->data
);
859 strout (pigbuf
, -1, printcharfun
);
866 print_string (obj
, printcharfun
);
870 register unsigned char c
;
875 #ifdef USE_TEXT_PROPERTIES
876 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
884 for (i
= 0; i
< XSTRING (obj
)->size
; i
++)
887 c
= XSTRING (obj
)->data
[i
];
888 if (c
== '\n' && print_escape_newlines
)
893 else if (c
== '\f' && print_escape_newlines
)
900 if (c
== '\"' || c
== '\\')
907 #ifdef USE_TEXT_PROPERTIES
908 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
910 traverse_intervals (XSTRING (obj
)->intervals
,
911 0, 0, print_interval
, printcharfun
);
922 register int confusing
;
923 register unsigned char *p
= XSYMBOL (obj
)->name
->data
;
924 register unsigned char *end
= p
+ XSYMBOL (obj
)->name
->size
;
925 register unsigned char c
;
927 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
932 while (p
!= end
&& *p
>= '0' && *p
<= '9')
934 confusing
= (end
== p
);
937 p
= XSYMBOL (obj
)->name
->data
;
944 if (c
== '\"' || c
== '\\' || c
== '\'' || c
== ';' || c
== '#' ||
945 c
== '(' || c
== ')' || c
== ',' || c
=='.' || c
== '`' ||
946 c
== '[' || c
== ']' || c
== '?' || c
<= 040 || confusing
)
947 PRINTCHAR ('\\'), confusing
= 0;
955 /* If deeper than spec'd depth, print placeholder. */
956 if (INTEGERP (Vprint_level
)
957 && print_depth
> XINT (Vprint_level
))
958 strout ("...", -1, printcharfun
);
964 register int max
= 0;
966 if (INTEGERP (Vprint_length
))
967 max
= XINT (Vprint_length
);
968 /* Could recognize circularities in cdrs here,
969 but that would make printing of long lists quadratic.
970 It's not worth doing. */
977 strout ("...", 3, printcharfun
);
980 print (Fcar (obj
), printcharfun
, escapeflag
);
984 if (!NILP (obj
) && !CONSP (obj
))
986 strout (" . ", 3, printcharfun
);
987 print (obj
, printcharfun
, escapeflag
);
993 case Lisp_Vectorlike
:
998 strout ("#<process ", -1, printcharfun
);
999 print_string (XPROCESS (obj
)->name
, printcharfun
);
1003 print_string (XPROCESS (obj
)->name
, printcharfun
);
1005 else if (BOOL_VECTOR_P (obj
))
1008 register unsigned char c
;
1009 struct gcpro gcpro1
;
1011 = (XBOOL_VECTOR (obj
)->size
+ BITS_PER_CHAR
) / BITS_PER_CHAR
;
1017 sprintf (buf
, "%d", XBOOL_VECTOR (obj
)->size
);
1018 strout (buf
, -1, printcharfun
);
1020 for (i
= 0; i
< size_in_chars
; i
++)
1023 c
= XBOOL_VECTOR (obj
)->data
[i
];
1024 if (c
== '\n' && print_escape_newlines
)
1029 else if (c
== '\f' && print_escape_newlines
)
1036 if (c
== '\"' || c
== '\\')
1045 else if (SUBRP (obj
))
1047 strout ("#<subr ", -1, printcharfun
);
1048 strout (XSUBR (obj
)->symbol_name
, -1, printcharfun
);
1052 else if (WINDOWP (obj
))
1054 strout ("#<window ", -1, printcharfun
);
1055 sprintf (buf
, "%d", XFASTINT (XWINDOW (obj
)->sequence_number
));
1056 strout (buf
, -1, printcharfun
);
1057 if (!NILP (XWINDOW (obj
)->buffer
))
1059 strout (" on ", -1, printcharfun
);
1060 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
1064 else if (BUFFERP (obj
))
1066 if (NILP (XBUFFER (obj
)->name
))
1067 strout ("#<killed buffer>", -1, printcharfun
);
1068 else if (escapeflag
)
1070 strout ("#<buffer ", -1, printcharfun
);
1071 print_string (XBUFFER (obj
)->name
, printcharfun
);
1075 print_string (XBUFFER (obj
)->name
, printcharfun
);
1077 else if (WINDOW_CONFIGURATIONP (obj
))
1079 strout ("#<window-configuration>", -1, printcharfun
);
1082 else if (FRAMEP (obj
))
1084 strout ((FRAME_LIVE_P (XFRAME (obj
))
1085 ? "#<frame " : "#<dead frame "),
1087 print_string (XFRAME (obj
)->name
, printcharfun
);
1088 sprintf (buf
, " 0x%lx", (unsigned long) (XFRAME (obj
)));
1089 strout (buf
, -1, printcharfun
);
1093 #endif /* not standalone */
1096 int size
= XVECTOR (obj
)->size
;
1097 if (COMPILEDP (obj
))
1100 size
&= PSEUDOVECTOR_SIZE_MASK
;
1102 if (CHAR_TABLE_P (obj
))
1104 /* We print a char-table as if it were a vector,
1105 lumping the parent and default slots in with the
1106 character slots. But we add #^ as a prefix. */
1109 size
&= PSEUDOVECTOR_SIZE_MASK
;
1111 if (size
& PSEUDOVECTOR_FLAG
)
1117 register Lisp_Object tem
;
1118 for (i
= 0; i
< size
; i
++)
1120 if (i
) PRINTCHAR (' ');
1121 tem
= XVECTOR (obj
)->contents
[i
];
1122 print (tem
, printcharfun
, escapeflag
);
1131 switch (XMISCTYPE (obj
))
1133 case Lisp_Misc_Marker
:
1134 strout ("#<marker ", -1, printcharfun
);
1135 if (!(XMARKER (obj
)->buffer
))
1136 strout ("in no buffer", -1, printcharfun
);
1139 sprintf (buf
, "at %d", marker_position (obj
));
1140 strout (buf
, -1, printcharfun
);
1141 strout (" in ", -1, printcharfun
);
1142 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
1147 case Lisp_Misc_Overlay
:
1148 strout ("#<overlay ", -1, printcharfun
);
1149 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
1150 strout ("in no buffer", -1, printcharfun
);
1153 sprintf (buf
, "from %d to %d in ",
1154 marker_position (OVERLAY_START (obj
)),
1155 marker_position (OVERLAY_END (obj
)));
1156 strout (buf
, -1, printcharfun
);
1157 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
1163 /* Remaining cases shouldn't happen in normal usage, but let's print
1164 them anyway for the benefit of the debugger. */
1165 case Lisp_Misc_Free
:
1166 strout ("#<misc free cell>", -1, printcharfun
);
1169 case Lisp_Misc_Intfwd
:
1170 sprintf (buf
, "#<intfwd to %d>", *XINTFWD (obj
)->intvar
);
1171 strout (buf
, -1, printcharfun
);
1174 case Lisp_Misc_Boolfwd
:
1175 sprintf (buf
, "#<boolfwd to %s>",
1176 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
1177 strout (buf
, -1, printcharfun
);
1180 case Lisp_Misc_Objfwd
:
1181 strout (buf
, "#<objfwd to ", -1, printcharfun
);
1182 print (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
1186 case Lisp_Misc_Buffer_Objfwd
:
1187 strout (buf
, "#<buffer_objfwd to ", -1, printcharfun
);
1188 print (*(Lisp_Object
*)((char *)current_buffer
1189 + XBUFFER_OBJFWD (obj
)->offset
),
1190 printcharfun
, escapeflag
);
1194 case Lisp_Misc_Kboard_Objfwd
:
1195 strout (buf
, "#<kboard_objfwd to ", -1, printcharfun
);
1196 print (*(Lisp_Object
*)((char *) current_kboard
1197 + XKBOARD_OBJFWD (obj
)->offset
),
1198 printcharfun
, escapeflag
);
1202 case Lisp_Misc_Buffer_Local_Value
:
1203 strout ("#<buffer_local_value ", -1, printcharfun
);
1204 goto do_buffer_local
;
1205 case Lisp_Misc_Some_Buffer_Local_Value
:
1206 strout ("#<some_buffer_local_value ", -1, printcharfun
);
1208 strout ("[realvalue] ", -1, printcharfun
);
1209 print (XBUFFER_LOCAL_VALUE (obj
)->car
, printcharfun
, escapeflag
);
1210 strout ("[buffer] ", -1, printcharfun
);
1211 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->car
,
1212 printcharfun
, escapeflag
);
1213 strout ("[alist-elt] ", -1, printcharfun
);
1214 print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
)->car
,
1215 printcharfun
, escapeflag
);
1216 strout ("[default-value] ", -1, printcharfun
);
1217 print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
)->cdr
,
1218 printcharfun
, escapeflag
);
1226 #endif /* standalone */
1231 /* We're in trouble if this happens!
1232 Probably should just abort () */
1233 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, printcharfun
);
1235 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
1236 else if (VECTORLIKEP (obj
))
1237 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
1239 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
1240 strout (buf
, -1, printcharfun
);
1241 strout (" Save your buffers immediately and please report this bug>",
1249 #ifdef USE_TEXT_PROPERTIES
1251 /* Print a description of INTERVAL using PRINTCHARFUN.
1252 This is part of printing a string that has text properties. */
1255 print_interval (interval
, printcharfun
)
1257 Lisp_Object printcharfun
;
1260 print (make_number (interval
->position
), printcharfun
, 1);
1262 print (make_number (interval
->position
+ LENGTH (interval
)),
1265 print (interval
->plist
, printcharfun
, 1);
1268 #endif /* USE_TEXT_PROPERTIES */
1273 staticpro (&Qprint_escape_newlines
);
1274 Qprint_escape_newlines
= intern ("print-escape-newlines");
1276 DEFVAR_LISP ("standard-output", &Vstandard_output
,
1277 "Output stream `print' uses by default for outputting a character.\n\
1278 This may be any function of one argument.\n\
1279 It may also be a buffer (output is inserted before point)\n\
1280 or a marker (output is inserted and the marker is advanced)\n\
1281 or the symbol t (output appears in the echo area).");
1282 Vstandard_output
= Qt
;
1283 Qstandard_output
= intern ("standard-output");
1284 staticpro (&Qstandard_output
);
1286 #ifdef LISP_FLOAT_TYPE
1287 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
1288 "The format descriptor string used to print floats.\n\
1289 This is a %-spec like those accepted by `printf' in C,\n\
1290 but with some restrictions. It must start with the two characters `%.'.\n\
1291 After that comes an integer precision specification,\n\
1292 and then a letter which controls the format.\n\
1293 The letters allowed are `e', `f' and `g'.\n\
1294 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
1295 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
1296 Use `g' to choose the shorter of those two formats for the number at hand.\n\
1297 The precision in any of these cases is the number of digits following\n\
1298 the decimal point. With `f', a precision of 0 means to omit the\n\
1299 decimal point. 0 is not allowed with `e' or `g'.\n\n\
1300 A value of nil means to use `%.17g'.");
1301 Vfloat_output_format
= Qnil
;
1302 Qfloat_output_format
= intern ("float-output-format");
1303 staticpro (&Qfloat_output_format
);
1304 #endif /* LISP_FLOAT_TYPE */
1306 DEFVAR_LISP ("print-length", &Vprint_length
,
1307 "Maximum length of list to print before abbreviating.\n\
1308 A value of nil means no limit.");
1309 Vprint_length
= Qnil
;
1311 DEFVAR_LISP ("print-level", &Vprint_level
,
1312 "Maximum depth of list nesting to print before abbreviating.\n\
1313 A value of nil means no limit.");
1314 Vprint_level
= Qnil
;
1316 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
1317 "Non-nil means print newlines in strings as backslash-n.\n\
1318 Also print formfeeds as backslash-f.");
1319 print_escape_newlines
= 0;
1321 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
1322 staticpro (&Vprin1_to_string_buffer
);
1325 defsubr (&Sprin1_to_string
);
1326 defsubr (&Serror_message_string
);
1330 defsubr (&Swrite_char
);
1331 defsubr (&Sexternal_debugging_output
);
1333 Qexternal_debugging_output
= intern ("external-debugging-output");
1334 staticpro (&Qexternal_debugging_output
);
1337 defsubr (&Swith_output_to_temp_buffer
);
1338 #endif /* not standalone */