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, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, 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 in many cases,
298 because printing one char can relocate. */
300 print_string (string
, printcharfun
)
302 Lisp_Object printcharfun
;
304 if (EQ (printcharfun
, Qt
))
305 /* strout is safe for output to a frame (echo area). */
306 strout (XSTRING (string
)->data
, XSTRING (string
)->size
, printcharfun
);
307 else if (EQ (printcharfun
, Qnil
))
309 #ifdef MAX_PRINT_CHARS
311 print_chars
+= XSTRING (string
)->size
;
312 #endif /* MAX_PRINT_CHARS */
313 insert_from_string (string
, 0, XSTRING (string
)->size
, 1);
317 /* Otherwise, fetch the string address for each character. */
319 int size
= XSTRING (string
)->size
;
322 for (i
= 0; i
< size
; i
++)
323 PRINTCHAR (XSTRING (string
)->data
[i
]);
328 DEFUN ("write-char", Fwrite_char
, Swrite_char
, 1, 2, 0,
329 "Output character CHARACTER to stream PRINTCHARFUN.\n\
330 PRINTCHARFUN defaults to the value of `standard-output' (which see).")
331 (character
, printcharfun
)
332 Lisp_Object character
, printcharfun
;
334 struct buffer
*old
= current_buffer
;
337 Lisp_Object original
;
339 if (NILP (printcharfun
))
340 printcharfun
= Vstandard_output
;
341 CHECK_NUMBER (character
, 0);
343 PRINTCHAR (XINT (character
));
348 /* Used from outside of print.c to print a block of SIZE chars at DATA
349 on the default output stream.
350 Do not use this on the contents of a Lisp string. */
352 write_string (data
, size
)
356 struct buffer
*old
= current_buffer
;
357 Lisp_Object printcharfun
;
360 Lisp_Object original
;
362 printcharfun
= Vstandard_output
;
365 strout (data
, size
, printcharfun
);
369 /* Used from outside of print.c to print a block of SIZE chars at DATA
370 on a specified stream PRINTCHARFUN.
371 Do not use this on the contents of a Lisp string. */
373 write_string_1 (data
, size
, printcharfun
)
376 Lisp_Object printcharfun
;
378 struct buffer
*old
= current_buffer
;
381 Lisp_Object original
;
384 strout (data
, size
, printcharfun
);
392 temp_output_buffer_setup (bufname
)
395 register struct buffer
*old
= current_buffer
;
396 register Lisp_Object buf
;
398 Fset_buffer (Fget_buffer_create (build_string (bufname
)));
400 current_buffer
->directory
= old
->directory
;
401 current_buffer
->read_only
= Qnil
;
404 XSETBUFFER (buf
, current_buffer
);
405 specbind (Qstandard_output
, buf
);
407 set_buffer_internal (old
);
411 internal_with_output_to_temp_buffer (bufname
, function
, args
)
413 Lisp_Object (*function
) ();
416 int count
= specpdl_ptr
- specpdl
;
417 Lisp_Object buf
, val
;
421 record_unwind_protect (Fset_buffer
, Fcurrent_buffer ());
422 temp_output_buffer_setup (bufname
);
423 buf
= Vstandard_output
;
426 val
= (*function
) (args
);
429 temp_output_buffer_show (buf
);
432 return unbind_to (count
, val
);
435 DEFUN ("with-output-to-temp-buffer", Fwith_output_to_temp_buffer
, Swith_output_to_temp_buffer
,
437 "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.\n\
438 The buffer is cleared out initially, and marked as unmodified when done.\n\
439 All output done by BODY is inserted in that buffer by default.\n\
440 The buffer is displayed in another window, but not selected.\n\
441 The value of the last form in BODY is returned.\n\
442 If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\n\
443 If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
444 to get the buffer displayed. It gets one argument, the buffer to display.")
450 int count
= specpdl_ptr
- specpdl
;
451 Lisp_Object buf
, val
;
454 name
= Feval (Fcar (args
));
457 CHECK_STRING (name
, 0);
458 temp_output_buffer_setup (XSTRING (name
)->data
);
459 buf
= Vstandard_output
;
461 val
= Fprogn (Fcdr (args
));
463 temp_output_buffer_show (buf
);
465 return unbind_to (count
, val
);
467 #endif /* not standalone */
469 static void print ();
471 DEFUN ("terpri", Fterpri
, Sterpri
, 0, 1, 0,
472 "Output a newline to stream PRINTCHARFUN.\n\
473 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.")
475 Lisp_Object printcharfun
;
477 struct buffer
*old
= current_buffer
;
480 Lisp_Object original
;
482 if (NILP (printcharfun
))
483 printcharfun
= Vstandard_output
;
490 DEFUN ("prin1", Fprin1
, Sprin1
, 1, 2, 0,
491 "Output the printed representation of OBJECT, any Lisp object.\n\
492 Quoting characters are printed when needed to make output that `read'\n\
493 can handle, whenever this is possible.\n\
494 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
495 (object
, printcharfun
)
496 Lisp_Object object
, printcharfun
;
498 struct buffer
*old
= current_buffer
;
501 Lisp_Object original
;
503 #ifdef MAX_PRINT_CHARS
505 #endif /* MAX_PRINT_CHARS */
506 if (NILP (printcharfun
))
507 printcharfun
= Vstandard_output
;
510 print (object
, printcharfun
, 1);
515 /* a buffer which is used to hold output being built by prin1-to-string */
516 Lisp_Object Vprin1_to_string_buffer
;
518 DEFUN ("prin1-to-string", Fprin1_to_string
, Sprin1_to_string
, 1, 2, 0,
519 "Return a string containing the printed representation of OBJECT,\n\
520 any Lisp object. Quoting characters are used when needed to make output\n\
521 that `read' can handle, whenever this is possible, unless the optional\n\
522 second argument NOESCAPE is non-nil.")
524 Lisp_Object object
, noescape
;
526 struct buffer
*old
= current_buffer
;
529 Lisp_Object original
, printcharfun
;
532 printcharfun
= Vprin1_to_string_buffer
;
535 print (object
, printcharfun
, NILP (noescape
));
536 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
538 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
539 object
= Fbuffer_string ();
543 set_buffer_internal (old
);
549 DEFUN ("princ", Fprinc
, Sprinc
, 1, 2, 0,
550 "Output the printed representation of OBJECT, any Lisp object.\n\
551 No quoting characters are used; no delimiters are printed around\n\
552 the contents of strings.\n\
553 Output stream is PRINTCHARFUN, or value of standard-output (which see).")
554 (object
, printcharfun
)
555 Lisp_Object object
, printcharfun
;
557 struct buffer
*old
= current_buffer
;
560 Lisp_Object original
;
562 if (NILP (printcharfun
))
563 printcharfun
= Vstandard_output
;
566 print (object
, printcharfun
, 0);
571 DEFUN ("print", Fprint
, Sprint
, 1, 2, 0,
572 "Output the printed representation of OBJECT, with newlines around it.\n\
573 Quoting characters are printed when needed to make output that `read'\n\
574 can handle, whenever this is possible.\n\
575 Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
576 (object
, printcharfun
)
577 Lisp_Object object
, printcharfun
;
579 struct buffer
*old
= current_buffer
;
582 Lisp_Object original
;
585 #ifdef MAX_PRINT_CHARS
587 max_print
= MAX_PRINT_CHARS
;
588 #endif /* MAX_PRINT_CHARS */
589 if (NILP (printcharfun
))
590 printcharfun
= Vstandard_output
;
595 print (object
, printcharfun
, 1);
598 #ifdef MAX_PRINT_CHARS
601 #endif /* MAX_PRINT_CHARS */
606 /* The subroutine object for external-debugging-output is kept here
607 for the convenience of the debugger. */
608 Lisp_Object Qexternal_debugging_output
;
610 DEFUN ("external-debugging-output", Fexternal_debugging_output
, Sexternal_debugging_output
, 1, 1, 0,
611 "Write CHARACTER to stderr.\n\
612 You can call print while debugging emacs, and pass it this function\n\
613 to make it write to the debugging output.\n")
615 Lisp_Object character
;
617 CHECK_NUMBER (character
, 0);
618 putc (XINT (character
), stderr
);
623 /* This is the interface for debugging printing. */
629 Fprin1 (arg
, Qexternal_debugging_output
);
630 fprintf (stderr
, "\r\n");
633 DEFUN ("error-message-string", Ferror_message_string
, Serror_message_string
,
635 "Convert an error value (ERROR-SYMBOL . DATA) to an error message.")
639 struct buffer
*old
= current_buffer
;
640 Lisp_Object original
, printcharfun
, value
;
643 print_error_message (obj
, Vprin1_to_string_buffer
, NULL
);
645 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
646 value
= Fbuffer_string ();
650 set_buffer_internal (old
);
656 /* Print an error message for the error DATA
657 onto Lisp output stream STREAM (suitable for the print functions). */
659 print_error_message (data
, stream
)
660 Lisp_Object data
, stream
;
662 Lisp_Object errname
, errmsg
, file_error
, tail
;
666 errname
= Fcar (data
);
668 if (EQ (errname
, Qerror
))
671 if (!CONSP (data
)) data
= Qnil
;
672 errmsg
= Fcar (data
);
677 errmsg
= Fget (errname
, Qerror_message
);
678 file_error
= Fmemq (Qfile_error
,
679 Fget (errname
, Qerror_conditions
));
682 /* Print an error message including the data items. */
684 tail
= Fcdr_safe (data
);
687 /* For file-error, make error message by concatenating
688 all the data items. They are all strings. */
689 if (!NILP (file_error
) && !NILP (tail
))
690 errmsg
= XCONS (tail
)->car
, tail
= XCONS (tail
)->cdr
;
692 if (STRINGP (errmsg
))
693 Fprinc (errmsg
, stream
);
695 write_string_1 ("peculiar error", -1, stream
);
697 for (i
= 0; CONSP (tail
); tail
= Fcdr (tail
), i
++)
699 write_string_1 (i
? ", " : ": ", 2, stream
);
700 if (!NILP (file_error
))
701 Fprinc (Fcar (tail
), stream
);
703 Fprin1 (Fcar (tail
), stream
);
708 #ifdef LISP_FLOAT_TYPE
711 * The buffer should be at least as large as the max string size of the
712 * largest float, printed in the biggest notation. This is undoubtedly
713 * 20d float_output_format, with the negative of the C-constant "HUGE"
716 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
718 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
719 * case of -1e307 in 20d float_output_format. What is one to do (short of
720 * re-writing _doprnt to be more sane)?
725 float_to_string (buf
, data
)
732 if (NILP (Vfloat_output_format
)
733 || !STRINGP (Vfloat_output_format
))
736 sprintf (buf
, "%.17g", data
);
741 /* Check that the spec we have is fully valid.
742 This means not only valid for printf,
743 but meant for floats, and reasonable. */
744 cp
= XSTRING (Vfloat_output_format
)->data
;
753 /* Check the width specification. */
755 if ('0' <= *cp
&& *cp
<= '9')
759 width
= (width
* 10) + (*cp
++ - '0');
760 while (*cp
>= '0' && *cp
<= '9');
762 /* A precision of zero is valid only for %f. */
764 || (width
== 0 && *cp
!= 'f'))
768 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
774 sprintf (buf
, XSTRING (Vfloat_output_format
)->data
, data
);
777 /* Make sure there is a decimal point with digit after, or an
778 exponent, so that the value is readable as a float. But don't do
779 this with "%.0f"; it's valid for that not to produce a decimal
780 point. Note that width can be 0 only for %.0f. */
783 for (cp
= buf
; *cp
; cp
++)
784 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
787 if (*cp
== '.' && cp
[1] == 0)
801 #endif /* LISP_FLOAT_TYPE */
804 print (obj
, printcharfun
, escapeflag
)
806 register Lisp_Object printcharfun
;
813 #if 1 /* I'm not sure this is really worth doing. */
814 /* Detect circularities and truncate them.
815 No need to offer any alternative--this is better than an error. */
816 if (CONSP (obj
) || VECTORP (obj
) || COMPILEDP (obj
))
819 for (i
= 0; i
< print_depth
; i
++)
820 if (EQ (obj
, being_printed
[i
]))
822 sprintf (buf
, "#%d", i
);
823 strout (buf
, -1, printcharfun
);
829 being_printed
[print_depth
] = obj
;
832 if (print_depth
> PRINT_CIRCLE
)
833 error ("Apparently circular structure being printed");
834 #ifdef MAX_PRINT_CHARS
835 if (max_print
&& print_chars
> max_print
)
840 #endif /* MAX_PRINT_CHARS */
842 switch (XGCTYPE (obj
))
845 if (sizeof (int) == sizeof (EMACS_INT
))
846 sprintf (buf
, "%d", XINT (obj
));
847 else if (sizeof (long) == sizeof (EMACS_INT
))
848 sprintf (buf
, "%ld", XINT (obj
));
851 strout (buf
, -1, printcharfun
);
854 #ifdef LISP_FLOAT_TYPE
857 char pigbuf
[350]; /* see comments in float_to_string */
859 float_to_string (pigbuf
, XFLOAT(obj
)->data
);
860 strout (pigbuf
, -1, printcharfun
);
867 print_string (obj
, printcharfun
);
871 register unsigned char c
;
876 #ifdef USE_TEXT_PROPERTIES
877 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
885 for (i
= 0; i
< XSTRING (obj
)->size
; i
++)
888 c
= XSTRING (obj
)->data
[i
];
889 if (c
== '\n' && print_escape_newlines
)
894 else if (c
== '\f' && print_escape_newlines
)
901 if (c
== '\"' || c
== '\\')
908 #ifdef USE_TEXT_PROPERTIES
909 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
911 traverse_intervals (XSTRING (obj
)->intervals
,
912 0, 0, print_interval
, printcharfun
);
923 register int confusing
;
924 register unsigned char *p
= XSYMBOL (obj
)->name
->data
;
925 register unsigned char *end
= p
+ XSYMBOL (obj
)->name
->size
;
926 register unsigned char c
;
928 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
933 while (p
!= end
&& *p
>= '0' && *p
<= '9')
935 confusing
= (end
== p
);
938 p
= XSYMBOL (obj
)->name
->data
;
945 if (c
== '\"' || c
== '\\' || c
== '\'' || c
== ';' || c
== '#' ||
946 c
== '(' || c
== ')' || c
== ',' || c
=='.' || c
== '`' ||
947 c
== '[' || c
== ']' || c
== '?' || c
<= 040 || confusing
)
948 PRINTCHAR ('\\'), confusing
= 0;
956 /* If deeper than spec'd depth, print placeholder. */
957 if (INTEGERP (Vprint_level
)
958 && print_depth
> XINT (Vprint_level
))
959 strout ("...", -1, printcharfun
);
965 register int max
= 0;
967 if (INTEGERP (Vprint_length
))
968 max
= XINT (Vprint_length
);
969 /* Could recognize circularities in cdrs here,
970 but that would make printing of long lists quadratic.
971 It's not worth doing. */
978 strout ("...", 3, printcharfun
);
981 print (Fcar (obj
), printcharfun
, escapeflag
);
985 if (!NILP (obj
) && !CONSP (obj
))
987 strout (" . ", 3, printcharfun
);
988 print (obj
, printcharfun
, escapeflag
);
994 case Lisp_Vectorlike
:
999 strout ("#<process ", -1, printcharfun
);
1000 print_string (XPROCESS (obj
)->name
, printcharfun
);
1004 print_string (XPROCESS (obj
)->name
, printcharfun
);
1006 else if (BOOL_VECTOR_P (obj
))
1009 register unsigned char c
;
1010 struct gcpro gcpro1
;
1012 = (XBOOL_VECTOR (obj
)->size
+ BITS_PER_CHAR
) / BITS_PER_CHAR
;
1018 sprintf (buf
, "%d", XBOOL_VECTOR (obj
)->size
);
1019 strout (buf
, -1, printcharfun
);
1021 for (i
= 0; i
< size_in_chars
; i
++)
1024 c
= XBOOL_VECTOR (obj
)->data
[i
];
1025 if (c
== '\n' && print_escape_newlines
)
1030 else if (c
== '\f' && print_escape_newlines
)
1037 if (c
== '\"' || c
== '\\')
1046 else if (SUBRP (obj
))
1048 strout ("#<subr ", -1, printcharfun
);
1049 strout (XSUBR (obj
)->symbol_name
, -1, printcharfun
);
1053 else if (WINDOWP (obj
))
1055 strout ("#<window ", -1, printcharfun
);
1056 sprintf (buf
, "%d", XFASTINT (XWINDOW (obj
)->sequence_number
));
1057 strout (buf
, -1, printcharfun
);
1058 if (!NILP (XWINDOW (obj
)->buffer
))
1060 strout (" on ", -1, printcharfun
);
1061 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
1065 else if (BUFFERP (obj
))
1067 if (NILP (XBUFFER (obj
)->name
))
1068 strout ("#<killed buffer>", -1, printcharfun
);
1069 else if (escapeflag
)
1071 strout ("#<buffer ", -1, printcharfun
);
1072 print_string (XBUFFER (obj
)->name
, printcharfun
);
1076 print_string (XBUFFER (obj
)->name
, printcharfun
);
1078 else if (WINDOW_CONFIGURATIONP (obj
))
1080 strout ("#<window-configuration>", -1, printcharfun
);
1083 else if (FRAMEP (obj
))
1085 strout ((FRAME_LIVE_P (XFRAME (obj
))
1086 ? "#<frame " : "#<dead frame "),
1088 print_string (XFRAME (obj
)->name
, printcharfun
);
1089 sprintf (buf
, " 0x%lx", (unsigned long) (XFRAME (obj
)));
1090 strout (buf
, -1, printcharfun
);
1094 #endif /* not standalone */
1097 int size
= XVECTOR (obj
)->size
;
1098 if (COMPILEDP (obj
))
1101 size
&= PSEUDOVECTOR_SIZE_MASK
;
1103 if (CHAR_TABLE_P (obj
))
1105 /* We print a char-table as if it were a vector,
1106 lumping the parent and default slots in with the
1107 character slots. But we add #^ as a prefix. */
1110 size
&= PSEUDOVECTOR_SIZE_MASK
;
1112 if (size
& PSEUDOVECTOR_FLAG
)
1118 register Lisp_Object tem
;
1119 for (i
= 0; i
< size
; i
++)
1121 if (i
) PRINTCHAR (' ');
1122 tem
= XVECTOR (obj
)->contents
[i
];
1123 print (tem
, printcharfun
, escapeflag
);
1132 switch (XMISCTYPE (obj
))
1134 case Lisp_Misc_Marker
:
1135 strout ("#<marker ", -1, printcharfun
);
1136 if (!(XMARKER (obj
)->buffer
))
1137 strout ("in no buffer", -1, printcharfun
);
1140 sprintf (buf
, "at %d", marker_position (obj
));
1141 strout (buf
, -1, printcharfun
);
1142 strout (" in ", -1, printcharfun
);
1143 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
1148 case Lisp_Misc_Overlay
:
1149 strout ("#<overlay ", -1, printcharfun
);
1150 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
1151 strout ("in no buffer", -1, printcharfun
);
1154 sprintf (buf
, "from %d to %d in ",
1155 marker_position (OVERLAY_START (obj
)),
1156 marker_position (OVERLAY_END (obj
)));
1157 strout (buf
, -1, printcharfun
);
1158 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
1164 /* Remaining cases shouldn't happen in normal usage, but let's print
1165 them anyway for the benefit of the debugger. */
1166 case Lisp_Misc_Free
:
1167 strout ("#<misc free cell>", -1, printcharfun
);
1170 case Lisp_Misc_Intfwd
:
1171 sprintf (buf
, "#<intfwd to %d>", *XINTFWD (obj
)->intvar
);
1172 strout (buf
, -1, printcharfun
);
1175 case Lisp_Misc_Boolfwd
:
1176 sprintf (buf
, "#<boolfwd to %s>",
1177 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
1178 strout (buf
, -1, printcharfun
);
1181 case Lisp_Misc_Objfwd
:
1182 strout (buf
, "#<objfwd to ", -1, printcharfun
);
1183 print (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
1187 case Lisp_Misc_Buffer_Objfwd
:
1188 strout (buf
, "#<buffer_objfwd to ", -1, printcharfun
);
1189 print (*(Lisp_Object
*)((char *)current_buffer
1190 + XBUFFER_OBJFWD (obj
)->offset
),
1191 printcharfun
, escapeflag
);
1195 case Lisp_Misc_Kboard_Objfwd
:
1196 strout (buf
, "#<kboard_objfwd to ", -1, printcharfun
);
1197 print (*(Lisp_Object
*)((char *) current_kboard
1198 + XKBOARD_OBJFWD (obj
)->offset
),
1199 printcharfun
, escapeflag
);
1203 case Lisp_Misc_Buffer_Local_Value
:
1204 strout ("#<buffer_local_value ", -1, printcharfun
);
1205 goto do_buffer_local
;
1206 case Lisp_Misc_Some_Buffer_Local_Value
:
1207 strout ("#<some_buffer_local_value ", -1, printcharfun
);
1209 strout ("[realvalue] ", -1, printcharfun
);
1210 print (XBUFFER_LOCAL_VALUE (obj
)->car
, printcharfun
, escapeflag
);
1211 strout ("[buffer] ", -1, printcharfun
);
1212 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->car
,
1213 printcharfun
, escapeflag
);
1214 strout ("[alist-elt] ", -1, printcharfun
);
1215 print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
)->car
,
1216 printcharfun
, escapeflag
);
1217 strout ("[default-value] ", -1, printcharfun
);
1218 print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
)->cdr
,
1219 printcharfun
, escapeflag
);
1227 #endif /* standalone */
1232 /* We're in trouble if this happens!
1233 Probably should just abort () */
1234 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, printcharfun
);
1236 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
1237 else if (VECTORLIKEP (obj
))
1238 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
1240 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
1241 strout (buf
, -1, printcharfun
);
1242 strout (" Save your buffers immediately and please report this bug>",
1250 #ifdef USE_TEXT_PROPERTIES
1252 /* Print a description of INTERVAL using PRINTCHARFUN.
1253 This is part of printing a string that has text properties. */
1256 print_interval (interval
, printcharfun
)
1258 Lisp_Object printcharfun
;
1261 print (make_number (interval
->position
), printcharfun
, 1);
1263 print (make_number (interval
->position
+ LENGTH (interval
)),
1266 print (interval
->plist
, printcharfun
, 1);
1269 #endif /* USE_TEXT_PROPERTIES */
1274 staticpro (&Qprint_escape_newlines
);
1275 Qprint_escape_newlines
= intern ("print-escape-newlines");
1277 DEFVAR_LISP ("standard-output", &Vstandard_output
,
1278 "Output stream `print' uses by default for outputting a character.\n\
1279 This may be any function of one argument.\n\
1280 It may also be a buffer (output is inserted before point)\n\
1281 or a marker (output is inserted and the marker is advanced)\n\
1282 or the symbol t (output appears in the echo area).");
1283 Vstandard_output
= Qt
;
1284 Qstandard_output
= intern ("standard-output");
1285 staticpro (&Qstandard_output
);
1287 #ifdef LISP_FLOAT_TYPE
1288 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
1289 "The format descriptor string used to print floats.\n\
1290 This is a %-spec like those accepted by `printf' in C,\n\
1291 but with some restrictions. It must start with the two characters `%.'.\n\
1292 After that comes an integer precision specification,\n\
1293 and then a letter which controls the format.\n\
1294 The letters allowed are `e', `f' and `g'.\n\
1295 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
1296 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
1297 Use `g' to choose the shorter of those two formats for the number at hand.\n\
1298 The precision in any of these cases is the number of digits following\n\
1299 the decimal point. With `f', a precision of 0 means to omit the\n\
1300 decimal point. 0 is not allowed with `e' or `g'.\n\n\
1301 A value of nil means to use `%.17g'.");
1302 Vfloat_output_format
= Qnil
;
1303 Qfloat_output_format
= intern ("float-output-format");
1304 staticpro (&Qfloat_output_format
);
1305 #endif /* LISP_FLOAT_TYPE */
1307 DEFVAR_LISP ("print-length", &Vprint_length
,
1308 "Maximum length of list to print before abbreviating.\n\
1309 A value of nil means no limit.");
1310 Vprint_length
= Qnil
;
1312 DEFVAR_LISP ("print-level", &Vprint_level
,
1313 "Maximum depth of list nesting to print before abbreviating.\n\
1314 A value of nil means no limit.");
1315 Vprint_level
= Qnil
;
1317 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
1318 "Non-nil means print newlines in strings as backslash-n.\n\
1319 Also print formfeeds as backslash-f.");
1320 print_escape_newlines
= 0;
1322 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
1323 staticpro (&Vprin1_to_string_buffer
);
1326 defsubr (&Sprin1_to_string
);
1327 defsubr (&Serror_message_string
);
1331 defsubr (&Swrite_char
);
1332 defsubr (&Sexternal_debugging_output
);
1334 Qexternal_debugging_output
= intern ("external-debugging-output");
1335 staticpro (&Qexternal_debugging_output
);
1338 defsubr (&Swith_output_to_temp_buffer
);
1339 #endif /* not standalone */