(Comments, Comment Commands, Options for Comments, Multi-Line Comments):
[emacs.git] / src / print.c
blob3a286361a8cd06ee9d9ac3b154def7639e7b1ea3
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, 2006 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 ();
185 /* GDB resets this to zero on W32 to disable OutputDebugString calls. */
186 int print_output_debug_flag = 1;
189 /* Low level output routines for characters and strings */
191 /* Lisp functions to do output using a stream
192 must have the stream in a variable called printcharfun
193 and must start with PRINTPREPARE, end with PRINTFINISH,
194 and use PRINTDECLARE to declare common variables.
195 Use PRINTCHAR to output one character,
196 or call strout to output a block of characters. */
198 #define PRINTDECLARE \
199 struct buffer *old = current_buffer; \
200 int old_point = -1, start_point = -1; \
201 int old_point_byte = -1, start_point_byte = -1; \
202 int specpdl_count = SPECPDL_INDEX (); \
203 int free_print_buffer = 0; \
204 int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
205 Lisp_Object original
207 #define PRINTPREPARE \
208 original = printcharfun; \
209 if (NILP (printcharfun)) printcharfun = Qt; \
210 if (BUFFERP (printcharfun)) \
212 if (XBUFFER (printcharfun) != current_buffer) \
213 Fset_buffer (printcharfun); \
214 printcharfun = Qnil; \
216 if (MARKERP (printcharfun)) \
218 EMACS_INT marker_pos; \
219 if (!(XMARKER (printcharfun)->buffer)) \
220 error ("Marker does not point anywhere"); \
221 if (XMARKER (printcharfun)->buffer != current_buffer) \
222 set_buffer_internal (XMARKER (printcharfun)->buffer); \
223 marker_pos = marker_position (printcharfun); \
224 if (marker_pos < BEGV || marker_pos > ZV) \
225 error ("Marker is outside the accessible part of the buffer"); \
226 old_point = PT; \
227 old_point_byte = PT_BYTE; \
228 SET_PT_BOTH (marker_pos, \
229 marker_byte_position (printcharfun)); \
230 start_point = PT; \
231 start_point_byte = PT_BYTE; \
232 printcharfun = Qnil; \
234 if (NILP (printcharfun)) \
236 Lisp_Object string; \
237 if (NILP (current_buffer->enable_multibyte_characters) \
238 && ! print_escape_multibyte) \
239 specbind (Qprint_escape_multibyte, Qt); \
240 if (! NILP (current_buffer->enable_multibyte_characters) \
241 && ! print_escape_nonascii) \
242 specbind (Qprint_escape_nonascii, Qt); \
243 if (print_buffer != 0) \
245 string = make_string_from_bytes (print_buffer, \
246 print_buffer_pos, \
247 print_buffer_pos_byte); \
248 record_unwind_protect (print_unwind, string); \
250 else \
252 print_buffer_size = 1000; \
253 print_buffer = (char *) xmalloc (print_buffer_size); \
254 free_print_buffer = 1; \
256 print_buffer_pos = 0; \
257 print_buffer_pos_byte = 0; \
259 if (EQ (printcharfun, Qt) && ! noninteractive) \
260 setup_echo_area_for_printing (multibyte);
262 #define PRINTFINISH \
263 if (NILP (printcharfun)) \
265 if (print_buffer_pos != print_buffer_pos_byte \
266 && NILP (current_buffer->enable_multibyte_characters)) \
268 unsigned char *temp \
269 = (unsigned char *) alloca (print_buffer_pos + 1); \
270 copy_text (print_buffer, temp, print_buffer_pos_byte, \
271 1, 0); \
272 insert_1_both (temp, print_buffer_pos, \
273 print_buffer_pos, 0, 1, 0); \
275 else \
276 insert_1_both (print_buffer, print_buffer_pos, \
277 print_buffer_pos_byte, 0, 1, 0); \
279 if (free_print_buffer) \
281 xfree (print_buffer); \
282 print_buffer = 0; \
284 unbind_to (specpdl_count, Qnil); \
285 if (MARKERP (original)) \
286 set_marker_both (original, Qnil, PT, PT_BYTE); \
287 if (old_point >= 0) \
288 SET_PT_BOTH (old_point + (old_point >= start_point \
289 ? PT - start_point : 0), \
290 old_point_byte + (old_point_byte >= start_point_byte \
291 ? PT_BYTE - start_point_byte : 0)); \
292 if (old != current_buffer) \
293 set_buffer_internal (old);
295 #define PRINTCHAR(ch) printchar (ch, printcharfun)
297 /* This is used to restore the saved contents of print_buffer
298 when there is a recursive call to print. */
300 static Lisp_Object
301 print_unwind (saved_text)
302 Lisp_Object saved_text;
304 bcopy (SDATA (saved_text), print_buffer, SCHARS (saved_text));
305 return Qnil;
309 /* Print character CH using method FUN. FUN nil means print to
310 print_buffer. FUN t means print to echo area or stdout if
311 non-interactive. If FUN is neither nil nor t, call FUN with CH as
312 argument. */
314 static void
315 printchar (ch, fun)
316 unsigned int ch;
317 Lisp_Object fun;
319 #ifdef MAX_PRINT_CHARS
320 if (max_print)
321 print_chars++;
322 #endif /* MAX_PRINT_CHARS */
324 if (!NILP (fun) && !EQ (fun, Qt))
325 call1 (fun, make_number (ch));
326 else
328 unsigned char str[MAX_MULTIBYTE_LENGTH];
329 int len = CHAR_STRING (ch, str);
331 QUIT;
333 if (NILP (fun))
335 if (print_buffer_pos_byte + len >= print_buffer_size)
336 print_buffer = (char *) xrealloc (print_buffer,
337 print_buffer_size *= 2);
338 bcopy (str, print_buffer + print_buffer_pos_byte, len);
339 print_buffer_pos += 1;
340 print_buffer_pos_byte += len;
342 else if (noninteractive)
344 fwrite (str, 1, len, stdout);
345 noninteractive_need_newline = 1;
347 else
349 int multibyte_p
350 = !NILP (current_buffer->enable_multibyte_characters);
352 setup_echo_area_for_printing (multibyte_p);
353 insert_char (ch);
354 message_dolog (str, len, 0, multibyte_p);
360 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
361 method PRINTCHARFUN. If SIZE < 0, use the string length of PTR for
362 both SIZE and SIZE_BYTE. PRINTCHARFUN nil means output to
363 print_buffer. PRINTCHARFUN t means output to the echo area or to
364 stdout if non-interactive. If neither nil nor t, call Lisp
365 function PRINTCHARFUN for each character printed. MULTIBYTE
366 non-zero means PTR contains multibyte characters. */
368 static void
369 strout (ptr, size, size_byte, printcharfun, multibyte)
370 char *ptr;
371 int size, size_byte;
372 Lisp_Object printcharfun;
373 int multibyte;
375 if (size < 0)
376 size_byte = size = strlen (ptr);
378 if (NILP (printcharfun))
380 if (print_buffer_pos_byte + size_byte > print_buffer_size)
382 print_buffer_size = print_buffer_size * 2 + size_byte;
383 print_buffer = (char *) xrealloc (print_buffer,
384 print_buffer_size);
386 bcopy (ptr, print_buffer + print_buffer_pos_byte, size_byte);
387 print_buffer_pos += size;
388 print_buffer_pos_byte += size_byte;
390 #ifdef MAX_PRINT_CHARS
391 if (max_print)
392 print_chars += size;
393 #endif /* MAX_PRINT_CHARS */
395 else if (noninteractive && EQ (printcharfun, Qt))
397 fwrite (ptr, 1, size_byte, stdout);
398 noninteractive_need_newline = 1;
400 else if (EQ (printcharfun, Qt))
402 /* Output to echo area. We're trying to avoid a little overhead
403 here, that's the reason we don't call printchar to do the
404 job. */
405 int i;
406 int multibyte_p
407 = !NILP (current_buffer->enable_multibyte_characters);
409 setup_echo_area_for_printing (multibyte_p);
410 message_dolog (ptr, size_byte, 0, multibyte_p);
412 if (size == size_byte)
414 for (i = 0; i < size; ++i)
415 insert_char ((unsigned char )*ptr++);
417 else
419 int len;
420 for (i = 0; i < size_byte; i += len)
422 int ch = STRING_CHAR_AND_LENGTH (ptr + i, size_byte - i, len);
423 insert_char (ch);
427 #ifdef MAX_PRINT_CHARS
428 if (max_print)
429 print_chars += size;
430 #endif /* MAX_PRINT_CHARS */
432 else
434 /* PRINTCHARFUN is a Lisp function. */
435 int i = 0;
437 if (size == size_byte)
439 while (i < size_byte)
441 int ch = ptr[i++];
442 PRINTCHAR (ch);
445 else
447 while (i < size_byte)
449 /* Here, we must convert each multi-byte form to the
450 corresponding character code before handing it to
451 PRINTCHAR. */
452 int len;
453 int ch = STRING_CHAR_AND_LENGTH (ptr + i, size_byte - i, len);
454 PRINTCHAR (ch);
455 i += len;
461 /* Print the contents of a string STRING using PRINTCHARFUN.
462 It isn't safe to use strout in many cases,
463 because printing one char can relocate. */
465 static void
466 print_string (string, printcharfun)
467 Lisp_Object string;
468 Lisp_Object printcharfun;
470 if (EQ (printcharfun, Qt) || NILP (printcharfun))
472 int chars;
474 if (STRING_MULTIBYTE (string))
475 chars = SCHARS (string);
476 else if (EQ (printcharfun, Qt)
477 ? ! NILP (buffer_defaults.enable_multibyte_characters)
478 : ! NILP (current_buffer->enable_multibyte_characters))
480 /* If unibyte string STRING contains 8-bit codes, we must
481 convert STRING to a multibyte string containing the same
482 character codes. */
483 Lisp_Object newstr;
484 int bytes;
486 chars = SBYTES (string);
487 bytes = parse_str_to_multibyte (SDATA (string), chars);
488 if (chars < bytes)
490 newstr = make_uninit_multibyte_string (chars, bytes);
491 bcopy (SDATA (string), SDATA (newstr), chars);
492 str_to_multibyte (SDATA (newstr), bytes, chars);
493 string = newstr;
496 else
497 chars = SBYTES (string);
499 /* strout is safe for output to a frame (echo area) or to print_buffer. */
500 strout (SDATA (string),
501 chars, SBYTES (string),
502 printcharfun, STRING_MULTIBYTE (string));
504 else
506 /* Otherwise, string may be relocated by printing one char.
507 So re-fetch the string address for each character. */
508 int i;
509 int size = SCHARS (string);
510 int size_byte = SBYTES (string);
511 struct gcpro gcpro1;
512 GCPRO1 (string);
513 if (size == size_byte)
514 for (i = 0; i < size; i++)
515 PRINTCHAR (SREF (string, i));
516 else
517 for (i = 0; i < size_byte; )
519 /* Here, we must convert each multi-byte form to the
520 corresponding character code before handing it to PRINTCHAR. */
521 int len;
522 int ch = STRING_CHAR_AND_LENGTH (SDATA (string) + i,
523 size_byte - i, len);
524 if (!CHAR_VALID_P (ch, 0))
526 ch = SREF (string, i);
527 len = 1;
529 PRINTCHAR (ch);
530 i += len;
532 UNGCPRO;
536 DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0,
537 doc: /* Output character CHARACTER to stream PRINTCHARFUN.
538 PRINTCHARFUN defaults to the value of `standard-output' (which see). */)
539 (character, printcharfun)
540 Lisp_Object character, printcharfun;
542 PRINTDECLARE;
544 if (NILP (printcharfun))
545 printcharfun = Vstandard_output;
546 CHECK_NUMBER (character);
547 PRINTPREPARE;
548 PRINTCHAR (XINT (character));
549 PRINTFINISH;
550 return character;
553 /* Used from outside of print.c to print a block of SIZE
554 single-byte chars at DATA on the default output stream.
555 Do not use this on the contents of a Lisp string. */
557 void
558 write_string (data, size)
559 char *data;
560 int size;
562 PRINTDECLARE;
563 Lisp_Object printcharfun;
565 printcharfun = Vstandard_output;
567 PRINTPREPARE;
568 strout (data, size, size, printcharfun, 0);
569 PRINTFINISH;
572 /* Used from outside of print.c to print a block of SIZE
573 single-byte chars at DATA on a specified stream PRINTCHARFUN.
574 Do not use this on the contents of a Lisp string. */
576 void
577 write_string_1 (data, size, printcharfun)
578 char *data;
579 int size;
580 Lisp_Object printcharfun;
582 PRINTDECLARE;
584 PRINTPREPARE;
585 strout (data, size, size, printcharfun, 0);
586 PRINTFINISH;
590 void
591 temp_output_buffer_setup (bufname)
592 const char *bufname;
594 int count = SPECPDL_INDEX ();
595 register struct buffer *old = current_buffer;
596 register Lisp_Object buf;
598 record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
600 Fset_buffer (Fget_buffer_create (build_string (bufname)));
602 Fkill_all_local_variables ();
603 delete_all_overlays (current_buffer);
604 current_buffer->directory = old->directory;
605 current_buffer->read_only = Qnil;
606 current_buffer->filename = Qnil;
607 current_buffer->undo_list = Qt;
608 eassert (current_buffer->overlays_before == NULL);
609 eassert (current_buffer->overlays_after == NULL);
610 current_buffer->enable_multibyte_characters
611 = buffer_defaults.enable_multibyte_characters;
612 specbind (Qinhibit_read_only, Qt);
613 specbind (Qinhibit_modification_hooks, Qt);
614 Ferase_buffer ();
615 XSETBUFFER (buf, current_buffer);
617 Frun_hooks (1, &Qtemp_buffer_setup_hook);
619 unbind_to (count, Qnil);
621 specbind (Qstandard_output, buf);
624 Lisp_Object
625 internal_with_output_to_temp_buffer (bufname, function, args)
626 const char *bufname;
627 Lisp_Object (*function) P_ ((Lisp_Object));
628 Lisp_Object args;
630 int count = SPECPDL_INDEX ();
631 Lisp_Object buf, val;
632 struct gcpro gcpro1;
634 GCPRO1 (args);
635 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
636 temp_output_buffer_setup (bufname);
637 buf = Vstandard_output;
638 UNGCPRO;
640 val = (*function) (args);
642 GCPRO1 (val);
643 temp_output_buffer_show (buf);
644 UNGCPRO;
646 return unbind_to (count, val);
649 DEFUN ("with-output-to-temp-buffer",
650 Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer,
651 1, UNEVALLED, 0,
652 doc: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
653 The buffer is cleared out initially, and marked as unmodified when done.
654 All output done by BODY is inserted in that buffer by default.
655 The buffer is displayed in another window, but not selected.
656 The value of the last form in BODY is returned.
657 If BODY does not finish normally, the buffer BUFNAME is not displayed.
659 The hook `temp-buffer-setup-hook' is run before BODY,
660 with the buffer BUFNAME temporarily current.
661 The hook `temp-buffer-show-hook' is run after the buffer is displayed,
662 with the buffer temporarily current, and the window that was used
663 to display it temporarily selected.
665 If variable `temp-buffer-show-function' is non-nil, call it at the end
666 to get the buffer displayed instead of just displaying the non-selected
667 buffer and calling the hook. It gets one argument, the buffer to display.
669 usage: (with-output-to-temp-buffer BUFNAME BODY ...) */)
670 (args)
671 Lisp_Object args;
673 struct gcpro gcpro1;
674 Lisp_Object name;
675 int count = SPECPDL_INDEX ();
676 Lisp_Object buf, val;
678 GCPRO1(args);
679 name = Feval (Fcar (args));
680 CHECK_STRING (name);
681 temp_output_buffer_setup (SDATA (name));
682 buf = Vstandard_output;
683 UNGCPRO;
685 val = Fprogn (XCDR (args));
687 GCPRO1 (val);
688 temp_output_buffer_show (buf);
689 UNGCPRO;
691 return unbind_to (count, val);
695 static void print ();
696 static void print_preprocess ();
697 static void print_preprocess_string ();
698 static void print_object ();
700 DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
701 doc: /* Output a newline to stream PRINTCHARFUN.
702 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
703 (printcharfun)
704 Lisp_Object printcharfun;
706 PRINTDECLARE;
708 if (NILP (printcharfun))
709 printcharfun = Vstandard_output;
710 PRINTPREPARE;
711 PRINTCHAR ('\n');
712 PRINTFINISH;
713 return Qt;
716 DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0,
717 doc: /* Output the printed representation of OBJECT, any Lisp object.
718 Quoting characters are printed when needed to make output that `read'
719 can handle, whenever this is possible. For complex objects, the behavior
720 is controlled by `print-level' and `print-length', which see.
722 OBJECT is any of the Lisp data types: a number, a string, a symbol,
723 a list, a buffer, a window, a frame, etc.
725 A printed representation of an object is text which describes that object.
727 Optional argument PRINTCHARFUN is the output stream, which can be one
728 of these:
730 - a buffer, in which case output is inserted into that buffer at point;
731 - a marker, in which case output is inserted at marker's position;
732 - a function, in which case that function is called once for each
733 character of OBJECT's printed representation;
734 - a symbol, in which case that symbol's function definition is called; or
735 - t, in which case the output is displayed in the echo area.
737 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
738 is used instead. */)
739 (object, printcharfun)
740 Lisp_Object object, printcharfun;
742 PRINTDECLARE;
744 #ifdef MAX_PRINT_CHARS
745 max_print = 0;
746 #endif /* MAX_PRINT_CHARS */
747 if (NILP (printcharfun))
748 printcharfun = Vstandard_output;
749 PRINTPREPARE;
750 print (object, printcharfun, 1);
751 PRINTFINISH;
752 return object;
755 /* a buffer which is used to hold output being built by prin1-to-string */
756 Lisp_Object Vprin1_to_string_buffer;
758 DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0,
759 doc: /* Return a string containing the printed representation of OBJECT.
760 OBJECT can be any Lisp object. This function outputs quoting characters
761 when necessary to make output that `read' can handle, whenever possible,
762 unless the optional second argument NOESCAPE is non-nil.
764 OBJECT is any of the Lisp data types: a number, a string, a symbol,
765 a list, a buffer, a window, a frame, etc.
767 A printed representation of an object is text which describes that object. */)
768 (object, noescape)
769 Lisp_Object object, noescape;
771 Lisp_Object printcharfun;
772 /* struct gcpro gcpro1, gcpro2; */
773 Lisp_Object save_deactivate_mark;
774 int count = specpdl_ptr - specpdl;
775 struct buffer *previous;
777 specbind (Qinhibit_modification_hooks, Qt);
780 PRINTDECLARE;
782 /* Save and restore this--we are altering a buffer
783 but we don't want to deactivate the mark just for that.
784 No need for specbind, since errors deactivate the mark. */
785 save_deactivate_mark = Vdeactivate_mark;
786 /* GCPRO2 (object, save_deactivate_mark); */
787 abort_on_gc++;
789 printcharfun = Vprin1_to_string_buffer;
790 PRINTPREPARE;
791 print (object, printcharfun, NILP (noescape));
792 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
793 PRINTFINISH;
796 previous = current_buffer;
797 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
798 object = Fbuffer_string ();
799 if (SBYTES (object) == SCHARS (object))
800 STRING_SET_UNIBYTE (object);
802 /* Note that this won't make prepare_to_modify_buffer call
803 ask-user-about-supersession-threat because this buffer
804 does not visit a file. */
805 Ferase_buffer ();
806 set_buffer_internal (previous);
808 Vdeactivate_mark = save_deactivate_mark;
809 /* UNGCPRO; */
811 abort_on_gc--;
812 return unbind_to (count, object);
815 DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
816 doc: /* Output the printed representation of OBJECT, any Lisp object.
817 No quoting characters are used; no delimiters are printed around
818 the contents of strings.
820 OBJECT is any of the Lisp data types: a number, a string, a symbol,
821 a list, a buffer, a window, a frame, etc.
823 A printed representation of an object is text which describes that object.
825 Optional argument PRINTCHARFUN is the output stream, which can be one
826 of these:
828 - a buffer, in which case output is inserted into that buffer at point;
829 - a marker, in which case output is inserted at marker's position;
830 - a function, in which case that function is called once for each
831 character of OBJECT's printed representation;
832 - a symbol, in which case that symbol's function definition is called; or
833 - t, in which case the output is displayed in the echo area.
835 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
836 is used instead. */)
837 (object, printcharfun)
838 Lisp_Object object, printcharfun;
840 PRINTDECLARE;
842 if (NILP (printcharfun))
843 printcharfun = Vstandard_output;
844 PRINTPREPARE;
845 print (object, printcharfun, 0);
846 PRINTFINISH;
847 return object;
850 DEFUN ("print", Fprint, Sprint, 1, 2, 0,
851 doc: /* Output the printed representation of OBJECT, with newlines around it.
852 Quoting characters are printed when needed to make output that `read'
853 can handle, whenever this is possible. For complex objects, the behavior
854 is controlled by `print-level' and `print-length', which see.
856 OBJECT is any of the Lisp data types: a number, a string, a symbol,
857 a list, a buffer, a window, a frame, etc.
859 A printed representation of an object is text which describes that object.
861 Optional argument PRINTCHARFUN is the output stream, which can be one
862 of these:
864 - a buffer, in which case output is inserted into that buffer at point;
865 - a marker, in which case output is inserted at marker's position;
866 - a function, in which case that function is called once for each
867 character of OBJECT's printed representation;
868 - a symbol, in which case that symbol's function definition is called; or
869 - t, in which case the output is displayed in the echo area.
871 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
872 is used instead. */)
873 (object, printcharfun)
874 Lisp_Object object, printcharfun;
876 PRINTDECLARE;
877 struct gcpro gcpro1;
879 #ifdef MAX_PRINT_CHARS
880 print_chars = 0;
881 max_print = MAX_PRINT_CHARS;
882 #endif /* MAX_PRINT_CHARS */
883 if (NILP (printcharfun))
884 printcharfun = Vstandard_output;
885 GCPRO1 (object);
886 PRINTPREPARE;
887 PRINTCHAR ('\n');
888 print (object, printcharfun, 1);
889 PRINTCHAR ('\n');
890 PRINTFINISH;
891 #ifdef MAX_PRINT_CHARS
892 max_print = 0;
893 print_chars = 0;
894 #endif /* MAX_PRINT_CHARS */
895 UNGCPRO;
896 return object;
899 /* The subroutine object for external-debugging-output is kept here
900 for the convenience of the debugger. */
901 Lisp_Object Qexternal_debugging_output;
903 DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0,
904 doc: /* Write CHARACTER to stderr.
905 You can call print while debugging emacs, and pass it this function
906 to make it write to the debugging output. */)
907 (character)
908 Lisp_Object character;
910 CHECK_NUMBER (character);
911 putc (XINT (character), stderr);
913 #ifdef WINDOWSNT
914 /* Send the output to a debugger (nothing happens if there isn't one). */
915 if (print_output_debug_flag)
917 char buf[2] = {(char) XINT (character), '\0'};
918 OutputDebugString (buf);
920 #endif
922 return character;
926 #if defined(GNU_LINUX)
928 /* This functionality is not vitally important in general, so we rely on
929 non-portable ability to use stderr as lvalue. */
931 #define WITH_REDIRECT_DEBUGGING_OUTPUT 1
933 FILE *initial_stderr_stream = NULL;
935 DEFUN ("redirect-debugging-output", Fredirect_debugging_output, Sredirect_debugging_output,
936 1, 2,
937 "FDebug output file: \nP",
938 doc: /* Redirect debugging output (stderr stream) to file FILE.
939 If FILE is nil, reset target to the initial stderr stream.
940 Optional arg APPEND non-nil (interactively, with prefix arg) means
941 append to existing target file. */)
942 (file, append)
943 Lisp_Object file, append;
945 if (initial_stderr_stream != NULL)
946 fclose(stderr);
947 stderr = initial_stderr_stream;
948 initial_stderr_stream = NULL;
950 if (STRINGP (file))
952 file = Fexpand_file_name (file, Qnil);
953 initial_stderr_stream = stderr;
954 stderr = fopen(SDATA (file), NILP (append) ? "w" : "a");
955 if (stderr == NULL)
957 stderr = initial_stderr_stream;
958 initial_stderr_stream = NULL;
959 report_file_error ("Cannot open debugging output stream",
960 Fcons (file, Qnil));
963 return Qnil;
965 #endif /* GNU_LINUX */
968 /* This is the interface for debugging printing. */
970 void
971 debug_print (arg)
972 Lisp_Object arg;
974 Fprin1 (arg, Qexternal_debugging_output);
975 fprintf (stderr, "\r\n");
978 void
979 safe_debug_print (arg)
980 Lisp_Object arg;
982 int valid = valid_lisp_object_p (arg);
984 if (valid > 0)
985 debug_print (arg);
986 else
987 fprintf (stderr, "#<%s_LISP_OBJECT 0x%08lx>\r\n",
988 !valid ? "INVALID" : "SOME",
989 #ifdef NO_UNION_TYPE
990 (unsigned long) arg
991 #else
992 (unsigned long) arg.i
993 #endif
998 DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
999 1, 1, 0,
1000 doc: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
1001 See Info anchor `(elisp)Definition of signal' for some details on how this
1002 error message is constructed. */)
1003 (obj)
1004 Lisp_Object obj;
1006 struct buffer *old = current_buffer;
1007 Lisp_Object value;
1008 struct gcpro gcpro1;
1010 /* If OBJ is (error STRING), just return STRING.
1011 That is not only faster, it also avoids the need to allocate
1012 space here when the error is due to memory full. */
1013 if (CONSP (obj) && EQ (XCAR (obj), Qerror)
1014 && CONSP (XCDR (obj))
1015 && STRINGP (XCAR (XCDR (obj)))
1016 && NILP (XCDR (XCDR (obj))))
1017 return XCAR (XCDR (obj));
1019 print_error_message (obj, Vprin1_to_string_buffer, 0, Qnil);
1021 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
1022 value = Fbuffer_string ();
1024 GCPRO1 (value);
1025 Ferase_buffer ();
1026 set_buffer_internal (old);
1027 UNGCPRO;
1029 return value;
1032 /* Print an error message for the error DATA onto Lisp output stream
1033 STREAM (suitable for the print functions). */
1035 void
1036 print_error_message (data, stream, context, caller)
1037 Lisp_Object data, stream;
1038 char *context;
1039 Lisp_Object caller;
1041 Lisp_Object errname, errmsg, file_error, tail;
1042 struct gcpro gcpro1;
1043 int i;
1045 if (context != 0)
1046 write_string_1 (context, -1, stream);
1048 /* If we know from where the error was signaled, show it in
1049 *Messages*. */
1050 if (!NILP (caller) && SYMBOLP (caller))
1052 Lisp_Object cname = SYMBOL_NAME (caller);
1053 char *name = alloca (SBYTES (cname));
1054 bcopy (SDATA (cname), name, SBYTES (cname));
1055 message_dolog (name, SBYTES (cname), 0, 0);
1056 message_dolog (": ", 2, 0, 0);
1059 errname = Fcar (data);
1061 if (EQ (errname, Qerror))
1063 data = Fcdr (data);
1064 if (!CONSP (data))
1065 data = Qnil;
1066 errmsg = Fcar (data);
1067 file_error = Qnil;
1069 else
1071 Lisp_Object error_conditions;
1072 errmsg = Fget (errname, Qerror_message);
1073 error_conditions = Fget (errname, Qerror_conditions);
1074 file_error = Fmemq (Qfile_error, error_conditions);
1077 /* Print an error message including the data items. */
1079 tail = Fcdr_safe (data);
1080 GCPRO1 (tail);
1082 /* For file-error, make error message by concatenating
1083 all the data items. They are all strings. */
1084 if (!NILP (file_error) && CONSP (tail))
1085 errmsg = XCAR (tail), tail = XCDR (tail);
1087 if (STRINGP (errmsg))
1088 Fprinc (errmsg, stream);
1089 else
1090 write_string_1 ("peculiar error", -1, stream);
1092 for (i = 0; CONSP (tail); tail = XCDR (tail), i++)
1094 Lisp_Object obj;
1096 write_string_1 (i ? ", " : ": ", 2, stream);
1097 obj = XCAR (tail);
1098 if (!NILP (file_error) || EQ (errname, Qend_of_file))
1099 Fprinc (obj, stream);
1100 else
1101 Fprin1 (obj, stream);
1104 UNGCPRO;
1110 * The buffer should be at least as large as the max string size of the
1111 * largest float, printed in the biggest notation. This is undoubtedly
1112 * 20d float_output_format, with the negative of the C-constant "HUGE"
1113 * from <math.h>.
1115 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1117 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1118 * case of -1e307 in 20d float_output_format. What is one to do (short of
1119 * re-writing _doprnt to be more sane)?
1120 * -wsr
1123 void
1124 float_to_string (buf, data)
1125 unsigned char *buf;
1126 double data;
1128 unsigned char *cp;
1129 int width;
1131 /* Check for plus infinity in a way that won't lose
1132 if there is no plus infinity. */
1133 if (data == data / 2 && data > 1.0)
1135 strcpy (buf, "1.0e+INF");
1136 return;
1138 /* Likewise for minus infinity. */
1139 if (data == data / 2 && data < -1.0)
1141 strcpy (buf, "-1.0e+INF");
1142 return;
1144 /* Check for NaN in a way that won't fail if there are no NaNs. */
1145 if (! (data * 0.0 >= 0.0))
1147 /* Prepend "-" if the NaN's sign bit is negative.
1148 The sign bit of a double is the bit that is 1 in -0.0. */
1149 int i;
1150 union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
1151 u_data.d = data;
1152 u_minus_zero.d = - 0.0;
1153 for (i = 0; i < sizeof (double); i++)
1154 if (u_data.c[i] & u_minus_zero.c[i])
1156 *buf++ = '-';
1157 break;
1160 strcpy (buf, "0.0e+NaN");
1161 return;
1164 if (NILP (Vfloat_output_format)
1165 || !STRINGP (Vfloat_output_format))
1166 lose:
1168 /* Generate the fewest number of digits that represent the
1169 floating point value without losing information.
1170 The following method is simple but a bit slow.
1171 For ideas about speeding things up, please see:
1173 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1174 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1176 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1177 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1179 width = fabs (data) < DBL_MIN ? 1 : DBL_DIG;
1181 sprintf (buf, "%.*g", width, data);
1182 while (width++ < DOUBLE_DIGITS_BOUND && atof (buf) != data);
1184 else /* oink oink */
1186 /* Check that the spec we have is fully valid.
1187 This means not only valid for printf,
1188 but meant for floats, and reasonable. */
1189 cp = SDATA (Vfloat_output_format);
1191 if (cp[0] != '%')
1192 goto lose;
1193 if (cp[1] != '.')
1194 goto lose;
1196 cp += 2;
1198 /* Check the width specification. */
1199 width = -1;
1200 if ('0' <= *cp && *cp <= '9')
1202 width = 0;
1204 width = (width * 10) + (*cp++ - '0');
1205 while (*cp >= '0' && *cp <= '9');
1207 /* A precision of zero is valid only for %f. */
1208 if (width > DBL_DIG
1209 || (width == 0 && *cp != 'f'))
1210 goto lose;
1213 if (*cp != 'e' && *cp != 'f' && *cp != 'g')
1214 goto lose;
1216 if (cp[1] != 0)
1217 goto lose;
1219 sprintf (buf, SDATA (Vfloat_output_format), data);
1222 /* Make sure there is a decimal point with digit after, or an
1223 exponent, so that the value is readable as a float. But don't do
1224 this with "%.0f"; it's valid for that not to produce a decimal
1225 point. Note that width can be 0 only for %.0f. */
1226 if (width != 0)
1228 for (cp = buf; *cp; cp++)
1229 if ((*cp < '0' || *cp > '9') && *cp != '-')
1230 break;
1232 if (*cp == '.' && cp[1] == 0)
1234 cp[1] = '0';
1235 cp[2] = 0;
1238 if (*cp == 0)
1240 *cp++ = '.';
1241 *cp++ = '0';
1242 *cp++ = 0;
1248 static void
1249 print (obj, printcharfun, escapeflag)
1250 Lisp_Object obj;
1251 register Lisp_Object printcharfun;
1252 int escapeflag;
1254 old_backquote_output = 0;
1256 /* Reset print_number_index and Vprint_number_table only when
1257 the variable Vprint_continuous_numbering is nil. Otherwise,
1258 the values of these variables will be kept between several
1259 print functions. */
1260 if (NILP (Vprint_continuous_numbering))
1262 print_number_index = 0;
1263 Vprint_number_table = Qnil;
1266 /* Construct Vprint_number_table for print-gensym and print-circle. */
1267 if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))
1269 int i, start, index;
1270 start = index = print_number_index;
1271 /* Construct Vprint_number_table.
1272 This increments print_number_index for the objects added. */
1273 print_depth = 0;
1274 print_preprocess (obj);
1276 /* Remove unnecessary objects, which appear only once in OBJ;
1277 that is, whose status is Qnil. Compactify the necessary objects. */
1278 for (i = start; i < print_number_index; i++)
1279 if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1281 PRINT_NUMBER_OBJECT (Vprint_number_table, index)
1282 = PRINT_NUMBER_OBJECT (Vprint_number_table, i);
1283 index++;
1286 /* Clear out objects outside the active part of the table. */
1287 for (i = index; i < print_number_index; i++)
1288 PRINT_NUMBER_OBJECT (Vprint_number_table, i) = Qnil;
1290 /* Reset the status field for the next print step. Now this
1291 field means whether the object has already been printed. */
1292 for (i = start; i < print_number_index; i++)
1293 PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qnil;
1295 print_number_index = index;
1298 print_depth = 0;
1299 print_object (obj, printcharfun, escapeflag);
1302 /* Construct Vprint_number_table according to the structure of OBJ.
1303 OBJ itself and all its elements will be added to Vprint_number_table
1304 recursively if it is a list, vector, compiled function, char-table,
1305 string (its text properties will be traced), or a symbol that has
1306 no obarray (this is for the print-gensym feature).
1307 The status fields of Vprint_number_table mean whether each object appears
1308 more than once in OBJ: Qnil at the first time, and Qt after that . */
1309 static void
1310 print_preprocess (obj)
1311 Lisp_Object obj;
1313 int i;
1314 EMACS_INT size;
1315 int loop_count = 0;
1316 Lisp_Object halftail;
1318 /* Give up if we go so deep that print_object will get an error. */
1319 /* See similar code in print_object. */
1320 if (print_depth >= PRINT_CIRCLE)
1321 error ("Apparently circular structure being printed");
1323 /* Avoid infinite recursion for circular nested structure
1324 in the case where Vprint_circle is nil. */
1325 if (NILP (Vprint_circle))
1327 for (i = 0; i < print_depth; i++)
1328 if (EQ (obj, being_printed[i]))
1329 return;
1330 being_printed[print_depth] = obj;
1333 print_depth++;
1334 halftail = obj;
1336 loop:
1337 if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
1338 || COMPILEDP (obj) || CHAR_TABLE_P (obj)
1339 || (! NILP (Vprint_gensym)
1340 && SYMBOLP (obj)
1341 && !SYMBOL_INTERNED_P (obj)))
1343 /* In case print-circle is nil and print-gensym is t,
1344 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1345 if (! NILP (Vprint_circle) || SYMBOLP (obj))
1347 for (i = 0; i < print_number_index; i++)
1348 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj))
1350 /* OBJ appears more than once. Let's remember that. */
1351 PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
1352 print_depth--;
1353 return;
1356 /* OBJ is not yet recorded. Let's add to the table. */
1357 if (print_number_index == 0)
1359 /* Initialize the table. */
1360 Vprint_number_table = Fmake_vector (make_number (40), Qnil);
1362 else if (XVECTOR (Vprint_number_table)->size == print_number_index * 2)
1364 /* Reallocate the table. */
1365 int i = print_number_index * 4;
1366 Lisp_Object old_table = Vprint_number_table;
1367 Vprint_number_table = Fmake_vector (make_number (i), Qnil);
1368 for (i = 0; i < print_number_index; i++)
1370 PRINT_NUMBER_OBJECT (Vprint_number_table, i)
1371 = PRINT_NUMBER_OBJECT (old_table, i);
1372 PRINT_NUMBER_STATUS (Vprint_number_table, i)
1373 = PRINT_NUMBER_STATUS (old_table, i);
1376 PRINT_NUMBER_OBJECT (Vprint_number_table, print_number_index) = obj;
1377 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1378 always print the gensym with a number. This is a special for
1379 the lisp function byte-compile-output-docform. */
1380 if (!NILP (Vprint_continuous_numbering)
1381 && SYMBOLP (obj)
1382 && !SYMBOL_INTERNED_P (obj))
1383 PRINT_NUMBER_STATUS (Vprint_number_table, print_number_index) = Qt;
1384 print_number_index++;
1387 switch (XGCTYPE (obj))
1389 case Lisp_String:
1390 /* A string may have text properties, which can be circular. */
1391 traverse_intervals_noorder (STRING_INTERVALS (obj),
1392 print_preprocess_string, Qnil);
1393 break;
1395 case Lisp_Cons:
1396 /* Use HALFTAIL and LOOP_COUNT to detect circular lists,
1397 just as in print_object. */
1398 if (loop_count && EQ (obj, halftail))
1399 break;
1400 print_preprocess (XCAR (obj));
1401 obj = XCDR (obj);
1402 loop_count++;
1403 if (!(loop_count & 1))
1404 halftail = XCDR (halftail);
1405 goto loop;
1407 case Lisp_Vectorlike:
1408 size = XVECTOR (obj)->size;
1409 if (size & PSEUDOVECTOR_FLAG)
1410 size &= PSEUDOVECTOR_SIZE_MASK;
1411 for (i = 0; i < size; i++)
1412 print_preprocess (XVECTOR (obj)->contents[i]);
1413 break;
1415 default:
1416 break;
1419 print_depth--;
1422 static void
1423 print_preprocess_string (interval, arg)
1424 INTERVAL interval;
1425 Lisp_Object arg;
1427 print_preprocess (interval->plist);
1430 static void
1431 print_object (obj, printcharfun, escapeflag)
1432 Lisp_Object obj;
1433 register Lisp_Object printcharfun;
1434 int escapeflag;
1436 char buf[40];
1438 QUIT;
1440 /* Detect circularities and truncate them. */
1441 if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
1442 || COMPILEDP (obj) || CHAR_TABLE_P (obj)
1443 || (! NILP (Vprint_gensym)
1444 && SYMBOLP (obj)
1445 && !SYMBOL_INTERNED_P (obj)))
1447 if (NILP (Vprint_circle) && NILP (Vprint_gensym))
1449 /* Simple but incomplete way. */
1450 int i;
1451 for (i = 0; i < print_depth; i++)
1452 if (EQ (obj, being_printed[i]))
1454 sprintf (buf, "#%d", i);
1455 strout (buf, -1, -1, printcharfun, 0);
1456 return;
1458 being_printed[print_depth] = obj;
1460 else
1462 /* With the print-circle feature. */
1463 int i;
1464 for (i = 0; i < print_number_index; i++)
1465 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj))
1467 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1469 /* Add a prefix #n= if OBJ has not yet been printed;
1470 that is, its status field is nil. */
1471 sprintf (buf, "#%d=", i + 1);
1472 strout (buf, -1, -1, printcharfun, 0);
1473 /* OBJ is going to be printed. Set the status to t. */
1474 PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
1475 break;
1477 else
1479 /* Just print #n# if OBJ has already been printed. */
1480 sprintf (buf, "#%d#", i + 1);
1481 strout (buf, -1, -1, printcharfun, 0);
1482 return;
1488 print_depth++;
1490 /* See similar code in print_preprocess. */
1491 if (print_depth > PRINT_CIRCLE)
1492 error ("Apparently circular structure being printed");
1493 #ifdef MAX_PRINT_CHARS
1494 if (max_print && print_chars > max_print)
1496 PRINTCHAR ('\n');
1497 print_chars = 0;
1499 #endif /* MAX_PRINT_CHARS */
1501 switch (XGCTYPE (obj))
1503 case Lisp_Int:
1504 if (sizeof (int) == sizeof (EMACS_INT))
1505 sprintf (buf, "%d", XINT (obj));
1506 else if (sizeof (long) == sizeof (EMACS_INT))
1507 sprintf (buf, "%ld", (long) XINT (obj));
1508 else
1509 abort ();
1510 strout (buf, -1, -1, printcharfun, 0);
1511 break;
1513 case Lisp_Float:
1515 char pigbuf[350]; /* see comments in float_to_string */
1517 float_to_string (pigbuf, XFLOAT_DATA (obj));
1518 strout (pigbuf, -1, -1, printcharfun, 0);
1520 break;
1522 case Lisp_String:
1523 if (!escapeflag)
1524 print_string (obj, printcharfun);
1525 else
1527 register int i, i_byte;
1528 struct gcpro gcpro1;
1529 unsigned char *str;
1530 int size_byte;
1531 /* 1 means we must ensure that the next character we output
1532 cannot be taken as part of a hex character escape. */
1533 int need_nonhex = 0;
1534 int multibyte = STRING_MULTIBYTE (obj);
1536 GCPRO1 (obj);
1538 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
1540 PRINTCHAR ('#');
1541 PRINTCHAR ('(');
1544 PRINTCHAR ('\"');
1545 str = SDATA (obj);
1546 size_byte = SBYTES (obj);
1548 for (i = 0, i_byte = 0; i_byte < size_byte;)
1550 /* Here, we must convert each multi-byte form to the
1551 corresponding character code before handing it to PRINTCHAR. */
1552 int len;
1553 int c;
1555 if (multibyte)
1557 c = STRING_CHAR_AND_LENGTH (str + i_byte,
1558 size_byte - i_byte, len);
1559 if (CHAR_VALID_P (c, 0))
1560 i_byte += len;
1561 else
1562 c = str[i_byte++];
1564 else
1565 c = str[i_byte++];
1567 QUIT;
1569 if (c == '\n' && print_escape_newlines)
1571 PRINTCHAR ('\\');
1572 PRINTCHAR ('n');
1574 else if (c == '\f' && print_escape_newlines)
1576 PRINTCHAR ('\\');
1577 PRINTCHAR ('f');
1579 else if (multibyte
1580 && ! ASCII_BYTE_P (c)
1581 && (SINGLE_BYTE_CHAR_P (c) || print_escape_multibyte))
1583 /* When multibyte is disabled,
1584 print multibyte string chars using hex escapes.
1585 For a char code that could be in a unibyte string,
1586 when found in a multibyte string, always use a hex escape
1587 so it reads back as multibyte. */
1588 unsigned char outbuf[50];
1589 sprintf (outbuf, "\\x%x", c);
1590 strout (outbuf, -1, -1, printcharfun, 0);
1591 need_nonhex = 1;
1593 else if (! multibyte
1594 && SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c)
1595 && print_escape_nonascii)
1597 /* When printing in a multibyte buffer
1598 or when explicitly requested,
1599 print single-byte non-ASCII string chars
1600 using octal escapes. */
1601 unsigned char outbuf[5];
1602 sprintf (outbuf, "\\%03o", c);
1603 strout (outbuf, -1, -1, printcharfun, 0);
1605 else
1607 /* If we just had a hex escape, and this character
1608 could be taken as part of it,
1609 output `\ ' to prevent that. */
1610 if (need_nonhex)
1612 need_nonhex = 0;
1613 if ((c >= 'a' && c <= 'f')
1614 || (c >= 'A' && c <= 'F')
1615 || (c >= '0' && c <= '9'))
1616 strout ("\\ ", -1, -1, printcharfun, 0);
1619 if (c == '\"' || c == '\\')
1620 PRINTCHAR ('\\');
1621 PRINTCHAR (c);
1624 PRINTCHAR ('\"');
1626 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
1628 traverse_intervals (STRING_INTERVALS (obj),
1629 0, print_interval, printcharfun);
1630 PRINTCHAR (')');
1633 UNGCPRO;
1635 break;
1637 case Lisp_Symbol:
1639 register int confusing;
1640 register unsigned char *p = SDATA (SYMBOL_NAME (obj));
1641 register unsigned char *end = p + SBYTES (SYMBOL_NAME (obj));
1642 register int c;
1643 int i, i_byte, size_byte;
1644 Lisp_Object name;
1646 name = SYMBOL_NAME (obj);
1648 if (p != end && (*p == '-' || *p == '+')) p++;
1649 if (p == end)
1650 confusing = 0;
1651 /* If symbol name begins with a digit, and ends with a digit,
1652 and contains nothing but digits and `e', it could be treated
1653 as a number. So set CONFUSING.
1655 Symbols that contain periods could also be taken as numbers,
1656 but periods are always escaped, so we don't have to worry
1657 about them here. */
1658 else if (*p >= '0' && *p <= '9'
1659 && end[-1] >= '0' && end[-1] <= '9')
1661 while (p != end && ((*p >= '0' && *p <= '9')
1662 /* Needed for \2e10. */
1663 || *p == 'e'))
1664 p++;
1665 confusing = (end == p);
1667 else
1668 confusing = 0;
1670 if (! NILP (Vprint_gensym) && !SYMBOL_INTERNED_P (obj))
1672 PRINTCHAR ('#');
1673 PRINTCHAR (':');
1676 size_byte = SBYTES (name);
1678 for (i = 0, i_byte = 0; i_byte < size_byte;)
1680 /* Here, we must convert each multi-byte form to the
1681 corresponding character code before handing it to PRINTCHAR. */
1682 FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte);
1683 QUIT;
1685 if (escapeflag)
1687 if (c == '\"' || c == '\\' || c == '\''
1688 || c == ';' || c == '#' || c == '(' || c == ')'
1689 || c == ',' || c =='.' || c == '`'
1690 || c == '[' || c == ']' || c == '?' || c <= 040
1691 || confusing)
1692 PRINTCHAR ('\\'), confusing = 0;
1694 PRINTCHAR (c);
1697 break;
1699 case Lisp_Cons:
1700 /* If deeper than spec'd depth, print placeholder. */
1701 if (INTEGERP (Vprint_level)
1702 && print_depth > XINT (Vprint_level))
1703 strout ("...", -1, -1, printcharfun, 0);
1704 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1705 && (EQ (XCAR (obj), Qquote)))
1707 PRINTCHAR ('\'');
1708 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1710 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1711 && (EQ (XCAR (obj), Qfunction)))
1713 PRINTCHAR ('#');
1714 PRINTCHAR ('\'');
1715 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1717 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1718 && ! old_backquote_output
1719 && ((EQ (XCAR (obj), Qbackquote)
1720 || EQ (XCAR (obj), Qcomma)
1721 || EQ (XCAR (obj), Qcomma_at)
1722 || EQ (XCAR (obj), Qcomma_dot))))
1724 print_object (XCAR (obj), printcharfun, 0);
1725 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1727 else
1729 PRINTCHAR ('(');
1731 /* If the first element is a backquote form,
1732 print it old-style so it won't be misunderstood. */
1733 if (print_quoted && CONSP (XCAR (obj))
1734 && CONSP (XCDR (XCAR (obj)))
1735 && NILP (XCDR (XCDR (XCAR (obj))))
1736 && EQ (XCAR (XCAR (obj)), Qbackquote))
1738 Lisp_Object tem;
1739 tem = XCAR (obj);
1740 PRINTCHAR ('(');
1742 print_object (Qbackquote, printcharfun, 0);
1743 PRINTCHAR (' ');
1745 ++old_backquote_output;
1746 print_object (XCAR (XCDR (tem)), printcharfun, 0);
1747 --old_backquote_output;
1748 PRINTCHAR (')');
1750 obj = XCDR (obj);
1754 int print_length, i;
1755 Lisp_Object halftail = obj;
1757 /* Negative values of print-length are invalid in CL.
1758 Treat them like nil, as CMUCL does. */
1759 if (NATNUMP (Vprint_length))
1760 print_length = XFASTINT (Vprint_length);
1761 else
1762 print_length = 0;
1764 i = 0;
1765 while (CONSP (obj))
1767 /* Detect circular list. */
1768 if (NILP (Vprint_circle))
1770 /* Simple but imcomplete way. */
1771 if (i != 0 && EQ (obj, halftail))
1773 sprintf (buf, " . #%d", i / 2);
1774 strout (buf, -1, -1, printcharfun, 0);
1775 goto end_of_list;
1778 else
1780 /* With the print-circle feature. */
1781 if (i != 0)
1783 int i;
1784 for (i = 0; i < print_number_index; i++)
1785 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i),
1786 obj))
1788 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1790 strout (" . ", 3, 3, printcharfun, 0);
1791 print_object (obj, printcharfun, escapeflag);
1793 else
1795 sprintf (buf, " . #%d#", i + 1);
1796 strout (buf, -1, -1, printcharfun, 0);
1798 goto end_of_list;
1803 if (i++)
1804 PRINTCHAR (' ');
1806 if (print_length && i > print_length)
1808 strout ("...", 3, 3, printcharfun, 0);
1809 goto end_of_list;
1812 print_object (XCAR (obj), printcharfun, escapeflag);
1814 obj = XCDR (obj);
1815 if (!(i & 1))
1816 halftail = XCDR (halftail);
1820 /* OBJ non-nil here means it's the end of a dotted list. */
1821 if (!NILP (obj))
1823 strout (" . ", 3, 3, printcharfun, 0);
1824 print_object (obj, printcharfun, escapeflag);
1827 end_of_list:
1828 PRINTCHAR (')');
1830 break;
1832 case Lisp_Vectorlike:
1833 if (PROCESSP (obj))
1835 if (escapeflag)
1837 strout ("#<process ", -1, -1, printcharfun, 0);
1838 print_string (XPROCESS (obj)->name, printcharfun);
1839 PRINTCHAR ('>');
1841 else
1842 print_string (XPROCESS (obj)->name, printcharfun);
1844 else if (BOOL_VECTOR_P (obj))
1846 register int i;
1847 register unsigned char c;
1848 struct gcpro gcpro1;
1849 int size_in_chars
1850 = ((XBOOL_VECTOR (obj)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
1851 / BOOL_VECTOR_BITS_PER_CHAR);
1853 GCPRO1 (obj);
1855 PRINTCHAR ('#');
1856 PRINTCHAR ('&');
1857 sprintf (buf, "%ld", (long) XBOOL_VECTOR (obj)->size);
1858 strout (buf, -1, -1, printcharfun, 0);
1859 PRINTCHAR ('\"');
1861 /* Don't print more characters than the specified maximum.
1862 Negative values of print-length are invalid. Treat them
1863 like a print-length of nil. */
1864 if (NATNUMP (Vprint_length)
1865 && XFASTINT (Vprint_length) < size_in_chars)
1866 size_in_chars = XFASTINT (Vprint_length);
1868 for (i = 0; i < size_in_chars; i++)
1870 QUIT;
1871 c = XBOOL_VECTOR (obj)->data[i];
1872 if (c == '\n' && print_escape_newlines)
1874 PRINTCHAR ('\\');
1875 PRINTCHAR ('n');
1877 else if (c == '\f' && print_escape_newlines)
1879 PRINTCHAR ('\\');
1880 PRINTCHAR ('f');
1882 else if (c > '\177')
1884 /* Use octal escapes to avoid encoding issues. */
1885 PRINTCHAR ('\\');
1886 PRINTCHAR ('0' + ((c >> 6) & 3));
1887 PRINTCHAR ('0' + ((c >> 3) & 7));
1888 PRINTCHAR ('0' + (c & 7));
1890 else
1892 if (c == '\"' || c == '\\')
1893 PRINTCHAR ('\\');
1894 PRINTCHAR (c);
1897 PRINTCHAR ('\"');
1899 UNGCPRO;
1901 else if (SUBRP (obj))
1903 strout ("#<subr ", -1, -1, printcharfun, 0);
1904 strout (XSUBR (obj)->symbol_name, -1, -1, printcharfun, 0);
1905 PRINTCHAR ('>');
1907 else if (WINDOWP (obj))
1909 strout ("#<window ", -1, -1, printcharfun, 0);
1910 sprintf (buf, "%ld", (long) XFASTINT (XWINDOW (obj)->sequence_number));
1911 strout (buf, -1, -1, printcharfun, 0);
1912 if (!NILP (XWINDOW (obj)->buffer))
1914 strout (" on ", -1, -1, printcharfun, 0);
1915 print_string (XBUFFER (XWINDOW (obj)->buffer)->name, printcharfun);
1917 PRINTCHAR ('>');
1919 else if (HASH_TABLE_P (obj))
1921 struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
1922 strout ("#<hash-table", -1, -1, printcharfun, 0);
1923 if (SYMBOLP (h->test))
1925 PRINTCHAR (' ');
1926 PRINTCHAR ('\'');
1927 strout (SDATA (SYMBOL_NAME (h->test)), -1, -1, printcharfun, 0);
1928 PRINTCHAR (' ');
1929 strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun, 0);
1930 PRINTCHAR (' ');
1931 sprintf (buf, "%ld/%ld", (long) XFASTINT (h->count),
1932 (long) XVECTOR (h->next)->size);
1933 strout (buf, -1, -1, printcharfun, 0);
1935 sprintf (buf, " 0x%lx", (unsigned long) h);
1936 strout (buf, -1, -1, printcharfun, 0);
1937 PRINTCHAR ('>');
1939 else if (BUFFERP (obj))
1941 if (NILP (XBUFFER (obj)->name))
1942 strout ("#<killed buffer>", -1, -1, printcharfun, 0);
1943 else if (escapeflag)
1945 strout ("#<buffer ", -1, -1, printcharfun, 0);
1946 print_string (XBUFFER (obj)->name, printcharfun);
1947 PRINTCHAR ('>');
1949 else
1950 print_string (XBUFFER (obj)->name, printcharfun);
1952 else if (WINDOW_CONFIGURATIONP (obj))
1954 strout ("#<window-configuration>", -1, -1, printcharfun, 0);
1956 else if (FRAMEP (obj))
1958 strout ((FRAME_LIVE_P (XFRAME (obj))
1959 ? "#<frame " : "#<dead frame "),
1960 -1, -1, printcharfun, 0);
1961 print_string (XFRAME (obj)->name, printcharfun);
1962 sprintf (buf, " 0x%lx", (unsigned long) (XFRAME (obj)));
1963 strout (buf, -1, -1, printcharfun, 0);
1964 PRINTCHAR ('>');
1966 else
1968 EMACS_INT size = XVECTOR (obj)->size;
1969 if (COMPILEDP (obj))
1971 PRINTCHAR ('#');
1972 size &= PSEUDOVECTOR_SIZE_MASK;
1974 if (CHAR_TABLE_P (obj))
1976 /* We print a char-table as if it were a vector,
1977 lumping the parent and default slots in with the
1978 character slots. But we add #^ as a prefix. */
1979 PRINTCHAR ('#');
1980 PRINTCHAR ('^');
1981 if (SUB_CHAR_TABLE_P (obj))
1982 PRINTCHAR ('^');
1983 size &= PSEUDOVECTOR_SIZE_MASK;
1985 if (size & PSEUDOVECTOR_FLAG)
1986 goto badtype;
1988 PRINTCHAR ('[');
1990 register int i;
1991 register Lisp_Object tem;
1992 int real_size = size;
1994 /* Don't print more elements than the specified maximum. */
1995 if (NATNUMP (Vprint_length)
1996 && XFASTINT (Vprint_length) < size)
1997 size = XFASTINT (Vprint_length);
1999 for (i = 0; i < size; i++)
2001 if (i) PRINTCHAR (' ');
2002 tem = XVECTOR (obj)->contents[i];
2003 print_object (tem, printcharfun, escapeflag);
2005 if (size < real_size)
2006 strout (" ...", 4, 4, printcharfun, 0);
2008 PRINTCHAR (']');
2010 break;
2012 case Lisp_Misc:
2013 switch (XMISCTYPE (obj))
2015 case Lisp_Misc_Marker:
2016 strout ("#<marker ", -1, -1, printcharfun, 0);
2017 /* Do you think this is necessary? */
2018 if (XMARKER (obj)->insertion_type != 0)
2019 strout ("(moves after insertion) ", -1, -1, printcharfun, 0);
2020 if (!(XMARKER (obj)->buffer))
2021 strout ("in no buffer", -1, -1, printcharfun, 0);
2022 else
2024 sprintf (buf, "at %d", marker_position (obj));
2025 strout (buf, -1, -1, printcharfun, 0);
2026 strout (" in ", -1, -1, printcharfun, 0);
2027 print_string (XMARKER (obj)->buffer->name, printcharfun);
2029 PRINTCHAR ('>');
2030 break;
2032 case Lisp_Misc_Overlay:
2033 strout ("#<overlay ", -1, -1, printcharfun, 0);
2034 if (!(XMARKER (OVERLAY_START (obj))->buffer))
2035 strout ("in no buffer", -1, -1, printcharfun, 0);
2036 else
2038 sprintf (buf, "from %d to %d in ",
2039 marker_position (OVERLAY_START (obj)),
2040 marker_position (OVERLAY_END (obj)));
2041 strout (buf, -1, -1, printcharfun, 0);
2042 print_string (XMARKER (OVERLAY_START (obj))->buffer->name,
2043 printcharfun);
2045 PRINTCHAR ('>');
2046 break;
2048 /* Remaining cases shouldn't happen in normal usage, but let's print
2049 them anyway for the benefit of the debugger. */
2050 case Lisp_Misc_Free:
2051 strout ("#<misc free cell>", -1, -1, printcharfun, 0);
2052 break;
2054 case Lisp_Misc_Intfwd:
2055 sprintf (buf, "#<intfwd to %ld>", (long) *XINTFWD (obj)->intvar);
2056 strout (buf, -1, -1, printcharfun, 0);
2057 break;
2059 case Lisp_Misc_Boolfwd:
2060 sprintf (buf, "#<boolfwd to %s>",
2061 (*XBOOLFWD (obj)->boolvar ? "t" : "nil"));
2062 strout (buf, -1, -1, printcharfun, 0);
2063 break;
2065 case Lisp_Misc_Objfwd:
2066 strout ("#<objfwd to ", -1, -1, printcharfun, 0);
2067 print_object (*XOBJFWD (obj)->objvar, printcharfun, escapeflag);
2068 PRINTCHAR ('>');
2069 break;
2071 case Lisp_Misc_Buffer_Objfwd:
2072 strout ("#<buffer_objfwd to ", -1, -1, printcharfun, 0);
2073 print_object (PER_BUFFER_VALUE (current_buffer,
2074 XBUFFER_OBJFWD (obj)->offset),
2075 printcharfun, escapeflag);
2076 PRINTCHAR ('>');
2077 break;
2079 case Lisp_Misc_Kboard_Objfwd:
2080 strout ("#<kboard_objfwd to ", -1, -1, printcharfun, 0);
2081 print_object (*(Lisp_Object *)((char *) current_kboard
2082 + XKBOARD_OBJFWD (obj)->offset),
2083 printcharfun, escapeflag);
2084 PRINTCHAR ('>');
2085 break;
2087 case Lisp_Misc_Buffer_Local_Value:
2088 strout ("#<buffer_local_value ", -1, -1, printcharfun, 0);
2089 goto do_buffer_local;
2090 case Lisp_Misc_Some_Buffer_Local_Value:
2091 strout ("#<some_buffer_local_value ", -1, -1, printcharfun, 0);
2092 do_buffer_local:
2093 strout ("[realvalue] ", -1, -1, printcharfun, 0);
2094 print_object (XBUFFER_LOCAL_VALUE (obj)->realvalue,
2095 printcharfun, escapeflag);
2096 if (XBUFFER_LOCAL_VALUE (obj)->found_for_buffer)
2097 strout ("[local in buffer] ", -1, -1, printcharfun, 0);
2098 else
2099 strout ("[buffer] ", -1, -1, printcharfun, 0);
2100 print_object (XBUFFER_LOCAL_VALUE (obj)->buffer,
2101 printcharfun, escapeflag);
2102 if (XBUFFER_LOCAL_VALUE (obj)->check_frame)
2104 if (XBUFFER_LOCAL_VALUE (obj)->found_for_frame)
2105 strout ("[local in frame] ", -1, -1, printcharfun, 0);
2106 else
2107 strout ("[frame] ", -1, -1, printcharfun, 0);
2108 print_object (XBUFFER_LOCAL_VALUE (obj)->frame,
2109 printcharfun, escapeflag);
2111 strout ("[alist-elt] ", -1, -1, printcharfun, 0);
2112 print_object (XCAR (XBUFFER_LOCAL_VALUE (obj)->cdr),
2113 printcharfun, escapeflag);
2114 strout ("[default-value] ", -1, -1, printcharfun, 0);
2115 print_object (XCDR (XBUFFER_LOCAL_VALUE (obj)->cdr),
2116 printcharfun, escapeflag);
2117 PRINTCHAR ('>');
2118 break;
2120 case Lisp_Misc_Save_Value:
2121 strout ("#<save_value ", -1, -1, printcharfun, 0);
2122 sprintf(buf, "ptr=0x%08lx int=%d",
2123 (unsigned long) XSAVE_VALUE (obj)->pointer,
2124 XSAVE_VALUE (obj)->integer);
2125 strout (buf, -1, -1, printcharfun, 0);
2126 PRINTCHAR ('>');
2127 break;
2129 default:
2130 goto badtype;
2132 break;
2134 default:
2135 badtype:
2137 /* We're in trouble if this happens!
2138 Probably should just abort () */
2139 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun, 0);
2140 if (MISCP (obj))
2141 sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj));
2142 else if (VECTORLIKEP (obj))
2143 sprintf (buf, "(PVEC 0x%08x)", (int) XVECTOR (obj)->size);
2144 else
2145 sprintf (buf, "(0x%02x)", (int) XTYPE (obj));
2146 strout (buf, -1, -1, printcharfun, 0);
2147 strout (" Save your buffers immediately and please report this bug>",
2148 -1, -1, printcharfun, 0);
2152 print_depth--;
2156 /* Print a description of INTERVAL using PRINTCHARFUN.
2157 This is part of printing a string that has text properties. */
2159 void
2160 print_interval (interval, printcharfun)
2161 INTERVAL interval;
2162 Lisp_Object printcharfun;
2164 PRINTCHAR (' ');
2165 print_object (make_number (interval->position), printcharfun, 1);
2166 PRINTCHAR (' ');
2167 print_object (make_number (interval->position + LENGTH (interval)),
2168 printcharfun, 1);
2169 PRINTCHAR (' ');
2170 print_object (interval->plist, printcharfun, 1);
2174 void
2175 syms_of_print ()
2177 Qtemp_buffer_setup_hook = intern ("temp-buffer-setup-hook");
2178 staticpro (&Qtemp_buffer_setup_hook);
2180 DEFVAR_LISP ("standard-output", &Vstandard_output,
2181 doc: /* Output stream `print' uses by default for outputting a character.
2182 This may be any function of one argument.
2183 It may also be a buffer (output is inserted before point)
2184 or a marker (output is inserted and the marker is advanced)
2185 or the symbol t (output appears in the echo area). */);
2186 Vstandard_output = Qt;
2187 Qstandard_output = intern ("standard-output");
2188 staticpro (&Qstandard_output);
2190 DEFVAR_LISP ("float-output-format", &Vfloat_output_format,
2191 doc: /* The format descriptor string used to print floats.
2192 This is a %-spec like those accepted by `printf' in C,
2193 but with some restrictions. It must start with the two characters `%.'.
2194 After that comes an integer precision specification,
2195 and then a letter which controls the format.
2196 The letters allowed are `e', `f' and `g'.
2197 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2198 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2199 Use `g' to choose the shorter of those two formats for the number at hand.
2200 The precision in any of these cases is the number of digits following
2201 the decimal point. With `f', a precision of 0 means to omit the
2202 decimal point. 0 is not allowed with `e' or `g'.
2204 A value of nil means to use the shortest notation
2205 that represents the number without losing information. */);
2206 Vfloat_output_format = Qnil;
2207 Qfloat_output_format = intern ("float-output-format");
2208 staticpro (&Qfloat_output_format);
2210 DEFVAR_LISP ("print-length", &Vprint_length,
2211 doc: /* Maximum length of list to print before abbreviating.
2212 A value of nil means no limit. See also `eval-expression-print-length'. */);
2213 Vprint_length = Qnil;
2215 DEFVAR_LISP ("print-level", &Vprint_level,
2216 doc: /* Maximum depth of list nesting to print before abbreviating.
2217 A value of nil means no limit. See also `eval-expression-print-level'. */);
2218 Vprint_level = Qnil;
2220 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines,
2221 doc: /* Non-nil means print newlines in strings as `\\n'.
2222 Also print formfeeds as `\\f'. */);
2223 print_escape_newlines = 0;
2225 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii,
2226 doc: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2227 \(OOO is the octal representation of the character code.)
2228 Only single-byte characters are affected, and only in `prin1'.
2229 When the output goes in a multibyte buffer, this feature is
2230 enabled regardless of the value of the variable. */);
2231 print_escape_nonascii = 0;
2233 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte,
2234 doc: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2235 \(XXXX is the hex representation of the character code.)
2236 This affects only `prin1'. */);
2237 print_escape_multibyte = 0;
2239 DEFVAR_BOOL ("print-quoted", &print_quoted,
2240 doc: /* Non-nil means print quoted forms with reader syntax.
2241 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and backquoted
2242 forms print as in the new syntax. */);
2243 print_quoted = 0;
2245 DEFVAR_LISP ("print-gensym", &Vprint_gensym,
2246 doc: /* Non-nil means print uninterned symbols so they will read as uninterned.
2247 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2248 When the uninterned symbol appears within a recursive data structure,
2249 and the symbol appears more than once, in addition use the #N# and #N=
2250 constructs as needed, so that multiple references to the same symbol are
2251 shared once again when the text is read back. */);
2252 Vprint_gensym = Qnil;
2254 DEFVAR_LISP ("print-circle", &Vprint_circle,
2255 doc: /* *Non-nil means print recursive structures using #N= and #N# syntax.
2256 If nil, printing proceeds recursively and may lead to
2257 `max-lisp-eval-depth' being exceeded or an error may occur:
2258 \"Apparently circular structure being printed.\" Also see
2259 `print-length' and `print-level'.
2260 If non-nil, shared substructures anywhere in the structure are printed
2261 with `#N=' before the first occurrence (in the order of the print
2262 representation) and `#N#' in place of each subsequent occurrence,
2263 where N is a positive decimal integer. */);
2264 Vprint_circle = Qnil;
2266 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering,
2267 doc: /* *Non-nil means number continuously across print calls.
2268 This affects the numbers printed for #N= labels and #M# references.
2269 See also `print-circle', `print-gensym', and `print-number-table'.
2270 This variable should not be set with `setq'; bind it with a `let' instead. */);
2271 Vprint_continuous_numbering = Qnil;
2273 DEFVAR_LISP ("print-number-table", &Vprint_number_table,
2274 doc: /* A vector used internally to produce `#N=' labels and `#N#' references.
2275 The Lisp printer uses this vector to detect Lisp objects referenced more
2276 than once.
2278 When you bind `print-continuous-numbering' to t, you should probably
2279 also bind `print-number-table' to nil. This ensures that the value of
2280 `print-number-table' can be garbage-collected once the printing is
2281 done. If all elements of `print-number-table' are nil, it means that
2282 the printing done so far has not found any shared structure or objects
2283 that need to be recorded in the table. */);
2284 Vprint_number_table = Qnil;
2286 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2287 staticpro (&Vprin1_to_string_buffer);
2289 defsubr (&Sprin1);
2290 defsubr (&Sprin1_to_string);
2291 defsubr (&Serror_message_string);
2292 defsubr (&Sprinc);
2293 defsubr (&Sprint);
2294 defsubr (&Sterpri);
2295 defsubr (&Swrite_char);
2296 defsubr (&Sexternal_debugging_output);
2297 #ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
2298 defsubr (&Sredirect_debugging_output);
2299 #endif
2301 Qexternal_debugging_output = intern ("external-debugging-output");
2302 staticpro (&Qexternal_debugging_output);
2304 Qprint_escape_newlines = intern ("print-escape-newlines");
2305 staticpro (&Qprint_escape_newlines);
2307 Qprint_escape_multibyte = intern ("print-escape-multibyte");
2308 staticpro (&Qprint_escape_multibyte);
2310 Qprint_escape_nonascii = intern ("print-escape-nonascii");
2311 staticpro (&Qprint_escape_nonascii);
2313 defsubr (&Swith_output_to_temp_buffer);
2316 /* arch-tag: bc797170-94ae-41de-86e3-75e20f8f7a39
2317 (do not change this comment) */