(Finsert_abbrev_table_description): Sort the abbrevs alphabetically.
[emacs.git] / src / print.c
blob4a79ad19d0059822fcd37f7bb4730827c0d98ece
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. For complex objects,
763 the behavior is controlled by `print-level' and `print-length', which see.
765 OBJECT is any of the Lisp data types: a number, a string, a symbol,
766 a list, a buffer, a window, a frame, etc.
768 A printed representation of an object is text which describes that object. */)
769 (object, noescape)
770 Lisp_Object object, noescape;
772 Lisp_Object printcharfun;
773 /* struct gcpro gcpro1, gcpro2; */
774 Lisp_Object save_deactivate_mark;
775 int count = specpdl_ptr - specpdl;
776 struct buffer *previous;
778 specbind (Qinhibit_modification_hooks, Qt);
781 PRINTDECLARE;
783 /* Save and restore this--we are altering a buffer
784 but we don't want to deactivate the mark just for that.
785 No need for specbind, since errors deactivate the mark. */
786 save_deactivate_mark = Vdeactivate_mark;
787 /* GCPRO2 (object, save_deactivate_mark); */
788 abort_on_gc++;
790 printcharfun = Vprin1_to_string_buffer;
791 PRINTPREPARE;
792 print (object, printcharfun, NILP (noescape));
793 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
794 PRINTFINISH;
797 previous = current_buffer;
798 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
799 object = Fbuffer_string ();
800 if (SBYTES (object) == SCHARS (object))
801 STRING_SET_UNIBYTE (object);
803 /* Note that this won't make prepare_to_modify_buffer call
804 ask-user-about-supersession-threat because this buffer
805 does not visit a file. */
806 Ferase_buffer ();
807 set_buffer_internal (previous);
809 Vdeactivate_mark = save_deactivate_mark;
810 /* UNGCPRO; */
812 abort_on_gc--;
813 return unbind_to (count, object);
816 DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
817 doc: /* Output the printed representation of OBJECT, any Lisp object.
818 No quoting characters are used; no delimiters are printed around
819 the contents of strings.
821 OBJECT is any of the Lisp data types: a number, a string, a symbol,
822 a list, a buffer, a window, a frame, etc.
824 A printed representation of an object is text which describes that object.
826 Optional argument PRINTCHARFUN is the output stream, which can be one
827 of these:
829 - a buffer, in which case output is inserted into that buffer at point;
830 - a marker, in which case output is inserted at marker's position;
831 - a function, in which case that function is called once for each
832 character of OBJECT's printed representation;
833 - a symbol, in which case that symbol's function definition is called; or
834 - t, in which case the output is displayed in the echo area.
836 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
837 is used instead. */)
838 (object, printcharfun)
839 Lisp_Object object, printcharfun;
841 PRINTDECLARE;
843 if (NILP (printcharfun))
844 printcharfun = Vstandard_output;
845 PRINTPREPARE;
846 print (object, printcharfun, 0);
847 PRINTFINISH;
848 return object;
851 DEFUN ("print", Fprint, Sprint, 1, 2, 0,
852 doc: /* Output the printed representation of OBJECT, with newlines around it.
853 Quoting characters are printed when needed to make output that `read'
854 can handle, whenever this is possible. For complex objects, the behavior
855 is controlled by `print-level' and `print-length', which see.
857 OBJECT is any of the Lisp data types: a number, a string, a symbol,
858 a list, a buffer, a window, a frame, etc.
860 A printed representation of an object is text which describes that object.
862 Optional argument PRINTCHARFUN is the output stream, which can be one
863 of these:
865 - a buffer, in which case output is inserted into that buffer at point;
866 - a marker, in which case output is inserted at marker's position;
867 - a function, in which case that function is called once for each
868 character of OBJECT's printed representation;
869 - a symbol, in which case that symbol's function definition is called; or
870 - t, in which case the output is displayed in the echo area.
872 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
873 is used instead. */)
874 (object, printcharfun)
875 Lisp_Object object, printcharfun;
877 PRINTDECLARE;
878 struct gcpro gcpro1;
880 #ifdef MAX_PRINT_CHARS
881 print_chars = 0;
882 max_print = MAX_PRINT_CHARS;
883 #endif /* MAX_PRINT_CHARS */
884 if (NILP (printcharfun))
885 printcharfun = Vstandard_output;
886 GCPRO1 (object);
887 PRINTPREPARE;
888 PRINTCHAR ('\n');
889 print (object, printcharfun, 1);
890 PRINTCHAR ('\n');
891 PRINTFINISH;
892 #ifdef MAX_PRINT_CHARS
893 max_print = 0;
894 print_chars = 0;
895 #endif /* MAX_PRINT_CHARS */
896 UNGCPRO;
897 return object;
900 /* The subroutine object for external-debugging-output is kept here
901 for the convenience of the debugger. */
902 Lisp_Object Qexternal_debugging_output;
904 DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0,
905 doc: /* Write CHARACTER to stderr.
906 You can call print while debugging emacs, and pass it this function
907 to make it write to the debugging output. */)
908 (character)
909 Lisp_Object character;
911 CHECK_NUMBER (character);
912 putc (XINT (character), stderr);
914 #ifdef WINDOWSNT
915 /* Send the output to a debugger (nothing happens if there isn't one). */
916 if (print_output_debug_flag)
918 char buf[2] = {(char) XINT (character), '\0'};
919 OutputDebugString (buf);
921 #endif
923 return character;
927 #if defined(GNU_LINUX)
929 /* This functionality is not vitally important in general, so we rely on
930 non-portable ability to use stderr as lvalue. */
932 #define WITH_REDIRECT_DEBUGGING_OUTPUT 1
934 FILE *initial_stderr_stream = NULL;
936 DEFUN ("redirect-debugging-output", Fredirect_debugging_output, Sredirect_debugging_output,
937 1, 2,
938 "FDebug output file: \nP",
939 doc: /* Redirect debugging output (stderr stream) to file FILE.
940 If FILE is nil, reset target to the initial stderr stream.
941 Optional arg APPEND non-nil (interactively, with prefix arg) means
942 append to existing target file. */)
943 (file, append)
944 Lisp_Object file, append;
946 if (initial_stderr_stream != NULL)
947 fclose(stderr);
948 stderr = initial_stderr_stream;
949 initial_stderr_stream = NULL;
951 if (STRINGP (file))
953 file = Fexpand_file_name (file, Qnil);
954 initial_stderr_stream = stderr;
955 stderr = fopen(SDATA (file), NILP (append) ? "w" : "a");
956 if (stderr == NULL)
958 stderr = initial_stderr_stream;
959 initial_stderr_stream = NULL;
960 report_file_error ("Cannot open debugging output stream",
961 Fcons (file, Qnil));
964 return Qnil;
966 #endif /* GNU_LINUX */
969 /* This is the interface for debugging printing. */
971 void
972 debug_print (arg)
973 Lisp_Object arg;
975 Fprin1 (arg, Qexternal_debugging_output);
976 fprintf (stderr, "\r\n");
979 void
980 safe_debug_print (arg)
981 Lisp_Object arg;
983 int valid = valid_lisp_object_p (arg);
985 if (valid > 0)
986 debug_print (arg);
987 else
988 fprintf (stderr, "#<%s_LISP_OBJECT 0x%08lx>\r\n",
989 !valid ? "INVALID" : "SOME",
990 #ifdef NO_UNION_TYPE
991 (unsigned long) arg
992 #else
993 (unsigned long) arg.i
994 #endif
999 DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
1000 1, 1, 0,
1001 doc: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
1002 See Info anchor `(elisp)Definition of signal' for some details on how this
1003 error message is constructed. */)
1004 (obj)
1005 Lisp_Object obj;
1007 struct buffer *old = current_buffer;
1008 Lisp_Object value;
1009 struct gcpro gcpro1;
1011 /* If OBJ is (error STRING), just return STRING.
1012 That is not only faster, it also avoids the need to allocate
1013 space here when the error is due to memory full. */
1014 if (CONSP (obj) && EQ (XCAR (obj), Qerror)
1015 && CONSP (XCDR (obj))
1016 && STRINGP (XCAR (XCDR (obj)))
1017 && NILP (XCDR (XCDR (obj))))
1018 return XCAR (XCDR (obj));
1020 print_error_message (obj, Vprin1_to_string_buffer, 0, Qnil);
1022 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
1023 value = Fbuffer_string ();
1025 GCPRO1 (value);
1026 Ferase_buffer ();
1027 set_buffer_internal (old);
1028 UNGCPRO;
1030 return value;
1033 /* Print an error message for the error DATA onto Lisp output stream
1034 STREAM (suitable for the print functions). */
1036 void
1037 print_error_message (data, stream, context, caller)
1038 Lisp_Object data, stream;
1039 char *context;
1040 Lisp_Object caller;
1042 Lisp_Object errname, errmsg, file_error, tail;
1043 struct gcpro gcpro1;
1044 int i;
1046 if (context != 0)
1047 write_string_1 (context, -1, stream);
1049 /* If we know from where the error was signaled, show it in
1050 *Messages*. */
1051 if (!NILP (caller) && SYMBOLP (caller))
1053 Lisp_Object cname = SYMBOL_NAME (caller);
1054 char *name = alloca (SBYTES (cname));
1055 bcopy (SDATA (cname), name, SBYTES (cname));
1056 message_dolog (name, SBYTES (cname), 0, 0);
1057 message_dolog (": ", 2, 0, 0);
1060 errname = Fcar (data);
1062 if (EQ (errname, Qerror))
1064 data = Fcdr (data);
1065 if (!CONSP (data))
1066 data = Qnil;
1067 errmsg = Fcar (data);
1068 file_error = Qnil;
1070 else
1072 Lisp_Object error_conditions;
1073 errmsg = Fget (errname, Qerror_message);
1074 error_conditions = Fget (errname, Qerror_conditions);
1075 file_error = Fmemq (Qfile_error, error_conditions);
1078 /* Print an error message including the data items. */
1080 tail = Fcdr_safe (data);
1081 GCPRO1 (tail);
1083 /* For file-error, make error message by concatenating
1084 all the data items. They are all strings. */
1085 if (!NILP (file_error) && CONSP (tail))
1086 errmsg = XCAR (tail), tail = XCDR (tail);
1088 if (STRINGP (errmsg))
1089 Fprinc (errmsg, stream);
1090 else
1091 write_string_1 ("peculiar error", -1, stream);
1093 for (i = 0; CONSP (tail); tail = XCDR (tail), i++)
1095 Lisp_Object obj;
1097 write_string_1 (i ? ", " : ": ", 2, stream);
1098 obj = XCAR (tail);
1099 if (!NILP (file_error) || EQ (errname, Qend_of_file))
1100 Fprinc (obj, stream);
1101 else
1102 Fprin1 (obj, stream);
1105 UNGCPRO;
1111 * The buffer should be at least as large as the max string size of the
1112 * largest float, printed in the biggest notation. This is undoubtedly
1113 * 20d float_output_format, with the negative of the C-constant "HUGE"
1114 * from <math.h>.
1116 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
1118 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
1119 * case of -1e307 in 20d float_output_format. What is one to do (short of
1120 * re-writing _doprnt to be more sane)?
1121 * -wsr
1124 void
1125 float_to_string (buf, data)
1126 unsigned char *buf;
1127 double data;
1129 unsigned char *cp;
1130 int width;
1132 /* Check for plus infinity in a way that won't lose
1133 if there is no plus infinity. */
1134 if (data == data / 2 && data > 1.0)
1136 strcpy (buf, "1.0e+INF");
1137 return;
1139 /* Likewise for minus infinity. */
1140 if (data == data / 2 && data < -1.0)
1142 strcpy (buf, "-1.0e+INF");
1143 return;
1145 /* Check for NaN in a way that won't fail if there are no NaNs. */
1146 if (! (data * 0.0 >= 0.0))
1148 /* Prepend "-" if the NaN's sign bit is negative.
1149 The sign bit of a double is the bit that is 1 in -0.0. */
1150 int i;
1151 union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
1152 u_data.d = data;
1153 u_minus_zero.d = - 0.0;
1154 for (i = 0; i < sizeof (double); i++)
1155 if (u_data.c[i] & u_minus_zero.c[i])
1157 *buf++ = '-';
1158 break;
1161 strcpy (buf, "0.0e+NaN");
1162 return;
1165 if (NILP (Vfloat_output_format)
1166 || !STRINGP (Vfloat_output_format))
1167 lose:
1169 /* Generate the fewest number of digits that represent the
1170 floating point value without losing information.
1171 The following method is simple but a bit slow.
1172 For ideas about speeding things up, please see:
1174 Guy L Steele Jr & Jon L White, How to print floating-point numbers
1175 accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
1177 Robert G Burger & R Kent Dybvig, Printing floating point numbers
1178 quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
1180 width = fabs (data) < DBL_MIN ? 1 : DBL_DIG;
1182 sprintf (buf, "%.*g", width, data);
1183 while (width++ < DOUBLE_DIGITS_BOUND && atof (buf) != data);
1185 else /* oink oink */
1187 /* Check that the spec we have is fully valid.
1188 This means not only valid for printf,
1189 but meant for floats, and reasonable. */
1190 cp = SDATA (Vfloat_output_format);
1192 if (cp[0] != '%')
1193 goto lose;
1194 if (cp[1] != '.')
1195 goto lose;
1197 cp += 2;
1199 /* Check the width specification. */
1200 width = -1;
1201 if ('0' <= *cp && *cp <= '9')
1203 width = 0;
1205 width = (width * 10) + (*cp++ - '0');
1206 while (*cp >= '0' && *cp <= '9');
1208 /* A precision of zero is valid only for %f. */
1209 if (width > DBL_DIG
1210 || (width == 0 && *cp != 'f'))
1211 goto lose;
1214 if (*cp != 'e' && *cp != 'f' && *cp != 'g')
1215 goto lose;
1217 if (cp[1] != 0)
1218 goto lose;
1220 sprintf (buf, SDATA (Vfloat_output_format), data);
1223 /* Make sure there is a decimal point with digit after, or an
1224 exponent, so that the value is readable as a float. But don't do
1225 this with "%.0f"; it's valid for that not to produce a decimal
1226 point. Note that width can be 0 only for %.0f. */
1227 if (width != 0)
1229 for (cp = buf; *cp; cp++)
1230 if ((*cp < '0' || *cp > '9') && *cp != '-')
1231 break;
1233 if (*cp == '.' && cp[1] == 0)
1235 cp[1] = '0';
1236 cp[2] = 0;
1239 if (*cp == 0)
1241 *cp++ = '.';
1242 *cp++ = '0';
1243 *cp++ = 0;
1249 static void
1250 print (obj, printcharfun, escapeflag)
1251 Lisp_Object obj;
1252 register Lisp_Object printcharfun;
1253 int escapeflag;
1255 old_backquote_output = 0;
1257 /* Reset print_number_index and Vprint_number_table only when
1258 the variable Vprint_continuous_numbering is nil. Otherwise,
1259 the values of these variables will be kept between several
1260 print functions. */
1261 if (NILP (Vprint_continuous_numbering))
1263 print_number_index = 0;
1264 Vprint_number_table = Qnil;
1267 /* Construct Vprint_number_table for print-gensym and print-circle. */
1268 if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))
1270 int i, start, index;
1271 start = index = print_number_index;
1272 /* Construct Vprint_number_table.
1273 This increments print_number_index for the objects added. */
1274 print_depth = 0;
1275 print_preprocess (obj);
1277 /* Remove unnecessary objects, which appear only once in OBJ;
1278 that is, whose status is Qnil. Compactify the necessary objects. */
1279 for (i = start; i < print_number_index; i++)
1280 if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1282 PRINT_NUMBER_OBJECT (Vprint_number_table, index)
1283 = PRINT_NUMBER_OBJECT (Vprint_number_table, i);
1284 index++;
1287 /* Clear out objects outside the active part of the table. */
1288 for (i = index; i < print_number_index; i++)
1289 PRINT_NUMBER_OBJECT (Vprint_number_table, i) = Qnil;
1291 /* Reset the status field for the next print step. Now this
1292 field means whether the object has already been printed. */
1293 for (i = start; i < print_number_index; i++)
1294 PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qnil;
1296 print_number_index = index;
1299 print_depth = 0;
1300 print_object (obj, printcharfun, escapeflag);
1303 /* Construct Vprint_number_table according to the structure of OBJ.
1304 OBJ itself and all its elements will be added to Vprint_number_table
1305 recursively if it is a list, vector, compiled function, char-table,
1306 string (its text properties will be traced), or a symbol that has
1307 no obarray (this is for the print-gensym feature).
1308 The status fields of Vprint_number_table mean whether each object appears
1309 more than once in OBJ: Qnil at the first time, and Qt after that . */
1310 static void
1311 print_preprocess (obj)
1312 Lisp_Object obj;
1314 int i;
1315 EMACS_INT size;
1316 int loop_count = 0;
1317 Lisp_Object halftail;
1319 /* Give up if we go so deep that print_object will get an error. */
1320 /* See similar code in print_object. */
1321 if (print_depth >= PRINT_CIRCLE)
1322 error ("Apparently circular structure being printed");
1324 /* Avoid infinite recursion for circular nested structure
1325 in the case where Vprint_circle is nil. */
1326 if (NILP (Vprint_circle))
1328 for (i = 0; i < print_depth; i++)
1329 if (EQ (obj, being_printed[i]))
1330 return;
1331 being_printed[print_depth] = obj;
1334 print_depth++;
1335 halftail = obj;
1337 loop:
1338 if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
1339 || COMPILEDP (obj) || CHAR_TABLE_P (obj)
1340 || (! NILP (Vprint_gensym)
1341 && SYMBOLP (obj)
1342 && !SYMBOL_INTERNED_P (obj)))
1344 /* In case print-circle is nil and print-gensym is t,
1345 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1346 if (! NILP (Vprint_circle) || SYMBOLP (obj))
1348 for (i = 0; i < print_number_index; i++)
1349 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj))
1351 /* OBJ appears more than once. Let's remember that. */
1352 PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
1353 print_depth--;
1354 return;
1357 /* OBJ is not yet recorded. Let's add to the table. */
1358 if (print_number_index == 0)
1360 /* Initialize the table. */
1361 Vprint_number_table = Fmake_vector (make_number (40), Qnil);
1363 else if (XVECTOR (Vprint_number_table)->size == print_number_index * 2)
1365 /* Reallocate the table. */
1366 int i = print_number_index * 4;
1367 Lisp_Object old_table = Vprint_number_table;
1368 Vprint_number_table = Fmake_vector (make_number (i), Qnil);
1369 for (i = 0; i < print_number_index; i++)
1371 PRINT_NUMBER_OBJECT (Vprint_number_table, i)
1372 = PRINT_NUMBER_OBJECT (old_table, i);
1373 PRINT_NUMBER_STATUS (Vprint_number_table, i)
1374 = PRINT_NUMBER_STATUS (old_table, i);
1377 PRINT_NUMBER_OBJECT (Vprint_number_table, print_number_index) = obj;
1378 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1379 always print the gensym with a number. This is a special for
1380 the lisp function byte-compile-output-docform. */
1381 if (!NILP (Vprint_continuous_numbering)
1382 && SYMBOLP (obj)
1383 && !SYMBOL_INTERNED_P (obj))
1384 PRINT_NUMBER_STATUS (Vprint_number_table, print_number_index) = Qt;
1385 print_number_index++;
1388 switch (XGCTYPE (obj))
1390 case Lisp_String:
1391 /* A string may have text properties, which can be circular. */
1392 traverse_intervals_noorder (STRING_INTERVALS (obj),
1393 print_preprocess_string, Qnil);
1394 break;
1396 case Lisp_Cons:
1397 /* Use HALFTAIL and LOOP_COUNT to detect circular lists,
1398 just as in print_object. */
1399 if (loop_count && EQ (obj, halftail))
1400 break;
1401 print_preprocess (XCAR (obj));
1402 obj = XCDR (obj);
1403 loop_count++;
1404 if (!(loop_count & 1))
1405 halftail = XCDR (halftail);
1406 goto loop;
1408 case Lisp_Vectorlike:
1409 size = XVECTOR (obj)->size;
1410 if (size & PSEUDOVECTOR_FLAG)
1411 size &= PSEUDOVECTOR_SIZE_MASK;
1412 for (i = 0; i < size; i++)
1413 print_preprocess (XVECTOR (obj)->contents[i]);
1414 break;
1416 default:
1417 break;
1420 print_depth--;
1423 static void
1424 print_preprocess_string (interval, arg)
1425 INTERVAL interval;
1426 Lisp_Object arg;
1428 print_preprocess (interval->plist);
1431 static void
1432 print_object (obj, printcharfun, escapeflag)
1433 Lisp_Object obj;
1434 register Lisp_Object printcharfun;
1435 int escapeflag;
1437 char buf[40];
1439 QUIT;
1441 /* Detect circularities and truncate them. */
1442 if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
1443 || COMPILEDP (obj) || CHAR_TABLE_P (obj)
1444 || (! NILP (Vprint_gensym)
1445 && SYMBOLP (obj)
1446 && !SYMBOL_INTERNED_P (obj)))
1448 if (NILP (Vprint_circle) && NILP (Vprint_gensym))
1450 /* Simple but incomplete way. */
1451 int i;
1452 for (i = 0; i < print_depth; i++)
1453 if (EQ (obj, being_printed[i]))
1455 sprintf (buf, "#%d", i);
1456 strout (buf, -1, -1, printcharfun, 0);
1457 return;
1459 being_printed[print_depth] = obj;
1461 else
1463 /* With the print-circle feature. */
1464 int i;
1465 for (i = 0; i < print_number_index; i++)
1466 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj))
1468 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1470 /* Add a prefix #n= if OBJ has not yet been printed;
1471 that is, its status field is nil. */
1472 sprintf (buf, "#%d=", i + 1);
1473 strout (buf, -1, -1, printcharfun, 0);
1474 /* OBJ is going to be printed. Set the status to t. */
1475 PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
1476 break;
1478 else
1480 /* Just print #n# if OBJ has already been printed. */
1481 sprintf (buf, "#%d#", i + 1);
1482 strout (buf, -1, -1, printcharfun, 0);
1483 return;
1489 print_depth++;
1491 /* See similar code in print_preprocess. */
1492 if (print_depth > PRINT_CIRCLE)
1493 error ("Apparently circular structure being printed");
1494 #ifdef MAX_PRINT_CHARS
1495 if (max_print && print_chars > max_print)
1497 PRINTCHAR ('\n');
1498 print_chars = 0;
1500 #endif /* MAX_PRINT_CHARS */
1502 switch (XGCTYPE (obj))
1504 case Lisp_Int:
1505 if (sizeof (int) == sizeof (EMACS_INT))
1506 sprintf (buf, "%d", XINT (obj));
1507 else if (sizeof (long) == sizeof (EMACS_INT))
1508 sprintf (buf, "%ld", (long) XINT (obj));
1509 else
1510 abort ();
1511 strout (buf, -1, -1, printcharfun, 0);
1512 break;
1514 case Lisp_Float:
1516 char pigbuf[350]; /* see comments in float_to_string */
1518 float_to_string (pigbuf, XFLOAT_DATA (obj));
1519 strout (pigbuf, -1, -1, printcharfun, 0);
1521 break;
1523 case Lisp_String:
1524 if (!escapeflag)
1525 print_string (obj, printcharfun);
1526 else
1528 register int i, i_byte;
1529 struct gcpro gcpro1;
1530 unsigned char *str;
1531 int size_byte;
1532 /* 1 means we must ensure that the next character we output
1533 cannot be taken as part of a hex character escape. */
1534 int need_nonhex = 0;
1535 int multibyte = STRING_MULTIBYTE (obj);
1537 GCPRO1 (obj);
1539 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
1541 PRINTCHAR ('#');
1542 PRINTCHAR ('(');
1545 PRINTCHAR ('\"');
1546 str = SDATA (obj);
1547 size_byte = SBYTES (obj);
1549 for (i = 0, i_byte = 0; i_byte < size_byte;)
1551 /* Here, we must convert each multi-byte form to the
1552 corresponding character code before handing it to PRINTCHAR. */
1553 int len;
1554 int c;
1556 if (multibyte)
1558 c = STRING_CHAR_AND_LENGTH (str + i_byte,
1559 size_byte - i_byte, len);
1560 if (CHAR_VALID_P (c, 0))
1561 i_byte += len;
1562 else
1563 c = str[i_byte++];
1565 else
1566 c = str[i_byte++];
1568 QUIT;
1570 if (c == '\n' && print_escape_newlines)
1572 PRINTCHAR ('\\');
1573 PRINTCHAR ('n');
1575 else if (c == '\f' && print_escape_newlines)
1577 PRINTCHAR ('\\');
1578 PRINTCHAR ('f');
1580 else if (multibyte
1581 && ! ASCII_BYTE_P (c)
1582 && (SINGLE_BYTE_CHAR_P (c) || print_escape_multibyte))
1584 /* When multibyte is disabled,
1585 print multibyte string chars using hex escapes.
1586 For a char code that could be in a unibyte string,
1587 when found in a multibyte string, always use a hex escape
1588 so it reads back as multibyte. */
1589 unsigned char outbuf[50];
1590 sprintf (outbuf, "\\x%x", c);
1591 strout (outbuf, -1, -1, printcharfun, 0);
1592 need_nonhex = 1;
1594 else if (! multibyte
1595 && SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c)
1596 && print_escape_nonascii)
1598 /* When printing in a multibyte buffer
1599 or when explicitly requested,
1600 print single-byte non-ASCII string chars
1601 using octal escapes. */
1602 unsigned char outbuf[5];
1603 sprintf (outbuf, "\\%03o", c);
1604 strout (outbuf, -1, -1, printcharfun, 0);
1606 else
1608 /* If we just had a hex escape, and this character
1609 could be taken as part of it,
1610 output `\ ' to prevent that. */
1611 if (need_nonhex)
1613 need_nonhex = 0;
1614 if ((c >= 'a' && c <= 'f')
1615 || (c >= 'A' && c <= 'F')
1616 || (c >= '0' && c <= '9'))
1617 strout ("\\ ", -1, -1, printcharfun, 0);
1620 if (c == '\"' || c == '\\')
1621 PRINTCHAR ('\\');
1622 PRINTCHAR (c);
1625 PRINTCHAR ('\"');
1627 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
1629 traverse_intervals (STRING_INTERVALS (obj),
1630 0, print_interval, printcharfun);
1631 PRINTCHAR (')');
1634 UNGCPRO;
1636 break;
1638 case Lisp_Symbol:
1640 register int confusing;
1641 register unsigned char *p = SDATA (SYMBOL_NAME (obj));
1642 register unsigned char *end = p + SBYTES (SYMBOL_NAME (obj));
1643 register int c;
1644 int i, i_byte, size_byte;
1645 Lisp_Object name;
1647 name = SYMBOL_NAME (obj);
1649 if (p != end && (*p == '-' || *p == '+')) p++;
1650 if (p == end)
1651 confusing = 0;
1652 /* If symbol name begins with a digit, and ends with a digit,
1653 and contains nothing but digits and `e', it could be treated
1654 as a number. So set CONFUSING.
1656 Symbols that contain periods could also be taken as numbers,
1657 but periods are always escaped, so we don't have to worry
1658 about them here. */
1659 else if (*p >= '0' && *p <= '9'
1660 && end[-1] >= '0' && end[-1] <= '9')
1662 while (p != end && ((*p >= '0' && *p <= '9')
1663 /* Needed for \2e10. */
1664 || *p == 'e'))
1665 p++;
1666 confusing = (end == p);
1668 else
1669 confusing = 0;
1671 if (! NILP (Vprint_gensym) && !SYMBOL_INTERNED_P (obj))
1673 PRINTCHAR ('#');
1674 PRINTCHAR (':');
1677 size_byte = SBYTES (name);
1679 for (i = 0, i_byte = 0; i_byte < size_byte;)
1681 /* Here, we must convert each multi-byte form to the
1682 corresponding character code before handing it to PRINTCHAR. */
1683 FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte);
1684 QUIT;
1686 if (escapeflag)
1688 if (c == '\"' || c == '\\' || c == '\''
1689 || c == ';' || c == '#' || c == '(' || c == ')'
1690 || c == ',' || c =='.' || c == '`'
1691 || c == '[' || c == ']' || c == '?' || c <= 040
1692 || confusing)
1693 PRINTCHAR ('\\'), confusing = 0;
1695 PRINTCHAR (c);
1698 break;
1700 case Lisp_Cons:
1701 /* If deeper than spec'd depth, print placeholder. */
1702 if (INTEGERP (Vprint_level)
1703 && print_depth > XINT (Vprint_level))
1704 strout ("...", -1, -1, printcharfun, 0);
1705 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1706 && (EQ (XCAR (obj), Qquote)))
1708 PRINTCHAR ('\'');
1709 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1711 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1712 && (EQ (XCAR (obj), Qfunction)))
1714 PRINTCHAR ('#');
1715 PRINTCHAR ('\'');
1716 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1718 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1719 && ! old_backquote_output
1720 && ((EQ (XCAR (obj), Qbackquote)
1721 || EQ (XCAR (obj), Qcomma)
1722 || EQ (XCAR (obj), Qcomma_at)
1723 || EQ (XCAR (obj), Qcomma_dot))))
1725 print_object (XCAR (obj), printcharfun, 0);
1726 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1728 else
1730 PRINTCHAR ('(');
1732 /* If the first element is a backquote form,
1733 print it old-style so it won't be misunderstood. */
1734 if (print_quoted && CONSP (XCAR (obj))
1735 && CONSP (XCDR (XCAR (obj)))
1736 && NILP (XCDR (XCDR (XCAR (obj))))
1737 && EQ (XCAR (XCAR (obj)), Qbackquote))
1739 Lisp_Object tem;
1740 tem = XCAR (obj);
1741 PRINTCHAR ('(');
1743 print_object (Qbackquote, printcharfun, 0);
1744 PRINTCHAR (' ');
1746 ++old_backquote_output;
1747 print_object (XCAR (XCDR (tem)), printcharfun, 0);
1748 --old_backquote_output;
1749 PRINTCHAR (')');
1751 obj = XCDR (obj);
1755 int print_length, i;
1756 Lisp_Object halftail = obj;
1758 /* Negative values of print-length are invalid in CL.
1759 Treat them like nil, as CMUCL does. */
1760 if (NATNUMP (Vprint_length))
1761 print_length = XFASTINT (Vprint_length);
1762 else
1763 print_length = 0;
1765 i = 0;
1766 while (CONSP (obj))
1768 /* Detect circular list. */
1769 if (NILP (Vprint_circle))
1771 /* Simple but imcomplete way. */
1772 if (i != 0 && EQ (obj, halftail))
1774 sprintf (buf, " . #%d", i / 2);
1775 strout (buf, -1, -1, printcharfun, 0);
1776 goto end_of_list;
1779 else
1781 /* With the print-circle feature. */
1782 if (i != 0)
1784 int i;
1785 for (i = 0; i < print_number_index; i++)
1786 if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i),
1787 obj))
1789 if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
1791 strout (" . ", 3, 3, printcharfun, 0);
1792 print_object (obj, printcharfun, escapeflag);
1794 else
1796 sprintf (buf, " . #%d#", i + 1);
1797 strout (buf, -1, -1, printcharfun, 0);
1799 goto end_of_list;
1804 if (i++)
1805 PRINTCHAR (' ');
1807 if (print_length && i > print_length)
1809 strout ("...", 3, 3, printcharfun, 0);
1810 goto end_of_list;
1813 print_object (XCAR (obj), printcharfun, escapeflag);
1815 obj = XCDR (obj);
1816 if (!(i & 1))
1817 halftail = XCDR (halftail);
1821 /* OBJ non-nil here means it's the end of a dotted list. */
1822 if (!NILP (obj))
1824 strout (" . ", 3, 3, printcharfun, 0);
1825 print_object (obj, printcharfun, escapeflag);
1828 end_of_list:
1829 PRINTCHAR (')');
1831 break;
1833 case Lisp_Vectorlike:
1834 if (PROCESSP (obj))
1836 if (escapeflag)
1838 strout ("#<process ", -1, -1, printcharfun, 0);
1839 print_string (XPROCESS (obj)->name, printcharfun);
1840 PRINTCHAR ('>');
1842 else
1843 print_string (XPROCESS (obj)->name, printcharfun);
1845 else if (BOOL_VECTOR_P (obj))
1847 register int i;
1848 register unsigned char c;
1849 struct gcpro gcpro1;
1850 int size_in_chars
1851 = ((XBOOL_VECTOR (obj)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
1852 / BOOL_VECTOR_BITS_PER_CHAR);
1854 GCPRO1 (obj);
1856 PRINTCHAR ('#');
1857 PRINTCHAR ('&');
1858 sprintf (buf, "%ld", (long) XBOOL_VECTOR (obj)->size);
1859 strout (buf, -1, -1, printcharfun, 0);
1860 PRINTCHAR ('\"');
1862 /* Don't print more characters than the specified maximum.
1863 Negative values of print-length are invalid. Treat them
1864 like a print-length of nil. */
1865 if (NATNUMP (Vprint_length)
1866 && XFASTINT (Vprint_length) < size_in_chars)
1867 size_in_chars = XFASTINT (Vprint_length);
1869 for (i = 0; i < size_in_chars; i++)
1871 QUIT;
1872 c = XBOOL_VECTOR (obj)->data[i];
1873 if (c == '\n' && print_escape_newlines)
1875 PRINTCHAR ('\\');
1876 PRINTCHAR ('n');
1878 else if (c == '\f' && print_escape_newlines)
1880 PRINTCHAR ('\\');
1881 PRINTCHAR ('f');
1883 else if (c > '\177')
1885 /* Use octal escapes to avoid encoding issues. */
1886 PRINTCHAR ('\\');
1887 PRINTCHAR ('0' + ((c >> 6) & 3));
1888 PRINTCHAR ('0' + ((c >> 3) & 7));
1889 PRINTCHAR ('0' + (c & 7));
1891 else
1893 if (c == '\"' || c == '\\')
1894 PRINTCHAR ('\\');
1895 PRINTCHAR (c);
1898 PRINTCHAR ('\"');
1900 UNGCPRO;
1902 else if (SUBRP (obj))
1904 strout ("#<subr ", -1, -1, printcharfun, 0);
1905 strout (XSUBR (obj)->symbol_name, -1, -1, printcharfun, 0);
1906 PRINTCHAR ('>');
1908 else if (WINDOWP (obj))
1910 strout ("#<window ", -1, -1, printcharfun, 0);
1911 sprintf (buf, "%ld", (long) XFASTINT (XWINDOW (obj)->sequence_number));
1912 strout (buf, -1, -1, printcharfun, 0);
1913 if (!NILP (XWINDOW (obj)->buffer))
1915 strout (" on ", -1, -1, printcharfun, 0);
1916 print_string (XBUFFER (XWINDOW (obj)->buffer)->name, printcharfun);
1918 PRINTCHAR ('>');
1920 else if (HASH_TABLE_P (obj))
1922 struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
1923 strout ("#<hash-table", -1, -1, printcharfun, 0);
1924 if (SYMBOLP (h->test))
1926 PRINTCHAR (' ');
1927 PRINTCHAR ('\'');
1928 strout (SDATA (SYMBOL_NAME (h->test)), -1, -1, printcharfun, 0);
1929 PRINTCHAR (' ');
1930 strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun, 0);
1931 PRINTCHAR (' ');
1932 sprintf (buf, "%ld/%ld", (long) XFASTINT (h->count),
1933 (long) XVECTOR (h->next)->size);
1934 strout (buf, -1, -1, printcharfun, 0);
1936 sprintf (buf, " 0x%lx", (unsigned long) h);
1937 strout (buf, -1, -1, printcharfun, 0);
1938 PRINTCHAR ('>');
1940 else if (BUFFERP (obj))
1942 if (NILP (XBUFFER (obj)->name))
1943 strout ("#<killed buffer>", -1, -1, printcharfun, 0);
1944 else if (escapeflag)
1946 strout ("#<buffer ", -1, -1, printcharfun, 0);
1947 print_string (XBUFFER (obj)->name, printcharfun);
1948 PRINTCHAR ('>');
1950 else
1951 print_string (XBUFFER (obj)->name, printcharfun);
1953 else if (WINDOW_CONFIGURATIONP (obj))
1955 strout ("#<window-configuration>", -1, -1, printcharfun, 0);
1957 else if (FRAMEP (obj))
1959 strout ((FRAME_LIVE_P (XFRAME (obj))
1960 ? "#<frame " : "#<dead frame "),
1961 -1, -1, printcharfun, 0);
1962 print_string (XFRAME (obj)->name, printcharfun);
1963 sprintf (buf, " 0x%lx", (unsigned long) (XFRAME (obj)));
1964 strout (buf, -1, -1, printcharfun, 0);
1965 PRINTCHAR ('>');
1967 else
1969 EMACS_INT size = XVECTOR (obj)->size;
1970 if (COMPILEDP (obj))
1972 PRINTCHAR ('#');
1973 size &= PSEUDOVECTOR_SIZE_MASK;
1975 if (CHAR_TABLE_P (obj))
1977 /* We print a char-table as if it were a vector,
1978 lumping the parent and default slots in with the
1979 character slots. But we add #^ as a prefix. */
1980 PRINTCHAR ('#');
1981 PRINTCHAR ('^');
1982 if (SUB_CHAR_TABLE_P (obj))
1983 PRINTCHAR ('^');
1984 size &= PSEUDOVECTOR_SIZE_MASK;
1986 if (size & PSEUDOVECTOR_FLAG)
1987 goto badtype;
1989 PRINTCHAR ('[');
1991 register int i;
1992 register Lisp_Object tem;
1993 int real_size = size;
1995 /* Don't print more elements than the specified maximum. */
1996 if (NATNUMP (Vprint_length)
1997 && XFASTINT (Vprint_length) < size)
1998 size = XFASTINT (Vprint_length);
2000 for (i = 0; i < size; i++)
2002 if (i) PRINTCHAR (' ');
2003 tem = XVECTOR (obj)->contents[i];
2004 print_object (tem, printcharfun, escapeflag);
2006 if (size < real_size)
2007 strout (" ...", 4, 4, printcharfun, 0);
2009 PRINTCHAR (']');
2011 break;
2013 case Lisp_Misc:
2014 switch (XMISCTYPE (obj))
2016 case Lisp_Misc_Marker:
2017 strout ("#<marker ", -1, -1, printcharfun, 0);
2018 /* Do you think this is necessary? */
2019 if (XMARKER (obj)->insertion_type != 0)
2020 strout ("(moves after insertion) ", -1, -1, printcharfun, 0);
2021 if (!(XMARKER (obj)->buffer))
2022 strout ("in no buffer", -1, -1, printcharfun, 0);
2023 else
2025 sprintf (buf, "at %d", marker_position (obj));
2026 strout (buf, -1, -1, printcharfun, 0);
2027 strout (" in ", -1, -1, printcharfun, 0);
2028 print_string (XMARKER (obj)->buffer->name, printcharfun);
2030 PRINTCHAR ('>');
2031 break;
2033 case Lisp_Misc_Overlay:
2034 strout ("#<overlay ", -1, -1, printcharfun, 0);
2035 if (!(XMARKER (OVERLAY_START (obj))->buffer))
2036 strout ("in no buffer", -1, -1, printcharfun, 0);
2037 else
2039 sprintf (buf, "from %d to %d in ",
2040 marker_position (OVERLAY_START (obj)),
2041 marker_position (OVERLAY_END (obj)));
2042 strout (buf, -1, -1, printcharfun, 0);
2043 print_string (XMARKER (OVERLAY_START (obj))->buffer->name,
2044 printcharfun);
2046 PRINTCHAR ('>');
2047 break;
2049 /* Remaining cases shouldn't happen in normal usage, but let's print
2050 them anyway for the benefit of the debugger. */
2051 case Lisp_Misc_Free:
2052 strout ("#<misc free cell>", -1, -1, printcharfun, 0);
2053 break;
2055 case Lisp_Misc_Intfwd:
2056 sprintf (buf, "#<intfwd to %ld>", (long) *XINTFWD (obj)->intvar);
2057 strout (buf, -1, -1, printcharfun, 0);
2058 break;
2060 case Lisp_Misc_Boolfwd:
2061 sprintf (buf, "#<boolfwd to %s>",
2062 (*XBOOLFWD (obj)->boolvar ? "t" : "nil"));
2063 strout (buf, -1, -1, printcharfun, 0);
2064 break;
2066 case Lisp_Misc_Objfwd:
2067 strout ("#<objfwd to ", -1, -1, printcharfun, 0);
2068 print_object (*XOBJFWD (obj)->objvar, printcharfun, escapeflag);
2069 PRINTCHAR ('>');
2070 break;
2072 case Lisp_Misc_Buffer_Objfwd:
2073 strout ("#<buffer_objfwd to ", -1, -1, printcharfun, 0);
2074 print_object (PER_BUFFER_VALUE (current_buffer,
2075 XBUFFER_OBJFWD (obj)->offset),
2076 printcharfun, escapeflag);
2077 PRINTCHAR ('>');
2078 break;
2080 case Lisp_Misc_Kboard_Objfwd:
2081 strout ("#<kboard_objfwd to ", -1, -1, printcharfun, 0);
2082 print_object (*(Lisp_Object *)((char *) current_kboard
2083 + XKBOARD_OBJFWD (obj)->offset),
2084 printcharfun, escapeflag);
2085 PRINTCHAR ('>');
2086 break;
2088 case Lisp_Misc_Buffer_Local_Value:
2089 strout ("#<buffer_local_value ", -1, -1, printcharfun, 0);
2090 goto do_buffer_local;
2091 case Lisp_Misc_Some_Buffer_Local_Value:
2092 strout ("#<some_buffer_local_value ", -1, -1, printcharfun, 0);
2093 do_buffer_local:
2094 strout ("[realvalue] ", -1, -1, printcharfun, 0);
2095 print_object (XBUFFER_LOCAL_VALUE (obj)->realvalue,
2096 printcharfun, escapeflag);
2097 if (XBUFFER_LOCAL_VALUE (obj)->found_for_buffer)
2098 strout ("[local in buffer] ", -1, -1, printcharfun, 0);
2099 else
2100 strout ("[buffer] ", -1, -1, printcharfun, 0);
2101 print_object (XBUFFER_LOCAL_VALUE (obj)->buffer,
2102 printcharfun, escapeflag);
2103 if (XBUFFER_LOCAL_VALUE (obj)->check_frame)
2105 if (XBUFFER_LOCAL_VALUE (obj)->found_for_frame)
2106 strout ("[local in frame] ", -1, -1, printcharfun, 0);
2107 else
2108 strout ("[frame] ", -1, -1, printcharfun, 0);
2109 print_object (XBUFFER_LOCAL_VALUE (obj)->frame,
2110 printcharfun, escapeflag);
2112 strout ("[alist-elt] ", -1, -1, printcharfun, 0);
2113 print_object (XCAR (XBUFFER_LOCAL_VALUE (obj)->cdr),
2114 printcharfun, escapeflag);
2115 strout ("[default-value] ", -1, -1, printcharfun, 0);
2116 print_object (XCDR (XBUFFER_LOCAL_VALUE (obj)->cdr),
2117 printcharfun, escapeflag);
2118 PRINTCHAR ('>');
2119 break;
2121 case Lisp_Misc_Save_Value:
2122 strout ("#<save_value ", -1, -1, printcharfun, 0);
2123 sprintf(buf, "ptr=0x%08lx int=%d",
2124 (unsigned long) XSAVE_VALUE (obj)->pointer,
2125 XSAVE_VALUE (obj)->integer);
2126 strout (buf, -1, -1, printcharfun, 0);
2127 PRINTCHAR ('>');
2128 break;
2130 default:
2131 goto badtype;
2133 break;
2135 default:
2136 badtype:
2138 /* We're in trouble if this happens!
2139 Probably should just abort () */
2140 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun, 0);
2141 if (MISCP (obj))
2142 sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj));
2143 else if (VECTORLIKEP (obj))
2144 sprintf (buf, "(PVEC 0x%08x)", (int) XVECTOR (obj)->size);
2145 else
2146 sprintf (buf, "(0x%02x)", (int) XTYPE (obj));
2147 strout (buf, -1, -1, printcharfun, 0);
2148 strout (" Save your buffers immediately and please report this bug>",
2149 -1, -1, printcharfun, 0);
2153 print_depth--;
2157 /* Print a description of INTERVAL using PRINTCHARFUN.
2158 This is part of printing a string that has text properties. */
2160 void
2161 print_interval (interval, printcharfun)
2162 INTERVAL interval;
2163 Lisp_Object printcharfun;
2165 PRINTCHAR (' ');
2166 print_object (make_number (interval->position), printcharfun, 1);
2167 PRINTCHAR (' ');
2168 print_object (make_number (interval->position + LENGTH (interval)),
2169 printcharfun, 1);
2170 PRINTCHAR (' ');
2171 print_object (interval->plist, printcharfun, 1);
2175 void
2176 syms_of_print ()
2178 Qtemp_buffer_setup_hook = intern ("temp-buffer-setup-hook");
2179 staticpro (&Qtemp_buffer_setup_hook);
2181 DEFVAR_LISP ("standard-output", &Vstandard_output,
2182 doc: /* Output stream `print' uses by default for outputting a character.
2183 This may be any function of one argument.
2184 It may also be a buffer (output is inserted before point)
2185 or a marker (output is inserted and the marker is advanced)
2186 or the symbol t (output appears in the echo area). */);
2187 Vstandard_output = Qt;
2188 Qstandard_output = intern ("standard-output");
2189 staticpro (&Qstandard_output);
2191 DEFVAR_LISP ("float-output-format", &Vfloat_output_format,
2192 doc: /* The format descriptor string used to print floats.
2193 This is a %-spec like those accepted by `printf' in C,
2194 but with some restrictions. It must start with the two characters `%.'.
2195 After that comes an integer precision specification,
2196 and then a letter which controls the format.
2197 The letters allowed are `e', `f' and `g'.
2198 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2199 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2200 Use `g' to choose the shorter of those two formats for the number at hand.
2201 The precision in any of these cases is the number of digits following
2202 the decimal point. With `f', a precision of 0 means to omit the
2203 decimal point. 0 is not allowed with `e' or `g'.
2205 A value of nil means to use the shortest notation
2206 that represents the number without losing information. */);
2207 Vfloat_output_format = Qnil;
2208 Qfloat_output_format = intern ("float-output-format");
2209 staticpro (&Qfloat_output_format);
2211 DEFVAR_LISP ("print-length", &Vprint_length,
2212 doc: /* Maximum length of list to print before abbreviating.
2213 A value of nil means no limit. See also `eval-expression-print-length'. */);
2214 Vprint_length = Qnil;
2216 DEFVAR_LISP ("print-level", &Vprint_level,
2217 doc: /* Maximum depth of list nesting to print before abbreviating.
2218 A value of nil means no limit. See also `eval-expression-print-level'. */);
2219 Vprint_level = Qnil;
2221 DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines,
2222 doc: /* Non-nil means print newlines in strings as `\\n'.
2223 Also print formfeeds as `\\f'. */);
2224 print_escape_newlines = 0;
2226 DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii,
2227 doc: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2228 \(OOO is the octal representation of the character code.)
2229 Only single-byte characters are affected, and only in `prin1'.
2230 When the output goes in a multibyte buffer, this feature is
2231 enabled regardless of the value of the variable. */);
2232 print_escape_nonascii = 0;
2234 DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte,
2235 doc: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2236 \(XXXX is the hex representation of the character code.)
2237 This affects only `prin1'. */);
2238 print_escape_multibyte = 0;
2240 DEFVAR_BOOL ("print-quoted", &print_quoted,
2241 doc: /* Non-nil means print quoted forms with reader syntax.
2242 I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and backquoted
2243 forms print as in the new syntax. */);
2244 print_quoted = 0;
2246 DEFVAR_LISP ("print-gensym", &Vprint_gensym,
2247 doc: /* Non-nil means print uninterned symbols so they will read as uninterned.
2248 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2249 When the uninterned symbol appears within a recursive data structure,
2250 and the symbol appears more than once, in addition use the #N# and #N=
2251 constructs as needed, so that multiple references to the same symbol are
2252 shared once again when the text is read back. */);
2253 Vprint_gensym = Qnil;
2255 DEFVAR_LISP ("print-circle", &Vprint_circle,
2256 doc: /* *Non-nil means print recursive structures using #N= and #N# syntax.
2257 If nil, printing proceeds recursively and may lead to
2258 `max-lisp-eval-depth' being exceeded or an error may occur:
2259 \"Apparently circular structure being printed.\" Also see
2260 `print-length' and `print-level'.
2261 If non-nil, shared substructures anywhere in the structure are printed
2262 with `#N=' before the first occurrence (in the order of the print
2263 representation) and `#N#' in place of each subsequent occurrence,
2264 where N is a positive decimal integer. */);
2265 Vprint_circle = Qnil;
2267 DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering,
2268 doc: /* *Non-nil means number continuously across print calls.
2269 This affects the numbers printed for #N= labels and #M# references.
2270 See also `print-circle', `print-gensym', and `print-number-table'.
2271 This variable should not be set with `setq'; bind it with a `let' instead. */);
2272 Vprint_continuous_numbering = Qnil;
2274 DEFVAR_LISP ("print-number-table", &Vprint_number_table,
2275 doc: /* A vector used internally to produce `#N=' labels and `#N#' references.
2276 The Lisp printer uses this vector to detect Lisp objects referenced more
2277 than once.
2279 When you bind `print-continuous-numbering' to t, you should probably
2280 also bind `print-number-table' to nil. This ensures that the value of
2281 `print-number-table' can be garbage-collected once the printing is
2282 done. If all elements of `print-number-table' are nil, it means that
2283 the printing done so far has not found any shared structure or objects
2284 that need to be recorded in the table. */);
2285 Vprint_number_table = Qnil;
2287 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2288 staticpro (&Vprin1_to_string_buffer);
2290 defsubr (&Sprin1);
2291 defsubr (&Sprin1_to_string);
2292 defsubr (&Serror_message_string);
2293 defsubr (&Sprinc);
2294 defsubr (&Sprint);
2295 defsubr (&Sterpri);
2296 defsubr (&Swrite_char);
2297 defsubr (&Sexternal_debugging_output);
2298 #ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
2299 defsubr (&Sredirect_debugging_output);
2300 #endif
2302 Qexternal_debugging_output = intern ("external-debugging-output");
2303 staticpro (&Qexternal_debugging_output);
2305 Qprint_escape_newlines = intern ("print-escape-newlines");
2306 staticpro (&Qprint_escape_newlines);
2308 Qprint_escape_multibyte = intern ("print-escape-multibyte");
2309 staticpro (&Qprint_escape_multibyte);
2311 Qprint_escape_nonascii = intern ("print-escape-nonascii");
2312 staticpro (&Qprint_escape_nonascii);
2314 defsubr (&Swith_output_to_temp_buffer);
2317 /* arch-tag: bc797170-94ae-41de-86e3-75e20f8f7a39
2318 (do not change this comment) */