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;
char *print_buffer;
/* Size allocated in print_buffer. */
-int print_buffer_size;
+EMACS_INT print_buffer_size;
/* Chars stored in print_buffer. */
-int print_buffer_pos;
+EMACS_INT print_buffer_pos;
/* Bytes stored in print_buffer. */
-int print_buffer_pos_byte;
+EMACS_INT print_buffer_pos_byte;
/* Maximum length of list to print in full; noninteger means
effectively infinity */
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. */
+/* 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. */
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 (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 */
#define PRINTDECLARE \
struct buffer *old = current_buffer; \
- int old_point = -1, start_point = -1; \
- int old_point_byte = -1, start_point_byte = -1; \
+ EMACS_INT old_point = -1, start_point = -1; \
+ EMACS_INT old_point_byte = -1, start_point_byte = -1; \
int specpdl_count = SPECPDL_INDEX (); \
int free_print_buffer = 0; \
int multibyte = !NILP (current_buffer->enable_multibyte_characters); \
to data in a Lisp string. Otherwise that is not safe. */
static void
-strout (const char *ptr, int size, int size_byte, Lisp_Object printcharfun,
- int multibyte)
+strout (const char *ptr, EMACS_INT size, EMACS_INT size_byte,
+ Lisp_Object printcharfun, int multibyte)
{
if (size < 0)
size_byte = size = strlen (ptr);
else
{
/* PRINTCHARFUN is a Lisp function. */
- int i = 0;
+ EMACS_INT i = 0;
if (size == size_byte)
{
{
if (EQ (printcharfun, Qt) || NILP (printcharfun))
{
- int chars;
+ EMACS_INT chars;
if (print_escape_nonascii)
string = string_escape_byte8 (string);
convert STRING to a multibyte string containing the same
character codes. */
Lisp_Object newstr;
- int bytes;
+ EMACS_INT bytes;
chars = SBYTES (string);
bytes = parse_str_to_multibyte (SDATA (string), chars);
if (EQ (printcharfun, Qt))
{
/* Output to echo area. */
- int nbytes = SBYTES (string);
+ EMACS_INT nbytes = SBYTES (string);
char *buffer;
/* Copy the string contents so that relocation of STRING by
{
/* 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);
+ EMACS_INT i;
+ EMACS_INT size = SCHARS (string);
+ EMACS_INT size_byte = SBYTES (string);
struct gcpro gcpro1;
GCPRO1 (string);
if (size == size_byte)
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
+static void
write_string_1 (const char *data, int size, Lisp_Object printcharfun)
{
PRINTDECLARE;
(Lisp_Object character)
{
CHECK_NUMBER (character);
- putc (XINT (character), stderr);
+ putc ((int) XINT (character), stderr);
#ifdef WINDOWSNT
/* Send the output to a debugger (nothing happens if there isn't one). */
/* 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;
+ 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);
+ int i;
- print_number_index = index;
+ 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;
&& SYMBOLP (obj)
&& !SYMBOL_INTERNED_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 (Vprint_number_table)->size == 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))
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);
}
/* 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 (INTERVAL interval, Lisp_Object string);
#define PRINT_STRING_NON_CHARSET_FOUND 1
#define PRINT_STRING_UNSAFE_CHARSET_FOUND 2
-/* Bitwize or of the abobe macros. */
+/* Bitwise or of the above macros. */
static int print_check_string_result;
static void
|| ! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
{
int i, c;
- int charpos = interval->position;
- int bytepos = string_char_to_byte (string, charpos);
+ EMACS_INT charpos = interval->position;
+ EMACS_INT bytepos = string_char_to_byte (string, charpos);
Lisp_Object charset;
charset = XCAR (XCDR (val));
else
{
/* 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;
- }
- }
+ Lisp_Object num = Fgethash (obj, Vprint_number_table, Qnil);
+ if (INTEGERP (num))
+ {
+ 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, "#%d=", -n);
+ strout (buf, -1, -1, printcharfun, 0);
+ /* 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, "#%d#", n);
+ strout (buf, -1, -1, printcharfun, 0);
+ return;
+ }
+ }
}
}
print_string (obj, printcharfun);
else
{
- register int i, i_byte;
+ register EMACS_INT i, i_byte;
struct gcpro gcpro1;
unsigned char *str;
- int size_byte;
+ EMACS_INT 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;
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;
+ int i, i_byte;
+ EMACS_INT size_byte;
Lisp_Object name;
name = SYMBOL_NAME (obj);
}
{
- int print_length, i;
+ EMACS_INT print_length;
+ int i;
Lisp_Object halftail = obj;
/* Negative values of print-length are invalid in CL.
/* 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, 0);
+ print_object (obj, printcharfun, escapeflag);
+ goto end_of_list;
+ }
}
}
register int i;
register unsigned char c;
struct gcpro gcpro1;
- int size_in_chars
+ EMACS_INT size_in_chars
= ((XBOOL_VECTOR (obj)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
/ BOOL_VECTOR_BITS_PER_CHAR);
else if (HASH_TABLE_P (obj))
{
struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
- int i, real_size, size;
+ int i;
+ EMACS_INT real_size, size;
#if 0
strout ("#<hash-table", -1, -1, printcharfun, 0);
if (SYMBOLP (h->test))
{
register int i;
register Lisp_Object tem;
- int real_size = size;
+ EMACS_INT real_size = size;
/* Don't print more elements than the specified maximum. */
if (NATNUMP (Vprint_length)
strout ("in no buffer", -1, -1, printcharfun, 0);
else
{
- sprintf (buf, "at %d", marker_position (obj));
+ sprintf (buf, "at %ld", (long)marker_position (obj));
strout (buf, -1, -1, printcharfun, 0);
strout (" in ", -1, -1, printcharfun, 0);
print_string (XMARKER (obj)->buffer->name, printcharfun);
strout ("in no buffer", -1, -1, printcharfun, 0);
else
{
- sprintf (buf, "from %d to %d in ",
- marker_position (OVERLAY_START (obj)),
- marker_position (OVERLAY_END (obj)));
+ sprintf (buf, "from %ld to %ld in ",
+ (long)marker_position (OVERLAY_START (obj)),
+ (long)marker_position (OVERLAY_END (obj)));
strout (buf, -1, -1, printcharfun, 0);
print_string (XMARKER (OVERLAY_START (obj))->buffer->name,
printcharfun);
HCoop / bpt / emacs.git / blobdiff