Merge from trunk.
[emacs.git] / src / print.c
blobd07f89702ccbcf58266982bdcffb6b2de103a24a
1 /* Lisp object printing and output streams.
3 Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2011
4 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 3 of the License, or
11 (at your option) 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. If not, see <http://www.gnu.org/licenses/>. */
22 #include <config.h>
23 #include <stdio.h>
24 #include <setjmp.h>
25 #include "lisp.h"
26 #include "buffer.h"
27 #include "character.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"
36 #include "blockinput.h"
37 #include "termhooks.h" /* For struct terminal. */
38 #include "font.h"
40 Lisp_Object Qstandard_output;
42 static Lisp_Object Qtemp_buffer_setup_hook;
44 /* These are used to print like we read. */
46 static Lisp_Object Qfloat_output_format;
48 #include <math.h>
50 #if STDC_HEADERS
51 #include <float.h>
52 #endif
53 #include <ftoastr.h>
55 /* Default to values appropriate for IEEE floating point. */
56 #ifndef DBL_DIG
57 #define DBL_DIG 15
58 #endif
60 /* Avoid actual stack overflow in print. */
61 static int print_depth;
63 /* Level of nesting inside outputting backquote in new style. */
64 static int new_backquote_output;
66 /* Detect most circularities to print finite output. */
67 #define PRINT_CIRCLE 200
68 static Lisp_Object being_printed[PRINT_CIRCLE];
70 /* When printing into a buffer, first we put the text in this
71 block, then insert it all at once. */
72 static char *print_buffer;
74 /* Size allocated in print_buffer. */
75 static EMACS_INT print_buffer_size;
76 /* Chars stored in print_buffer. */
77 static EMACS_INT print_buffer_pos;
78 /* Bytes stored in print_buffer. */
79 static EMACS_INT print_buffer_pos_byte;
81 Lisp_Object Qprint_escape_newlines;
82 static Lisp_Object Qprint_escape_multibyte, Qprint_escape_nonascii;
84 /* Vprint_number_table is a table, that keeps objects that are going to
85 be printed, to allow use of #n= and #n# to express sharing.
86 For any given object, the table can give the following values:
87 t the object will be printed only once.
88 -N the object will be printed several times and will take number N.
89 N the object has been printed so we can refer to it as #N#.
90 print_number_index holds the largest N already used.
91 N has to be striclty larger than 0 since we need to distinguish -N. */
92 static int print_number_index;
93 static void print_interval (INTERVAL interval, Lisp_Object printcharfun);
95 /* GDB resets this to zero on W32 to disable OutputDebugString calls. */
96 int print_output_debug_flag EXTERNALLY_VISIBLE = 1;
99 /* Low level output routines for characters and strings */
101 /* Lisp functions to do output using a stream
102 must have the stream in a variable called printcharfun
103 and must start with PRINTPREPARE, end with PRINTFINISH,
104 and use PRINTDECLARE to declare common variables.
105 Use PRINTCHAR to output one character,
106 or call strout to output a block of characters. */
108 #define PRINTDECLARE \
109 struct buffer *old = current_buffer; \
110 EMACS_INT old_point = -1, start_point = -1; \
111 EMACS_INT old_point_byte = -1, start_point_byte = -1; \
112 int specpdl_count = SPECPDL_INDEX (); \
113 int free_print_buffer = 0; \
114 int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); \
115 Lisp_Object original
117 #define PRINTPREPARE \
118 original = printcharfun; \
119 if (NILP (printcharfun)) printcharfun = Qt; \
120 if (BUFFERP (printcharfun)) \
122 if (XBUFFER (printcharfun) != current_buffer) \
123 Fset_buffer (printcharfun); \
124 printcharfun = Qnil; \
126 if (MARKERP (printcharfun)) \
128 EMACS_INT marker_pos; \
129 if (! XMARKER (printcharfun)->buffer) \
130 error ("Marker does not point anywhere"); \
131 if (XMARKER (printcharfun)->buffer != current_buffer) \
132 set_buffer_internal (XMARKER (printcharfun)->buffer); \
133 marker_pos = marker_position (printcharfun); \
134 if (marker_pos < BEGV || marker_pos > ZV) \
135 error ("Marker is outside the accessible part of the buffer"); \
136 old_point = PT; \
137 old_point_byte = PT_BYTE; \
138 SET_PT_BOTH (marker_pos, \
139 marker_byte_position (printcharfun)); \
140 start_point = PT; \
141 start_point_byte = PT_BYTE; \
142 printcharfun = Qnil; \
144 if (NILP (printcharfun)) \
146 Lisp_Object string; \
147 if (NILP (BVAR (current_buffer, enable_multibyte_characters)) \
148 && ! print_escape_multibyte) \
149 specbind (Qprint_escape_multibyte, Qt); \
150 if (! NILP (BVAR (current_buffer, enable_multibyte_characters)) \
151 && ! print_escape_nonascii) \
152 specbind (Qprint_escape_nonascii, Qt); \
153 if (print_buffer != 0) \
155 string = make_string_from_bytes (print_buffer, \
156 print_buffer_pos, \
157 print_buffer_pos_byte); \
158 record_unwind_protect (print_unwind, string); \
160 else \
162 print_buffer_size = 1000; \
163 print_buffer = (char *) xmalloc (print_buffer_size); \
164 free_print_buffer = 1; \
166 print_buffer_pos = 0; \
167 print_buffer_pos_byte = 0; \
169 if (EQ (printcharfun, Qt) && ! noninteractive) \
170 setup_echo_area_for_printing (multibyte);
172 #define PRINTFINISH \
173 if (NILP (printcharfun)) \
175 if (print_buffer_pos != print_buffer_pos_byte \
176 && NILP (BVAR (current_buffer, enable_multibyte_characters))) \
178 unsigned char *temp \
179 = (unsigned char *) alloca (print_buffer_pos + 1); \
180 copy_text ((unsigned char *) print_buffer, temp, \
181 print_buffer_pos_byte, 1, 0); \
182 insert_1_both ((char *) temp, print_buffer_pos, \
183 print_buffer_pos, 0, 1, 0); \
185 else \
186 insert_1_both (print_buffer, print_buffer_pos, \
187 print_buffer_pos_byte, 0, 1, 0); \
188 signal_after_change (PT - print_buffer_pos, 0, print_buffer_pos);\
190 if (free_print_buffer) \
192 xfree (print_buffer); \
193 print_buffer = 0; \
195 unbind_to (specpdl_count, Qnil); \
196 if (MARKERP (original)) \
197 set_marker_both (original, Qnil, PT, PT_BYTE); \
198 if (old_point >= 0) \
199 SET_PT_BOTH (old_point + (old_point >= start_point \
200 ? PT - start_point : 0), \
201 old_point_byte + (old_point_byte >= start_point_byte \
202 ? PT_BYTE - start_point_byte : 0)); \
203 if (old != current_buffer) \
204 set_buffer_internal (old);
206 #define PRINTCHAR(ch) printchar (ch, printcharfun)
208 /* This is used to restore the saved contents of print_buffer
209 when there is a recursive call to print. */
211 static Lisp_Object
212 print_unwind (Lisp_Object saved_text)
214 memcpy (print_buffer, SDATA (saved_text), SCHARS (saved_text));
215 return Qnil;
219 /* Print character CH using method FUN. FUN nil means print to
220 print_buffer. FUN t means print to echo area or stdout if
221 non-interactive. If FUN is neither nil nor t, call FUN with CH as
222 argument. */
224 static void
225 printchar (unsigned int ch, Lisp_Object fun)
227 if (!NILP (fun) && !EQ (fun, Qt))
228 call1 (fun, make_number (ch));
229 else
231 unsigned char str[MAX_MULTIBYTE_LENGTH];
232 int len = CHAR_STRING (ch, str);
234 QUIT;
236 if (NILP (fun))
238 if (print_buffer_pos_byte + len >= print_buffer_size)
239 print_buffer = (char *) xrealloc (print_buffer,
240 print_buffer_size *= 2);
241 memcpy (print_buffer + print_buffer_pos_byte, str, len);
242 print_buffer_pos += 1;
243 print_buffer_pos_byte += len;
245 else if (noninteractive)
247 fwrite (str, 1, len, stdout);
248 noninteractive_need_newline = 1;
250 else
252 int multibyte_p
253 = !NILP (BVAR (current_buffer, enable_multibyte_characters));
255 setup_echo_area_for_printing (multibyte_p);
256 insert_char (ch);
257 message_dolog ((char *) str, len, 0, multibyte_p);
263 /* Output SIZE characters, SIZE_BYTE bytes from string PTR using
264 method PRINTCHARFUN. If SIZE < 0, use the string length of PTR for
265 both SIZE and SIZE_BYTE. PRINTCHARFUN nil means output to
266 print_buffer. PRINTCHARFUN t means output to the echo area or to
267 stdout if non-interactive. If neither nil nor t, call Lisp
268 function PRINTCHARFUN for each character printed. MULTIBYTE
269 non-zero means PTR contains multibyte characters.
271 In the case where PRINTCHARFUN is nil, it is safe for PTR to point
272 to data in a Lisp string. Otherwise that is not safe. */
274 static void
275 strout (const char *ptr, EMACS_INT size, EMACS_INT size_byte,
276 Lisp_Object printcharfun)
278 if (size < 0)
279 size_byte = size = strlen (ptr);
281 if (NILP (printcharfun))
283 if (print_buffer_pos_byte + size_byte > print_buffer_size)
285 print_buffer_size = print_buffer_size * 2 + size_byte;
286 print_buffer = (char *) xrealloc (print_buffer,
287 print_buffer_size);
289 memcpy (print_buffer + print_buffer_pos_byte, ptr, size_byte);
290 print_buffer_pos += size;
291 print_buffer_pos_byte += size_byte;
293 else if (noninteractive && EQ (printcharfun, Qt))
295 fwrite (ptr, 1, size_byte, stdout);
296 noninteractive_need_newline = 1;
298 else if (EQ (printcharfun, Qt))
300 /* Output to echo area. We're trying to avoid a little overhead
301 here, that's the reason we don't call printchar to do the
302 job. */
303 int i;
304 int multibyte_p
305 = !NILP (BVAR (current_buffer, enable_multibyte_characters));
307 setup_echo_area_for_printing (multibyte_p);
308 message_dolog (ptr, size_byte, 0, multibyte_p);
310 if (size == size_byte)
312 for (i = 0; i < size; ++i)
313 insert_char ((unsigned char) *ptr++);
315 else
317 int len;
318 for (i = 0; i < size_byte; i += len)
320 int ch = STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr + i,
321 len);
322 insert_char (ch);
326 else
328 /* PRINTCHARFUN is a Lisp function. */
329 EMACS_INT i = 0;
331 if (size == size_byte)
333 while (i < size_byte)
335 int ch = ptr[i++];
336 PRINTCHAR (ch);
339 else
341 while (i < size_byte)
343 /* Here, we must convert each multi-byte form to the
344 corresponding character code before handing it to
345 PRINTCHAR. */
346 int len;
347 int ch = STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr + i,
348 len);
349 PRINTCHAR (ch);
350 i += len;
356 /* Print the contents of a string STRING using PRINTCHARFUN.
357 It isn't safe to use strout in many cases,
358 because printing one char can relocate. */
360 static void
361 print_string (Lisp_Object string, Lisp_Object printcharfun)
363 if (EQ (printcharfun, Qt) || NILP (printcharfun))
365 EMACS_INT chars;
367 if (print_escape_nonascii)
368 string = string_escape_byte8 (string);
370 if (STRING_MULTIBYTE (string))
371 chars = SCHARS (string);
372 else if (! print_escape_nonascii
373 && (EQ (printcharfun, Qt)
374 ? ! NILP (BVAR (&buffer_defaults, enable_multibyte_characters))
375 : ! NILP (BVAR (current_buffer, enable_multibyte_characters))))
377 /* If unibyte string STRING contains 8-bit codes, we must
378 convert STRING to a multibyte string containing the same
379 character codes. */
380 Lisp_Object newstr;
381 EMACS_INT bytes;
383 chars = SBYTES (string);
384 bytes = count_size_as_multibyte (SDATA (string), chars);
385 if (chars < bytes)
387 newstr = make_uninit_multibyte_string (chars, bytes);
388 memcpy (SDATA (newstr), SDATA (string), chars);
389 str_to_multibyte (SDATA (newstr), bytes, chars);
390 string = newstr;
393 else
394 chars = SBYTES (string);
396 if (EQ (printcharfun, Qt))
398 /* Output to echo area. */
399 EMACS_INT nbytes = SBYTES (string);
400 char *buffer;
402 /* Copy the string contents so that relocation of STRING by
403 GC does not cause trouble. */
404 USE_SAFE_ALLOCA;
406 SAFE_ALLOCA (buffer, char *, nbytes);
407 memcpy (buffer, SDATA (string), nbytes);
409 strout (buffer, chars, SBYTES (string), printcharfun);
411 SAFE_FREE ();
413 else
414 /* No need to copy, since output to print_buffer can't GC. */
415 strout (SSDATA (string), chars, SBYTES (string), printcharfun);
417 else
419 /* Otherwise, string may be relocated by printing one char.
420 So re-fetch the string address for each character. */
421 EMACS_INT i;
422 EMACS_INT size = SCHARS (string);
423 EMACS_INT size_byte = SBYTES (string);
424 struct gcpro gcpro1;
425 GCPRO1 (string);
426 if (size == size_byte)
427 for (i = 0; i < size; i++)
428 PRINTCHAR (SREF (string, i));
429 else
430 for (i = 0; i < size_byte; )
432 /* Here, we must convert each multi-byte form to the
433 corresponding character code before handing it to PRINTCHAR. */
434 int len;
435 int ch = STRING_CHAR_AND_LENGTH (SDATA (string) + i, len);
436 PRINTCHAR (ch);
437 i += len;
439 UNGCPRO;
443 DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0,
444 doc: /* Output character CHARACTER to stream PRINTCHARFUN.
445 PRINTCHARFUN defaults to the value of `standard-output' (which see). */)
446 (Lisp_Object character, Lisp_Object printcharfun)
448 PRINTDECLARE;
450 if (NILP (printcharfun))
451 printcharfun = Vstandard_output;
452 CHECK_NUMBER (character);
453 PRINTPREPARE;
454 PRINTCHAR (XINT (character));
455 PRINTFINISH;
456 return character;
459 /* Used from outside of print.c to print a block of SIZE
460 single-byte chars at DATA on the default output stream.
461 Do not use this on the contents of a Lisp string. */
463 void
464 write_string (const char *data, int size)
466 PRINTDECLARE;
467 Lisp_Object printcharfun;
469 printcharfun = Vstandard_output;
471 PRINTPREPARE;
472 strout (data, size, size, printcharfun);
473 PRINTFINISH;
476 /* Used to print a block of SIZE single-byte chars at DATA on a
477 specified stream PRINTCHARFUN.
478 Do not use this on the contents of a Lisp string. */
480 static void
481 write_string_1 (const char *data, int size, Lisp_Object printcharfun)
483 PRINTDECLARE;
485 PRINTPREPARE;
486 strout (data, size, size, printcharfun);
487 PRINTFINISH;
491 void
492 temp_output_buffer_setup (const char *bufname)
494 int count = SPECPDL_INDEX ();
495 register struct buffer *old = current_buffer;
496 register Lisp_Object buf;
498 record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
500 Fset_buffer (Fget_buffer_create (build_string (bufname)));
502 Fkill_all_local_variables ();
503 delete_all_overlays (current_buffer);
504 BVAR (current_buffer, directory) = BVAR (old, directory);
505 BVAR (current_buffer, read_only) = Qnil;
506 BVAR (current_buffer, filename) = Qnil;
507 BVAR (current_buffer, undo_list) = Qt;
508 eassert (current_buffer->overlays_before == NULL);
509 eassert (current_buffer->overlays_after == NULL);
510 BVAR (current_buffer, enable_multibyte_characters)
511 = BVAR (&buffer_defaults, enable_multibyte_characters);
512 specbind (Qinhibit_read_only, Qt);
513 specbind (Qinhibit_modification_hooks, Qt);
514 Ferase_buffer ();
515 XSETBUFFER (buf, current_buffer);
517 Frun_hooks (1, &Qtemp_buffer_setup_hook);
519 unbind_to (count, Qnil);
521 specbind (Qstandard_output, buf);
524 static void print (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag);
525 static void print_preprocess (Lisp_Object obj);
526 static void print_preprocess_string (INTERVAL interval, Lisp_Object arg);
527 static void print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag);
529 DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
530 doc: /* Output a newline to stream PRINTCHARFUN.
531 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
532 (Lisp_Object printcharfun)
534 PRINTDECLARE;
536 if (NILP (printcharfun))
537 printcharfun = Vstandard_output;
538 PRINTPREPARE;
539 PRINTCHAR ('\n');
540 PRINTFINISH;
541 return Qt;
544 DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0,
545 doc: /* Output the printed representation of OBJECT, any Lisp object.
546 Quoting characters are printed when needed to make output that `read'
547 can handle, whenever this is possible. For complex objects, the behavior
548 is controlled by `print-level' and `print-length', which see.
550 OBJECT is any of the Lisp data types: a number, a string, a symbol,
551 a list, a buffer, a window, a frame, etc.
553 A printed representation of an object is text which describes that object.
555 Optional argument PRINTCHARFUN is the output stream, which can be one
556 of these:
558 - a buffer, in which case output is inserted into that buffer at point;
559 - a marker, in which case output is inserted at marker's position;
560 - a function, in which case that function is called once for each
561 character of OBJECT's printed representation;
562 - a symbol, in which case that symbol's function definition is called; or
563 - t, in which case the output is displayed in the echo area.
565 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
566 is used instead. */)
567 (Lisp_Object object, Lisp_Object printcharfun)
569 PRINTDECLARE;
571 if (NILP (printcharfun))
572 printcharfun = Vstandard_output;
573 PRINTPREPARE;
574 print (object, printcharfun, 1);
575 PRINTFINISH;
576 return object;
579 /* a buffer which is used to hold output being built by prin1-to-string */
580 Lisp_Object Vprin1_to_string_buffer;
582 DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0,
583 doc: /* Return a string containing the printed representation of OBJECT.
584 OBJECT can be any Lisp object. This function outputs quoting characters
585 when necessary to make output that `read' can handle, whenever possible,
586 unless the optional second argument NOESCAPE is non-nil. For complex objects,
587 the behavior is controlled by `print-level' and `print-length', which see.
589 OBJECT is any of the Lisp data types: a number, a string, a symbol,
590 a list, a buffer, a window, a frame, etc.
592 A printed representation of an object is text which describes that object. */)
593 (Lisp_Object object, Lisp_Object noescape)
595 Lisp_Object printcharfun;
596 /* struct gcpro gcpro1, gcpro2; */
597 Lisp_Object save_deactivate_mark;
598 int count = SPECPDL_INDEX ();
599 struct buffer *previous;
601 specbind (Qinhibit_modification_hooks, Qt);
604 PRINTDECLARE;
606 /* Save and restore this--we are altering a buffer
607 but we don't want to deactivate the mark just for that.
608 No need for specbind, since errors deactivate the mark. */
609 save_deactivate_mark = Vdeactivate_mark;
610 /* GCPRO2 (object, save_deactivate_mark); */
611 abort_on_gc++;
613 printcharfun = Vprin1_to_string_buffer;
614 PRINTPREPARE;
615 print (object, printcharfun, NILP (noescape));
616 /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
617 PRINTFINISH;
620 previous = current_buffer;
621 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
622 object = Fbuffer_string ();
623 if (SBYTES (object) == SCHARS (object))
624 STRING_SET_UNIBYTE (object);
626 /* Note that this won't make prepare_to_modify_buffer call
627 ask-user-about-supersession-threat because this buffer
628 does not visit a file. */
629 Ferase_buffer ();
630 set_buffer_internal (previous);
632 Vdeactivate_mark = save_deactivate_mark;
633 /* UNGCPRO; */
635 abort_on_gc--;
636 return unbind_to (count, object);
639 DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
640 doc: /* Output the printed representation of OBJECT, any Lisp object.
641 No quoting characters are used; no delimiters are printed around
642 the contents of strings.
644 OBJECT is any of the Lisp data types: a number, a string, a symbol,
645 a list, a buffer, a window, a frame, etc.
647 A printed representation of an object is text which describes that object.
649 Optional argument PRINTCHARFUN is the output stream, which can be one
650 of these:
652 - a buffer, in which case output is inserted into that buffer at point;
653 - a marker, in which case output is inserted at marker's position;
654 - a function, in which case that function is called once for each
655 character of OBJECT's printed representation;
656 - a symbol, in which case that symbol's function definition is called; or
657 - t, in which case the output is displayed in the echo area.
659 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
660 is used instead. */)
661 (Lisp_Object object, Lisp_Object printcharfun)
663 PRINTDECLARE;
665 if (NILP (printcharfun))
666 printcharfun = Vstandard_output;
667 PRINTPREPARE;
668 print (object, printcharfun, 0);
669 PRINTFINISH;
670 return object;
673 DEFUN ("print", Fprint, Sprint, 1, 2, 0,
674 doc: /* Output the printed representation of OBJECT, with newlines around it.
675 Quoting characters are printed when needed to make output that `read'
676 can handle, whenever this is possible. For complex objects, the behavior
677 is controlled by `print-level' and `print-length', which see.
679 OBJECT is any of the Lisp data types: a number, a string, a symbol,
680 a list, a buffer, a window, a frame, etc.
682 A printed representation of an object is text which describes that object.
684 Optional argument PRINTCHARFUN is the output stream, which can be one
685 of these:
687 - a buffer, in which case output is inserted into that buffer at point;
688 - a marker, in which case output is inserted at marker's position;
689 - a function, in which case that function is called once for each
690 character of OBJECT's printed representation;
691 - a symbol, in which case that symbol's function definition is called; or
692 - t, in which case the output is displayed in the echo area.
694 If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
695 is used instead. */)
696 (Lisp_Object object, Lisp_Object printcharfun)
698 PRINTDECLARE;
699 struct gcpro gcpro1;
701 if (NILP (printcharfun))
702 printcharfun = Vstandard_output;
703 GCPRO1 (object);
704 PRINTPREPARE;
705 PRINTCHAR ('\n');
706 print (object, printcharfun, 1);
707 PRINTCHAR ('\n');
708 PRINTFINISH;
709 UNGCPRO;
710 return object;
713 /* The subroutine object for external-debugging-output is kept here
714 for the convenience of the debugger. */
715 Lisp_Object Qexternal_debugging_output;
717 DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0,
718 doc: /* Write CHARACTER to stderr.
719 You can call print while debugging emacs, and pass it this function
720 to make it write to the debugging output. */)
721 (Lisp_Object character)
723 CHECK_NUMBER (character);
724 putc ((int) XINT (character), stderr);
726 #ifdef WINDOWSNT
727 /* Send the output to a debugger (nothing happens if there isn't one). */
728 if (print_output_debug_flag)
730 char buf[2] = {(char) XINT (character), '\0'};
731 OutputDebugString (buf);
733 #endif
735 return character;
738 /* This function is never called. Its purpose is to prevent
739 print_output_debug_flag from being optimized away. */
741 extern void debug_output_compilation_hack (int) EXTERNALLY_VISIBLE;
742 void
743 debug_output_compilation_hack (int x)
745 print_output_debug_flag = x;
748 #if defined (GNU_LINUX)
750 /* This functionality is not vitally important in general, so we rely on
751 non-portable ability to use stderr as lvalue. */
753 #define WITH_REDIRECT_DEBUGGING_OUTPUT 1
755 static FILE *initial_stderr_stream = NULL;
757 DEFUN ("redirect-debugging-output", Fredirect_debugging_output, Sredirect_debugging_output,
758 1, 2,
759 "FDebug output file: \nP",
760 doc: /* Redirect debugging output (stderr stream) to file FILE.
761 If FILE is nil, reset target to the initial stderr stream.
762 Optional arg APPEND non-nil (interactively, with prefix arg) means
763 append to existing target file. */)
764 (Lisp_Object file, Lisp_Object append)
766 if (initial_stderr_stream != NULL)
768 BLOCK_INPUT;
769 fclose (stderr);
770 UNBLOCK_INPUT;
772 stderr = initial_stderr_stream;
773 initial_stderr_stream = NULL;
775 if (STRINGP (file))
777 file = Fexpand_file_name (file, Qnil);
778 initial_stderr_stream = stderr;
779 stderr = fopen (SSDATA (file), NILP (append) ? "w" : "a");
780 if (stderr == NULL)
782 stderr = initial_stderr_stream;
783 initial_stderr_stream = NULL;
784 report_file_error ("Cannot open debugging output stream",
785 Fcons (file, Qnil));
788 return Qnil;
790 #endif /* GNU_LINUX */
793 /* This is the interface for debugging printing. */
795 void
796 debug_print (Lisp_Object arg)
798 Fprin1 (arg, Qexternal_debugging_output);
799 fprintf (stderr, "\r\n");
802 void safe_debug_print (Lisp_Object) EXTERNALLY_VISIBLE;
803 void
804 safe_debug_print (Lisp_Object arg)
806 int valid = valid_lisp_object_p (arg);
808 if (valid > 0)
809 debug_print (arg);
810 else
811 fprintf (stderr, "#<%s_LISP_OBJECT 0x%08"pI"x>\r\n",
812 !valid ? "INVALID" : "SOME",
813 XHASH (arg));
817 DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
818 1, 1, 0,
819 doc: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
820 See Info anchor `(elisp)Definition of signal' for some details on how this
821 error message is constructed. */)
822 (Lisp_Object obj)
824 struct buffer *old = current_buffer;
825 Lisp_Object value;
826 struct gcpro gcpro1;
828 /* If OBJ is (error STRING), just return STRING.
829 That is not only faster, it also avoids the need to allocate
830 space here when the error is due to memory full. */
831 if (CONSP (obj) && EQ (XCAR (obj), Qerror)
832 && CONSP (XCDR (obj))
833 && STRINGP (XCAR (XCDR (obj)))
834 && NILP (XCDR (XCDR (obj))))
835 return XCAR (XCDR (obj));
837 print_error_message (obj, Vprin1_to_string_buffer, 0, Qnil);
839 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
840 value = Fbuffer_string ();
842 GCPRO1 (value);
843 Ferase_buffer ();
844 set_buffer_internal (old);
845 UNGCPRO;
847 return value;
850 /* Print an error message for the error DATA onto Lisp output stream
851 STREAM (suitable for the print functions).
852 CONTEXT is a C string describing the context of the error.
853 CALLER is the Lisp function inside which the error was signaled. */
855 void
856 print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
857 Lisp_Object caller)
859 Lisp_Object errname, errmsg, file_error, tail;
860 struct gcpro gcpro1;
861 int i;
863 if (context != 0)
864 write_string_1 (context, -1, stream);
866 /* If we know from where the error was signaled, show it in
867 *Messages*. */
868 if (!NILP (caller) && SYMBOLP (caller))
870 Lisp_Object cname = SYMBOL_NAME (caller);
871 char *name = alloca (SBYTES (cname));
872 memcpy (name, SDATA (cname), SBYTES (cname));
873 message_dolog (name, SBYTES (cname), 0, 0);
874 message_dolog (": ", 2, 0, 0);
877 errname = Fcar (data);
879 if (EQ (errname, Qerror))
881 data = Fcdr (data);
882 if (!CONSP (data))
883 data = Qnil;
884 errmsg = Fcar (data);
885 file_error = Qnil;
887 else
889 Lisp_Object error_conditions;
890 errmsg = Fget (errname, Qerror_message);
891 error_conditions = Fget (errname, Qerror_conditions);
892 file_error = Fmemq (Qfile_error, error_conditions);
895 /* Print an error message including the data items. */
897 tail = Fcdr_safe (data);
898 GCPRO1 (tail);
900 /* For file-error, make error message by concatenating
901 all the data items. They are all strings. */
902 if (!NILP (file_error) && CONSP (tail))
903 errmsg = XCAR (tail), tail = XCDR (tail);
905 if (STRINGP (errmsg))
906 Fprinc (errmsg, stream);
907 else
908 write_string_1 ("peculiar error", -1, stream);
910 for (i = 0; CONSP (tail); tail = XCDR (tail), i = 1)
912 Lisp_Object obj;
914 write_string_1 (i ? ", " : ": ", 2, stream);
915 obj = XCAR (tail);
916 if (!NILP (file_error) || EQ (errname, Qend_of_file))
917 Fprinc (obj, stream);
918 else
919 Fprin1 (obj, stream);
922 UNGCPRO;
928 * The buffer should be at least as large as the max string size of the
929 * largest float, printed in the biggest notation. This is undoubtedly
930 * 20d float_output_format, with the negative of the C-constant "HUGE"
931 * from <math.h>.
933 * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
935 * I assume that IEEE-754 format numbers can take 329 bytes for the worst
936 * case of -1e307 in 20d float_output_format. What is one to do (short of
937 * re-writing _doprnt to be more sane)?
938 * -wsr
939 * Given the above, the buffer must be least FLOAT_TO_STRING_BUFSIZE bytes.
942 void
943 float_to_string (char *buf, double data)
945 char *cp;
946 int width;
948 /* Check for plus infinity in a way that won't lose
949 if there is no plus infinity. */
950 if (data == data / 2 && data > 1.0)
952 strcpy (buf, "1.0e+INF");
953 return;
955 /* Likewise for minus infinity. */
956 if (data == data / 2 && data < -1.0)
958 strcpy (buf, "-1.0e+INF");
959 return;
961 /* Check for NaN in a way that won't fail if there are no NaNs. */
962 if (! (data * 0.0 >= 0.0))
964 /* Prepend "-" if the NaN's sign bit is negative.
965 The sign bit of a double is the bit that is 1 in -0.0. */
966 int i;
967 union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
968 u_data.d = data;
969 u_minus_zero.d = - 0.0;
970 for (i = 0; i < sizeof (double); i++)
971 if (u_data.c[i] & u_minus_zero.c[i])
973 *buf++ = '-';
974 break;
977 strcpy (buf, "0.0e+NaN");
978 return;
981 if (NILP (Vfloat_output_format)
982 || !STRINGP (Vfloat_output_format))
983 lose:
985 /* Generate the fewest number of digits that represent the
986 floating point value without losing information. */
987 dtoastr (buf, FLOAT_TO_STRING_BUFSIZE - 2, 0, 0, data);
988 /* The decimal point must be printed, or the byte compiler can
989 get confused (Bug#8033). */
990 width = 1;
992 else /* oink oink */
994 /* Check that the spec we have is fully valid.
995 This means not only valid for printf,
996 but meant for floats, and reasonable. */
997 cp = SSDATA (Vfloat_output_format);
999 if (cp[0] != '%')
1000 goto lose;
1001 if (cp[1] != '.')
1002 goto lose;
1004 cp += 2;
1006 /* Check the width specification. */
1007 width = -1;
1008 if ('0' <= *cp && *cp <= '9')
1010 width = 0;
1012 width = (width * 10) + (*cp++ - '0');
1013 while (*cp >= '0' && *cp <= '9');
1015 /* A precision of zero is valid only for %f. */
1016 if (width > DBL_DIG
1017 || (width == 0 && *cp != 'f'))
1018 goto lose;
1021 if (*cp != 'e' && *cp != 'f' && *cp != 'g')
1022 goto lose;
1024 if (cp[1] != 0)
1025 goto lose;
1027 sprintf (buf, SSDATA (Vfloat_output_format), data);
1030 /* Make sure there is a decimal point with digit after, or an
1031 exponent, so that the value is readable as a float. But don't do
1032 this with "%.0f"; it's valid for that not to produce a decimal
1033 point. Note that width can be 0 only for %.0f. */
1034 if (width != 0)
1036 for (cp = buf; *cp; cp++)
1037 if ((*cp < '0' || *cp > '9') && *cp != '-')
1038 break;
1040 if (*cp == '.' && cp[1] == 0)
1042 cp[1] = '0';
1043 cp[2] = 0;
1045 else if (*cp == 0)
1047 *cp++ = '.';
1048 *cp++ = '0';
1049 *cp++ = 0;
1055 static void
1056 print (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag)
1058 new_backquote_output = 0;
1060 /* Reset print_number_index and Vprint_number_table only when
1061 the variable Vprint_continuous_numbering is nil. Otherwise,
1062 the values of these variables will be kept between several
1063 print functions. */
1064 if (NILP (Vprint_continuous_numbering)
1065 || NILP (Vprint_number_table))
1067 print_number_index = 0;
1068 Vprint_number_table = Qnil;
1071 /* Construct Vprint_number_table for print-gensym and print-circle. */
1072 if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))
1074 /* Construct Vprint_number_table.
1075 This increments print_number_index for the objects added. */
1076 print_depth = 0;
1077 print_preprocess (obj);
1079 if (HASH_TABLE_P (Vprint_number_table))
1080 { /* Remove unnecessary objects, which appear only once in OBJ;
1081 that is, whose status is Qt.
1082 Maybe a better way to do that is to copy elements to
1083 a new hash table. */
1084 struct Lisp_Hash_Table *h = XHASH_TABLE (Vprint_number_table);
1085 EMACS_INT i;
1087 for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
1088 if (!NILP (HASH_HASH (h, i))
1089 && EQ (HASH_VALUE (h, i), Qt))
1090 Fremhash (HASH_KEY (h, i), Vprint_number_table);
1094 print_depth = 0;
1095 print_object (obj, printcharfun, escapeflag);
1098 #define PRINT_CIRCLE_CANDIDATE_P(obj) \
1099 (STRINGP (obj) || CONSP (obj) \
1100 || (VECTORLIKEP (obj) \
1101 && (VECTORP (obj) || COMPILEDP (obj) \
1102 || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) \
1103 || HASH_TABLE_P (obj) || FONTP (obj))) \
1104 || (! NILP (Vprint_gensym) \
1105 && SYMBOLP (obj) \
1106 && !SYMBOL_INTERNED_P (obj)))
1108 /* Construct Vprint_number_table according to the structure of OBJ.
1109 OBJ itself and all its elements will be added to Vprint_number_table
1110 recursively if it is a list, vector, compiled function, char-table,
1111 string (its text properties will be traced), or a symbol that has
1112 no obarray (this is for the print-gensym feature).
1113 The status fields of Vprint_number_table mean whether each object appears
1114 more than once in OBJ: Qnil at the first time, and Qt after that . */
1115 static void
1116 print_preprocess (Lisp_Object obj)
1118 int i;
1119 EMACS_INT size;
1120 int loop_count = 0;
1121 Lisp_Object halftail;
1123 /* Give up if we go so deep that print_object will get an error. */
1124 /* See similar code in print_object. */
1125 if (print_depth >= PRINT_CIRCLE)
1126 error ("Apparently circular structure being printed");
1128 /* Avoid infinite recursion for circular nested structure
1129 in the case where Vprint_circle is nil. */
1130 if (NILP (Vprint_circle))
1132 for (i = 0; i < print_depth; i++)
1133 if (EQ (obj, being_printed[i]))
1134 return;
1135 being_printed[print_depth] = obj;
1138 print_depth++;
1139 halftail = obj;
1141 loop:
1142 if (PRINT_CIRCLE_CANDIDATE_P (obj))
1144 if (!HASH_TABLE_P (Vprint_number_table))
1146 Lisp_Object args[2];
1147 args[0] = QCtest;
1148 args[1] = Qeq;
1149 Vprint_number_table = Fmake_hash_table (2, args);
1152 /* In case print-circle is nil and print-gensym is t,
1153 add OBJ to Vprint_number_table only when OBJ is a symbol. */
1154 if (! NILP (Vprint_circle) || SYMBOLP (obj))
1156 Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
1157 if (!NILP (num)
1158 /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
1159 always print the gensym with a number. This is a special for
1160 the lisp function byte-compile-output-docform. */
1161 || (!NILP (Vprint_continuous_numbering)
1162 && SYMBOLP (obj)
1163 && !SYMBOL_INTERNED_P (obj)))
1164 { /* OBJ appears more than once. Let's remember that. */
1165 if (!INTEGERP (num))
1167 print_number_index++;
1168 /* Negative number indicates it hasn't been printed yet. */
1169 Fputhash (obj, make_number (- print_number_index),
1170 Vprint_number_table);
1172 print_depth--;
1173 return;
1175 else
1176 /* OBJ is not yet recorded. Let's add to the table. */
1177 Fputhash (obj, Qt, Vprint_number_table);
1180 switch (XTYPE (obj))
1182 case Lisp_String:
1183 /* A string may have text properties, which can be circular. */
1184 traverse_intervals_noorder (STRING_INTERVALS (obj),
1185 print_preprocess_string, Qnil);
1186 break;
1188 case Lisp_Cons:
1189 /* Use HALFTAIL and LOOP_COUNT to detect circular lists,
1190 just as in print_object. */
1191 if (loop_count && EQ (obj, halftail))
1192 break;
1193 print_preprocess (XCAR (obj));
1194 obj = XCDR (obj);
1195 loop_count++;
1196 if (!(loop_count & 1))
1197 halftail = XCDR (halftail);
1198 goto loop;
1200 case Lisp_Vectorlike:
1201 size = ASIZE (obj);
1202 if (size & PSEUDOVECTOR_FLAG)
1203 size &= PSEUDOVECTOR_SIZE_MASK;
1204 for (i = 0; i < size; i++)
1205 print_preprocess (XVECTOR (obj)->contents[i]);
1206 if (HASH_TABLE_P (obj))
1207 { /* For hash tables, the key_and_value slot is past
1208 `size' because it needs to be marked specially in case
1209 the table is weak. */
1210 struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
1211 print_preprocess (h->key_and_value);
1213 break;
1215 default:
1216 break;
1219 print_depth--;
1222 static void
1223 print_preprocess_string (INTERVAL interval, Lisp_Object arg)
1225 print_preprocess (interval->plist);
1228 static void print_check_string_charset_prop (INTERVAL interval, Lisp_Object string);
1230 #define PRINT_STRING_NON_CHARSET_FOUND 1
1231 #define PRINT_STRING_UNSAFE_CHARSET_FOUND 2
1233 /* Bitwise or of the above macros. */
1234 static int print_check_string_result;
1236 static void
1237 print_check_string_charset_prop (INTERVAL interval, Lisp_Object string)
1239 Lisp_Object val;
1241 if (NILP (interval->plist)
1242 || (print_check_string_result == (PRINT_STRING_NON_CHARSET_FOUND
1243 | PRINT_STRING_UNSAFE_CHARSET_FOUND)))
1244 return;
1245 for (val = interval->plist; CONSP (val) && ! EQ (XCAR (val), Qcharset);
1246 val = XCDR (XCDR (val)));
1247 if (! CONSP (val))
1249 print_check_string_result |= PRINT_STRING_NON_CHARSET_FOUND;
1250 return;
1252 if (! (print_check_string_result & PRINT_STRING_NON_CHARSET_FOUND))
1254 if (! EQ (val, interval->plist)
1255 || CONSP (XCDR (XCDR (val))))
1256 print_check_string_result |= PRINT_STRING_NON_CHARSET_FOUND;
1258 if (NILP (Vprint_charset_text_property)
1259 || ! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
1261 int i, c;
1262 EMACS_INT charpos = interval->position;
1263 EMACS_INT bytepos = string_char_to_byte (string, charpos);
1264 Lisp_Object charset;
1266 charset = XCAR (XCDR (val));
1267 for (i = 0; i < LENGTH (interval); i++)
1269 FETCH_STRING_CHAR_ADVANCE (c, string, charpos, bytepos);
1270 if (! ASCII_CHAR_P (c)
1271 && ! EQ (CHARSET_NAME (CHAR_CHARSET (c)), charset))
1273 print_check_string_result |= PRINT_STRING_UNSAFE_CHARSET_FOUND;
1274 break;
1280 /* The value is (charset . nil). */
1281 static Lisp_Object print_prune_charset_plist;
1283 static Lisp_Object
1284 print_prune_string_charset (Lisp_Object string)
1286 print_check_string_result = 0;
1287 traverse_intervals (STRING_INTERVALS (string), 0,
1288 print_check_string_charset_prop, string);
1289 if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
1291 string = Fcopy_sequence (string);
1292 if (print_check_string_result & PRINT_STRING_NON_CHARSET_FOUND)
1294 if (NILP (print_prune_charset_plist))
1295 print_prune_charset_plist = Fcons (Qcharset, Qnil);
1296 Fremove_text_properties (make_number (0),
1297 make_number (SCHARS (string)),
1298 print_prune_charset_plist, string);
1300 else
1301 Fset_text_properties (make_number (0), make_number (SCHARS (string)),
1302 Qnil, string);
1304 return string;
1307 static void
1308 print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag)
1310 char buf[40];
1312 QUIT;
1314 /* See similar code in print_preprocess. */
1315 if (print_depth >= PRINT_CIRCLE)
1316 error ("Apparently circular structure being printed");
1318 /* Detect circularities and truncate them. */
1319 if (PRINT_CIRCLE_CANDIDATE_P (obj))
1321 if (NILP (Vprint_circle) && NILP (Vprint_gensym))
1323 /* Simple but incomplete way. */
1324 int i;
1325 for (i = 0; i < print_depth; i++)
1326 if (EQ (obj, being_printed[i]))
1328 sprintf (buf, "#%d", i);
1329 strout (buf, -1, -1, printcharfun);
1330 return;
1332 being_printed[print_depth] = obj;
1334 else
1336 /* With the print-circle feature. */
1337 Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
1338 if (INTEGERP (num))
1340 EMACS_INT n = XINT (num);
1341 if (n < 0)
1342 { /* Add a prefix #n= if OBJ has not yet been printed;
1343 that is, its status field is nil. */
1344 sprintf (buf, "#%"pI"d=", -n);
1345 strout (buf, -1, -1, printcharfun);
1346 /* OBJ is going to be printed. Remember that fact. */
1347 Fputhash (obj, make_number (- n), Vprint_number_table);
1349 else
1351 /* Just print #n# if OBJ has already been printed. */
1352 sprintf (buf, "#%"pI"d#", n);
1353 strout (buf, -1, -1, printcharfun);
1354 return;
1360 print_depth++;
1362 switch (XTYPE (obj))
1364 case_Lisp_Int:
1365 sprintf (buf, "%"pI"d", XINT (obj));
1366 strout (buf, -1, -1, printcharfun);
1367 break;
1369 case Lisp_Float:
1371 char pigbuf[FLOAT_TO_STRING_BUFSIZE];
1373 float_to_string (pigbuf, XFLOAT_DATA (obj));
1374 strout (pigbuf, -1, -1, printcharfun);
1376 break;
1378 case Lisp_String:
1379 if (!escapeflag)
1380 print_string (obj, printcharfun);
1381 else
1383 register EMACS_INT i_byte;
1384 struct gcpro gcpro1;
1385 unsigned char *str;
1386 EMACS_INT size_byte;
1387 /* 1 means we must ensure that the next character we output
1388 cannot be taken as part of a hex character escape. */
1389 int need_nonhex = 0;
1390 int multibyte = STRING_MULTIBYTE (obj);
1392 GCPRO1 (obj);
1394 if (! EQ (Vprint_charset_text_property, Qt))
1395 obj = print_prune_string_charset (obj);
1397 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
1399 PRINTCHAR ('#');
1400 PRINTCHAR ('(');
1403 PRINTCHAR ('\"');
1404 str = SDATA (obj);
1405 size_byte = SBYTES (obj);
1407 for (i_byte = 0; i_byte < size_byte;)
1409 /* Here, we must convert each multi-byte form to the
1410 corresponding character code before handing it to PRINTCHAR. */
1411 int len;
1412 int c;
1414 if (multibyte)
1416 c = STRING_CHAR_AND_LENGTH (str + i_byte, len);
1417 i_byte += len;
1419 else
1420 c = str[i_byte++];
1422 QUIT;
1424 if (c == '\n' && print_escape_newlines)
1426 PRINTCHAR ('\\');
1427 PRINTCHAR ('n');
1429 else if (c == '\f' && print_escape_newlines)
1431 PRINTCHAR ('\\');
1432 PRINTCHAR ('f');
1434 else if (multibyte
1435 && (CHAR_BYTE8_P (c)
1436 || (! ASCII_CHAR_P (c) && print_escape_multibyte)))
1438 /* When multibyte is disabled,
1439 print multibyte string chars using hex escapes.
1440 For a char code that could be in a unibyte string,
1441 when found in a multibyte string, always use a hex escape
1442 so it reads back as multibyte. */
1443 char outbuf[50];
1445 if (CHAR_BYTE8_P (c))
1446 sprintf (outbuf, "\\%03o", CHAR_TO_BYTE8 (c));
1447 else
1449 sprintf (outbuf, "\\x%04x", c);
1450 need_nonhex = 1;
1452 strout (outbuf, -1, -1, printcharfun);
1454 else if (! multibyte
1455 && SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c)
1456 && print_escape_nonascii)
1458 /* When printing in a multibyte buffer
1459 or when explicitly requested,
1460 print single-byte non-ASCII string chars
1461 using octal escapes. */
1462 char outbuf[5];
1463 sprintf (outbuf, "\\%03o", c);
1464 strout (outbuf, -1, -1, printcharfun);
1466 else
1468 /* If we just had a hex escape, and this character
1469 could be taken as part of it,
1470 output `\ ' to prevent that. */
1471 if (need_nonhex)
1473 need_nonhex = 0;
1474 if ((c >= 'a' && c <= 'f')
1475 || (c >= 'A' && c <= 'F')
1476 || (c >= '0' && c <= '9'))
1477 strout ("\\ ", -1, -1, printcharfun);
1480 if (c == '\"' || c == '\\')
1481 PRINTCHAR ('\\');
1482 PRINTCHAR (c);
1485 PRINTCHAR ('\"');
1487 if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
1489 traverse_intervals (STRING_INTERVALS (obj),
1490 0, print_interval, printcharfun);
1491 PRINTCHAR (')');
1494 UNGCPRO;
1496 break;
1498 case Lisp_Symbol:
1500 register int confusing;
1501 register unsigned char *p = SDATA (SYMBOL_NAME (obj));
1502 register unsigned char *end = p + SBYTES (SYMBOL_NAME (obj));
1503 register int c;
1504 int i, i_byte;
1505 EMACS_INT size_byte;
1506 Lisp_Object name;
1508 name = SYMBOL_NAME (obj);
1510 if (p != end && (*p == '-' || *p == '+')) p++;
1511 if (p == end)
1512 confusing = 0;
1513 /* If symbol name begins with a digit, and ends with a digit,
1514 and contains nothing but digits and `e', it could be treated
1515 as a number. So set CONFUSING.
1517 Symbols that contain periods could also be taken as numbers,
1518 but periods are always escaped, so we don't have to worry
1519 about them here. */
1520 else if (*p >= '0' && *p <= '9'
1521 && end[-1] >= '0' && end[-1] <= '9')
1523 while (p != end && ((*p >= '0' && *p <= '9')
1524 /* Needed for \2e10. */
1525 || *p == 'e' || *p == 'E'))
1526 p++;
1527 confusing = (end == p);
1529 else
1530 confusing = 0;
1532 if (! NILP (Vprint_gensym) && !SYMBOL_INTERNED_P (obj))
1534 PRINTCHAR ('#');
1535 PRINTCHAR (':');
1538 size_byte = SBYTES (name);
1540 for (i = 0, i_byte = 0; i_byte < size_byte;)
1542 /* Here, we must convert each multi-byte form to the
1543 corresponding character code before handing it to PRINTCHAR. */
1544 FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte);
1545 QUIT;
1547 if (escapeflag)
1549 if (c == '\"' || c == '\\' || c == '\''
1550 || c == ';' || c == '#' || c == '(' || c == ')'
1551 || c == ',' || c =='.' || c == '`'
1552 || c == '[' || c == ']' || c == '?' || c <= 040
1553 || confusing)
1554 PRINTCHAR ('\\'), confusing = 0;
1556 PRINTCHAR (c);
1559 break;
1561 case Lisp_Cons:
1562 /* If deeper than spec'd depth, print placeholder. */
1563 if (INTEGERP (Vprint_level)
1564 && print_depth > XINT (Vprint_level))
1565 strout ("...", -1, -1, printcharfun);
1566 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1567 && (EQ (XCAR (obj), Qquote)))
1569 PRINTCHAR ('\'');
1570 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1572 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1573 && (EQ (XCAR (obj), Qfunction)))
1575 PRINTCHAR ('#');
1576 PRINTCHAR ('\'');
1577 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1579 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1580 && ((EQ (XCAR (obj), Qbackquote))))
1582 print_object (XCAR (obj), printcharfun, 0);
1583 new_backquote_output++;
1584 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1585 new_backquote_output--;
1587 else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
1588 && new_backquote_output
1589 && ((EQ (XCAR (obj), Qbackquote)
1590 || EQ (XCAR (obj), Qcomma)
1591 || EQ (XCAR (obj), Qcomma_at)
1592 || EQ (XCAR (obj), Qcomma_dot))))
1594 print_object (XCAR (obj), printcharfun, 0);
1595 new_backquote_output--;
1596 print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
1597 new_backquote_output++;
1599 else
1601 PRINTCHAR ('(');
1604 EMACS_INT print_length;
1605 int i;
1606 Lisp_Object halftail = obj;
1608 /* Negative values of print-length are invalid in CL.
1609 Treat them like nil, as CMUCL does. */
1610 if (NATNUMP (Vprint_length))
1611 print_length = XFASTINT (Vprint_length);
1612 else
1613 print_length = 0;
1615 i = 0;
1616 while (CONSP (obj))
1618 /* Detect circular list. */
1619 if (NILP (Vprint_circle))
1621 /* Simple but imcomplete way. */
1622 if (i != 0 && EQ (obj, halftail))
1624 sprintf (buf, " . #%d", i / 2);
1625 strout (buf, -1, -1, printcharfun);
1626 goto end_of_list;
1629 else
1631 /* With the print-circle feature. */
1632 if (i != 0)
1634 Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
1635 if (INTEGERP (num))
1637 strout (" . ", 3, 3, printcharfun);
1638 print_object (obj, printcharfun, escapeflag);
1639 goto end_of_list;
1644 if (i++)
1645 PRINTCHAR (' ');
1647 if (print_length && i > print_length)
1649 strout ("...", 3, 3, printcharfun);
1650 goto end_of_list;
1653 print_object (XCAR (obj), printcharfun, escapeflag);
1655 obj = XCDR (obj);
1656 if (!(i & 1))
1657 halftail = XCDR (halftail);
1661 /* OBJ non-nil here means it's the end of a dotted list. */
1662 if (!NILP (obj))
1664 strout (" . ", 3, 3, printcharfun);
1665 print_object (obj, printcharfun, escapeflag);
1668 end_of_list:
1669 PRINTCHAR (')');
1671 break;
1673 case Lisp_Vectorlike:
1674 if (PROCESSP (obj))
1676 if (escapeflag)
1678 strout ("#<process ", -1, -1, printcharfun);
1679 print_string (XPROCESS (obj)->name, printcharfun);
1680 PRINTCHAR ('>');
1682 else
1683 print_string (XPROCESS (obj)->name, printcharfun);
1685 else if (BOOL_VECTOR_P (obj))
1687 register int i;
1688 register unsigned char c;
1689 struct gcpro gcpro1;
1690 EMACS_INT size_in_chars
1691 = ((XBOOL_VECTOR (obj)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
1692 / BOOL_VECTOR_BITS_PER_CHAR);
1694 GCPRO1 (obj);
1696 PRINTCHAR ('#');
1697 PRINTCHAR ('&');
1698 sprintf (buf, "%"pI"d", XBOOL_VECTOR (obj)->size);
1699 strout (buf, -1, -1, printcharfun);
1700 PRINTCHAR ('\"');
1702 /* Don't print more characters than the specified maximum.
1703 Negative values of print-length are invalid. Treat them
1704 like a print-length of nil. */
1705 if (NATNUMP (Vprint_length)
1706 && XFASTINT (Vprint_length) < size_in_chars)
1707 size_in_chars = XFASTINT (Vprint_length);
1709 for (i = 0; i < size_in_chars; i++)
1711 QUIT;
1712 c = XBOOL_VECTOR (obj)->data[i];
1713 if (c == '\n' && print_escape_newlines)
1715 PRINTCHAR ('\\');
1716 PRINTCHAR ('n');
1718 else if (c == '\f' && print_escape_newlines)
1720 PRINTCHAR ('\\');
1721 PRINTCHAR ('f');
1723 else if (c > '\177')
1725 /* Use octal escapes to avoid encoding issues. */
1726 PRINTCHAR ('\\');
1727 PRINTCHAR ('0' + ((c >> 6) & 3));
1728 PRINTCHAR ('0' + ((c >> 3) & 7));
1729 PRINTCHAR ('0' + (c & 7));
1731 else
1733 if (c == '\"' || c == '\\')
1734 PRINTCHAR ('\\');
1735 PRINTCHAR (c);
1738 PRINTCHAR ('\"');
1740 UNGCPRO;
1742 else if (SUBRP (obj))
1744 strout ("#<subr ", -1, -1, printcharfun);
1745 strout (XSUBR (obj)->symbol_name, -1, -1, printcharfun);
1746 PRINTCHAR ('>');
1748 else if (WINDOWP (obj))
1750 strout ("#<window ", -1, -1, printcharfun);
1751 sprintf (buf, "%"pI"d", XFASTINT (XWINDOW (obj)->sequence_number));
1752 strout (buf, -1, -1, printcharfun);
1753 if (!NILP (XWINDOW (obj)->buffer))
1755 strout (" on ", -1, -1, printcharfun);
1756 print_string (BVAR (XBUFFER (XWINDOW (obj)->buffer), name), printcharfun);
1758 PRINTCHAR ('>');
1760 else if (TERMINALP (obj))
1762 struct terminal *t = XTERMINAL (obj);
1763 strout ("#<terminal ", -1, -1, printcharfun);
1764 sprintf (buf, "%d", t->id);
1765 strout (buf, -1, -1, printcharfun);
1766 if (t->name)
1768 strout (" on ", -1, -1, printcharfun);
1769 strout (t->name, -1, -1, printcharfun);
1771 PRINTCHAR ('>');
1773 else if (HASH_TABLE_P (obj))
1775 struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
1776 int i;
1777 EMACS_INT real_size, size;
1778 #if 0
1779 strout ("#<hash-table", -1, -1, printcharfun);
1780 if (SYMBOLP (h->test))
1782 PRINTCHAR (' ');
1783 PRINTCHAR ('\'');
1784 strout (SDATA (SYMBOL_NAME (h->test)), -1, -1, printcharfun);
1785 PRINTCHAR (' ');
1786 strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun);
1787 PRINTCHAR (' ');
1788 sprintf (buf, "%ld/%ld", (long) h->count,
1789 (long) ASIZE (h->next));
1790 strout (buf, -1, -1, printcharfun);
1792 sprintf (buf, " 0x%lx", (unsigned long) h);
1793 strout (buf, -1, -1, printcharfun);
1794 PRINTCHAR ('>');
1795 #endif
1796 /* Implement a readable output, e.g.:
1797 #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
1798 /* Always print the size. */
1799 sprintf (buf, "#s(hash-table size %ld",
1800 (long) ASIZE (h->next));
1801 strout (buf, -1, -1, printcharfun);
1803 if (!NILP (h->test))
1805 strout (" test ", -1, -1, printcharfun);
1806 print_object (h->test, printcharfun, escapeflag);
1809 if (!NILP (h->weak))
1811 strout (" weakness ", -1, -1, printcharfun);
1812 print_object (h->weak, printcharfun, escapeflag);
1815 if (!NILP (h->rehash_size))
1817 strout (" rehash-size ", -1, -1, printcharfun);
1818 print_object (h->rehash_size, printcharfun, escapeflag);
1821 if (!NILP (h->rehash_threshold))
1823 strout (" rehash-threshold ", -1, -1, printcharfun);
1824 print_object (h->rehash_threshold, printcharfun, escapeflag);
1827 strout (" data ", -1, -1, printcharfun);
1829 /* Print the data here as a plist. */
1830 real_size = HASH_TABLE_SIZE (h);
1831 size = real_size;
1833 /* Don't print more elements than the specified maximum. */
1834 if (NATNUMP (Vprint_length)
1835 && XFASTINT (Vprint_length) < size)
1836 size = XFASTINT (Vprint_length);
1838 PRINTCHAR ('(');
1839 for (i = 0; i < size; i++)
1840 if (!NILP (HASH_HASH (h, i)))
1842 if (i) PRINTCHAR (' ');
1843 print_object (HASH_KEY (h, i), printcharfun, escapeflag);
1844 PRINTCHAR (' ');
1845 print_object (HASH_VALUE (h, i), printcharfun, escapeflag);
1848 if (size < real_size)
1849 strout (" ...", 4, 4, printcharfun);
1851 PRINTCHAR (')');
1852 PRINTCHAR (')');
1855 else if (BUFFERP (obj))
1857 if (NILP (BVAR (XBUFFER (obj), name)))
1858 strout ("#<killed buffer>", -1, -1, printcharfun);
1859 else if (escapeflag)
1861 strout ("#<buffer ", -1, -1, printcharfun);
1862 print_string (BVAR (XBUFFER (obj), name), printcharfun);
1863 PRINTCHAR ('>');
1865 else
1866 print_string (BVAR (XBUFFER (obj), name), printcharfun);
1868 else if (WINDOW_CONFIGURATIONP (obj))
1870 strout ("#<window-configuration>", -1, -1, printcharfun);
1872 else if (FRAMEP (obj))
1874 strout ((FRAME_LIVE_P (XFRAME (obj))
1875 ? "#<frame " : "#<dead frame "),
1876 -1, -1, printcharfun);
1877 print_string (XFRAME (obj)->name, printcharfun);
1878 sprintf (buf, " %p", XFRAME (obj));
1879 strout (buf, -1, -1, printcharfun);
1880 PRINTCHAR ('>');
1882 else if (FONTP (obj))
1884 EMACS_INT i;
1886 if (! FONT_OBJECT_P (obj))
1888 if (FONT_SPEC_P (obj))
1889 strout ("#<font-spec", -1, -1, printcharfun);
1890 else
1891 strout ("#<font-entity", -1, -1, printcharfun);
1892 for (i = 0; i < FONT_SPEC_MAX; i++)
1894 PRINTCHAR (' ');
1895 if (i < FONT_WEIGHT_INDEX || i > FONT_WIDTH_INDEX)
1896 print_object (AREF (obj, i), printcharfun, escapeflag);
1897 else
1898 print_object (font_style_symbolic (obj, i, 0),
1899 printcharfun, escapeflag);
1902 else
1904 strout ("#<font-object ", -1, -1, printcharfun);
1905 print_object (AREF (obj, FONT_NAME_INDEX), printcharfun,
1906 escapeflag);
1908 PRINTCHAR ('>');
1910 else
1912 EMACS_INT size = ASIZE (obj);
1913 if (COMPILEDP (obj))
1915 PRINTCHAR ('#');
1916 size &= PSEUDOVECTOR_SIZE_MASK;
1918 if (CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj))
1920 /* We print a char-table as if it were a vector,
1921 lumping the parent and default slots in with the
1922 character slots. But we add #^ as a prefix. */
1924 /* Make each lowest sub_char_table start a new line.
1925 Otherwise we'll make a line extremely long, which
1926 results in slow redisplay. */
1927 if (SUB_CHAR_TABLE_P (obj)
1928 && XINT (XSUB_CHAR_TABLE (obj)->depth) == 3)
1929 PRINTCHAR ('\n');
1930 PRINTCHAR ('#');
1931 PRINTCHAR ('^');
1932 if (SUB_CHAR_TABLE_P (obj))
1933 PRINTCHAR ('^');
1934 size &= PSEUDOVECTOR_SIZE_MASK;
1936 if (size & PSEUDOVECTOR_FLAG)
1937 goto badtype;
1939 PRINTCHAR ('[');
1941 register int i;
1942 register Lisp_Object tem;
1943 EMACS_INT real_size = size;
1945 /* Don't print more elements than the specified maximum. */
1946 if (NATNUMP (Vprint_length)
1947 && XFASTINT (Vprint_length) < size)
1948 size = XFASTINT (Vprint_length);
1950 for (i = 0; i < size; i++)
1952 if (i) PRINTCHAR (' ');
1953 tem = XVECTOR (obj)->contents[i];
1954 print_object (tem, printcharfun, escapeflag);
1956 if (size < real_size)
1957 strout (" ...", 4, 4, printcharfun);
1959 PRINTCHAR (']');
1961 break;
1963 case Lisp_Misc:
1964 switch (XMISCTYPE (obj))
1966 case Lisp_Misc_Marker:
1967 strout ("#<marker ", -1, -1, printcharfun);
1968 /* Do you think this is necessary? */
1969 if (XMARKER (obj)->insertion_type != 0)
1970 strout ("(moves after insertion) ", -1, -1, printcharfun);
1971 if (! XMARKER (obj)->buffer)
1972 strout ("in no buffer", -1, -1, printcharfun);
1973 else
1975 sprintf (buf, "at %"pI"d", marker_position (obj));
1976 strout (buf, -1, -1, printcharfun);
1977 strout (" in ", -1, -1, printcharfun);
1978 print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun);
1980 PRINTCHAR ('>');
1981 break;
1983 case Lisp_Misc_Overlay:
1984 strout ("#<overlay ", -1, -1, printcharfun);
1985 if (! XMARKER (OVERLAY_START (obj))->buffer)
1986 strout ("in no buffer", -1, -1, printcharfun);
1987 else
1989 sprintf (buf, "from %"pI"d to %"pI"d in ",
1990 marker_position (OVERLAY_START (obj)),
1991 marker_position (OVERLAY_END (obj)));
1992 strout (buf, -1, -1, printcharfun);
1993 print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name),
1994 printcharfun);
1996 PRINTCHAR ('>');
1997 break;
1999 /* Remaining cases shouldn't happen in normal usage, but let's print
2000 them anyway for the benefit of the debugger. */
2001 case Lisp_Misc_Free:
2002 strout ("#<misc free cell>", -1, -1, printcharfun);
2003 break;
2005 case Lisp_Misc_Save_Value:
2006 strout ("#<save_value ", -1, -1, printcharfun);
2007 sprintf(buf, "ptr=%p int=%"pD"d",
2008 XSAVE_VALUE (obj)->pointer,
2009 XSAVE_VALUE (obj)->integer);
2010 strout (buf, -1, -1, printcharfun);
2011 PRINTCHAR ('>');
2012 break;
2014 default:
2015 goto badtype;
2017 break;
2019 default:
2020 badtype:
2022 /* We're in trouble if this happens!
2023 Probably should just abort () */
2024 strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun);
2025 if (MISCP (obj))
2026 sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj));
2027 else if (VECTORLIKEP (obj))
2028 sprintf (buf, "(PVEC 0x%08lx)", (unsigned long) ASIZE (obj));
2029 else
2030 sprintf (buf, "(0x%02x)", (int) XTYPE (obj));
2031 strout (buf, -1, -1, printcharfun);
2032 strout (" Save your buffers immediately and please report this bug>",
2033 -1, -1, printcharfun);
2037 print_depth--;
2041 /* Print a description of INTERVAL using PRINTCHARFUN.
2042 This is part of printing a string that has text properties. */
2044 void
2045 print_interval (INTERVAL interval, Lisp_Object printcharfun)
2047 if (NILP (interval->plist))
2048 return;
2049 PRINTCHAR (' ');
2050 print_object (make_number (interval->position), printcharfun, 1);
2051 PRINTCHAR (' ');
2052 print_object (make_number (interval->position + LENGTH (interval)),
2053 printcharfun, 1);
2054 PRINTCHAR (' ');
2055 print_object (interval->plist, printcharfun, 1);
2059 void
2060 syms_of_print (void)
2062 Qtemp_buffer_setup_hook = intern_c_string ("temp-buffer-setup-hook");
2063 staticpro (&Qtemp_buffer_setup_hook);
2065 DEFVAR_LISP ("standard-output", Vstandard_output,
2066 doc: /* Output stream `print' uses by default for outputting a character.
2067 This may be any function of one argument.
2068 It may also be a buffer (output is inserted before point)
2069 or a marker (output is inserted and the marker is advanced)
2070 or the symbol t (output appears in the echo area). */);
2071 Vstandard_output = Qt;
2072 Qstandard_output = intern_c_string ("standard-output");
2073 staticpro (&Qstandard_output);
2075 DEFVAR_LISP ("float-output-format", Vfloat_output_format,
2076 doc: /* The format descriptor string used to print floats.
2077 This is a %-spec like those accepted by `printf' in C,
2078 but with some restrictions. It must start with the two characters `%.'.
2079 After that comes an integer precision specification,
2080 and then a letter which controls the format.
2081 The letters allowed are `e', `f' and `g'.
2082 Use `e' for exponential notation \"DIG.DIGITSeEXPT\"
2083 Use `f' for decimal point notation \"DIGITS.DIGITS\".
2084 Use `g' to choose the shorter of those two formats for the number at hand.
2085 The precision in any of these cases is the number of digits following
2086 the decimal point. With `f', a precision of 0 means to omit the
2087 decimal point. 0 is not allowed with `e' or `g'.
2089 A value of nil means to use the shortest notation
2090 that represents the number without losing information. */);
2091 Vfloat_output_format = Qnil;
2092 Qfloat_output_format = intern_c_string ("float-output-format");
2093 staticpro (&Qfloat_output_format);
2095 DEFVAR_LISP ("print-length", Vprint_length,
2096 doc: /* Maximum length of list to print before abbreviating.
2097 A value of nil means no limit. See also `eval-expression-print-length'. */);
2098 Vprint_length = Qnil;
2100 DEFVAR_LISP ("print-level", Vprint_level,
2101 doc: /* Maximum depth of list nesting to print before abbreviating.
2102 A value of nil means no limit. See also `eval-expression-print-level'. */);
2103 Vprint_level = Qnil;
2105 DEFVAR_BOOL ("print-escape-newlines", print_escape_newlines,
2106 doc: /* Non-nil means print newlines in strings as `\\n'.
2107 Also print formfeeds as `\\f'. */);
2108 print_escape_newlines = 0;
2110 DEFVAR_BOOL ("print-escape-nonascii", print_escape_nonascii,
2111 doc: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
2112 \(OOO is the octal representation of the character code.)
2113 Only single-byte characters are affected, and only in `prin1'.
2114 When the output goes in a multibyte buffer, this feature is
2115 enabled regardless of the value of the variable. */);
2116 print_escape_nonascii = 0;
2118 DEFVAR_BOOL ("print-escape-multibyte", print_escape_multibyte,
2119 doc: /* Non-nil means print multibyte characters in strings as \\xXXXX.
2120 \(XXXX is the hex representation of the character code.)
2121 This affects only `prin1'. */);
2122 print_escape_multibyte = 0;
2124 DEFVAR_BOOL ("print-quoted", print_quoted,
2125 doc: /* Non-nil means print quoted forms with reader syntax.
2126 I.e., (quote foo) prints as 'foo, (function foo) as #'foo. */);
2127 print_quoted = 0;
2129 DEFVAR_LISP ("print-gensym", Vprint_gensym,
2130 doc: /* Non-nil means print uninterned symbols so they will read as uninterned.
2131 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
2132 When the uninterned symbol appears within a recursive data structure,
2133 and the symbol appears more than once, in addition use the #N# and #N=
2134 constructs as needed, so that multiple references to the same symbol are
2135 shared once again when the text is read back. */);
2136 Vprint_gensym = Qnil;
2138 DEFVAR_LISP ("print-circle", Vprint_circle,
2139 doc: /* *Non-nil means print recursive structures using #N= and #N# syntax.
2140 If nil, printing proceeds recursively and may lead to
2141 `max-lisp-eval-depth' being exceeded or an error may occur:
2142 \"Apparently circular structure being printed.\" Also see
2143 `print-length' and `print-level'.
2144 If non-nil, shared substructures anywhere in the structure are printed
2145 with `#N=' before the first occurrence (in the order of the print
2146 representation) and `#N#' in place of each subsequent occurrence,
2147 where N is a positive decimal integer. */);
2148 Vprint_circle = Qnil;
2150 DEFVAR_LISP ("print-continuous-numbering", Vprint_continuous_numbering,
2151 doc: /* *Non-nil means number continuously across print calls.
2152 This affects the numbers printed for #N= labels and #M# references.
2153 See also `print-circle', `print-gensym', and `print-number-table'.
2154 This variable should not be set with `setq'; bind it with a `let' instead. */);
2155 Vprint_continuous_numbering = Qnil;
2157 DEFVAR_LISP ("print-number-table", Vprint_number_table,
2158 doc: /* A vector used internally to produce `#N=' labels and `#N#' references.
2159 The Lisp printer uses this vector to detect Lisp objects referenced more
2160 than once.
2162 When you bind `print-continuous-numbering' to t, you should probably
2163 also bind `print-number-table' to nil. This ensures that the value of
2164 `print-number-table' can be garbage-collected once the printing is
2165 done. If all elements of `print-number-table' are nil, it means that
2166 the printing done so far has not found any shared structure or objects
2167 that need to be recorded in the table. */);
2168 Vprint_number_table = Qnil;
2170 DEFVAR_LISP ("print-charset-text-property", Vprint_charset_text_property,
2171 doc: /* A flag to control printing of `charset' text property on printing a string.
2172 The value must be nil, t, or `default'.
2174 If the value is nil, don't print the text property `charset'.
2176 If the value is t, always print the text property `charset'.
2178 If the value is `default', print the text property `charset' only when
2179 the value is different from what is guessed in the current charset
2180 priorities. */);
2181 Vprint_charset_text_property = Qdefault;
2183 /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
2184 staticpro (&Vprin1_to_string_buffer);
2186 defsubr (&Sprin1);
2187 defsubr (&Sprin1_to_string);
2188 defsubr (&Serror_message_string);
2189 defsubr (&Sprinc);
2190 defsubr (&Sprint);
2191 defsubr (&Sterpri);
2192 defsubr (&Swrite_char);
2193 defsubr (&Sexternal_debugging_output);
2194 #ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
2195 defsubr (&Sredirect_debugging_output);
2196 #endif
2198 Qexternal_debugging_output = intern_c_string ("external-debugging-output");
2199 staticpro (&Qexternal_debugging_output);
2201 Qprint_escape_newlines = intern_c_string ("print-escape-newlines");
2202 staticpro (&Qprint_escape_newlines);
2204 Qprint_escape_multibyte = intern_c_string ("print-escape-multibyte");
2205 staticpro (&Qprint_escape_multibyte);
2207 Qprint_escape_nonascii = intern_c_string ("print-escape-nonascii");
2208 staticpro (&Qprint_escape_nonascii);
2210 print_prune_charset_plist = Qnil;
2211 staticpro (&print_prune_charset_plist);