/* Lisp object printing and output streams.
- Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997,
- 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+
+Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2012
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include "termhooks.h" /* For struct terminal. */
#include "font.h"
-Lisp_Object Vstandard_output, Qstandard_output;
+Lisp_Object Qstandard_output;
-Lisp_Object Qtemp_buffer_setup_hook;
+static Lisp_Object Qtemp_buffer_setup_hook;
/* These are used to print like we read. */
-extern Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
-Lisp_Object Vfloat_output_format, Qfloat_output_format;
+static Lisp_Object Qfloat_output_format;
#include <math.h>
-
-#if STDC_HEADERS
#include <float.h>
-#endif
+#include <ftoastr.h>
/* Default to values appropriate for IEEE floating point. */
-#ifndef FLT_RADIX
-#define FLT_RADIX 2
-#endif
-#ifndef DBL_MANT_DIG
-#define DBL_MANT_DIG 53
-#endif
#ifndef DBL_DIG
#define DBL_DIG 15
#endif
-#ifndef DBL_MIN
-#define DBL_MIN 2.2250738585072014e-308
-#endif
-
-#ifdef DBL_MIN_REPLACEMENT
-#undef DBL_MIN
-#define DBL_MIN DBL_MIN_REPLACEMENT
-#endif
-
-/* Define DOUBLE_DIGITS_BOUND, an upper bound on the number of decimal digits
- needed to express a float without losing information.
- The general-case formula is valid for the usual case, IEEE floating point,
- but many compilers can't optimize the formula to an integer constant,
- so make a special case for it. */
-#if FLT_RADIX == 2 && DBL_MANT_DIG == 53
-#define DOUBLE_DIGITS_BOUND 17 /* IEEE floating point */
-#else
-#define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
-#endif
/* Avoid actual stack overflow in print. */
-int print_depth;
+static ptrdiff_t print_depth;
/* Level of nesting inside outputting backquote in new style. */
-int new_backquote_output;
+static ptrdiff_t new_backquote_output;
/* Detect most circularities to print finite output. */
#define PRINT_CIRCLE 200
-Lisp_Object being_printed[PRINT_CIRCLE];
+static Lisp_Object being_printed[PRINT_CIRCLE];
/* When printing into a buffer, first we put the text in this
block, then insert it all at once. */
-char *print_buffer;
+static char *print_buffer;
/* Size allocated in print_buffer. */
-int print_buffer_size;
+static ptrdiff_t print_buffer_size;
/* Chars stored in print_buffer. */
-int print_buffer_pos;
+static ptrdiff_t print_buffer_pos;
/* Bytes stored in print_buffer. */
-int print_buffer_pos_byte;
-
-/* Maximum length of list to print in full; noninteger means
- effectively infinity */
-
-Lisp_Object Vprint_length;
-
-/* Maximum depth of list to print in full; noninteger means
- effectively infinity. */
-
-Lisp_Object Vprint_level;
-
-/* Nonzero means print newlines in strings as \n. */
-
-int print_escape_newlines;
-
-/* Nonzero means to print single-byte non-ascii characters in strings as
- octal escapes. */
-
-int print_escape_nonascii;
-
-/* Nonzero means to print multibyte characters in strings as hex escapes. */
-
-int print_escape_multibyte;
+static ptrdiff_t print_buffer_pos_byte;
Lisp_Object Qprint_escape_newlines;
-Lisp_Object Qprint_escape_multibyte, Qprint_escape_nonascii;
-
-/* Nonzero means print (quote foo) forms as 'foo, etc. */
-
-int print_quoted;
-
-/* Non-nil means print #: before uninterned symbols. */
-
-Lisp_Object Vprint_gensym;
-
-/* Non-nil means print recursive structures using #n= and #n# syntax. */
-
-Lisp_Object Vprint_circle;
-
-/* Non-nil means keep continuous number for #n= and #n# syntax
- between several print functions. */
-
-Lisp_Object Vprint_continuous_numbering;
-
-/* Vprint_number_table is a vector like [OBJ1 STAT1 OBJ2 STAT2 ...],
- where OBJn are objects going to be printed, and STATn are their status,
- which may be different meanings during process. See the comments of
- the functions print and print_preprocess for details.
- print_number_index keeps the last position the next object should be added,
- twice of which is the actual vector position in Vprint_number_table. */
-int print_number_index;
-Lisp_Object Vprint_number_table;
-
-/* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table TABLE.
- PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE.
- See the comment of the variable Vprint_number_table. */
-#define PRINT_NUMBER_OBJECT(table,i) XVECTOR ((table))->contents[(i) * 2]
-#define PRINT_NUMBER_STATUS(table,i) XVECTOR ((table))->contents[(i) * 2 + 1]
-
-/* Nonzero means print newline to stdout before next minibuffer message.
- Defined in xdisp.c */
-
-extern int noninteractive_need_newline;
-
-extern int minibuffer_auto_raise;
-
-void print_interval ();
+static Lisp_Object Qprint_escape_multibyte, Qprint_escape_nonascii;
+
+/* Vprint_number_table is a table, that keeps objects that are going to
+ be printed, to allow use of #n= and #n# to express sharing.
+ For any given object, the table can give the following values:
+ t the object will be printed only once.
+ -N the object will be printed several times and will take number N.
+ N the object has been printed so we can refer to it as #N#.
+ print_number_index holds the largest N already used.
+ N has to be striclty larger than 0 since we need to distinguish -N. */
+static ptrdiff_t print_number_index;
+static void print_interval (INTERVAL interval, Lisp_Object printcharfun);
/* GDB resets this to zero on W32 to disable OutputDebugString calls. */
-int print_output_debug_flag = 1;
+int print_output_debug_flag EXTERNALLY_VISIBLE = 1;
\f
-/* Low level output routines for characters and strings */
+/* Low level output routines for characters and strings. */
/* Lisp functions to do output using a stream
must have the stream in a variable called printcharfun
and must start with PRINTPREPARE, end with PRINTFINISH,
and use PRINTDECLARE to declare common variables.
Use PRINTCHAR to output one character,
- or call strout to output a block of characters. */
+ or call strout to output a block of characters. */
#define PRINTDECLARE \
struct buffer *old = current_buffer; \
- int old_point = -1, start_point = -1; \
- int old_point_byte = -1, start_point_byte = -1; \
- int specpdl_count = SPECPDL_INDEX (); \
+ ptrdiff_t old_point = -1, start_point = -1; \
+ ptrdiff_t old_point_byte = -1, start_point_byte = -1; \
+ ptrdiff_t specpdl_count = SPECPDL_INDEX (); \
int free_print_buffer = 0; \
- int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
+ int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); \
Lisp_Object original
#define PRINTPREPARE \
} \
if (MARKERP (printcharfun)) \
{ \
- EMACS_INT marker_pos; \
+ ptrdiff_t marker_pos; \
if (! XMARKER (printcharfun)->buffer) \
error ("Marker does not point anywhere"); \
if (XMARKER (printcharfun)->buffer != current_buffer) \
if (NILP (printcharfun)) \
{ \
Lisp_Object string; \
- if (NILP (current_buffer->enable_multibyte_characters) \
+ if (NILP (BVAR (current_buffer, enable_multibyte_characters)) \
&& ! print_escape_multibyte) \
specbind (Qprint_escape_multibyte, Qt); \
- if (! NILP (current_buffer->enable_multibyte_characters) \
+ if (! NILP (BVAR (current_buffer, enable_multibyte_characters)) \
&& ! print_escape_nonascii) \
specbind (Qprint_escape_nonascii, Qt); \
if (print_buffer != 0) \
} \
else \
{ \
- print_buffer_size = 1000; \
- print_buffer = (char *) xmalloc (print_buffer_size); \
+ int new_size = 1000; \
+ print_buffer = (char *) xmalloc (new_size); \
+ print_buffer_size = new_size; \
free_print_buffer = 1; \
} \
print_buffer_pos = 0; \
if (NILP (printcharfun)) \
{ \
if (print_buffer_pos != print_buffer_pos_byte \
- && NILP (current_buffer->enable_multibyte_characters)) \
+ && NILP (BVAR (current_buffer, enable_multibyte_characters))) \
{ \
unsigned char *temp \
= (unsigned char *) alloca (print_buffer_pos + 1); \
- copy_text (print_buffer, temp, print_buffer_pos_byte, \
- 1, 0); \
- insert_1_both (temp, print_buffer_pos, \
+ copy_text ((unsigned char *) print_buffer, temp, \
+ print_buffer_pos_byte, 1, 0); \
+ insert_1_both ((char *) temp, print_buffer_pos, \
print_buffer_pos, 0, 1, 0); \
} \
else \
when there is a recursive call to print. */
static Lisp_Object
-print_unwind (saved_text)
- Lisp_Object saved_text;
+print_unwind (Lisp_Object saved_text)
{
- bcopy (SDATA (saved_text), print_buffer, SCHARS (saved_text));
+ memcpy (print_buffer, SDATA (saved_text), SCHARS (saved_text));
return Qnil;
}
argument. */
static void
-printchar (ch, fun)
- unsigned int ch;
- Lisp_Object fun;
+printchar (unsigned int ch, Lisp_Object fun)
{
if (!NILP (fun) && !EQ (fun, Qt))
call1 (fun, make_number (ch));
if (NILP (fun))
{
- if (print_buffer_pos_byte + len >= print_buffer_size)
- print_buffer = (char *) xrealloc (print_buffer,
- print_buffer_size *= 2);
- bcopy (str, print_buffer + print_buffer_pos_byte, len);
+ ptrdiff_t incr = len - (print_buffer_size - print_buffer_pos_byte);
+ if (0 < incr)
+ print_buffer =
+ xpalloc (print_buffer, &print_buffer_size, incr, -1, 1);
+ memcpy (print_buffer + print_buffer_pos_byte, str, len);
print_buffer_pos += 1;
print_buffer_pos_byte += len;
}
else
{
int multibyte_p
- = !NILP (current_buffer->enable_multibyte_characters);
+ = !NILP (BVAR (current_buffer, enable_multibyte_characters));
setup_echo_area_for_printing (multibyte_p);
insert_char (ch);
- message_dolog (str, len, 0, multibyte_p);
+ message_dolog ((char *) str, len, 0, multibyte_p);
}
}
}
to data in a Lisp string. Otherwise that is not safe. */
static void
-strout (ptr, size, size_byte, printcharfun, multibyte)
- char *ptr;
- int size, size_byte;
- Lisp_Object printcharfun;
- int multibyte;
+strout (const char *ptr, ptrdiff_t size, ptrdiff_t size_byte,
+ Lisp_Object printcharfun)
{
if (size < 0)
size_byte = size = strlen (ptr);
if (NILP (printcharfun))
{
- if (print_buffer_pos_byte + size_byte > print_buffer_size)
- {
- print_buffer_size = print_buffer_size * 2 + size_byte;
- print_buffer = (char *) xrealloc (print_buffer,
- print_buffer_size);
- }
- bcopy (ptr, print_buffer + print_buffer_pos_byte, size_byte);
+ ptrdiff_t incr = size_byte - (print_buffer_size - print_buffer_pos_byte);
+ if (0 < incr)
+ print_buffer = xpalloc (print_buffer, &print_buffer_size, incr, -1, 1);
+ memcpy (print_buffer + print_buffer_pos_byte, ptr, size_byte);
print_buffer_pos += size;
print_buffer_pos_byte += size_byte;
}
job. */
int i;
int multibyte_p
- = !NILP (current_buffer->enable_multibyte_characters);
+ = !NILP (BVAR (current_buffer, enable_multibyte_characters));
setup_echo_area_for_printing (multibyte_p);
message_dolog (ptr, size_byte, 0, multibyte_p);
int len;
for (i = 0; i < size_byte; i += len)
{
- int ch = STRING_CHAR_AND_LENGTH (ptr + i, len);
+ int ch = STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr + i,
+ len);
insert_char (ch);
}
}
else
{
/* PRINTCHARFUN is a Lisp function. */
- int i = 0;
+ ptrdiff_t i = 0;
if (size == size_byte)
{
corresponding character code before handing it to
PRINTCHAR. */
int len;
- int ch = STRING_CHAR_AND_LENGTH (ptr + i, len);
+ int ch = STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr + i,
+ len);
PRINTCHAR (ch);
i += len;
}
because printing one char can relocate. */
static void
-print_string (string, printcharfun)
- Lisp_Object string;
- Lisp_Object printcharfun;
+print_string (Lisp_Object string, Lisp_Object printcharfun)
{
if (EQ (printcharfun, Qt) || NILP (printcharfun))
{
- int chars;
+ ptrdiff_t chars;
if (print_escape_nonascii)
string = string_escape_byte8 (string);
chars = SCHARS (string);
else if (! print_escape_nonascii
&& (EQ (printcharfun, Qt)
- ? ! NILP (buffer_defaults.enable_multibyte_characters)
- : ! NILP (current_buffer->enable_multibyte_characters)))
+ ? ! NILP (BVAR (&buffer_defaults, enable_multibyte_characters))
+ : ! NILP (BVAR (current_buffer, enable_multibyte_characters))))
{
/* If unibyte string STRING contains 8-bit codes, we must
convert STRING to a multibyte string containing the same
character codes. */
Lisp_Object newstr;
- int bytes;
+ ptrdiff_t bytes;
chars = SBYTES (string);
- bytes = parse_str_to_multibyte (SDATA (string), chars);
+ bytes = count_size_as_multibyte (SDATA (string), chars);
if (chars < bytes)
{
newstr = make_uninit_multibyte_string (chars, bytes);
- bcopy (SDATA (string), SDATA (newstr), chars);
+ memcpy (SDATA (newstr), SDATA (string), chars);
str_to_multibyte (SDATA (newstr), bytes, chars);
string = newstr;
}
if (EQ (printcharfun, Qt))
{
/* Output to echo area. */
- int nbytes = SBYTES (string);
+ ptrdiff_t nbytes = SBYTES (string);
char *buffer;
/* Copy the string contents so that relocation of STRING by
USE_SAFE_ALLOCA;
SAFE_ALLOCA (buffer, char *, nbytes);
- bcopy (SDATA (string), buffer, nbytes);
+ memcpy (buffer, SDATA (string), nbytes);
- strout (buffer, chars, SBYTES (string),
- printcharfun, STRING_MULTIBYTE (string));
+ strout (buffer, chars, SBYTES (string), printcharfun);
SAFE_FREE ();
}
else
/* No need to copy, since output to print_buffer can't GC. */
- strout (SDATA (string),
- chars, SBYTES (string),
- printcharfun, STRING_MULTIBYTE (string));
+ strout (SSDATA (string), chars, SBYTES (string), printcharfun);
}
else
{
/* Otherwise, string may be relocated by printing one char.
So re-fetch the string address for each character. */
- int i;
- int size = SCHARS (string);
- int size_byte = SBYTES (string);
+ ptrdiff_t i;
+ ptrdiff_t size = SCHARS (string);
+ ptrdiff_t size_byte = SBYTES (string);
struct gcpro gcpro1;
GCPRO1 (string);
if (size == size_byte)
DEFUN ("write-char", Fwrite_char, Swrite_char, 1, 2, 0,
doc: /* Output character CHARACTER to stream PRINTCHARFUN.
PRINTCHARFUN defaults to the value of `standard-output' (which see). */)
- (character, printcharfun)
- Lisp_Object character, printcharfun;
+ (Lisp_Object character, Lisp_Object printcharfun)
{
PRINTDECLARE;
Do not use this on the contents of a Lisp string. */
void
-write_string (data, size)
- char *data;
- int size;
+write_string (const char *data, int size)
{
PRINTDECLARE;
Lisp_Object printcharfun;
printcharfun = Vstandard_output;
PRINTPREPARE;
- strout (data, size, size, printcharfun, 0);
+ strout (data, size, size, printcharfun);
PRINTFINISH;
}
-/* Used from outside of print.c to print a block of SIZE
- single-byte chars at DATA on a specified stream PRINTCHARFUN.
+/* Used to print a block of SIZE single-byte chars at DATA on a
+ specified stream PRINTCHARFUN.
Do not use this on the contents of a Lisp string. */
-void
-write_string_1 (data, size, printcharfun)
- char *data;
- int size;
- Lisp_Object printcharfun;
+static void
+write_string_1 (const char *data, int size, Lisp_Object printcharfun)
{
PRINTDECLARE;
PRINTPREPARE;
- strout (data, size, size, printcharfun, 0);
+ strout (data, size, size, printcharfun);
PRINTFINISH;
}
void
-temp_output_buffer_setup (bufname)
- const char *bufname;
+temp_output_buffer_setup (const char *bufname)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
register struct buffer *old = current_buffer;
register Lisp_Object buf;
Fkill_all_local_variables ();
delete_all_overlays (current_buffer);
- current_buffer->directory = old->directory;
- current_buffer->read_only = Qnil;
- current_buffer->filename = Qnil;
- current_buffer->undo_list = Qt;
+ BVAR (current_buffer, directory) = BVAR (old, directory);
+ BVAR (current_buffer, read_only) = Qnil;
+ BVAR (current_buffer, filename) = Qnil;
+ BVAR (current_buffer, undo_list) = Qt;
eassert (current_buffer->overlays_before == NULL);
eassert (current_buffer->overlays_after == NULL);
- current_buffer->enable_multibyte_characters
- = buffer_defaults.enable_multibyte_characters;
+ BVAR (current_buffer, enable_multibyte_characters)
+ = BVAR (&buffer_defaults, enable_multibyte_characters);
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
Ferase_buffer ();
specbind (Qstandard_output, buf);
}
-
-Lisp_Object
-internal_with_output_to_temp_buffer (bufname, function, args)
- const char *bufname;
- Lisp_Object (*function) P_ ((Lisp_Object));
- Lisp_Object args;
-{
- int count = SPECPDL_INDEX ();
- Lisp_Object buf, val;
- struct gcpro gcpro1;
-
- GCPRO1 (args);
- record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
- temp_output_buffer_setup (bufname);
- buf = Vstandard_output;
- UNGCPRO;
-
- val = (*function) (args);
-
- GCPRO1 (val);
- temp_output_buffer_show (buf);
- UNGCPRO;
-
- return unbind_to (count, val);
-}
-
-DEFUN ("with-output-to-temp-buffer",
- Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer,
- 1, UNEVALLED, 0,
- doc: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
-
-This construct makes buffer BUFNAME empty before running BODY.
-It does not make the buffer current for BODY.
-Instead it binds `standard-output' to that buffer, so that output
-generated with `prin1' and similar functions in BODY goes into
-the buffer.
-
-At the end of BODY, this marks buffer BUFNAME unmodifed and displays
-it in a window, but does not select it. The normal way to do this is
-by calling `display-buffer', then running `temp-buffer-show-hook'.
-However, if `temp-buffer-show-function' is non-nil, it calls that
-function instead (and does not run `temp-buffer-show-hook'). The
-function gets one argument, the buffer to display.
-
-The return value of `with-output-to-temp-buffer' is the value of the
-last form in BODY. If BODY does not finish normally, the buffer
-BUFNAME is not displayed.
-
-This runs the hook `temp-buffer-setup-hook' before BODY,
-with the buffer BUFNAME temporarily current. It runs the hook
-`temp-buffer-show-hook' after displaying buffer BUFNAME, with that
-buffer temporarily current, and the window that was used to display it
-temporarily selected. But it doesn't run `temp-buffer-show-hook'
-if it uses `temp-buffer-show-function'.
-
-usage: (with-output-to-temp-buffer BUFNAME BODY...) */)
- (args)
- Lisp_Object args;
-{
- struct gcpro gcpro1;
- Lisp_Object name;
- int count = SPECPDL_INDEX ();
- Lisp_Object buf, val;
-
- GCPRO1(args);
- name = Feval (Fcar (args));
- CHECK_STRING (name);
- temp_output_buffer_setup (SDATA (name));
- buf = Vstandard_output;
- UNGCPRO;
-
- val = Fprogn (XCDR (args));
-
- GCPRO1 (val);
- temp_output_buffer_show (buf);
- UNGCPRO;
-
- return unbind_to (count, val);
-}
-
\f
-static void print ();
-static void print_preprocess ();
-static void print_preprocess_string ();
-static void print_object ();
+static void print (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag);
+static void print_preprocess (Lisp_Object obj);
+static void print_preprocess_string (INTERVAL interval, Lisp_Object arg);
+static void print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag);
DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
doc: /* Output a newline to stream PRINTCHARFUN.
If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
- (printcharfun)
- Lisp_Object printcharfun;
+ (Lisp_Object printcharfun)
{
PRINTDECLARE;
If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
is used instead. */)
- (object, printcharfun)
- Lisp_Object object, printcharfun;
+ (Lisp_Object object, Lisp_Object printcharfun)
{
PRINTDECLARE;
a list, a buffer, a window, a frame, etc.
A printed representation of an object is text which describes that object. */)
- (object, noescape)
- Lisp_Object object, noescape;
+ (Lisp_Object object, Lisp_Object noescape)
{
Lisp_Object printcharfun;
/* struct gcpro gcpro1, gcpro2; */
Lisp_Object save_deactivate_mark;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct buffer *previous;
specbind (Qinhibit_modification_hooks, Qt);
printcharfun = Vprin1_to_string_buffer;
PRINTPREPARE;
print (object, printcharfun, NILP (noescape));
- /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
+ /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINISH */
PRINTFINISH;
}
If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
is used instead. */)
- (object, printcharfun)
- Lisp_Object object, printcharfun;
+ (Lisp_Object object, Lisp_Object printcharfun)
{
PRINTDECLARE;
If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
is used instead. */)
- (object, printcharfun)
- Lisp_Object object, printcharfun;
+ (Lisp_Object object, Lisp_Object printcharfun)
{
PRINTDECLARE;
struct gcpro gcpro1;
doc: /* Write CHARACTER to stderr.
You can call print while debugging emacs, and pass it this function
to make it write to the debugging output. */)
- (character)
- Lisp_Object character;
+ (Lisp_Object character)
{
CHECK_NUMBER (character);
- putc (XINT (character), stderr);
+ putc (XINT (character) & 0xFF, stderr);
#ifdef WINDOWSNT
/* Send the output to a debugger (nothing happens if there isn't one). */
/* This function is never called. Its purpose is to prevent
print_output_debug_flag from being optimized away. */
+extern void debug_output_compilation_hack (int) EXTERNALLY_VISIBLE;
void
-debug_output_compilation_hack (x)
- int x;
+debug_output_compilation_hack (int x)
{
print_output_debug_flag = x;
}
#define WITH_REDIRECT_DEBUGGING_OUTPUT 1
-FILE *initial_stderr_stream = NULL;
+static FILE *initial_stderr_stream = NULL;
DEFUN ("redirect-debugging-output", Fredirect_debugging_output, Sredirect_debugging_output,
1, 2,
If FILE is nil, reset target to the initial stderr stream.
Optional arg APPEND non-nil (interactively, with prefix arg) means
append to existing target file. */)
- (file, append)
- Lisp_Object file, append;
+ (Lisp_Object file, Lisp_Object append)
{
if (initial_stderr_stream != NULL)
{
{
file = Fexpand_file_name (file, Qnil);
initial_stderr_stream = stderr;
- stderr = fopen (SDATA (file), NILP (append) ? "w" : "a");
+ stderr = fopen (SSDATA (file), NILP (append) ? "w" : "a");
if (stderr == NULL)
{
stderr = initial_stderr_stream;
/* This is the interface for debugging printing. */
void
-debug_print (arg)
- Lisp_Object arg;
+debug_print (Lisp_Object arg)
{
Fprin1 (arg, Qexternal_debugging_output);
fprintf (stderr, "\r\n");
}
+void safe_debug_print (Lisp_Object) EXTERNALLY_VISIBLE;
void
-safe_debug_print (arg)
- Lisp_Object arg;
+safe_debug_print (Lisp_Object arg)
{
int valid = valid_lisp_object_p (arg);
if (valid > 0)
debug_print (arg);
else
- fprintf (stderr, "#<%s_LISP_OBJECT 0x%08lx>\r\n",
+ fprintf (stderr, "#<%s_LISP_OBJECT 0x%08"pI"x>\r\n",
!valid ? "INVALID" : "SOME",
- (unsigned long) XHASH (arg)
- );
+ XHASH (arg));
}
\f
doc: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
See Info anchor `(elisp)Definition of signal' for some details on how this
error message is constructed. */)
- (obj)
- Lisp_Object obj;
+ (Lisp_Object obj)
{
struct buffer *old = current_buffer;
Lisp_Object value;
CALLER is the Lisp function inside which the error was signaled. */
void
-print_error_message (data, stream, context, caller)
- Lisp_Object data, stream;
- char *context;
- Lisp_Object caller;
+print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
+ Lisp_Object caller)
{
Lisp_Object errname, errmsg, file_error, tail;
struct gcpro gcpro1;
- int i;
if (context != 0)
write_string_1 (context, -1, stream);
if (!NILP (caller) && SYMBOLP (caller))
{
Lisp_Object cname = SYMBOL_NAME (caller);
- char *name = alloca (SBYTES (cname));
- bcopy (SDATA (cname), name, SBYTES (cname));
+ char *name;
+ USE_SAFE_ALLOCA;
+ SAFE_ALLOCA (name, char *, SBYTES (cname));
+ memcpy (name, SDATA (cname), SBYTES (cname));
message_dolog (name, SBYTES (cname), 0, 0);
message_dolog (": ", 2, 0, 0);
+ SAFE_FREE ();
}
errname = Fcar (data);
}
else
{
- Lisp_Object error_conditions;
+ Lisp_Object error_conditions = Fget (errname, Qerror_conditions);
errmsg = Fget (errname, Qerror_message);
- error_conditions = Fget (errname, Qerror_conditions);
file_error = Fmemq (Qfile_error, error_conditions);
}
if (!NILP (file_error) && CONSP (tail))
errmsg = XCAR (tail), tail = XCDR (tail);
- if (STRINGP (errmsg))
- Fprinc (errmsg, stream);
- else
- write_string_1 ("peculiar error", -1, stream);
+ {
+ const char *sep = ": ";
- for (i = 0; CONSP (tail); tail = XCDR (tail), i++)
- {
- Lisp_Object obj;
+ if (!STRINGP (errmsg))
+ write_string_1 ("peculiar error", -1, stream);
+ else if (SCHARS (errmsg))
+ Fprinc (errmsg, stream);
+ else
+ sep = NULL;
- write_string_1 (i ? ", " : ": ", 2, stream);
- obj = XCAR (tail);
- if (!NILP (file_error) || EQ (errname, Qend_of_file))
- Fprinc (obj, stream);
- else
- Fprin1 (obj, stream);
- }
+ for (; CONSP (tail); tail = XCDR (tail), sep = ", ")
+ {
+ Lisp_Object obj;
+
+ if (sep)
+ write_string_1 (sep, 2, stream);
+ obj = XCAR (tail);
+ if (!NILP (file_error)
+ || EQ (errname, Qend_of_file) || EQ (errname, Quser_error))
+ Fprinc (obj, stream);
+ else
+ Fprin1 (obj, stream);
+ }
+ }
UNGCPRO;
}
* case of -1e307 in 20d float_output_format. What is one to do (short of
* re-writing _doprnt to be more sane)?
* -wsr
+ * Given the above, the buffer must be least FLOAT_TO_STRING_BUFSIZE bytes.
*/
void
-float_to_string (buf, data)
- unsigned char *buf;
- double data;
+float_to_string (char *buf, double data)
{
- unsigned char *cp;
+ char *cp;
int width;
/* Check for plus infinity in a way that won't lose
lose:
{
/* Generate the fewest number of digits that represent the
- floating point value without losing information.
- The following method is simple but a bit slow.
- For ideas about speeding things up, please see:
-
- Guy L Steele Jr & Jon L White, How to print floating-point numbers
- accurately. SIGPLAN notices 25, 6 (June 1990), 112-126.
-
- Robert G Burger & R Kent Dybvig, Printing floating point numbers
- quickly and accurately, SIGPLAN notices 31, 5 (May 1996), 108-116. */
-
- width = fabs (data) < DBL_MIN ? 1 : DBL_DIG;
- do
- sprintf (buf, "%.*g", width, data);
- while (width++ < DOUBLE_DIGITS_BOUND && atof (buf) != data);
+ floating point value without losing information. */
+ dtoastr (buf, FLOAT_TO_STRING_BUFSIZE - 2, 0, 0, data);
+ /* The decimal point must be printed, or the byte compiler can
+ get confused (Bug#8033). */
+ width = 1;
}
else /* oink oink */
{
/* Check that the spec we have is fully valid.
This means not only valid for printf,
but meant for floats, and reasonable. */
- cp = SDATA (Vfloat_output_format);
+ cp = SSDATA (Vfloat_output_format);
if (cp[0] != '%')
goto lose;
{
width = 0;
do
- width = (width * 10) + (*cp++ - '0');
+ {
+ width = (width * 10) + (*cp++ - '0');
+ if (DBL_DIG < width)
+ goto lose;
+ }
while (*cp >= '0' && *cp <= '9');
/* A precision of zero is valid only for %f. */
- if (width > DBL_DIG
- || (width == 0 && *cp != 'f'))
+ if (width == 0 && *cp != 'f')
goto lose;
}
if (cp[1] != 0)
goto lose;
- sprintf (buf, SDATA (Vfloat_output_format), data);
+ sprintf (buf, SSDATA (Vfloat_output_format), data);
}
/* Make sure there is a decimal point with digit after, or an
cp[1] = '0';
cp[2] = 0;
}
-
- if (*cp == 0)
+ else if (*cp == 0)
{
*cp++ = '.';
*cp++ = '0';
\f
static void
-print (obj, printcharfun, escapeflag)
- Lisp_Object obj;
- register Lisp_Object printcharfun;
- int escapeflag;
+print (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag)
{
new_backquote_output = 0;
/* Construct Vprint_number_table for print-gensym and print-circle. */
if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))
{
- int i, start, index;
- start = index = print_number_index;
/* Construct Vprint_number_table.
This increments print_number_index for the objects added. */
print_depth = 0;
print_preprocess (obj);
- /* Remove unnecessary objects, which appear only once in OBJ;
- that is, whose status is Qnil. Compactify the necessary objects. */
- for (i = start; i < print_number_index; i++)
- if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
- {
- PRINT_NUMBER_OBJECT (Vprint_number_table, index)
- = PRINT_NUMBER_OBJECT (Vprint_number_table, i);
- index++;
- }
-
- /* Clear out objects outside the active part of the table. */
- for (i = index; i < print_number_index; i++)
- PRINT_NUMBER_OBJECT (Vprint_number_table, i) = Qnil;
-
- /* Reset the status field for the next print step. Now this
- field means whether the object has already been printed. */
- for (i = start; i < print_number_index; i++)
- PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qnil;
-
- print_number_index = index;
+ if (HASH_TABLE_P (Vprint_number_table))
+ { /* Remove unnecessary objects, which appear only once in OBJ;
+ that is, whose status is Qt.
+ Maybe a better way to do that is to copy elements to
+ a new hash table. */
+ struct Lisp_Hash_Table *h = XHASH_TABLE (Vprint_number_table);
+ ptrdiff_t i;
+
+ for (i = 0; i < HASH_TABLE_SIZE (h); ++i)
+ if (!NILP (HASH_HASH (h, i))
+ && EQ (HASH_VALUE (h, i), Qt))
+ Fremhash (HASH_KEY (h, i), Vprint_number_table);
+ }
}
print_depth = 0;
print_object (obj, printcharfun, escapeflag);
}
+#define PRINT_CIRCLE_CANDIDATE_P(obj) \
+ (STRINGP (obj) || CONSP (obj) \
+ || (VECTORLIKEP (obj) \
+ && (VECTORP (obj) || COMPILEDP (obj) \
+ || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) \
+ || HASH_TABLE_P (obj) || FONTP (obj))) \
+ || (! NILP (Vprint_gensym) \
+ && SYMBOLP (obj) \
+ && !SYMBOL_INTERNED_P (obj)))
+
/* Construct Vprint_number_table according to the structure of OBJ.
OBJ itself and all its elements will be added to Vprint_number_table
recursively if it is a list, vector, compiled function, char-table,
The status fields of Vprint_number_table mean whether each object appears
more than once in OBJ: Qnil at the first time, and Qt after that . */
static void
-print_preprocess (obj)
- Lisp_Object obj;
+print_preprocess (Lisp_Object obj)
{
int i;
- EMACS_INT size;
+ ptrdiff_t size;
int loop_count = 0;
Lisp_Object halftail;
- /* Give up if we go so deep that print_object will get an error. */
- /* See similar code in print_object. */
- if (print_depth >= PRINT_CIRCLE)
- error ("Apparently circular structure being printed");
-
/* Avoid infinite recursion for circular nested structure
in the case where Vprint_circle is nil. */
if (NILP (Vprint_circle))
{
+ /* Give up if we go so deep that print_object will get an error. */
+ /* See similar code in print_object. */
+ if (print_depth >= PRINT_CIRCLE)
+ error ("Apparently circular structure being printed");
+
for (i = 0; i < print_depth; i++)
if (EQ (obj, being_printed[i]))
return;
halftail = obj;
loop:
- if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
- || COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
- || HASH_TABLE_P (obj)
- || (! NILP (Vprint_gensym)
- && SYMBOLP (obj)
- && !SYMBOL_INTERNED_P (obj)))
+ if (PRINT_CIRCLE_CANDIDATE_P (obj))
{
+ if (!HASH_TABLE_P (Vprint_number_table))
+ {
+ Lisp_Object args[2];
+ args[0] = QCtest;
+ args[1] = Qeq;
+ Vprint_number_table = Fmake_hash_table (2, args);
+ }
+
/* In case print-circle is nil and print-gensym is t,
add OBJ to Vprint_number_table only when OBJ is a symbol. */
if (! NILP (Vprint_circle) || SYMBOLP (obj))
{
- for (i = 0; i < print_number_index; i++)
- if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj))
- {
- /* OBJ appears more than once. Let's remember that. */
- PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
- print_depth--;
- return;
- }
-
- /* OBJ is not yet recorded. Let's add to the table. */
- if (print_number_index == 0)
- {
- /* Initialize the table. */
- Vprint_number_table = Fmake_vector (make_number (40), Qnil);
- }
- else if (XVECTOR_SIZE (Vprint_number_table) == print_number_index * 2)
- {
- /* Reallocate the table. */
- int i = print_number_index * 4;
- Lisp_Object old_table = Vprint_number_table;
- Vprint_number_table = Fmake_vector (make_number (i), Qnil);
- for (i = 0; i < print_number_index; i++)
+ Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
+ if (!NILP (num)
+ /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
+ always print the gensym with a number. This is a special for
+ the lisp function byte-compile-output-docform. */
+ || (!NILP (Vprint_continuous_numbering)
+ && SYMBOLP (obj)
+ && !SYMBOL_INTERNED_P (obj)))
+ { /* OBJ appears more than once. Let's remember that. */
+ if (!INTEGERP (num))
{
- PRINT_NUMBER_OBJECT (Vprint_number_table, i)
- = PRINT_NUMBER_OBJECT (old_table, i);
- PRINT_NUMBER_STATUS (Vprint_number_table, i)
- = PRINT_NUMBER_STATUS (old_table, i);
+ print_number_index++;
+ /* Negative number indicates it hasn't been printed yet. */
+ Fputhash (obj, make_number (- print_number_index),
+ Vprint_number_table);
}
+ print_depth--;
+ return;
}
- PRINT_NUMBER_OBJECT (Vprint_number_table, print_number_index) = obj;
- /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
- always print the gensym with a number. This is a special for
- the lisp function byte-compile-output-docform. */
- if (!NILP (Vprint_continuous_numbering)
- && SYMBOLP (obj)
- && !SYMBOL_INTERNED_P (obj))
- PRINT_NUMBER_STATUS (Vprint_number_table, print_number_index) = Qt;
- print_number_index++;
+ else
+ /* OBJ is not yet recorded. Let's add to the table. */
+ Fputhash (obj, Qt, Vprint_number_table);
}
switch (XTYPE (obj))
goto loop;
case Lisp_Vectorlike:
- size = XVECTOR_SIZE (obj);
+ size = ASIZE (obj);
if (size & PSEUDOVECTOR_FLAG)
size &= PSEUDOVECTOR_SIZE_MASK;
for (i = 0; i < size; i++)
print_preprocess (XVECTOR (obj)->contents[i]);
if (HASH_TABLE_P (obj))
{ /* For hash tables, the key_and_value slot is past
- `size' because it needs to be marked specially in case
- the table is weak. */
+ `size' because it needs to be marked specially in case
+ the table is weak. */
struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
print_preprocess (h->key_and_value);
}
}
static void
-print_preprocess_string (interval, arg)
- INTERVAL interval;
- Lisp_Object arg;
+print_preprocess_string (INTERVAL interval, Lisp_Object arg)
{
print_preprocess (interval->plist);
}
-/* A flag to control printing of `charset' text property.
- The default value is Qdefault. */
-Lisp_Object Vprint_charset_text_property;
-extern Lisp_Object Qdefault;
-
-static void print_check_string_charset_prop ();
+static void print_check_string_charset_prop (INTERVAL interval, Lisp_Object string);
#define PRINT_STRING_NON_CHARSET_FOUND 1
#define PRINT_STRING_UNSAFE_CHARSET_FOUND 2
-/* Bitwise or of the above macros. */
+/* Bitwise or of the above macros. */
static int print_check_string_result;
static void
-print_check_string_charset_prop (interval, string)
- INTERVAL interval;
- Lisp_Object string;
+print_check_string_charset_prop (INTERVAL interval, Lisp_Object string)
{
Lisp_Object val;
|| ! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
{
int i, c;
- int charpos = interval->position;
- int bytepos = string_char_to_byte (string, charpos);
+ ptrdiff_t charpos = interval->position;
+ ptrdiff_t bytepos = string_char_to_byte (string, charpos);
Lisp_Object charset;
charset = XCAR (XCDR (val));
static Lisp_Object print_prune_charset_plist;
static Lisp_Object
-print_prune_string_charset (string)
- Lisp_Object string;
+print_prune_string_charset (Lisp_Object string)
{
print_check_string_result = 0;
traverse_intervals (STRING_INTERVALS (string), 0,
}
static void
-print_object (obj, printcharfun, escapeflag)
- Lisp_Object obj;
- register Lisp_Object printcharfun;
- int escapeflag;
+print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag)
{
- char buf[40];
+ char buf[max (sizeof "from..to..in " + 2 * INT_STRLEN_BOUND (EMACS_INT),
+ max (sizeof " . #" + INT_STRLEN_BOUND (printmax_t),
+ 40))];
QUIT;
- /* See similar code in print_preprocess. */
- if (print_depth >= PRINT_CIRCLE)
- error ("Apparently circular structure being printed");
-
/* Detect circularities and truncate them. */
- if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
- || COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
- || HASH_TABLE_P (obj)
- || (! NILP (Vprint_gensym)
- && SYMBOLP (obj)
- && !SYMBOL_INTERNED_P (obj)))
+ if (NILP (Vprint_circle))
{
- if (NILP (Vprint_circle) && NILP (Vprint_gensym))
- {
- /* Simple but incomplete way. */
- int i;
- for (i = 0; i < print_depth; i++)
- if (EQ (obj, being_printed[i]))
- {
- sprintf (buf, "#%d", i);
- strout (buf, -1, -1, printcharfun, 0);
- return;
- }
- being_printed[print_depth] = obj;
- }
- else
+ /* Simple but incomplete way. */
+ int i;
+
+ /* See similar code in print_preprocess. */
+ if (print_depth >= PRINT_CIRCLE)
+ error ("Apparently circular structure being printed");
+
+ for (i = 0; i < print_depth; i++)
+ if (EQ (obj, being_printed[i]))
+ {
+ sprintf (buf, "#%d", i);
+ strout (buf, -1, -1, printcharfun);
+ return;
+ }
+ being_printed[print_depth] = obj;
+ }
+ else if (PRINT_CIRCLE_CANDIDATE_P (obj))
+ {
+ /* With the print-circle feature. */
+ Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
+ if (INTEGERP (num))
{
- /* With the print-circle feature. */
- int i;
- for (i = 0; i < print_number_index; i++)
- if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj))
- {
- if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
- {
- /* Add a prefix #n= if OBJ has not yet been printed;
- that is, its status field is nil. */
- sprintf (buf, "#%d=", i + 1);
- strout (buf, -1, -1, printcharfun, 0);
- /* OBJ is going to be printed. Set the status to t. */
- PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
- break;
- }
- else
- {
- /* Just print #n# if OBJ has already been printed. */
- sprintf (buf, "#%d#", i + 1);
- strout (buf, -1, -1, printcharfun, 0);
- return;
- }
- }
+ EMACS_INT n = XINT (num);
+ if (n < 0)
+ { /* Add a prefix #n= if OBJ has not yet been printed;
+ that is, its status field is nil. */
+ sprintf (buf, "#%"pI"d=", -n);
+ strout (buf, -1, -1, printcharfun);
+ /* OBJ is going to be printed. Remember that fact. */
+ Fputhash (obj, make_number (- n), Vprint_number_table);
+ }
+ else
+ {
+ /* Just print #n# if OBJ has already been printed. */
+ sprintf (buf, "#%"pI"d#", n);
+ strout (buf, -1, -1, printcharfun);
+ return;
+ }
}
}
switch (XTYPE (obj))
{
case_Lisp_Int:
- if (sizeof (int) == sizeof (EMACS_INT))
- sprintf (buf, "%d", (int) XINT (obj));
- else if (sizeof (long) == sizeof (EMACS_INT))
- sprintf (buf, "%ld", (long) XINT (obj));
- else
- abort ();
- strout (buf, -1, -1, printcharfun, 0);
+ sprintf (buf, "%"pI"d", XINT (obj));
+ strout (buf, -1, -1, printcharfun);
break;
case Lisp_Float:
{
- char pigbuf[350]; /* see comments in float_to_string */
+ char pigbuf[FLOAT_TO_STRING_BUFSIZE];
float_to_string (pigbuf, XFLOAT_DATA (obj));
- strout (pigbuf, -1, -1, printcharfun, 0);
+ strout (pigbuf, -1, -1, printcharfun);
}
break;
print_string (obj, printcharfun);
else
{
- register int i, i_byte;
+ register ptrdiff_t i_byte;
struct gcpro gcpro1;
unsigned char *str;
- int size_byte;
+ ptrdiff_t size_byte;
/* 1 means we must ensure that the next character we output
cannot be taken as part of a hex character escape. */
int need_nonhex = 0;
str = SDATA (obj);
size_byte = SBYTES (obj);
- for (i = 0, i_byte = 0; i_byte < size_byte;)
+ for (i_byte = 0; i_byte < size_byte;)
{
/* Here, we must convert each multi-byte form to the
corresponding character code before handing it to PRINTCHAR. */
PRINTCHAR ('f');
}
else if (multibyte
- && (CHAR_BYTE8_P (c)
+ && (CHAR_BYTE8_P (c)
|| (! ASCII_CHAR_P (c) && print_escape_multibyte)))
{
/* When multibyte is disabled,
For a char code that could be in a unibyte string,
when found in a multibyte string, always use a hex escape
so it reads back as multibyte. */
- unsigned char outbuf[50];
+ char outbuf[50];
if (CHAR_BYTE8_P (c))
sprintf (outbuf, "\\%03o", CHAR_TO_BYTE8 (c));
sprintf (outbuf, "\\x%04x", c);
need_nonhex = 1;
}
- strout (outbuf, -1, -1, printcharfun, 0);
+ strout (outbuf, -1, -1, printcharfun);
}
else if (! multibyte
&& SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c)
or when explicitly requested,
print single-byte non-ASCII string chars
using octal escapes. */
- unsigned char outbuf[5];
+ char outbuf[5];
sprintf (outbuf, "\\%03o", c);
- strout (outbuf, -1, -1, printcharfun, 0);
+ strout (outbuf, -1, -1, printcharfun);
}
else
{
if ((c >= 'a' && c <= 'f')
|| (c >= 'A' && c <= 'F')
|| (c >= '0' && c <= '9'))
- strout ("\\ ", -1, -1, printcharfun, 0);
+ strout ("\\ ", -1, -1, printcharfun);
}
if (c == '\"' || c == '\\')
register unsigned char *p = SDATA (SYMBOL_NAME (obj));
register unsigned char *end = p + SBYTES (SYMBOL_NAME (obj));
register int c;
- int i, i_byte, size_byte;
+ ptrdiff_t i, i_byte;
+ ptrdiff_t size_byte;
Lisp_Object name;
name = SYMBOL_NAME (obj);
else
confusing = 0;
+ size_byte = SBYTES (name);
+
if (! NILP (Vprint_gensym) && !SYMBOL_INTERNED_P (obj))
{
PRINTCHAR ('#');
PRINTCHAR (':');
}
-
- size_byte = SBYTES (name);
+ else if (size_byte == 0)
+ {
+ PRINTCHAR ('#');
+ PRINTCHAR ('#');
+ break;
+ }
for (i = 0, i_byte = 0; i_byte < size_byte;)
{
{
if (c == '\"' || c == '\\' || c == '\''
|| c == ';' || c == '#' || c == '(' || c == ')'
- || c == ',' || c =='.' || c == '`'
+ || c == ',' || c == '.' || c == '`'
|| c == '[' || c == ']' || c == '?' || c <= 040
|| confusing)
PRINTCHAR ('\\'), confusing = 0;
/* If deeper than spec'd depth, print placeholder. */
if (INTEGERP (Vprint_level)
&& print_depth > XINT (Vprint_level))
- strout ("...", -1, -1, printcharfun, 0);
+ strout ("...", -1, -1, printcharfun);
else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
&& (EQ (XCAR (obj), Qquote)))
{
{
PRINTCHAR ('(');
- /* If the first element is a backquote form,
- print it old-style so it won't be misunderstood. */
- if (print_quoted && CONSP (XCAR (obj))
- && CONSP (XCDR (XCAR (obj)))
- && NILP (XCDR (XCDR (XCAR (obj))))
- && EQ (XCAR (XCAR (obj)), Qbackquote))
- {
- Lisp_Object tem;
- tem = XCAR (obj);
- PRINTCHAR ('(');
-
- print_object (Qbackquote, printcharfun, 0);
- PRINTCHAR (' ');
-
- print_object (XCAR (XCDR (tem)), printcharfun, 0);
- PRINTCHAR (')');
-
- obj = XCDR (obj);
- }
-
{
- int print_length, i;
+ printmax_t i, print_length;
Lisp_Object halftail = obj;
/* Negative values of print-length are invalid in CL.
if (NATNUMP (Vprint_length))
print_length = XFASTINT (Vprint_length);
else
- print_length = 0;
+ print_length = TYPE_MAXIMUM (printmax_t);
i = 0;
while (CONSP (obj))
/* Detect circular list. */
if (NILP (Vprint_circle))
{
- /* Simple but imcomplete way. */
+ /* Simple but incomplete way. */
if (i != 0 && EQ (obj, halftail))
{
- sprintf (buf, " . #%d", i / 2);
- strout (buf, -1, -1, printcharfun, 0);
+ sprintf (buf, " . #%"pMd, i / 2);
+ strout (buf, -1, -1, printcharfun);
goto end_of_list;
}
}
/* With the print-circle feature. */
if (i != 0)
{
- int i;
- for (i = 0; i < print_number_index; i++)
- if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i),
- obj))
- {
- if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
- {
- strout (" . ", 3, 3, printcharfun, 0);
- print_object (obj, printcharfun, escapeflag);
- }
- else
- {
- sprintf (buf, " . #%d#", i + 1);
- strout (buf, -1, -1, printcharfun, 0);
- }
- goto end_of_list;
- }
+ Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
+ if (INTEGERP (num))
+ {
+ strout (" . ", 3, 3, printcharfun);
+ print_object (obj, printcharfun, escapeflag);
+ goto end_of_list;
+ }
}
}
- if (i++)
+ if (i)
PRINTCHAR (' ');
- if (print_length && i > print_length)
+ if (print_length <= i)
{
- strout ("...", 3, 3, printcharfun, 0);
+ strout ("...", 3, 3, printcharfun);
goto end_of_list;
}
+ i++;
print_object (XCAR (obj), printcharfun, escapeflag);
obj = XCDR (obj);
/* OBJ non-nil here means it's the end of a dotted list. */
if (!NILP (obj))
{
- strout (" . ", 3, 3, printcharfun, 0);
+ strout (" . ", 3, 3, printcharfun);
print_object (obj, printcharfun, escapeflag);
}
{
if (escapeflag)
{
- strout ("#<process ", -1, -1, printcharfun, 0);
+ strout ("#<process ", -1, -1, printcharfun);
print_string (XPROCESS (obj)->name, printcharfun);
PRINTCHAR ('>');
}
}
else if (BOOL_VECTOR_P (obj))
{
- register int i;
+ ptrdiff_t i;
register unsigned char c;
struct gcpro gcpro1;
- int size_in_chars
+ ptrdiff_t size_in_chars
= ((XBOOL_VECTOR (obj)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
/ BOOL_VECTOR_BITS_PER_CHAR);
PRINTCHAR ('#');
PRINTCHAR ('&');
- sprintf (buf, "%ld", (long) XBOOL_VECTOR (obj)->size);
- strout (buf, -1, -1, printcharfun, 0);
+ sprintf (buf, "%"pI"d", XBOOL_VECTOR (obj)->size);
+ strout (buf, -1, -1, printcharfun);
PRINTCHAR ('\"');
/* Don't print more characters than the specified maximum.
}
else if (SUBRP (obj))
{
- strout ("#<subr ", -1, -1, printcharfun, 0);
- strout (XSUBR (obj)->symbol_name, -1, -1, printcharfun, 0);
+ strout ("#<subr ", -1, -1, printcharfun);
+ strout (XSUBR (obj)->symbol_name, -1, -1, printcharfun);
PRINTCHAR ('>');
}
else if (WINDOWP (obj))
{
- strout ("#<window ", -1, -1, printcharfun, 0);
- sprintf (buf, "%ld", (long) XFASTINT (XWINDOW (obj)->sequence_number));
- strout (buf, -1, -1, printcharfun, 0);
+ strout ("#<window ", -1, -1, printcharfun);
+ sprintf (buf, "%"pI"d", XFASTINT (XWINDOW (obj)->sequence_number));
+ strout (buf, -1, -1, printcharfun);
if (!NILP (XWINDOW (obj)->buffer))
{
- strout (" on ", -1, -1, printcharfun, 0);
- print_string (XBUFFER (XWINDOW (obj)->buffer)->name, printcharfun);
+ strout (" on ", -1, -1, printcharfun);
+ print_string (BVAR (XBUFFER (XWINDOW (obj)->buffer), name), printcharfun);
}
PRINTCHAR ('>');
}
else if (TERMINALP (obj))
{
struct terminal *t = XTERMINAL (obj);
- strout ("#<terminal ", -1, -1, printcharfun, 0);
+ strout ("#<terminal ", -1, -1, printcharfun);
sprintf (buf, "%d", t->id);
- strout (buf, -1, -1, printcharfun, 0);
+ strout (buf, -1, -1, printcharfun);
if (t->name)
{
- strout (" on ", -1, -1, printcharfun, 0);
- strout (t->name, -1, -1, printcharfun, 0);
+ strout (" on ", -1, -1, printcharfun);
+ strout (t->name, -1, -1, printcharfun);
}
PRINTCHAR ('>');
}
else if (HASH_TABLE_P (obj))
{
struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
- int i, real_size, size;
+ ptrdiff_t i;
+ ptrdiff_t real_size, size;
#if 0
- strout ("#<hash-table", -1, -1, printcharfun, 0);
+ strout ("#<hash-table", -1, -1, printcharfun);
if (SYMBOLP (h->test))
{
PRINTCHAR (' ');
PRINTCHAR ('\'');
- strout (SDATA (SYMBOL_NAME (h->test)), -1, -1, printcharfun, 0);
+ strout (SDATA (SYMBOL_NAME (h->test)), -1, -1, printcharfun);
PRINTCHAR (' ');
- strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun, 0);
+ strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun);
PRINTCHAR (' ');
- sprintf (buf, "%ld/%ld", (long) h->count,
- (long) XVECTOR_SIZE (h->next));
- strout (buf, -1, -1, printcharfun, 0);
+ sprintf (buf, "%"pD"d/%"pD"d", h->count, ASIZE (h->next));
+ strout (buf, -1, -1, printcharfun);
}
- sprintf (buf, " 0x%lx", (unsigned long) h);
- strout (buf, -1, -1, printcharfun, 0);
+ sprintf (buf, " %p", h);
+ strout (buf, -1, -1, printcharfun);
PRINTCHAR ('>');
#endif
/* Implement a readable output, e.g.:
#s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
/* Always print the size. */
- sprintf (buf, "#s(hash-table size %ld",
- (long) XVECTOR_SIZE (h->next));
- strout (buf, -1, -1, printcharfun, 0);
+ sprintf (buf, "#s(hash-table size %"pD"d", ASIZE (h->next));
+ strout (buf, -1, -1, printcharfun);
if (!NILP (h->test))
{
- strout (" test ", -1, -1, printcharfun, 0);
- print_object (h->test, printcharfun, 0);
+ strout (" test ", -1, -1, printcharfun);
+ print_object (h->test, printcharfun, escapeflag);
}
if (!NILP (h->weak))
{
- strout (" weakness ", -1, -1, printcharfun, 0);
- print_object (h->weak, printcharfun, 0);
+ strout (" weakness ", -1, -1, printcharfun);
+ print_object (h->weak, printcharfun, escapeflag);
}
if (!NILP (h->rehash_size))
{
- strout (" rehash-size ", -1, -1, printcharfun, 0);
- print_object (h->rehash_size, printcharfun, 0);
+ strout (" rehash-size ", -1, -1, printcharfun);
+ print_object (h->rehash_size, printcharfun, escapeflag);
}
if (!NILP (h->rehash_threshold))
{
- strout (" rehash-threshold ", -1, -1, printcharfun, 0);
- print_object (h->rehash_threshold, printcharfun, 0);
+ strout (" rehash-threshold ", -1, -1, printcharfun);
+ print_object (h->rehash_threshold, printcharfun, escapeflag);
}
- strout (" data ", -1, -1, printcharfun, 0);
+ strout (" data ", -1, -1, printcharfun);
/* Print the data here as a plist. */
real_size = HASH_TABLE_SIZE (h);
if (NATNUMP (Vprint_length)
&& XFASTINT (Vprint_length) < size)
size = XFASTINT (Vprint_length);
-
+
PRINTCHAR ('(');
for (i = 0; i < size; i++)
if (!NILP (HASH_HASH (h, i)))
{
if (i) PRINTCHAR (' ');
- print_object (HASH_KEY (h, i), printcharfun, 1);
+ print_object (HASH_KEY (h, i), printcharfun, escapeflag);
PRINTCHAR (' ');
- print_object (HASH_VALUE (h, i), printcharfun, 1);
+ print_object (HASH_VALUE (h, i), printcharfun, escapeflag);
}
if (size < real_size)
- strout (" ...", 4, 4, printcharfun, 0);
+ strout (" ...", 4, 4, printcharfun);
PRINTCHAR (')');
PRINTCHAR (')');
}
else if (BUFFERP (obj))
{
- if (NILP (XBUFFER (obj)->name))
- strout ("#<killed buffer>", -1, -1, printcharfun, 0);
+ if (NILP (BVAR (XBUFFER (obj), name)))
+ strout ("#<killed buffer>", -1, -1, printcharfun);
else if (escapeflag)
{
- strout ("#<buffer ", -1, -1, printcharfun, 0);
- print_string (XBUFFER (obj)->name, printcharfun);
+ strout ("#<buffer ", -1, -1, printcharfun);
+ print_string (BVAR (XBUFFER (obj), name), printcharfun);
PRINTCHAR ('>');
}
else
- print_string (XBUFFER (obj)->name, printcharfun);
+ print_string (BVAR (XBUFFER (obj), name), printcharfun);
}
else if (WINDOW_CONFIGURATIONP (obj))
{
- strout ("#<window-configuration>", -1, -1, printcharfun, 0);
+ strout ("#<window-configuration>", -1, -1, printcharfun);
}
else if (FRAMEP (obj))
{
strout ((FRAME_LIVE_P (XFRAME (obj))
? "#<frame " : "#<dead frame "),
- -1, -1, printcharfun, 0);
+ -1, -1, printcharfun);
print_string (XFRAME (obj)->name, printcharfun);
- sprintf (buf, " 0x%lx", (unsigned long) (XFRAME (obj)));
- strout (buf, -1, -1, printcharfun, 0);
+ sprintf (buf, " %p", XFRAME (obj));
+ strout (buf, -1, -1, printcharfun);
PRINTCHAR ('>');
}
else if (FONTP (obj))
{
- EMACS_INT i;
+ int i;
if (! FONT_OBJECT_P (obj))
{
if (FONT_SPEC_P (obj))
- strout ("#<font-spec", -1, -1, printcharfun, 0);
+ strout ("#<font-spec", -1, -1, printcharfun);
else
- strout ("#<font-entity", -1, -1, printcharfun, 0);
+ strout ("#<font-entity", -1, -1, printcharfun);
for (i = 0; i < FONT_SPEC_MAX; i++)
{
PRINTCHAR (' ');
}
else
{
- strout ("#<font-object ", -1, -1, printcharfun, 0);
+ strout ("#<font-object ", -1, -1, printcharfun);
print_object (AREF (obj, FONT_NAME_INDEX), printcharfun,
escapeflag);
}
}
else
{
- EMACS_INT size = XVECTOR_SIZE (obj);
+ ptrdiff_t size = ASIZE (obj);
if (COMPILEDP (obj))
{
PRINTCHAR ('#');
{
register int i;
register Lisp_Object tem;
- int real_size = size;
+ ptrdiff_t real_size = size;
/* Don't print more elements than the specified maximum. */
if (NATNUMP (Vprint_length)
print_object (tem, printcharfun, escapeflag);
}
if (size < real_size)
- strout (" ...", 4, 4, printcharfun, 0);
+ strout (" ...", 4, 4, printcharfun);
}
PRINTCHAR (']');
}
switch (XMISCTYPE (obj))
{
case Lisp_Misc_Marker:
- strout ("#<marker ", -1, -1, printcharfun, 0);
+ strout ("#<marker ", -1, -1, printcharfun);
/* Do you think this is necessary? */
if (XMARKER (obj)->insertion_type != 0)
- strout ("(moves after insertion) ", -1, -1, printcharfun, 0);
+ strout ("(moves after insertion) ", -1, -1, printcharfun);
if (! XMARKER (obj)->buffer)
- strout ("in no buffer", -1, -1, printcharfun, 0);
+ strout ("in no buffer", -1, -1, printcharfun);
else
{
- sprintf (buf, "at %d", marker_position (obj));
- strout (buf, -1, -1, printcharfun, 0);
- strout (" in ", -1, -1, printcharfun, 0);
- print_string (XMARKER (obj)->buffer->name, printcharfun);
+ sprintf (buf, "at %"pD"d", marker_position (obj));
+ strout (buf, -1, -1, printcharfun);
+ strout (" in ", -1, -1, printcharfun);
+ print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun);
}
PRINTCHAR ('>');
break;
case Lisp_Misc_Overlay:
- strout ("#<overlay ", -1, -1, printcharfun, 0);
+ strout ("#<overlay ", -1, -1, printcharfun);
if (! XMARKER (OVERLAY_START (obj))->buffer)
- strout ("in no buffer", -1, -1, printcharfun, 0);
+ strout ("in no buffer", -1, -1, printcharfun);
else
{
- sprintf (buf, "from %d to %d in ",
+ sprintf (buf, "from %"pD"d to %"pD"d in ",
marker_position (OVERLAY_START (obj)),
marker_position (OVERLAY_END (obj)));
- strout (buf, -1, -1, printcharfun, 0);
- print_string (XMARKER (OVERLAY_START (obj))->buffer->name,
+ strout (buf, -1, -1, printcharfun);
+ print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name),
printcharfun);
}
PRINTCHAR ('>');
/* Remaining cases shouldn't happen in normal usage, but let's print
them anyway for the benefit of the debugger. */
case Lisp_Misc_Free:
- strout ("#<misc free cell>", -1, -1, printcharfun, 0);
- break;
-
- case Lisp_Misc_Intfwd:
- sprintf (buf, "#<intfwd to %ld>", (long) *XINTFWD (obj)->intvar);
- strout (buf, -1, -1, printcharfun, 0);
- break;
-
- case Lisp_Misc_Boolfwd:
- sprintf (buf, "#<boolfwd to %s>",
- (*XBOOLFWD (obj)->boolvar ? "t" : "nil"));
- strout (buf, -1, -1, printcharfun, 0);
- break;
-
- case Lisp_Misc_Objfwd:
- strout ("#<objfwd to ", -1, -1, printcharfun, 0);
- print_object (*XOBJFWD (obj)->objvar, printcharfun, escapeflag);
- PRINTCHAR ('>');
- break;
-
- case Lisp_Misc_Buffer_Objfwd:
- strout ("#<buffer_objfwd to ", -1, -1, printcharfun, 0);
- print_object (PER_BUFFER_VALUE (current_buffer,
- XBUFFER_OBJFWD (obj)->offset),
- printcharfun, escapeflag);
- PRINTCHAR ('>');
- break;
-
- case Lisp_Misc_Kboard_Objfwd:
- strout ("#<kboard_objfwd to ", -1, -1, printcharfun, 0);
- print_object (*(Lisp_Object *) ((char *) current_kboard
- + XKBOARD_OBJFWD (obj)->offset),
- printcharfun, escapeflag);
- PRINTCHAR ('>');
- break;
-
- case Lisp_Misc_Buffer_Local_Value:
- strout ("#<buffer_local_value ", -1, -1, printcharfun, 0);
- if (XBUFFER_LOCAL_VALUE (obj)->local_if_set)
- strout ("[local-if-set] ", -1, -1, printcharfun, 0);
- strout ("[realvalue] ", -1, -1, printcharfun, 0);
- print_object (XBUFFER_LOCAL_VALUE (obj)->realvalue,
- printcharfun, escapeflag);
- if (XBUFFER_LOCAL_VALUE (obj)->found_for_buffer)
- strout ("[local in buffer] ", -1, -1, printcharfun, 0);
- else
- strout ("[buffer] ", -1, -1, printcharfun, 0);
- print_object (XBUFFER_LOCAL_VALUE (obj)->buffer,
- printcharfun, escapeflag);
- if (XBUFFER_LOCAL_VALUE (obj)->check_frame)
- {
- if (XBUFFER_LOCAL_VALUE (obj)->found_for_frame)
- strout ("[local in frame] ", -1, -1, printcharfun, 0);
- else
- strout ("[frame] ", -1, -1, printcharfun, 0);
- print_object (XBUFFER_LOCAL_VALUE (obj)->frame,
- printcharfun, escapeflag);
- }
- strout ("[alist-elt] ", -1, -1, printcharfun, 0);
- print_object (XCAR (XBUFFER_LOCAL_VALUE (obj)->cdr),
- printcharfun, escapeflag);
- strout ("[default-value] ", -1, -1, printcharfun, 0);
- print_object (XCDR (XBUFFER_LOCAL_VALUE (obj)->cdr),
- printcharfun, escapeflag);
- PRINTCHAR ('>');
+ strout ("#<misc free cell>", -1, -1, printcharfun);
break;
case Lisp_Misc_Save_Value:
- strout ("#<save_value ", -1, -1, printcharfun, 0);
- sprintf(buf, "ptr=0x%08lx int=%d",
- (unsigned long) XSAVE_VALUE (obj)->pointer,
- XSAVE_VALUE (obj)->integer);
- strout (buf, -1, -1, printcharfun, 0);
+ strout ("#<save_value ", -1, -1, printcharfun);
+ sprintf (buf, "ptr=%p int=%"pD"d",
+ XSAVE_VALUE (obj)->pointer,
+ XSAVE_VALUE (obj)->integer);
+ strout (buf, -1, -1, printcharfun);
PRINTCHAR ('>');
break;
{
/* We're in trouble if this happens!
Probably should just abort () */
- strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun, 0);
+ strout ("#<EMACS BUG: INVALID DATATYPE ", -1, -1, printcharfun);
if (MISCP (obj))
sprintf (buf, "(MISC 0x%04x)", (int) XMISCTYPE (obj));
else if (VECTORLIKEP (obj))
- sprintf (buf, "(PVEC 0x%08lx)", (unsigned long) XVECTOR_SIZE (obj));
+ sprintf (buf, "(PVEC 0x%08"pD"x)", ASIZE (obj));
else
sprintf (buf, "(0x%02x)", (int) XTYPE (obj));
- strout (buf, -1, -1, printcharfun, 0);
+ strout (buf, -1, -1, printcharfun);
strout (" Save your buffers immediately and please report this bug>",
- -1, -1, printcharfun, 0);
+ -1, -1, printcharfun);
}
}
This is part of printing a string that has text properties. */
void
-print_interval (interval, printcharfun)
- INTERVAL interval;
- Lisp_Object printcharfun;
+print_interval (INTERVAL interval, Lisp_Object printcharfun)
{
if (NILP (interval->plist))
return;
\f
void
-syms_of_print ()
+syms_of_print (void)
{
- Qtemp_buffer_setup_hook = intern_c_string ("temp-buffer-setup-hook");
- staticpro (&Qtemp_buffer_setup_hook);
+ DEFSYM (Qtemp_buffer_setup_hook, "temp-buffer-setup-hook");
- DEFVAR_LISP ("standard-output", &Vstandard_output,
+ DEFVAR_LISP ("standard-output", Vstandard_output,
doc: /* Output stream `print' uses by default for outputting a character.
This may be any function of one argument.
It may also be a buffer (output is inserted before point)
or a marker (output is inserted and the marker is advanced)
or the symbol t (output appears in the echo area). */);
Vstandard_output = Qt;
- Qstandard_output = intern_c_string ("standard-output");
- staticpro (&Qstandard_output);
+ DEFSYM (Qstandard_output, "standard-output");
- DEFVAR_LISP ("float-output-format", &Vfloat_output_format,
+ DEFVAR_LISP ("float-output-format", Vfloat_output_format,
doc: /* The format descriptor string used to print floats.
This is a %-spec like those accepted by `printf' in C,
but with some restrictions. It must start with the two characters `%.'.
A value of nil means to use the shortest notation
that represents the number without losing information. */);
Vfloat_output_format = Qnil;
- Qfloat_output_format = intern_c_string ("float-output-format");
- staticpro (&Qfloat_output_format);
+ DEFSYM (Qfloat_output_format, "float-output-format");
- DEFVAR_LISP ("print-length", &Vprint_length,
+ DEFVAR_LISP ("print-length", Vprint_length,
doc: /* Maximum length of list to print before abbreviating.
A value of nil means no limit. See also `eval-expression-print-length'. */);
Vprint_length = Qnil;
- DEFVAR_LISP ("print-level", &Vprint_level,
+ DEFVAR_LISP ("print-level", Vprint_level,
doc: /* Maximum depth of list nesting to print before abbreviating.
A value of nil means no limit. See also `eval-expression-print-level'. */);
Vprint_level = Qnil;
- DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines,
+ DEFVAR_BOOL ("print-escape-newlines", print_escape_newlines,
doc: /* Non-nil means print newlines in strings as `\\n'.
Also print formfeeds as `\\f'. */);
print_escape_newlines = 0;
- DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii,
+ DEFVAR_BOOL ("print-escape-nonascii", print_escape_nonascii,
doc: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
\(OOO is the octal representation of the character code.)
Only single-byte characters are affected, and only in `prin1'.
enabled regardless of the value of the variable. */);
print_escape_nonascii = 0;
- DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte,
+ DEFVAR_BOOL ("print-escape-multibyte", print_escape_multibyte,
doc: /* Non-nil means print multibyte characters in strings as \\xXXXX.
\(XXXX is the hex representation of the character code.)
This affects only `prin1'. */);
print_escape_multibyte = 0;
- DEFVAR_BOOL ("print-quoted", &print_quoted,
+ DEFVAR_BOOL ("print-quoted", print_quoted,
doc: /* Non-nil means print quoted forms with reader syntax.
I.e., (quote foo) prints as 'foo, (function foo) as #'foo. */);
print_quoted = 0;
- DEFVAR_LISP ("print-gensym", &Vprint_gensym,
+ DEFVAR_LISP ("print-gensym", Vprint_gensym,
doc: /* Non-nil means print uninterned symbols so they will read as uninterned.
I.e., the value of (make-symbol \"foobar\") prints as #:foobar.
When the uninterned symbol appears within a recursive data structure,
shared once again when the text is read back. */);
Vprint_gensym = Qnil;
- DEFVAR_LISP ("print-circle", &Vprint_circle,
- doc: /* *Non-nil means print recursive structures using #N= and #N# syntax.
+ DEFVAR_LISP ("print-circle", Vprint_circle,
+ doc: /* Non-nil means print recursive structures using #N= and #N# syntax.
If nil, printing proceeds recursively and may lead to
`max-lisp-eval-depth' being exceeded or an error may occur:
\"Apparently circular structure being printed.\" Also see
where N is a positive decimal integer. */);
Vprint_circle = Qnil;
- DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering,
- doc: /* *Non-nil means number continuously across print calls.
+ DEFVAR_LISP ("print-continuous-numbering", Vprint_continuous_numbering,
+ doc: /* Non-nil means number continuously across print calls.
This affects the numbers printed for #N= labels and #M# references.
See also `print-circle', `print-gensym', and `print-number-table'.
This variable should not be set with `setq'; bind it with a `let' instead. */);
Vprint_continuous_numbering = Qnil;
- DEFVAR_LISP ("print-number-table", &Vprint_number_table,
+ DEFVAR_LISP ("print-number-table", Vprint_number_table,
doc: /* A vector used internally to produce `#N=' labels and `#N#' references.
The Lisp printer uses this vector to detect Lisp objects referenced more
than once.
that need to be recorded in the table. */);
Vprint_number_table = Qnil;
- DEFVAR_LISP ("print-charset-text-property", &Vprint_charset_text_property,
+ DEFVAR_LISP ("print-charset-text-property", Vprint_charset_text_property,
doc: /* A flag to control printing of `charset' text property on printing a string.
The value must be nil, t, or `default'.
defsubr (&Sredirect_debugging_output);
#endif
- Qexternal_debugging_output = intern_c_string ("external-debugging-output");
- staticpro (&Qexternal_debugging_output);
-
- Qprint_escape_newlines = intern_c_string ("print-escape-newlines");
- staticpro (&Qprint_escape_newlines);
-
- Qprint_escape_multibyte = intern_c_string ("print-escape-multibyte");
- staticpro (&Qprint_escape_multibyte);
-
- Qprint_escape_nonascii = intern_c_string ("print-escape-nonascii");
- staticpro (&Qprint_escape_nonascii);
+ DEFSYM (Qexternal_debugging_output, "external-debugging-output");
+ DEFSYM (Qprint_escape_newlines, "print-escape-newlines");
+ DEFSYM (Qprint_escape_multibyte, "print-escape-multibyte");
+ DEFSYM (Qprint_escape_nonascii, "print-escape-nonascii");
print_prune_charset_plist = Qnil;
staticpro (&print_prune_charset_plist);
-
- defsubr (&Swith_output_to_temp_buffer);
}
-
-/* arch-tag: bc797170-94ae-41de-86e3-75e20f8f7a39
- (do not change this comment) */
HCoop / bpt / emacs.git / blobdiff