(gud-menu-map): Put gud-finish back on the
[emacs.git] / src / print.c
blobd563580ddd3d4bb75a37fdb007fb29d257a268ed
1 /* Lisp object printing and output streams.
2 Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997,
3 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
11 any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
24 #include <config.h>
25 #include <stdio.h>
26 #include "lisp.h"
27 #include "buffer.h"
28 #include "charset.h"
29 #include "keyboard.h"
30 #include "frame.h"
31 #include "window.h"
32 #include "process.h"
33 #include "dispextern.h"
34 #include "termchar.h"
35 #include "intervals.h"
37 Lisp_Object Vstandard_output, Qstandard_output;
39 Lisp_Object Qtemp_buffer_setup_hook;
41 /* These are used to print like we read. */
42 extern Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
44 Lisp_Object Vfloat_output_format, Qfloat_output_format;
46 /* Work around a problem that happens because math.h on hpux 7
47 defines two static variables--which, in Emacs, are not really static,
48 because `static' is defined as nothing. The problem is that they are
49 defined both here and in lread.c.
50 These macros prevent the name conflict. */
51 #if defined (HPUX) && !defined (HPUX8)
52 #define _MAXLDBL print_maxldbl
53 #define _NMAXLDBL print_nmaxldbl
54 #endif
56 #include <math.h>
58 #if STDC_HEADERS
59 #include <float.h>
60 #endif
62 /* Default to values appropriate for IEEE floating point. */
63 #ifndef FLT_RADIX
64 #define FLT_RADIX 2
65 #endif
66 #ifndef DBL_MANT_DIG
67 #define DBL_MANT_DIG 53
68 #endif
69 #ifndef DBL_DIG
70 #define DBL_DIG 15
71 #endif
72 #ifndef DBL_MIN
73 #define DBL_MIN 2.2250738585072014e-308
74 #endif
76 #ifdef DBL_MIN_REPLACEMENT
77 #undef DBL_MIN
78 #define DBL_MIN DBL_MIN_REPLACEMENT
79 #endif
81 /* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits
82 needed to express a float without losing information.
83 The general-case formula is valid for the usual case, IEEE floating point,
84 but many compilers can't optimize the formula to an integer constant,
85 so make a special case for it. */
86 #if FLT_RADIX == 2 && DBL_MANT_DIG == 53
87 #define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */
88 #else
89 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
90 #endif
92 /* Avoid actual stack overflow in print. */
93 int print_depth;
95 /* Nonzero if inside outputting backquote in old style. */
96 int old_backquote_output;
98 /* Detect most circularities to print finite output. */
99 #define PRINT_CIRCLE 200
100 Lisp_Object being_printed[PRINT_CIRCLE];
102 /* When printing into a buffer, first we put the text in this
103 block, then insert it all at once. */
104 char *print_buffer;
106 /* Size allocated in print_buffer. */
107 int print_buffer_size;
108 /* Chars stored in print_buffer. */
109 int print_buffer_pos;
110 /* Bytes stored in print_buffer. */
111 int print_buffer_pos_byte;
113 /* Maximum length of list to print in full; noninteger means
114 effectively infinity */
116 Lisp_Object Vprint_length;
118 /* Maximum depth of list to print in full; noninteger means
119 effectively infinity. */
121 Lisp_Object Vprint_level;
123 /* Nonzero means print newlines in strings as \n. */
125 int print_escape_newlines;
127 /* Nonzero means to print single-byte non-ascii characters in strings as
128 octal escapes. */
130 int print_escape_nonascii;
132 /* Nonzero means to print multibyte characters in strings as hex escapes. */
134 int print_escape_multibyte;
136 Lisp_Object Qprint_escape_newlines;
137 Lisp_Object Qprint_escape_multibyte, Qprint_escape_nonascii;
139 /* Nonzero means print (quote foo) forms as 'foo, etc. */
141 int print_quoted;
143 /* Non-nil means print #: before uninterned symbols. */
145 Lisp_Object Vprint_gensym;
147 /* Non-nil means print recursive structures using #n= and #n# syntax. */
149 Lisp_Object Vprint_circle;
151 /* Non-nil means keep continuous number for #n= and #n# syntax
152 between several print functions. */
154 Lisp_Object Vprint_continuous_numbering;
156 /* Vprint_number_table is a vector like [OBJ1 STAT1 OBJ2 STAT2 ...],
157 where OBJn are objects going to be printed, and STATn are their status,
158 which may be different meanings during process. See the comments of
159 the functions print and print_preprocess for details.
160 print_number_index keeps the last position the next object should be added,
161 twice of which is the actual vector position in Vprint_number_table. */
162 int print_number_index;
163 Lisp_Object Vprint_number_table;
165 /* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table TABLE.
166 PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE.
167 See the comment of the variable Vprint_number_table. */
168 #define PRINT_NUMBER_OBJECT(table,i) XVECTOR ((table))->contents[(i) * 2]
169 #define PRINT_NUMBER_STATUS(table,i) XVECTOR ((table))->contents[(i) * 2 + 1]
171 /* Nonzero means print newline to stdout before next minibuffer message.
172 Defined in xdisp.c */
174 extern int noninteractive_need_newline;
176 extern int minibuffer_auto_raise;
178 #ifdef MAX_PRINT_CHARS
179 static int print_chars;
180 static int max_print;
181 #endif /* MAX_PRINT_CHARS */
183 void print_interval ();
186 /* Low level output routines for characters and strings */
188 /* Lisp functions to do output using a stream
189 must have the stream in a variable called printcharfun
190 and must start with PRINTPREPARE, end with PRINTFINISH,
191 and use PRINTDECLARE to declare common variables.
192 Use PRINTCHAR to output one character,
193 or call strout to output a block of characters. */
195 #define PRINTDECLARE \
196 struct buffer *old = current_buffer; \
197 int old_point = -1, start_point = -1; \
198 int old_point_byte = -1, start_point_byte = -1; \
199 int specpdl_count = SPECPDL_INDEX (); \
200 int free_print_buffer = 0; \
201 int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
202 Lisp_Object original
204 #define PRINTPREPARE \
205 original = printcharfun; \
206 if (NILP (printcharfun)) printcharfun = Qt; \
207 if (BUFFERP (printcharfun)) \
209 if (XBUFFER (printcharfun) != current_buffer) \
210 Fset_buffer (printcharfun); \
211 printcharfun = Qnil; \
213 if (MARKERP (printcharfun)) \
215 EMACS_INT marker_pos; \
216 if (!(XMARKER (printcharfun)->buffer)) \
217 error ("Marker does not point anywhere"); \
218 if (XMARKER (printcharfun)->buffer != current_buffer) \
219 set_buffer_internal (XMARKER (printcharfun)->buffer); \
220 marker_pos = marker_position (printcharfun); \
221 if (marker_pos < BEGV || marker_pos > ZV) \
222 error ("Marker is outside the accessible part of the buffer"); \
223 old_point = PT; \
224 old_point_byte = PT_BYTE; \
225 SET_PT_BOTH (marker_pos, \
226 marker_byte_position (printcharfun)); \
227 start_point = PT; \
228 start_point_byte = PT_BYTE; \
229 printcharfun = Qnil; \
231 if (NILP (printcharfun)) \
233 Lisp_Object string; \
234 if (NILP (current_buffer->enable_multibyte_characters) \
235 && ! print_escape_multibyte) \
236 specbind (Qprint_escape_multibyte, Qt); \
237 if (! NILP (current_buffer->enable_multibyte_characters) \
238 && ! print_escape_nonascii) \
239 specbind (Qprint_escape_nonascii, Qt); \
240 if (print_buffer != 0) \
242 string = make_string_from_bytes (print_buffer, \
243 print_buffer_pos, \
244 print_buffer_pos_byte); \
245 record_unwind_protect (print_unwind, string); \
247 else \
249 print_buffer_size = 1000; \
250 print_buffer = (char *) xmalloc (print_buffer_size); \
251 free_print_buffer = 1; \
253 print_buffer_pos = 0; \
254 print_buffer_pos_byte = 0; \
256 if (EQ (printcharfun, Qt) && ! noninteractive) \
257 setup_echo_area_for_printing (multibyte);
259 #define PRINTFINISH \
260 if (NILP (printcharfun)) \
262 if (print_buffer_pos != print_buffer_pos_byte \
263 && NILP (current_buffer->enable_multibyte_characters)) \
265 unsigned char *temp \
266 = (unsigned char *) alloca (print_buffer_pos + 1); \
267 copy_text (print_buffer, temp, print_buffer_pos_byte, \
268 1, 0); \
269 insert_1_both (temp, print_buffer_pos, \
270 print_buffer_pos, 0, 1, 0); \
272 else \
273 insert_1_both (print_buffer, print_buffer_pos, \
274 print_buffer_pos_byte, 0, 1, 0); \
276 if (free_print_buffer) \
278 xfree (print_buffer); \
279 print_buffer = 0; \
281 unbind_to (specpdl_count, Qnil); \
282 if (MARKERP (original)) \
283 set_marker_both (original, Qnil, PT, PT_BYTE); \
284 if (old_point >= 0) \
285 SET_PT_BOTH (old_point + (old_point >= start_point \
286 ? PT - start_point : 0), \
287 old_point_byte + (old_point_byte >= start_point_byte \
288 ? PT_BYTE - start_point_byte : 0)); \
289 if (old != current_buffer) \
290 set_buffer_internal (old);
292 #define PRINTCHAR(ch) printchar (ch, printcharfun)
294 /* This is used to restore the saved contents of print_buffer
295 when there is a recursive call to print. */
297 static Lisp_Object
298 print_unwind (saved_text)
299 Lisp_Object saved_text;
301 bcopy (SDATA (saved_text), print_buffer, SCHARS (saved_text));
302 return Qnil;
306 /* Print character CH using method FUN. FUN nil means print to
307 print_buffer. FUN t means print to echo area or stdout if
308 non-interactive. If FUN is neither nil nor t, call FUN with CH as
309 argument. */
311 static void
312 printchar (ch, fun)
313 unsigned int ch;
314 Lisp_Object fun;
316 #ifdef MAX_PRINT_CHARS
317 if (max_print)
318 print_chars++;
319 #endif /* MAX_PRINT_CHARS */
321 if (!NILP (fun) && !EQ (fun, Qt))
322 call1 (fun, make_number (ch));
323 else
325 unsigned char str[MAX_MULTIBYTE_LENGTH];
326 int len = CHAR_STRING (ch, str);
328 QUIT;
330 if (NILP (fun))
332 if (print_buffer_pos_byte + len >= print_buffer_size)
333 print_buffer = (char *) xrealloc (print_buffer,
334 print_buffer_size *= 2);
335 bcopy (str, print_buffer + print_buffer_pos_byte, len);
336 print_buffer_pos += 1;
337 print_buffer_pos_byte += len;
339 else if (noninteractive)
341 fwrite (str, 1, len, stdout);
342 noninteractive_need_newline = 1;
344 else
346 int multibyte_p
347 = !NILP (current_buffer->enable_multibyte_characters);
349 setup_echo_area_for_printing (multibyte_p);
350 insert_char (ch);
351 message_dolog (str, len, 0, multibyte_p);
357 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
358 method PRINTCHARFUN. If SIZE < 0, use the string length of PTR for
359 both SIZE and SIZE_BYTE. PRINTCHARFUN nil means output to
360 print_buffer. PRINTCHARFUN t means output to the echo area or to
361 stdout if non-interactive. If neither nil nor t, call Lisp
362 function PRINTCHARFUN for each character printed. MULTIBYTE
363 non-zero means PTR contains multibyte characters. */
365 static void
366 strout (ptr, size, size_byte, printcharfun, multibyte)
367 char *ptr;
368 int size, size_byte;
369 Lisp_Object printcharfun;
370 int multibyte;
372 if (size < 0)
373 size_byte = size = strlen (ptr);
375 if (NILP (printcharfun))
377 if (print_buffer_pos_byte + size_byte > print_buffer_size)
379 print_buffer_size = print_buffer_size * 2 + size_byte;
380 print_buffer = (char *) xrealloc (print_buffer,
381 print_buffer_size);
383 bcopy (ptr, print_buffer + print_buffer_pos_byte, size_byte);
384 print_buffer_pos += size;
385 print_buffer_pos_byte += size_byte;
387 #ifdef MAX_PRINT_CHARS
388 if (max_print)
389 print_chars += size;
390 #endif /* MAX_PRINT_CHARS */
392 else if (noninteractive && EQ (printcharfun, Qt))
394 fwrite (ptr, 1, size_byte, stdout);
395 noninteractive_need_newline = 1;
397 else if (EQ (printcharfun, Qt))
399 /* Output to echo area. We're trying to avoid a little overhead
400 here, that's the reason we don't call printchar to do the
401 job. */
402 int i;
403 int multibyte_p
404 = !NILP (current_buffer->enable_multibyte_characters);
406 setup_echo_area_for_printing (multibyte_p);
407 message_dolog (ptr, size_byte, 0, multibyte_p);
409 if (size == size_byte)
411 for (i = 0; i < size; ++i)
412 insert_char ((unsigned char )*ptr++);
414 else
416 int len;
417 for (i = 0; i < size_byte; i += len)
419 int ch = STRING_CHAR_AND_LENGTH (ptr + i, size_byte - i, len);
420 insert_char (ch);
424 #ifdef MAX_PRINT_CHARS
425 if (max_print)
426 print_chars += size;
427 #endif /* MAX_PRINT_CHARS */
429 else
431 /* PRINTCHARFUN is a Lisp function. */
432 int i = 0;
434 if (size == size_byte)
436 while (i < size_byte)
438 int ch = ptr[i++];
439 PRINTCHAR (ch);
442 else
444 while (i < size_byte)
446 /* Here, we must convert each multi-byte form to the
447 corresponding character code before handing it to
448 PRINTCHAR. */
449 int len;
450 int ch = STRING_CHAR_AND_LENGTH (ptr + i, size_byte - i, len);
451 PRINTCHAR (ch);
452 i += len;
458 /* Print the contents of a string STRING using PRINTCHARFUN.
459 It isn't safe to use strout in many cases,
460 because printing one char can relocate. */
462 static void
463 print_string (string, printcharfun)
464 Lisp_Object string;
465 Lisp_Object printcharfun;
467 if (EQ (printcharfun, Qt) || NILP (printcharfun))
469 int chars;
471 if (STRING_MULTIBYTE (string))
472 chars = SCHARS (string);
473 else if (EQ (printcharfun, Qt)
474 ? ! NILP (buffer_defaults.enable_multibyte_characters)
475 : ! NILP (current_buffer->enable_multibyte_characters))
477 /* If unibyte string STRING contains 8-bit codes, we must
478 convert STRING to a multibyte string containing the same
479 character codes. */
480 Lisp_Object newstr;
481 int bytes;
483 chars = SBYTES (string);
484 bytes = parse_str_to_multibyte (SDATA (string), chars);
485 if (chars < bytes)
487 newstr = make_uninit_multibyte_string (chars, bytes);
488 bcopy (SDATA (string), SDATA (newstr), chars);
489 str_to_multibyte (SDATA (newstr), bytes, chars);
490 string = newstr;
493 else
494 chars = SBYTES (string);
496 /* strout is safe for output to a frame (echo area) or to print_buffer. */
497 strout (SDATA (string),
498 chars, SBYTES (string),
499 printcharfun, STRING_MULTIBYTE (string));
501 else
503 /* Otherwise, string may be relocated by printing one char.
504 So re-fetch the string address for each character. */
505 int i;
506 int size = SCHARS (string);
507 int size_byte = SBYTES (string);
508 struct gcpro gcpro1;
509 GCPRO1 (string);
510 if (size == size_byte)
511 for (i = 0; i < size; i++)
512 PRINTCHAR (SREF (string, i));
513 else
514 for (i = 0; i < size_byte; )
516 /* Here, we must convert each multi-byte form to the
517 corresponding character code before handing it to PRINTCHAR. */
518 int len;
519 int ch = STRING_CHAR_AND_LENGTH (SDATA (string) + i,
520 size_byte - i, len);
521 if (!CHAR_VALID_P (ch, 0))
523 ch = SREF (string, i);
524 len = 1;
526 PRINTCHAR (ch);
527 i += len;
529 UNGCPRO;
533 DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0,
534 doc: /* Output character CHARACTER to stream PRINTCHARFUN.
535 PRINTCHARFUN defaults to the value of `standard-output' (which see). */)
536 (character, printcharfun)
537 Lisp_Object character, printcharfun;
539 PRINTDECLARE;
541 if (NILP (printcharfun))
542 printcharfun = Vstandard_output;
543 CHECK_NUMBER (character);
544 PRINTPREPARE;
545 PRINTCHAR (XINT (character));
546 PRINTFINISH;
547 return character;
550 /* Used from outside of print.c to print a block of SIZE
551 single-byte chars at DATA on the default output stream.
552 Do not use this on the contents of a Lisp string. */
554 void
555 write_string (data, size)
556 char *data;
557 int size;
559 PRINTDECLARE;
560 Lisp_Object printcharfun;
562 printcharfun = Vstandard_output;
564 PRINTPREPARE;
565 strout (data, size, size, printcharfun, 0);
566 PRINTFINISH;
569 /* Used from outside of print.c to print a block of SIZE
570 single-byte chars at DATA on a specified stream PRINTCHARFUN.
571 Do not use this on the contents of a Lisp string. */
573 void
574 write_string_1 (data, size, printcharfun)
575 char *data;
576 int size;
577 Lisp_Object printcharfun;
579 PRINTDECLARE;
581 PRINTPREPARE;
582 strout (data, size, size, printcharfun, 0);
583 PRINTFINISH;
587 void
588 temp_output_buffer_setup (bufname)
589 const char *bufname;
591 int count = SPECPDL_INDEX ();
592 register struct buffer *old = current_buffer;
593 register Lisp_Object buf;
595 record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
597 Fset_buffer (Fget_buffer_create (build_string (bufname)));
599 Fkill_all_local_variables ();
600 delete_all_overlays (current_buffer);
601 current_buffer->directory = old->directory;
602 current_buffer->read_only = Qnil;
603 current_buffer->filename = Qnil;
604 current_buffer->undo_list = Qt;
605 eassert (current_buffer->overlays_before == NULL);
606 eassert (current_buffer->overlays_after == NULL);
607 current_buffer->enable_multibyte_characters
608 = buffer_defaults.enable_multibyte_characters;
609 specbind (Qinhibit_read_only, Qt);
610 specbind (Qinhibit_modification_hooks, Qt);
611 Ferase_buffer ();
612 XSETBUFFER (buf, current_buffer);
614 Frun_hooks (1, &Qtemp_buffer_setup_hook);
616 unbind_to (count, Qnil);
618 specbind (Qstandard_output, buf);
621 Lisp_Object
622 internal_with_output_to_temp_buffer (bufname, function, args)
623 const char *bufname;
624 Lisp_Object (*function) P_ ((Lisp_Object));
625 Lisp_Object args;
627 int count = SPECPDL_INDEX ();
628 Lisp_Object buf, val;
629 struct gcpro gcpro1;
631 GCPRO1 (args);
632 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
633 temp_output_buffer_setup (bufname);
634 buf = Vstandard_output;
635 UNGCPRO;
637 val = (*function) (args);
639 GCPRO1 (val);
640 temp_output_buffer_show (buf);
641 UNGCPRO;
643 return unbind_to (count, val);
646 DEFUN ("with-output-to-temp-buffer",
647 Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer,
648 1, UNEVALLED, 0,
649 doc: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
650 The buffer is cleared out initially, and marked as unmodified when done.
651 All output done by BODY is inserted in that buffer by default.
652 The buffer is displayed in another window, but not selected.
653 The value of the last form in BODY is returned.
654 If BODY does not finish normally, the buffer BUFNAME is not displayed.
656 The hook `temp-buffer-setup-hook' is run before BODY,
657 with the buffer BUFNAME temporarily current.
658 The hook `temp-buffer-show-hook' is run after the buffer is displayed,
659 with the buffer temporarily current, and the window that was used
660 to display it temporarily selected.
662 If variable `temp-buffer-show-function' is non-nil, call it at the end
663 to get the buffer displayed instead of just displaying the non-selected
664 buffer and calling the hook. It gets one argument, the buffer to display.
666 usage: (with-output-to-temp-buffer BUFNAME BODY ...) */)
667 (args)
668 Lisp_Object args;
670 struct gcpro gcpro1;
671 Lisp_Object name;
672 int count = SPECPDL_INDEX ();
673 Lisp_Object buf, val;
675 GCPRO1(args);
676 name = Feval (Fcar (args));
677 CHECK_STRING (name);
678 temp_output_buffer_setup (SDATA (name));
679 buf = Vstandard_output;
680 UNGCPRO;
682 val = Fprogn (XCDR (args));
684 GCPRO1 (val);
685 temp_output_buffer_show (buf);
686 UNGCPRO;
688 return unbind_to (count, val);
692 static void print ();
693 static void print_preprocess ();
694 static void print_preprocess_string ();
695 static void print_object ();
697 DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
698 doc: /* Output a newline to stream PRINTCHARFUN.
699 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
700 (printcharfun)
701 Lisp_Object printcharfun;
703 PRINTDECLARE;
705 if (NILP (printcharfun))
706 printcharfun = Vstandard_output;
707 PRINTPREPARE;
708 PRINTCHAR ('\n');
709 PRINTFINISH;
710 return Qt;
713 DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0,
714 doc: /* Output the printed representation of OBJECT, any Lisp object.
715 Quoting characters are printed when needed to make output that `read'
716 can handle, whenever this is possible. For complex objects, the behavior
717 is controlled by `print-level' and `print-length', which see.
719 OBJECT is any of the Lisp data types: a number, a string, a symbol,
720 a list, a buffer, a window, a frame, etc.
722 A printed representation of an object is text which describes that object.
724 Optional argument PRINTCHARFUN is the output stream, which can be one
725 of these:
727 - a buffer, in which case output is inserted into that buffer at point;
728 - a marker, in which case output is inserted at marker's position;
729 - a function, in which case that function is called once for each
730 character of OBJECT's printed representation;
731 - a symbol, in which case that symbol's function definition is called; or
732 - t, in which case the output is displayed in the echo area.
734 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
735 is used instead. */)
736 (object, printcharfun)
737 Lisp_Object object, printcharfun;
739 PRINTDECLARE;
741 #ifdef MAX_PRINT_CHARS
742 max_print = 0;
743 #endif /* MAX_PRINT_CHARS */
744 if (NILP (printcharfun))
745 printcharfun = Vstandard_output;
746 PRINTPREPARE;
747 print (object, printcharfun, 1);
748 PRINTFINISH;
749 return object;
752 /* a buffer which is used to hold output being built by prin1-to-string */
753 Lisp_Object Vprin1_to_string_buffer;
755 DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0,
756 doc: /* Return a string containing the printed representation of OBJECT.
757 OBJECT can be any Lisp object. This function outputs quoting characters
758 when necessary to make output that `read' can handle, whenever possible,
759 unless the optional second argument NOESCAPE is non-nil.
761 OBJECT is any of the Lisp data types: a number, a string, a symbol,
762 a list, a buffer, a window, a frame, etc.
764 A printed representation of an object is text which describes that object. */)
765 (object, noescape)
766 Lisp_Object object, noescape;
768 Lisp_Object printcharfun;
769 /* struct gcpro gcpro1, gcpro2; */
770 Lisp_Object save_deactivate_mark;
771 int count = specpdl_ptr - specpdl;
772 struct buffer *previous;
774 specbind (Qinhibit_modification_hooks, Qt);
777 PRINTDECLARE;
779 /* Save and restore this--we are altering a buffer
780 but we don't want to deactivate the mark just for that.
781 No need for specbind, since errors deactivate the mark. */
782 save_deactivate_mark = Vdeactivate_mark;
783 /* GCPRO2 (object, save_deactivate_mark); */
784 abort_on_gc++;
786 printcharfun = Vprin1_to_string_buffer;
787 PRINTPREPARE;
788 print (object, printcharfun, NILP (noescape));
789 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
790 PRINTFINISH;
793 previous = current_buffer;
794 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
795 object = Fbuffer_string ();
796 if (SBYTES (object) == SCHARS (object))
797 STRING_SET_UNIBYTE (object);
799 /* Note that this won't make prepare_to_modify_buffer call
800 ask-user-about-supersession-threat because this buffer
801 does not visit a file. */
802 Ferase_buffer ();
803 set_buffer_internal (previous);
805 Vdeactivate_mark = save_deactivate_mark;
806 /* UNGCPRO; */
808 abort_on_gc--;
809 return unbind_to (count, object);
812 DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
813 doc: /* Output the printed representation of OBJECT, any Lisp object.
814 No quoting characters are used; no delimiters are printed around
815 the contents of strings.
817 OBJECT is any of the Lisp data types: a number, a string, a symbol,
818 a list, a buffer, a window, a frame, etc.
820 A printed representation of an object is text which describes that object.
822 Optional argument PRINTCHARFUN is the output stream, which can be one
823 of these:
825 - a buffer, in which case output is inserted into that buffer at point;
826 - a marker, in which case output is inserted at marker's position;
827 - a function, in which case that function is called once for each
828 character of OBJECT's printed representation;
829 - a symbol, in which case that symbol's function definition is called; or
830 - t, in which case the output is displayed in the echo area.
832 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
833 is used instead. */)
834 (object, printcharfun)
835 Lisp_Object object, printcharfun;
837 PRINTDECLARE;
839 if (NILP (printcharfun))
840 printcharfun = Vstandard_output;
841 PRINTPREPARE;
842 print (object, printcharfun, 0);
843 PRINTFINISH;
844 return object;
847 DEFUN ("print", Fprint, Sprint, 1, 2, 0,
848 doc: /* Output the printed representation of OBJECT, with newlines around it.
849 Quoting characters are printed when needed to make output that `read'
850 can handle, whenever this is possible. For complex objects, the behavior
851 is controlled by `print-level' and `print-length', which see.
853 OBJECT is any of the Lisp data types: a number, a string, a symbol,
854 a list, a buffer, a window, a frame, etc.
856 A printed representation of an object is text which describes that object.
858 Optional argument PRINTCHARFUN is the output stream, which can be one
859 of these:
861 - a buffer, in which case output is inserted into that buffer at point;
862 - a marker, in which case output is inserted at marker's position;
863 - a function, in which case that function is called once for each
864 character of OBJECT's printed representation;
865 - a symbol, in which case that symbol's function definition is called; or
866 - t, in which case the output is displayed in the echo area.
868 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
869 is used instead. */)
870 (object, printcharfun)
871 Lisp_Object object, printcharfun;
873 PRINTDECLARE;
874 struct gcpro gcpro1;
876 #ifdef MAX_PRINT_CHARS
877 print_chars = 0;
878 max_print = MAX_PRINT_CHARS;
879 #endif /* MAX_PRINT_CHARS */
880 if (NILP (printcharfun))
881 printcharfun = Vstandard_output;
882 GCPRO1 (object);
883 PRINTPREPARE;
884 PRINTCHAR ('\n');
885 print (object, printcharfun, 1);
886 PRINTCHAR ('\n');
887 PRINTFINISH;
888 #ifdef MAX_PRINT_CHARS
889 max_print = 0;
890 print_chars = 0;
891 #endif /* MAX_PRINT_CHARS */
892 UNGCPRO;
893 return object;
896 /* The subroutine object for external-debugging-output is kept here
897 for the convenience of the debugger. */
898 Lisp_Object Qexternal_debugging_output;
900 DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0,
901 doc: /* Write CHARACTER to stderr.
902 You can call print while debugging emacs, and pass it this function
903 to make it write to the debugging output. */)
904 (character)
905 Lisp_Object character;
907 CHECK_NUMBER (character);
908 putc (XINT (character), stderr);
910 #ifdef WINDOWSNT
911 /* Send the output to a debugger (nothing happens if there isn't one). */
913 char buf[2] = {(char) XINT (character), '\0'};
914 OutputDebugString (buf);
916 #endif
918 return character;
922 #if defined(GNU_LINUX)
924 /* This functionality is not vitally important in general, so we rely on
925 non-portable ability to use stderr as lvalue. */
927 #define WITH_REDIRECT_DEBUGGING_OUTPUT 1
929 FILE *initial_stderr_stream = NULL;
931 DEFUN ("redirect-debugging-output", Fredirect_debugging_output, Sredirect_debugging_output,
932 1, 2,
933 "FDebug output file: \nP",
934 doc: /* Redirect debugging output (stderr stream) to file FILE.
935 If FILE is nil, reset target to the initial stderr stream.
936 Optional arg APPEND non-nil (interactively, with prefix arg) means
937 append to existing target file. */)
938 (file, append)
939 Lisp_Object file, append;
941 if (initial_stderr_stream != NULL)
942 fclose(stderr);
943 stderr = initial_stderr_stream;
944 initial_stderr_stream = NULL;
946 if (STRINGP (file))
948 file = Fexpand_file_name (file, Qnil);
949 initial_stderr_stream = stderr;
950 stderr = fopen(SDATA (file), NILP (append) ? "w" : "a");
951 if (stderr == NULL)
953 stderr = initial_stderr_stream;
954 initial_stderr_stream = NULL;
955 report_file_error ("Cannot open debugging output stream",
956 Fcons (file, Qnil));
959 return Qnil;
961 #endif /* GNU_LINUX */
964 /* This is the interface for debugging printing. */
966 void
967 debug_print (arg)
968 Lisp_Object arg;
970 Fprin1 (arg, Qexternal_debugging_output);
971 fprintf (stderr, "\r\n");
974 void
975 safe_debug_print (arg)
976 Lisp_Object arg;
978 int valid = valid_lisp_object_p (arg);
980 if (valid > 0)
981 debug_print (arg);
982 else
983 fprintf (stderr, "#<%s_LISP_OBJECT 0x%08lx>\r\n",
984 !valid ? "INVALID" : "SOME",
985 #ifdef NO_UNION_TYPE
986 (unsigned long) arg
987 #else
988 (unsigned long) arg.i
989 #endif
994 DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
995 1, 1, 0,
996 doc: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
997 See Info anchor `(elisp)Definition of signal' for some details on how this
998 error message is constructed. */)
999 (obj)
1000 Lisp_Object obj;
1002 struct buffer *old = current_buffer;
1003 Lisp_Object value;
1004 struct gcpro gcpro1;
1006 /* If OBJ is (error STRING), just return STRING.
1007 That is not only faster, it also avoids the need to allocate
1008 space here when the error is due to memory full. */
1009 if (CONSP (obj) && EQ (XCAR (obj), Qerror)
1010 && CONSP (XCDR (obj))
1011 && STRINGP (XCAR (XCDR (obj)))
1012 && NILP (XCDR (XCDR (obj))))
1013 return XCAR (XCDR (obj));
1015 print_error_message (obj, Vprin1_to_string_buffer, 0, Qnil);
1017 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
1018 value = Fbuffer_string ();
1020 GCPRO1 (value);
1021 Ferase_buffer ();
1022 set_buffer_internal (old);
1023 UNGCPRO;
1025 return value;
1028 /* Print an error message for the error DATA onto Lisp output stream
1029 STREAM (suitable for the print functions). */
1031 void
1032 print_error_message (data, stream, context, caller)
1033 Lisp_Object data, stream;
1034 char *context;
1035 Lisp_Object caller;
1037 Lisp_Object errname, errmsg, file_error, tail;
1038 struct gcpro gcpro1;
1039 int i;
1041 if (context != 0)
1042 write_string_1 (context, -1, stream);
1044 /* If we know from where the error was signaled, show it in
1045 *Messages*. */
1046 if (!NILP (caller) && SYMBOLP (caller))
1048 Lisp_Object cname = SYMBOL_NAME (caller);
1049 char *name = alloca (SBYTES (cname));
1050 bcopy (SDATA (cname), name, SBYTES (cname));
1051 message_dolog (name, SBYTES (cname), 0, 0);
1052 message_dolog (": ", 2, 0, 0);
1055 errname = Fcar (data);
1057 if (EQ (errname, Qerror))
1059 data = Fcdr (data);
1060 if (!CONSP (data))
1061 data = Qnil;
1062 errmsg = Fcar (data);
1063 file_error = Qnil;
1065 else
1067 Lisp_Object error_conditions;
1068 errmsg = Fget (errname, Qerror_message);
1069 error_conditions = Fget (errname, Qerror_conditions);
1070 file_error = Fmemq (Qfile_error, error_conditions);
1073 /* Print an error message including the data items. */
1075 tail = Fcdr_safe (data);
1076 GCPRO1 (tail);
1078 /* For file-error, make error message by concatenating
1079 all the data items. They are all strings. */
1080 if (!NILP (file_error) && CONSP (tail))
1081 errmsg = XCAR (tail), tail = XCDR (tail);
1083 if (STRINGP (errmsg))
1084 Fprinc (errmsg, stream);
1085 else
1086 write_string_1 ("peculiar error", -1, stream);
1088 for (i = 0; CONSP (tail); tail = XCDR (tail), i++)
1090 Lisp_Object obj;
1092 write_string_1 (i ? ", " : ": ", 2, stream);
1093 obj = XCAR (tail);
1094 if (!NILP (file_error) || EQ (errname, Qend_of_file))
1095 Fprinc (obj, stream);
1096 else
1097 Fprin1 (obj, stream);
1100 UNGCPRO;
1106 * The buffer should be at least as large as the max string size of the
1107 * largest float, printed in the biggest notation. This is undoubtedly
1108 * 20d float_output_format, with the negative of the C-constant "HUGE"
1109 * from <math.h>.
1111 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1113 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1114 * case of -1e307 in 20d float_output_format. What is one to do (short of
1115 * re-writing _doprnt to be more sane)?
1116 * -wsr
1119 void
1120 float_to_string (buf, data)
1121 unsigned char *buf;
1122 double data;
1124 unsigned char *cp;
1125 int width;
1127 /* Check for plus infinity in a way that won't lose
1128 if there is no plus infinity. */
1129 if (data == data / 2 && data > 1.0)
1131 strcpy (buf, "1.0e+INF");
1132 return;
1134 /* Likewise for minus infinity. */
1135 if (data == data / 2 && data < -1.0)
1137 strcpy (buf, "-1.0e+INF");
1138 return;
1140 /* Check for NaN in a way that won't fail if there are no NaNs. */
1141 if (! (data * 0.0 >= 0.0))
1143 /* Prepend "-" if the NaN's sign bit is negative.
1144 The sign bit of a double is the bit that is 1 in -0.0. */
1145 int i;
1146 union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
1147 u_data.d = data;
1148 u_minus_zero.d = - 0.0;
1149 for (i = 0; i < sizeof (double); i++)
1150 if (u_data.c[i] & u_minus_zero.c[i])
1152 *buf++ = '-';
1153 break;
1156 strcpy (buf, "0.0e+NaN");
1157 return;
1160 if (NILP (Vfloat_output_format)
1161 || !STRINGP (Vfloat_output_format))
1162 lose:
1164 /* Generate the fewest number of digits that represent the
1165 floating point value without losing information.
1166 The following method is simple but a bit slow.
1167 For ideas about speeding things up, please see:
1169 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1170 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1172 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1173 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1175 width = fabs (data) < DBL_MIN ? 1 : DBL_DIG;
1177 sprintf (buf, "%.*g", width, data);
1178 while (width++ < DOUBLE_DIGITS_BOUND && atof (buf) != data);
1180 else /* oink oink */
1182 /* Check that the spec we have is fully valid.
1183 This means not only valid for printf,
1184 but meant for floats, and reasonable. */
1185 cp = SDATA (Vfloat_output_format);
1187 if (cp[0] != '%')
1188 goto lose;
1189 if (cp[1] != '.')
1190 goto lose;
1192 cp += 2;
1194 /* Check the width specification. */
1195 width = -1;
1196 if ('0' <= *cp && *cp <= '9')
1198 width = 0;
1200 width = (width * 10) + (*cp++ - '0');
1201 while (*cp >= '0' && *cp <= '9');
1203 /* A precision of zero is valid only for %f. */
1204 if (width > DBL_DIG
1205 || (width == 0 && *cp != 'f'))
1206 goto lose;
1209 if (*cp != 'e' && *cp != 'f' && *cp != 'g')
1210 goto lose;
1212 if (cp[1] != 0)
1213 goto lose;
1215 sprintf (buf, SDATA (Vfloat_output_format), data);
1218 /* Make sure there is a decimal point with digit after, or an
1219 exponent, so that the value is readable as a float. But don't do
1220 this with "%.0f"; it's valid for that not to produce a decimal
1221 point. Note that width can be 0 only for %.0f. */
1222 if (width != 0)
1224 for (cp = buf; *cp; cp++)
1225 if ((*cp < '0' || *cp > '9') && *cp != '-')
1226 break;
1228 if (*cp == '.' && cp[1] == 0)
1230 cp[1] = '0';
1231 cp[2] = 0;
1234 if (*cp == 0)
1236 *cp++ = '.';
1237 *cp++ = '0';
1238 *cp++ = 0;
1244 static void
1245 print (obj, printcharfun, escapeflag)
1246 Lisp_Object obj;
1247 register Lisp_Object printcharfun;
1248 int escapeflag;
1250 old_backquote_output = 0;
1252 /* Reset print_number_index and Vprint_number_table only when
1253 the variable Vprint_continuous_numbering is nil. Otherwise,
1254 the values of these variables will be kept between several
1255 print functions. */
1256 if (NILP (Vprint_continuous_numbering))
1258 print_number_index = 0;
1259 Vprint_number_table = Qnil;
1262 /* Construct Vprint_number_table for print-gensym and print-circle. */
1263 if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))
1265 int i, start, index;
1266 start = index = print_number_index;
1267 /* Construct Vprint_number_table.
1268 This increments print_number_index for the objects added. */
1269 print_depth = 0;
1270 print_preprocess (obj);
1272 /* Remove unnecessary objects, which appear only once in OBJ;
1273 that is, whose status is Qnil. Compactify the necessary objects. */
1274 for (i = start; i < print_number_index; i++)
1275 if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1277 PRINT_NUMBER_OBJECT (Vprint_number_table, index)
1278 = PRINT_NUMBER_OBJECT (Vprint_number_table, i);
1279 index++;
1282 /* Clear out objects outside the active part of the table. */
1283 for (i = index; i < print_number_index; i++)
1284 PRINT_NUMBER_OBJECT (Vprint_number_table, i) = Qnil;
1286 /* Reset the status field for the next print step. Now this
1287 field means whether the object has already been printed. */
1288 for (i = start; i < print_number_index; i++)
1289 PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qnil;
1291 print_number_index = index;
1294 print_depth = 0;
1295 print_object (obj, printcharfun, escapeflag);
1298 /* Construct Vprint_number_table according to the structure of OBJ.
1299 OBJ itself and all its elements will be added to Vprint_number_table
1300 recursively if it is a list, vector, compiled function, char-table,
1301 string (its text properties will be traced), or a symbol that has
1302 no obarray (this is for the print-gensym feature).
1303 The status fields of Vprint_number_table mean whether each object appears
1304 more than once in OBJ: Qnil at the first time, and Qt after that . */
1305 static void
1306 print_preprocess (obj)
1307 Lisp_Object obj;
1309 int i;
1310 EMACS_INT size;
1311 int loop_count = 0;
1312 Lisp_Object halftail;
1314 /* Give up if we go so deep that print_object will get an error. */
1315 /* See similar code in print_object. */
1316 if (print_depth >= PRINT_CIRCLE)
1317 return;
1319 /* Avoid infinite recursion for circular nested structure
1320 in the case where Vprint_circle is nil. */
1321 if (NILP (Vprint_circle))
1323 for (i = 0; i < print_depth; i++)
1324 if (EQ (obj, being_printed[i]))
1325 return;
1326 being_printed[print_depth] = obj;
1329 print_depth++;
1330 halftail = obj;
1332 loop:
1333 if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
1334 || COMPILEDP (obj) || CHAR_TABLE_P (obj)
1335 || (! NILP (Vprint_gensym)
1336 && SYMBOLP (obj)
1337 && !SYMBOL_INTERNED_P (obj)))
1339 /* In case print-circle is nil and print-gensym is t,
1340 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1341 if (! NILP (Vprint_circle) || SYMBOLP (obj))
1343 for (i = 0; i < print_number_index; i++)
1344 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj))
1346 /* OBJ appears more than once. Let's remember that. */
1347 PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
1348 return;
1351 /* OBJ is not yet recorded. Let's add to the table. */
1352 if (print_number_index == 0)
1354 /* Initialize the table. */
1355 Vprint_number_table = Fmake_vector (make_number (40), Qnil);
1357 else if (XVECTOR (Vprint_number_table)->size == print_number_index * 2)
1359 /* Reallocate the table. */
1360 int i = print_number_index * 4;
1361 Lisp_Object old_table = Vprint_number_table;
1362 Vprint_number_table = Fmake_vector (make_number (i), Qnil);
1363 for (i = 0; i < print_number_index; i++)
1365 PRINT_NUMBER_OBJECT (Vprint_number_table, i)
1366 = PRINT_NUMBER_OBJECT (old_table, i);
1367 PRINT_NUMBER_STATUS (Vprint_number_table, i)
1368 = PRINT_NUMBER_STATUS (old_table, i);
1371 PRINT_NUMBER_OBJECT (Vprint_number_table, print_number_index) = obj;
1372 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1373 always print the gensym with a number. This is a special for
1374 the lisp function byte-compile-output-docform. */
1375 if (!NILP (Vprint_continuous_numbering)
1376 && SYMBOLP (obj)
1377 && !SYMBOL_INTERNED_P (obj))
1378 PRINT_NUMBER_STATUS (Vprint_number_table, print_number_index) = Qt;
1379 print_number_index++;
1382 switch (XGCTYPE (obj))
1384 case Lisp_String:
1385 /* A string may have text properties, which can be circular. */
1386 traverse_intervals_noorder (STRING_INTERVALS (obj),
1387 print_preprocess_string, Qnil);
1388 break;
1390 case Lisp_Cons:
1391 /* Use HALFTAIL and LOOP_COUNT to detect circular lists,
1392 just as in print_object. */
1393 if (loop_count && EQ (obj, halftail))
1394 break;
1395 print_preprocess (XCAR (obj));
1396 obj = XCDR (obj);
1397 loop_count++;
1398 if (!(loop_count & 1))
1399 halftail = XCDR (halftail);
1400 goto loop;
1402 case Lisp_Vectorlike:
1403 size = XVECTOR (obj)->size;
1404 if (size & PSEUDOVECTOR_FLAG)
1405 size &= PSEUDOVECTOR_SIZE_MASK;
1406 for (i = 0; i < size; i++)
1407 print_preprocess (XVECTOR (obj)->contents[i]);
1408 break;
1410 default:
1411 break;
1414 print_depth--;
1417 static void
1418 print_preprocess_string (interval, arg)
1419 INTERVAL interval;
1420 Lisp_Object arg;
1422 print_preprocess (interval->plist);
1425 static void
1426 print_object (obj, printcharfun, escapeflag)
1427 Lisp_Object obj;
1428 register Lisp_Object printcharfun;
1429 int escapeflag;
1431 char buf[40];
1433 QUIT;
1435 /* Detect circularities and truncate them. */
1436 if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
1437 || COMPILEDP (obj) || CHAR_TABLE_P (obj)
1438 || (! NILP (Vprint_gensym)
1439 && SYMBOLP (obj)
1440 && !SYMBOL_INTERNED_P (obj)))
1442 if (NILP (Vprint_circle) && NILP (Vprint_gensym))
1444 /* Simple but incomplete way. */
1445 int i;
1446 for (i = 0; i < print_depth; i++)
1447 if (EQ (obj, being_printed[i]))
1449 sprintf (buf, "#%d", i);
1450 strout (buf, -1, -1, printcharfun, 0);
1451 return;
1453 being_printed[print_depth] = obj;
1455 else
1457 /* With the print-circle feature. */
1458 int i;
1459 for (i = 0; i < print_number_index; i++)
1460 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj))
1462 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1464 /* Add a prefix #n= if OBJ has not yet been printed;
1465 that is, its status field is nil. */
1466 sprintf (buf, "#%d=", i + 1);
1467 strout (buf, -1, -1, printcharfun, 0);
1468 /* OBJ is going to be printed. Set the status to t. */
1469 PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
1470 break;
1472 else
1474 /* Just print #n# if OBJ has already been printed. */
1475 sprintf (buf, "#%d#", i + 1);
1476 strout (buf, -1, -1, printcharfun, 0);
1477 return;
1483 print_depth++;
1485 /* See similar code in print_preprocess. */
1486 if (print_depth > PRINT_CIRCLE)
1487 error ("Apparently circular structure being printed");
1488 #ifdef MAX_PRINT_CHARS
1489 if (max_print && print_chars > max_print)
1491 PRINTCHAR ('\n');
1492 print_chars = 0;
1494 #endif /* MAX_PRINT_CHARS */
1496 switch (XGCTYPE (obj))
1498 case Lisp_Int:
1499 if (sizeof (int) == sizeof (EMACS_INT))
1500 sprintf (buf, "%d", XINT (obj));
1501 else if (sizeof (long) == sizeof (EMACS_INT))
1502 sprintf (buf, "%ld", (long) XINT (obj));
1503 else
1504 abort ();
1505 strout (buf, -1, -1, printcharfun, 0);
1506 break;
1508 case Lisp_Float:
1510 char pigbuf[350]; /* see comments in float_to_string */
1512 float_to_string (pigbuf, XFLOAT_DATA (obj));
1513 strout (pigbuf, -1, -1, printcharfun, 0);
1515 break;
1517 case Lisp_String:
1518 if (!escapeflag)
1519 print_string (obj, printcharfun);
1520 else
1522 register int i, i_byte;
1523 struct gcpro gcpro1;
1524 unsigned char *str;
1525 int size_byte;
1526 /* 1 means we must ensure that the next character we output
1527 cannot be taken as part of a hex character escape. */
1528 int need_nonhex = 0;
1529 int multibyte = STRING_MULTIBYTE (obj);
1531 GCPRO1 (obj);
1533 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
1535 PRINTCHAR ('#');
1536 PRINTCHAR ('(');
1539 PRINTCHAR ('\"');
1540 str = SDATA (obj);
1541 size_byte = SBYTES (obj);
1543 for (i = 0, i_byte = 0; i_byte < size_byte;)
1545 /* Here, we must convert each multi-byte form to the
1546 corresponding character code before handing it to PRINTCHAR. */
1547 int len;
1548 int c;
1550 if (multibyte)
1552 c = STRING_CHAR_AND_LENGTH (str + i_byte,
1553 size_byte - i_byte, len);
1554 if (CHAR_VALID_P (c, 0))
1555 i_byte += len;
1556 else
1557 c = str[i_byte++];
1559 else
1560 c = str[i_byte++];
1562 QUIT;
1564 if (c == '\n' && print_escape_newlines)
1566 PRINTCHAR ('\\');
1567 PRINTCHAR ('n');
1569 else if (c == '\f' && print_escape_newlines)
1571 PRINTCHAR ('\\');
1572 PRINTCHAR ('f');
1574 else if (multibyte
1575 && ! ASCII_BYTE_P (c)
1576 && (SINGLE_BYTE_CHAR_P (c) || print_escape_multibyte))
1578 /* When multibyte is disabled,
1579 print multibyte string chars using hex escapes.
1580 For a char code that could be in a unibyte string,
1581 when found in a multibyte string, always use a hex escape
1582 so it reads back as multibyte. */
1583 unsigned char outbuf[50];
1584 sprintf (outbuf, "\\x%x", c);
1585 strout (outbuf, -1, -1, printcharfun, 0);
1586 need_nonhex = 1;
1588 else if (! multibyte
1589 && SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c)
1590 && print_escape_nonascii)
1592 /* When printing in a multibyte buffer
1593 or when explicitly requested,
1594 print single-byte non-ASCII string chars
1595 using octal escapes. */
1596 unsigned char outbuf[5];
1597 sprintf (outbuf, "\\%03o", c);
1598 strout (outbuf, -1, -1, printcharfun, 0);
1600 else
1602 /* If we just had a hex escape, and this character
1603 could be taken as part of it,
1604 output `\ ' to prevent that. */
1605 if (need_nonhex)
1607 need_nonhex = 0;
1608 if ((c >= 'a' && c <= 'f')
1609 || (c >= 'A' && c <= 'F')
1610 || (c >= '0' && c <= '9'))
1611 strout ("\\ ", -1, -1, printcharfun, 0);
1614 if (c == '\"' || c == '\\')
1615 PRINTCHAR ('\\');
1616 PRINTCHAR (c);
1619 PRINTCHAR ('\"');
1621 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
1623 traverse_intervals (STRING_INTERVALS (obj),
1624 0, print_interval, printcharfun);
1625 PRINTCHAR (')');
1628 UNGCPRO;
1630 break;
1632 case Lisp_Symbol:
1634 register int confusing;
1635 register unsigned char *p = SDATA (SYMBOL_NAME (obj));
1636 register unsigned char *end = p + SBYTES (SYMBOL_NAME (obj));
1637 register int c;
1638 int i, i_byte, size_byte;
1639 Lisp_Object name;
1641 name = SYMBOL_NAME (obj);
1643 if (p != end && (*p == '-' || *p == '+')) p++;
1644 if (p == end)
1645 confusing = 0;
1646 /* If symbol name begins with a digit, and ends with a digit,
1647 and contains nothing but digits and `e', it could be treated
1648 as a number. So set CONFUSING.
1650 Symbols that contain periods could also be taken as numbers,
1651 but periods are always escaped, so we don't have to worry
1652 about them here. */
1653 else if (*p >= '0' && *p <= '9'
1654 && end[-1] >= '0' && end[-1] <= '9')
1656 while (p != end && ((*p >= '0' && *p <= '9')
1657 /* Needed for \2e10. */
1658 || *p == 'e'))
1659 p++;
1660 confusing = (end == p);
1662 else
1663 confusing = 0;
1665 if (! NILP (Vprint_gensym) && !SYMBOL_INTERNED_P (obj))
1667 PRINTCHAR ('#');
1668 PRINTCHAR (':');
1671 size_byte = SBYTES (name);
1673 for (i = 0, i_byte = 0; i_byte < size_byte;)
1675 /* Here, we must convert each multi-byte form to the
1676 corresponding character code before handing it to PRINTCHAR. */
1677 FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte);
1678 QUIT;
1680 if (escapeflag)
1682 if (c == '\"' || c == '\\' || c == '\''
1683 || c == ';' || c == '#' || c == '(' || c == ')'
1684 || c == ',' || c =='.' || c == '`'
1685 || c == '[' || c == ']' || c == '?' || c <= 040
1686 || confusing)
1687 PRINTCHAR ('\\'), confusing = 0;
1689 PRINTCHAR (c);
1692 break;
1694 case Lisp_Cons:
1695 /* If deeper than spec'd depth, print placeholder. */
1696 if (INTEGERP (Vprint_level)
1697 && print_depth > XINT (Vprint_level))
1698 strout ("...", -1, -1, printcharfun, 0);
1699 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1700 && (EQ (XCAR (obj), Qquote)))
1702 PRINTCHAR ('\'');
1703 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1705 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1706 && (EQ (XCAR (obj), Qfunction)))
1708 PRINTCHAR ('#');
1709 PRINTCHAR ('\'');
1710 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1712 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1713 && ! old_backquote_output
1714 && ((EQ (XCAR (obj), Qbackquote)
1715 || EQ (XCAR (obj), Qcomma)
1716 || EQ (XCAR (obj), Qcomma_at)
1717 || EQ (XCAR (obj), Qcomma_dot))))
1719 print_object (XCAR (obj), printcharfun, 0);
1720 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1722 else
1724 PRINTCHAR ('(');
1726 /* If the first element is a backquote form,
1727 print it old-style so it won't be misunderstood. */
1728 if (print_quoted && CONSP (XCAR (obj))
1729 && CONSP (XCDR (XCAR (obj)))
1730 && NILP (XCDR (XCDR (XCAR (obj))))
1731 && EQ (XCAR (XCAR (obj)), Qbackquote))
1733 Lisp_Object tem;
1734 tem = XCAR (obj);
1735 PRINTCHAR ('(');
1737 print_object (Qbackquote, printcharfun, 0);
1738 PRINTCHAR (' ');
1740 ++old_backquote_output;
1741 print_object (XCAR (XCDR (tem)), printcharfun, 0);
1742 --old_backquote_output;
1743 PRINTCHAR (')');
1745 obj = XCDR (obj);
1749 int print_length, i;
1750 Lisp_Object halftail = obj;
1752 /* Negative values of print-length are invalid in CL.
1753 Treat them like nil, as CMUCL does. */
1754 if (NATNUMP (Vprint_length))
1755 print_length = XFASTINT (Vprint_length);
1756 else
1757 print_length = 0;
1759 i = 0;
1760 while (CONSP (obj))
1762 /* Detect circular list. */
1763 if (NILP (Vprint_circle))
1765 /* Simple but imcomplete way. */
1766 if (i != 0 && EQ (obj, halftail))
1768 sprintf (buf, " . #%d", i / 2);
1769 strout (buf, -1, -1, printcharfun, 0);
1770 goto end_of_list;
1773 else
1775 /* With the print-circle feature. */
1776 if (i != 0)
1778 int i;
1779 for (i = 0; i < print_number_index; i++)
1780 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i),
1781 obj))
1783 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1785 strout (" . ", 3, 3, printcharfun, 0);
1786 print_object (obj, printcharfun, escapeflag);
1788 else
1790 sprintf (buf, " . #%d#", i + 1);
1791 strout (buf, -1, -1, printcharfun, 0);
1793 goto end_of_list;
1798 if (i++)
1799 PRINTCHAR (' ');
1801 if (print_length && i > print_length)
1803 strout ("...", 3, 3, printcharfun, 0);
1804 goto end_of_list;
1807 print_object (XCAR (obj), printcharfun, escapeflag);
1809 obj = XCDR (obj);
1810 if (!(i & 1))
1811 halftail = XCDR (halftail);
1815 /* OBJ non-nil here means it's the end of a dotted list. */
1816 if (!NILP (obj))
1818 strout (" . ", 3, 3, printcharfun, 0);
1819 print_object (obj, printcharfun, escapeflag);
1822 end_of_list:
1823 PRINTCHAR (')');
1825 break;
1827 case Lisp_Vectorlike:
1828 if (PROCESSP (obj))
1830 if (escapeflag)
1832 strout ("#<process ", -1, -1, printcharfun, 0);
1833 print_string (XPROCESS (obj)->name, printcharfun);
1834 PRINTCHAR ('>');
1836 else
1837 print_string (XPROCESS (obj)->name, printcharfun);
1839 else if (BOOL_VECTOR_P (obj))
1841 register int i;
1842 register unsigned char c;
1843 struct gcpro gcpro1;
1844 int size_in_chars
1845 = ((XBOOL_VECTOR (obj)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
1846 / BOOL_VECTOR_BITS_PER_CHAR);
1848 GCPRO1 (obj);
1850 PRINTCHAR ('#');
1851 PRINTCHAR ('&');
1852 sprintf (buf, "%ld", (long) XBOOL_VECTOR (obj)->size);
1853 strout (buf, -1, -1, printcharfun, 0);
1854 PRINTCHAR ('\"');
1856 /* Don't print more characters than the specified maximum.
1857 Negative values of print-length are invalid. Treat them
1858 like a print-length of nil. */
1859 if (NATNUMP (Vprint_length)
1860 && XFASTINT (Vprint_length) < size_in_chars)
1861 size_in_chars = XFASTINT (Vprint_length);
1863 for (i = 0; i < size_in_chars; i++)
1865 QUIT;
1866 c = XBOOL_VECTOR (obj)->data[i];
1867 if (c == '\n' && print_escape_newlines)
1869 PRINTCHAR ('\\');
1870 PRINTCHAR ('n');
1872 else if (c == '\f' && print_escape_newlines)
1874 PRINTCHAR ('\\');
1875 PRINTCHAR ('f');
1877 else if (c > '\177')
1879 /* Use octal escapes to avoid encoding issues. */
1880 PRINTCHAR ('\\');
1881 PRINTCHAR ('0' + ((c >> 6) & 3));
1882 PRINTCHAR ('0' + ((c >> 3) & 7));
1883 PRINTCHAR ('0' + (c & 7));
1885 else
1887 if (c == '\"' || c == '\\')
1888 PRINTCHAR ('\\');
1889 PRINTCHAR (c);
1892 PRINTCHAR ('\"');
1894 UNGCPRO;
1896 else if (SUBRP (obj))
1898 strout ("#<subr ", -1, -1, printcharfun, 0);
1899 strout (XSUBR (obj)->symbol_name, -1, -1, printcharfun, 0);
1900 PRINTCHAR ('>');
1902 else if (WINDOWP (obj))
1904 strout ("#<window ", -1, -1, printcharfun, 0);
1905 sprintf (buf, "%ld", (long) XFASTINT (XWINDOW (obj)->sequence_number));
1906 strout (buf, -1, -1, printcharfun, 0);
1907 if (!NILP (XWINDOW (obj)->buffer))
1909 strout (" on ", -1, -1, printcharfun, 0);
1910 print_string (XBUFFER (XWINDOW (obj)->buffer)->name, printcharfun);
1912 PRINTCHAR ('>');
1914 else if (HASH_TABLE_P (obj))
1916 struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
1917 strout ("#<hash-table", -1, -1, printcharfun, 0);
1918 if (SYMBOLP (h->test))
1920 PRINTCHAR (' ');
1921 PRINTCHAR ('\'');
1922 strout (SDATA (SYMBOL_NAME (h->test)), -1, -1, printcharfun, 0);
1923 PRINTCHAR (' ');
1924 strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun, 0);
1925 PRINTCHAR (' ');
1926 sprintf (buf, "%ld/%ld", (long) XFASTINT (h->count),
1927 (long) XVECTOR (h->next)->size);
1928 strout (buf, -1, -1, printcharfun, 0);
1930 sprintf (buf, " 0x%lx", (unsigned long) h);
1931 strout (buf, -1, -1, printcharfun, 0);
1932 PRINTCHAR ('>');
1934 else if (BUFFERP (obj))
1936 if (NILP (XBUFFER (obj)->name))
1937 strout ("#<killed buffer>", -1, -1, printcharfun, 0);
1938 else if (escapeflag)
1940 strout ("#<buffer ", -1, -1, printcharfun, 0);
1941 print_string (XBUFFER (obj)->name, printcharfun);
1942 PRINTCHAR ('>');
1944 else
1945 print_string (XBUFFER (obj)->name, printcharfun);
1947 else if (WINDOW_CONFIGURATIONP (obj))
1949 strout ("#<window-configuration>", -1, -1, printcharfun, 0);
1951 else if (FRAMEP (obj))
1953 strout ((FRAME_LIVE_P (XFRAME (obj))
1954 ? "#<frame " : "#<dead frame "),
1955 -1, -1, printcharfun, 0);
1956 print_string (XFRAME (obj)->name, printcharfun);
1957 sprintf (buf, " 0x%lx", (unsigned long) (XFRAME (obj)));
1958 strout (buf, -1, -1, printcharfun, 0);
1959 PRINTCHAR ('>');
1961 else
1963 EMACS_INT size = XVECTOR (obj)->size;
1964 if (COMPILEDP (obj))
1966 PRINTCHAR ('#');
1967 size &= PSEUDOVECTOR_SIZE_MASK;
1969 if (CHAR_TABLE_P (obj))
1971 /* We print a char-table as if it were a vector,
1972 lumping the parent and default slots in with the
1973 character slots. But we add #^ as a prefix. */
1974 PRINTCHAR ('#');
1975 PRINTCHAR ('^');
1976 if (SUB_CHAR_TABLE_P (obj))
1977 PRINTCHAR ('^');
1978 size &= PSEUDOVECTOR_SIZE_MASK;
1980 if (size & PSEUDOVECTOR_FLAG)
1981 goto badtype;
1983 PRINTCHAR ('[');
1985 register int i;
1986 register Lisp_Object tem;
1987 int real_size = size;
1989 /* Don't print more elements than the specified maximum. */
1990 if (NATNUMP (Vprint_length)
1991 && XFASTINT (Vprint_length) < size)
1992 size = XFASTINT (Vprint_length);
1994 for (i = 0; i < size; i++)
1996 if (i) PRINTCHAR (' ');
1997 tem = XVECTOR (obj)->contents[i];
1998 print_object (tem, printcharfun, escapeflag);
2000 if (size < real_size)
2001 strout (" ...", 4, 4, printcharfun, 0);
2003 PRINTCHAR (']');
2005 break;
2007 case Lisp_Misc:
2008 switch (XMISCTYPE (obj))
2010 case Lisp_Misc_Marker:
2011 strout ("#<marker ", -1, -1, printcharfun, 0);
2012 /* Do you think this is necessary? */
2013 if (XMARKER (obj)->insertion_type != 0)
2014 strout ("(moves after insertion) ", -1, -1, printcharfun, 0);
2015 if (!(XMARKER (obj)->buffer))
2016 strout ("in no buffer", -1, -1, printcharfun, 0);
2017 else
2019 sprintf (buf, "at %d", marker_position (obj));
2020 strout (buf, -1, -1, printcharfun, 0);
2021 strout (" in ", -1, -1, printcharfun, 0);
2022 print_string (XMARKER (obj)->buffer->name, printcharfun);
2024 PRINTCHAR ('>');
2025 break;
2027 case Lisp_Misc_Overlay:
2028 strout ("#<overlay ", -1, -1, printcharfun, 0);
2029 if (!(XMARKER (OVERLAY_START (obj))->buffer))
2030 strout ("in no buffer", -1, -1, printcharfun, 0);
2031 else
2033 sprintf (buf, "from %d to %d in ",
2034 marker_position (OVERLAY_START (obj)),
2035 marker_position (OVERLAY_END (obj)));
2036 strout (buf, -1, -1, printcharfun, 0);
2037 print_string (XMARKER (OVERLAY_START (obj))->buffer->name,
2038 printcharfun);
2040 PRINTCHAR ('>');
2041 break;
2043 /* Remaining cases shouldn't happen in normal usage, but let's print
2044 them anyway for the benefit of the debugger. */
2045 case Lisp_Misc_Free:
2046 strout ("#<misc free cell>", -1, -1, printcharfun, 0);
2047 break;
2049 case Lisp_Misc_Intfwd:
2050 sprintf (buf, "#<intfwd to %ld>", (long) *XINTFWD (obj)->intvar);
2051 strout (buf, -1, -1, printcharfun, 0);
2052 break;
2054 case Lisp_Misc_Boolfwd:
2055 sprintf (buf, "#<boolfwd to %s>",
2056 (*XBOOLFWD (obj)->boolvar ? "t" : "nil"));
2057 strout (buf, -1, -1, printcharfun, 0);
2058 break;
2060 case Lisp_Misc_Objfwd:
2061 strout ("#<objfwd to ", -1, -1, printcharfun, 0);
2062 print_object (*XOBJFWD (obj)->objvar, printcharfun, escapeflag);
2063 PRINTCHAR ('>');
2064 break;
2066 case Lisp_Misc_Buffer_Objfwd:
2067 strout ("#<buffer_objfwd to ", -1, -1, printcharfun, 0);
2068 print_object (PER_BUFFER_VALUE (current_buffer,
2069 XBUFFER_OBJFWD (obj)->offset),
2070 printcharfun, escapeflag);
2071 PRINTCHAR ('>');
2072 break;
2074 case Lisp_Misc_Kboard_Objfwd:
2075 strout ("#<kboard_objfwd to ", -1, -1, printcharfun, 0);
2076 print_object (*(Lisp_Object *)((char *) current_kboard
2077 + XKBOARD_OBJFWD (obj)->offset),
2078 printcharfun, escapeflag);
2079 PRINTCHAR ('>');
2080 break;
2082 case Lisp_Misc_Buffer_Local_Value:
2083 strout ("#<buffer_local_value ", -1, -1, printcharfun, 0);
2084 goto do_buffer_local;
2085 case Lisp_Misc_Some_Buffer_Local_Value:
2086 strout ("#<some_buffer_local_value ", -1, -1, printcharfun, 0);
2087 do_buffer_local:
2088 strout ("[realvalue] ", -1, -1, printcharfun, 0);
2089 print_object (XBUFFER_LOCAL_VALUE (obj)->realvalue,
2090 printcharfun, escapeflag);
2091 if (XBUFFER_LOCAL_VALUE (obj)->found_for_buffer)
2092 strout ("[local in buffer] ", -1, -1, printcharfun, 0);
2093 else
2094 strout ("[buffer] ", -1, -1, printcharfun, 0);
2095 print_object (XBUFFER_LOCAL_VALUE (obj)->buffer,
2096 printcharfun, escapeflag);
2097 if (XBUFFER_LOCAL_VALUE (obj)->check_frame)
2099 if (XBUFFER_LOCAL_VALUE (obj)->found_for_frame)
2100 strout ("[local in frame] ", -1, -1, printcharfun, 0);
2101 else
2102 strout ("[frame] ", -1, -1, printcharfun, 0);
2103 print_object (XBUFFER_LOCAL_VALUE (obj)->frame,
2104 printcharfun, escapeflag);
2106 strout ("[alist-elt] ", -1, -1, printcharfun, 0);
2107 print_object (XCAR (XBUFFER_LOCAL_VALUE (obj)->cdr),
2108 printcharfun, escapeflag);
2109 strout ("[default-value] ", -1, -1, printcharfun, 0);
2110 print_object (XCDR (XBUFFER_LOCAL_VALUE (obj)->cdr),
2111 printcharfun, escapeflag);
2112 PRINTCHAR ('>');
2113 break;
2115 case Lisp_Misc_Save_Value:
2116 strout ("#<save_value ", -1, -1, printcharfun, 0);
2117 sprintf(buf, "ptr=0x%08lx int=%d",
2118 (unsigned long) XSAVE_VALUE (obj)->pointer,
2119 XSAVE_VALUE (obj)->integer);
2120 strout (buf, -1, -1, printcharfun, 0);
2121 PRINTCHAR ('>');
2122 break;
2124 default:
2125 goto badtype;
2127 break;
2129 default:
2130 badtype:
2132 /* We're in trouble if this happens!
2133 Probably should just abort () */
2134 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun, 0);
2135 if (MISCP (obj))
2136 sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj));
2137 else if (VECTORLIKEP (obj))
2138 sprintf (buf, "(PVEC 0x%08x)", (int) XVECTOR (obj)->size);
2139 else
2140 sprintf (buf, "(0x%02x)", (int) XTYPE (obj));
2141 strout (buf, -1, -1, printcharfun, 0);
2142 strout (" Save your buffers immediately and please report this bug>",
2143 -1, -1, printcharfun, 0);
2147 print_depth--;
2151 /* Print a description of INTERVAL using PRINTCHARFUN.
2152 This is part of printing a string that has text properties. */
2154 void
2155 print_interval (interval, printcharfun)
2156 INTERVAL interval;
2157 Lisp_Object printcharfun;
2159 PRINTCHAR (' ');
2160 print_object (make_number (interval->position), printcharfun, 1);
2161 PRINTCHAR (' ');
2162 print_object (make_number (interval->position + LENGTH (interval)),
2163 printcharfun, 1);
2164 PRINTCHAR (' ');
2165 print_object (interval->plist, printcharfun, 1);
2169 void
2170 syms_of_print ()
2172 Qtemp_buffer_setup_hook = intern ("temp-buffer-setup-hook");
2173 staticpro (&Qtemp_buffer_setup_hook);
2175 DEFVAR_LISP ("standard-output", &Vstandard_output,
2176 doc: /* Output stream `print' uses by default for outputting a character.
2177 This may be any function of one argument.
2178 It may also be a buffer (output is inserted before point)
2179 or a marker (output is inserted and the marker is advanced)
2180 or the symbol t (output appears in the echo area). */);
2181 Vstandard_output = Qt;
2182 Qstandard_output = intern ("standard-output");
2183 staticpro (&Qstandard_output);
2185 DEFVAR_LISP ("float-output-format", &Vfloat_output_format,
2186 doc: /* The format descriptor string used to print floats.
2187 This is a %-spec like those accepted by `printf' in C,
2188 but with some restrictions. It must start with the two characters `%.'.
2189 After that comes an integer precision specification,
2190 and then a letter which controls the format.
2191 The letters allowed are `e', `f' and `g'.
2192 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2193 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2194 Use `g' to choose the shorter of those two formats for the number at hand.
2195 The precision in any of these cases is the number of digits following
2196 the decimal point. With `f', a precision of 0 means to omit the
2197 decimal point. 0 is not allowed with `e' or `g'.
2199 A value of nil means to use the shortest notation
2200 that represents the number without losing information. */);
2201 Vfloat_output_format = Qnil;
2202 Qfloat_output_format = intern ("float-output-format");
2203 staticpro (&Qfloat_output_format);
2205 DEFVAR_LISP ("print-length", &Vprint_length,
2206 doc: /* Maximum length of list to print before abbreviating.
2207 A value of nil means no limit. See also `eval-expression-print-length'. */);
2208 Vprint_length = Qnil;
2210 DEFVAR_LISP ("print-level", &Vprint_level,
2211 doc: /* Maximum depth of list nesting to print before abbreviating.
2212 A value of nil means no limit. See also `eval-expression-print-level'. */);
2213 Vprint_level = Qnil;
2215 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines,
2216 doc: /* Non-nil means print newlines in strings as `\\n'.
2217 Also print formfeeds as `\\f'. */);
2218 print_escape_newlines = 0;
2220 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii,
2221 doc: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2222 \(OOO is the octal representation of the character code.)
2223 Only single-byte characters are affected, and only in `prin1'.
2224 When the output goes in a multibyte buffer, this feature is
2225 enabled regardless of the value of the variable. */);
2226 print_escape_nonascii = 0;
2228 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte,
2229 doc: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2230 \(XXXX is the hex representation of the character code.)
2231 This affects only `prin1'. */);
2232 print_escape_multibyte = 0;
2234 DEFVAR_BOOL ("print-quoted", &print_quoted,
2235 doc: /* Non-nil means print quoted forms with reader syntax.
2236 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and backquoted
2237 forms print as in the new syntax. */);
2238 print_quoted = 0;
2240 DEFVAR_LISP ("print-gensym", &Vprint_gensym,
2241 doc: /* Non-nil means print uninterned symbols so they will read as uninterned.
2242 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2243 When the uninterned symbol appears within a recursive data structure,
2244 and the symbol appears more than once, in addition use the #N# and #N=
2245 constructs as needed, so that multiple references to the same symbol are
2246 shared once again when the text is read back. */);
2247 Vprint_gensym = Qnil;
2249 DEFVAR_LISP ("print-circle", &Vprint_circle,
2250 doc: /* *Non-nil means print recursive structures using #N= and #N# syntax.
2251 If nil, printing proceeds recursively and may lead to
2252 `max-lisp-eval-depth' being exceeded or an error may occur:
2253 \"Apparently circular structure being printed.\" Also see
2254 `print-length' and `print-level'.
2255 If non-nil, shared substructures anywhere in the structure are printed
2256 with `#N=' before the first occurrence (in the order of the print
2257 representation) and `#N#' in place of each subsequent occurrence,
2258 where N is a positive decimal integer. */);
2259 Vprint_circle = Qnil;
2261 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering,
2262 doc: /* *Non-nil means number continuously across print calls.
2263 This affects the numbers printed for #N= labels and #M# references.
2264 See also `print-circle', `print-gensym', and `print-number-table'.
2265 This variable should not be set with `setq'; bind it with a `let' instead. */);
2266 Vprint_continuous_numbering = Qnil;
2268 DEFVAR_LISP ("print-number-table", &Vprint_number_table,
2269 doc: /* A vector used internally to produce `#N=' labels and `#N#' references.
2270 The Lisp printer uses this vector to detect Lisp objects referenced more
2271 than once.
2273 When you bind `print-continuous-numbering' to t, you should probably
2274 also bind `print-number-table' to nil. This ensures that the value of
2275 `print-number-table' can be garbage-collected once the printing is
2276 done. If all elements of `print-number-table' are nil, it means that
2277 the printing done so far has not found any shared structure or objects
2278 that need to be recorded in the table. */);
2279 Vprint_number_table = Qnil;
2281 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2282 staticpro (&Vprin1_to_string_buffer);
2284 defsubr (&Sprin1);
2285 defsubr (&Sprin1_to_string);
2286 defsubr (&Serror_message_string);
2287 defsubr (&Sprinc);
2288 defsubr (&Sprint);
2289 defsubr (&Sterpri);
2290 defsubr (&Swrite_char);
2291 defsubr (&Sexternal_debugging_output);
2292 #ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
2293 defsubr (&Sredirect_debugging_output);
2294 #endif
2296 Qexternal_debugging_output = intern ("external-debugging-output");
2297 staticpro (&Qexternal_debugging_output);
2299 Qprint_escape_newlines = intern ("print-escape-newlines");
2300 staticpro (&Qprint_escape_newlines);
2302 Qprint_escape_multibyte = intern ("print-escape-multibyte");
2303 staticpro (&Qprint_escape_multibyte);
2305 Qprint_escape_nonascii = intern ("print-escape-nonascii");
2306 staticpro (&Qprint_escape_nonascii);
2308 defsubr (&Swith_output_to_temp_buffer);
2311 /* arch-tag: bc797170-94ae-41de-86e3-75e20f8f7a39
2312 (do not change this comment) */