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
, 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
);
631 #ifdef LISP_FLOAT_TYPE
634 * The buffer should be at least as large as the max string size of the
635 * largest float, printed in the biggest notation. This is undoubtably
636 * 20d float_output_format, with the negative of the C-constant "HUGE"
639 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
641 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
642 * case of -1e307 in 20d float_output_format. What is one to do (short of
643 * re-writing _doprnt to be more sane)?
648 float_to_string (buf
, data
)
655 if (NILP (Vfloat_output_format
)
656 || !STRINGP (Vfloat_output_format
))
659 sprintf (buf
, "%.17g", data
);
664 /* Check that the spec we have is fully valid.
665 This means not only valid for printf,
666 but meant for floats, and reasonable. */
667 cp
= XSTRING (Vfloat_output_format
)->data
;
676 /* Check the width specification. */
678 if ('0' <= *cp
&& *cp
<= '9')
682 width
= (width
* 10) + (*cp
++ - '0');
683 while (*cp
>= '0' && *cp
<= '9');
685 /* A precision of zero is valid only for %f. */
687 || (width
== 0 && *cp
!= 'f'))
691 if (*cp
!= 'e' && *cp
!= 'f' && *cp
!= 'g')
697 sprintf (buf
, XSTRING (Vfloat_output_format
)->data
, data
);
700 /* Make sure there is a decimal point with digit after, or an
701 exponent, so that the value is readable as a float. But don't do
702 this with "%.0f"; it's valid for that not to produce a decimal
703 point. Note that width can be 0 only for %.0f. */
706 for (cp
= buf
; *cp
; cp
++)
707 if ((*cp
< '0' || *cp
> '9') && *cp
!= '-')
710 if (*cp
== '.' && cp
[1] == 0)
724 #endif /* LISP_FLOAT_TYPE */
727 print (obj
, printcharfun
, escapeflag
)
729 register Lisp_Object printcharfun
;
736 #if 1 /* I'm not sure this is really worth doing. */
737 /* Detect circularities and truncate them.
738 No need to offer any alternative--this is better than an error. */
739 if (CONSP (obj
) || VECTORP (obj
) || COMPILEDP (obj
))
742 for (i
= 0; i
< print_depth
; i
++)
743 if (EQ (obj
, being_printed
[i
]))
745 sprintf (buf
, "#%d", i
);
746 strout (buf
, -1, printcharfun
);
752 being_printed
[print_depth
] = obj
;
755 if (print_depth
> PRINT_CIRCLE
)
756 error ("Apparently circular structure being printed");
757 #ifdef MAX_PRINT_CHARS
758 if (max_print
&& print_chars
> max_print
)
763 #endif /* MAX_PRINT_CHARS */
765 switch (XGCTYPE (obj
))
768 if (sizeof (int) == sizeof (EMACS_INT
))
769 sprintf (buf
, "%d", XINT (obj
));
770 else if (sizeof (long) == sizeof (EMACS_INT
))
771 sprintf (buf
, "%ld", XINT (obj
));
774 strout (buf
, -1, printcharfun
);
777 #ifdef LISP_FLOAT_TYPE
780 char pigbuf
[350]; /* see comments in float_to_string */
782 float_to_string (pigbuf
, XFLOAT(obj
)->data
);
783 strout (pigbuf
, -1, printcharfun
);
790 print_string (obj
, printcharfun
);
794 register unsigned char c
;
799 #ifdef USE_TEXT_PROPERTIES
800 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
808 for (i
= 0; i
< XSTRING (obj
)->size
; i
++)
811 c
= XSTRING (obj
)->data
[i
];
812 if (c
== '\n' && print_escape_newlines
)
817 else if (c
== '\f' && print_escape_newlines
)
824 if (c
== '\"' || c
== '\\')
831 #ifdef USE_TEXT_PROPERTIES
832 if (!NULL_INTERVAL_P (XSTRING (obj
)->intervals
))
834 traverse_intervals (XSTRING (obj
)->intervals
,
835 0, 0, print_interval
, printcharfun
);
846 register int confusing
;
847 register unsigned char *p
= XSYMBOL (obj
)->name
->data
;
848 register unsigned char *end
= p
+ XSYMBOL (obj
)->name
->size
;
849 register unsigned char c
;
851 if (p
!= end
&& (*p
== '-' || *p
== '+')) p
++;
856 while (p
!= end
&& *p
>= '0' && *p
<= '9')
858 confusing
= (end
== p
);
861 p
= XSYMBOL (obj
)->name
->data
;
868 if (c
== '\"' || c
== '\\' || c
== '\'' || c
== ';' || c
== '#' ||
869 c
== '(' || c
== ')' || c
== ',' || c
=='.' || c
== '`' ||
870 c
== '[' || c
== ']' || c
== '?' || c
<= 040 || confusing
)
871 PRINTCHAR ('\\'), confusing
= 0;
879 /* If deeper than spec'd depth, print placeholder. */
880 if (INTEGERP (Vprint_level
)
881 && print_depth
> XINT (Vprint_level
))
882 strout ("...", -1, printcharfun
);
888 register int max
= 0;
890 if (INTEGERP (Vprint_length
))
891 max
= XINT (Vprint_length
);
892 /* Could recognize circularities in cdrs here,
893 but that would make printing of long lists quadratic.
894 It's not worth doing. */
901 strout ("...", 3, printcharfun
);
904 print (Fcar (obj
), printcharfun
, escapeflag
);
908 if (!NILP (obj
) && !CONSP (obj
))
910 strout (" . ", 3, printcharfun
);
911 print (obj
, printcharfun
, escapeflag
);
917 case Lisp_Vectorlike
:
922 strout ("#<process ", -1, printcharfun
);
923 print_string (XPROCESS (obj
)->name
, printcharfun
);
927 print_string (XPROCESS (obj
)->name
, printcharfun
);
929 else if (SUBRP (obj
))
931 strout ("#<subr ", -1, printcharfun
);
932 strout (XSUBR (obj
)->symbol_name
, -1, printcharfun
);
936 else if (WINDOWP (obj
))
938 strout ("#<window ", -1, printcharfun
);
939 sprintf (buf
, "%d", XFASTINT (XWINDOW (obj
)->sequence_number
));
940 strout (buf
, -1, printcharfun
);
941 if (!NILP (XWINDOW (obj
)->buffer
))
943 strout (" on ", -1, printcharfun
);
944 print_string (XBUFFER (XWINDOW (obj
)->buffer
)->name
, printcharfun
);
948 else if (BUFFERP (obj
))
950 if (NILP (XBUFFER (obj
)->name
))
951 strout ("#<killed buffer>", -1, printcharfun
);
954 strout ("#<buffer ", -1, printcharfun
);
955 print_string (XBUFFER (obj
)->name
, printcharfun
);
959 print_string (XBUFFER (obj
)->name
, printcharfun
);
961 else if (WINDOW_CONFIGURATIONP (obj
))
963 strout ("#<window-configuration>", -1, printcharfun
);
966 else if (FRAMEP (obj
))
968 strout ((FRAME_LIVE_P (XFRAME (obj
))
969 ? "#<frame " : "#<dead frame "),
971 print_string (XFRAME (obj
)->name
, printcharfun
);
972 sprintf (buf
, " 0x%lx", (unsigned long) (XFRAME (obj
)));
973 strout (buf
, -1, printcharfun
);
977 #endif /* not standalone */
980 int size
= XVECTOR (obj
)->size
;
984 size
&= PSEUDOVECTOR_SIZE_MASK
;
986 if (size
& PSEUDOVECTOR_FLAG
)
992 register Lisp_Object tem
;
993 for (i
= 0; i
< size
; i
++)
995 if (i
) PRINTCHAR (' ');
996 tem
= XVECTOR (obj
)->contents
[i
];
997 print (tem
, printcharfun
, escapeflag
);
1006 switch (XMISCTYPE (obj
))
1008 case Lisp_Misc_Marker
:
1009 strout ("#<marker ", -1, printcharfun
);
1010 if (!(XMARKER (obj
)->buffer
))
1011 strout ("in no buffer", -1, printcharfun
);
1014 sprintf (buf
, "at %d", marker_position (obj
));
1015 strout (buf
, -1, printcharfun
);
1016 strout (" in ", -1, printcharfun
);
1017 print_string (XMARKER (obj
)->buffer
->name
, printcharfun
);
1022 case Lisp_Misc_Overlay
:
1023 strout ("#<overlay ", -1, printcharfun
);
1024 if (!(XMARKER (OVERLAY_START (obj
))->buffer
))
1025 strout ("in no buffer", -1, printcharfun
);
1028 sprintf (buf
, "from %d to %d in ",
1029 marker_position (OVERLAY_START (obj
)),
1030 marker_position (OVERLAY_END (obj
)));
1031 strout (buf
, -1, printcharfun
);
1032 print_string (XMARKER (OVERLAY_START (obj
))->buffer
->name
,
1038 /* Remaining cases shouldn't happen in normal usage, but let's print
1039 them anyway for the benefit of the debugger. */
1040 case Lisp_Misc_Free
:
1041 strout ("#<misc free cell>", -1, printcharfun
);
1044 case Lisp_Misc_Intfwd
:
1045 sprintf (buf
, "#<intfwd to %d>", *XINTFWD (obj
)->intvar
);
1046 strout (buf
, -1, printcharfun
);
1049 case Lisp_Misc_Boolfwd
:
1050 sprintf (buf
, "#<boolfwd to %s>",
1051 (*XBOOLFWD (obj
)->boolvar
? "t" : "nil"));
1052 strout (buf
, -1, printcharfun
);
1055 case Lisp_Misc_Objfwd
:
1056 strout (buf
, "#<objfwd to ", -1, printcharfun
);
1057 print (*XOBJFWD (obj
)->objvar
, printcharfun
, escapeflag
);
1061 case Lisp_Misc_Buffer_Objfwd
:
1062 strout (buf
, "#<buffer_objfwd to ", -1, printcharfun
);
1063 print (*(Lisp_Object
*)((char *)current_buffer
1064 + XBUFFER_OBJFWD (obj
)->offset
),
1065 printcharfun
, escapeflag
);
1069 case Lisp_Misc_Kboard_Objfwd
:
1070 strout (buf
, "#<kboard_objfwd to ", -1, printcharfun
);
1071 print (*(Lisp_Object
*)((char *) current_kboard
1072 + XKBOARD_OBJFWD (obj
)->offset
),
1073 printcharfun
, escapeflag
);
1077 case Lisp_Misc_Buffer_Local_Value
:
1078 strout ("#<buffer_local_value ", -1, printcharfun
);
1079 goto do_buffer_local
;
1080 case Lisp_Misc_Some_Buffer_Local_Value
:
1081 strout ("#<some_buffer_local_value ", -1, printcharfun
);
1083 strout ("[realvalue] ", -1, printcharfun
);
1084 print (XBUFFER_LOCAL_VALUE (obj
)->car
, printcharfun
, escapeflag
);
1085 strout ("[buffer] ", -1, printcharfun
);
1086 print (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->car
,
1087 printcharfun
, escapeflag
);
1088 strout ("[alist-elt] ", -1, printcharfun
);
1089 print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
)->car
,
1090 printcharfun
, escapeflag
);
1091 strout ("[default-value] ", -1, printcharfun
);
1092 print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj
)->cdr
)->cdr
)->cdr
,
1093 printcharfun
, escapeflag
);
1101 #endif /* standalone */
1106 /* We're in trouble if this happens!
1107 Probably should just abort () */
1108 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, printcharfun
);
1110 sprintf (buf
, "(MISC 0x%04x)", (int) XMISCTYPE (obj
));
1111 else if (VECTORLIKEP (obj
))
1112 sprintf (buf
, "(PVEC 0x%08x)", (int) XVECTOR (obj
)->size
);
1114 sprintf (buf
, "(0x%02x)", (int) XTYPE (obj
));
1115 strout (buf
, -1, printcharfun
);
1116 strout (" Save your buffers immediately and please report this bug>",
1124 #ifdef USE_TEXT_PROPERTIES
1126 /* Print a description of INTERVAL using PRINTCHARFUN.
1127 This is part of printing a string that has text properties. */
1130 print_interval (interval
, printcharfun
)
1132 Lisp_Object printcharfun
;
1135 print (make_number (interval
->position
), printcharfun
, 1);
1137 print (make_number (interval
->position
+ LENGTH (interval
)),
1140 print (interval
->plist
, printcharfun
, 1);
1143 #endif /* USE_TEXT_PROPERTIES */
1148 staticpro (&Qprint_escape_newlines
);
1149 Qprint_escape_newlines
= intern ("print-escape-newlines");
1151 DEFVAR_LISP ("standard-output", &Vstandard_output
,
1152 "Output stream `print' uses by default for outputting a character.\n\
1153 This may be any function of one argument.\n\
1154 It may also be a buffer (output is inserted before point)\n\
1155 or a marker (output is inserted and the marker is advanced)\n\
1156 or the symbol t (output appears in the minibuffer line).");
1157 Vstandard_output
= Qt
;
1158 Qstandard_output
= intern ("standard-output");
1159 staticpro (&Qstandard_output
);
1161 #ifdef LISP_FLOAT_TYPE
1162 DEFVAR_LISP ("float-output-format", &Vfloat_output_format
,
1163 "The format descriptor string used to print floats.\n\
1164 This is a %-spec like those accepted by `printf' in C,\n\
1165 but with some restrictions. It must start with the two characters `%.'.\n\
1166 After that comes an integer precision specification,\n\
1167 and then a letter which controls the format.\n\
1168 The letters allowed are `e', `f' and `g'.\n\
1169 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"\n\
1170 Use `f' for decimal point notation \"DIGITS.DIGITS\".\n\
1171 Use `g' to choose the shorter of those two formats for the number at hand.\n\
1172 The precision in any of these cases is the number of digits following\n\
1173 the decimal point. With `f', a precision of 0 means to omit the\n\
1174 decimal point. 0 is not allowed with `e' or `g'.\n\n\
1175 A value of nil means to use `%.17g'.");
1176 Vfloat_output_format
= Qnil
;
1177 Qfloat_output_format
= intern ("float-output-format");
1178 staticpro (&Qfloat_output_format
);
1179 #endif /* LISP_FLOAT_TYPE */
1181 DEFVAR_LISP ("print-length", &Vprint_length
,
1182 "Maximum length of list to print before abbreviating.\n\
1183 A value of nil means no limit.");
1184 Vprint_length
= Qnil
;
1186 DEFVAR_LISP ("print-level", &Vprint_level
,
1187 "Maximum depth of list nesting to print before abbreviating.\n\
1188 A value of nil means no limit.");
1189 Vprint_level
= Qnil
;
1191 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines
,
1192 "Non-nil means print newlines in strings as backslash-n.\n\
1193 Also print formfeeds as backslash-f.");
1194 print_escape_newlines
= 0;
1196 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
1197 staticpro (&Vprin1_to_string_buffer
);
1200 defsubr (&Sprin1_to_string
);
1204 defsubr (&Swrite_char
);
1205 defsubr (&Sexternal_debugging_output
);
1207 Qexternal_debugging_output
= intern ("external-debugging-output");
1208 staticpro (&Qexternal_debugging_output
);
1211 defsubr (&Swith_output_to_temp_buffer
);
1212 #endif /* not standalone */