HCoop
/
bpt
/
emacs.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix bug #16576 with PRINTCHARFUN that conses output a lot.
[bpt/emacs.git]
/
src
/
print.c
diff --git
a/src/print.c
b/src/print.c
index
811ab50
..
71fa30d
100644
(file)
--- a/
src/print.c
+++ b/
src/print.c
@@
-1,6
+1,6
@@
/* Lisp object printing and output streams.
/* Lisp object printing and output streams.
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-201
3
Free Software
+Copyright (C) 1985-1986, 1988, 1993-1995, 1997-201
4
Free Software
Foundation, Inc.
This file is part of GNU Emacs.
Foundation, Inc.
This file is part of GNU Emacs.
@@
-20,7
+20,7
@@
along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <config.h>
-#include
<stdio.h>
+#include
"sysstdio.h"
#include "lisp.h"
#include "character.h"
#include "lisp.h"
#include "character.h"
@@
-124,7
+124,8
@@
bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;
set_buffer_internal (XMARKER (printcharfun)->buffer); \
marker_pos = marker_position (printcharfun); \
if (marker_pos < BEGV || marker_pos > ZV) \
set_buffer_internal (XMARKER (printcharfun)->buffer); \
marker_pos = marker_position (printcharfun); \
if (marker_pos < BEGV || marker_pos > ZV) \
- error ("Marker is outside the accessible part of the buffer"); \
+ signal_error ("Marker is outside the accessible " \
+ "part of the buffer", printcharfun); \
old_point = PT; \
old_point_byte = PT_BYTE; \
SET_PT_BOTH (marker_pos, \
old_point = PT; \
old_point_byte = PT_BYTE; \
SET_PT_BOTH (marker_pos, \
@@
-136,10
+137,10
@@
bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;
if (NILP (printcharfun)) \
{ \
Lisp_Object string; \
if (NILP (printcharfun)) \
{ \
Lisp_Object string; \
- if (NILP (BVAR (current_buffer, enable_multibyte_characters))
\
+ if (NILP (BVAR (current_buffer, enable_multibyte_characters)) \
&& ! print_escape_multibyte) \
specbind (Qprint_escape_multibyte, Qt); \
&& ! print_escape_multibyte) \
specbind (Qprint_escape_multibyte, Qt); \
- if (! NILP (BVAR (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) \
&& ! print_escape_nonascii) \
specbind (Qprint_escape_nonascii, Qt); \
if (print_buffer != 0) \
@@
-166,7
+167,7
@@
bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;
if (NILP (printcharfun)) \
{ \
if (print_buffer_pos != print_buffer_pos_byte \
if (NILP (printcharfun)) \
{ \
if (print_buffer_pos != print_buffer_pos_byte \
- && NILP (BVAR (current_buffer, enable_multibyte_characters)))
\
+ && NILP (BVAR (current_buffer, enable_multibyte_characters)))\
{ \
unsigned char *temp = alloca (print_buffer_pos + 1); \
copy_text ((unsigned char *) print_buffer, temp, \
{ \
unsigned char *temp = alloca (print_buffer_pos + 1); \
copy_text ((unsigned char *) print_buffer, temp, \
@@
-199,11
+200,10
@@
bool print_output_debug_flag EXTERNALLY_VISIBLE = 1;
/* This is used to restore the saved contents of print_buffer
when there is a recursive call to print. */
/* This is used to restore the saved contents of print_buffer
when there is a recursive call to print. */
-static
Lisp_Object
+static
void
print_unwind (Lisp_Object saved_text)
{
memcpy (print_buffer, SDATA (saved_text), SCHARS (saved_text));
print_unwind (Lisp_Object saved_text)
{
memcpy (print_buffer, SDATA (saved_text), SCHARS (saved_text));
- return Qnil;
}
}
@@
-765,13
+765,12
@@
append to existing target file. */)
{
file = Fexpand_file_name (file, Qnil);
initial_stderr_stream = stderr;
{
file = Fexpand_file_name (file, Qnil);
initial_stderr_stream = stderr;
- stderr = fopen (SSDATA (file), NILP (append) ? "w" : "a");
+ stderr =
emacs_
fopen (SSDATA (file), NILP (append) ? "w" : "a");
if (stderr == NULL)
{
stderr = initial_stderr_stream;
initial_stderr_stream = NULL;
if (stderr == NULL)
{
stderr = initial_stderr_stream;
initial_stderr_stream = NULL;
- report_file_error ("Cannot open debugging output stream",
- Fcons (file, Qnil));
+ report_file_error ("Cannot open debugging output stream", file);
}
}
return Qnil;
}
}
return Qnil;
@@
-1120,7
+1119,7
@@
print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
string (its text properties will be traced), or a symbol that has
no obarray (this is for the print-gensym feature).
The status fields of Vprint_number_table mean whether each object appears
string (its text properties will be traced), or a symbol that has
no obarray (this is for the print-gensym feature).
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
. */
+ more than once in OBJ: Qnil at the first time, and Qt after that. */
static void
print_preprocess (Lisp_Object obj)
{
static void
print_preprocess (Lisp_Object obj)
{
@@
-1301,7
+1300,7
@@
print_prune_string_charset (Lisp_Object string)
if (print_check_string_result & PRINT_STRING_NON_CHARSET_FOUND)
{
if (NILP (print_prune_charset_plist))
if (print_check_string_result & PRINT_STRING_NON_CHARSET_FOUND)
{
if (NILP (print_prune_charset_plist))
- print_prune_charset_plist =
Fcons (Qcharset, Qnil
);
+ print_prune_charset_plist =
list1 (Qcharset
);
Fremove_text_properties (make_number (0),
make_number (SCHARS (string)),
print_prune_charset_plist, string);
Fremove_text_properties (make_number (0),
make_number (SCHARS (string)),
print_prune_charset_plist, string);
@@
-1390,9
+1389,8
@@
print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
print_string (obj, printcharfun);
else
{
print_string (obj, printcharfun);
else
{
- register ptrdiff_t i_byte;
+ register ptrdiff_t i
, i
_byte;
struct gcpro gcpro1;
struct gcpro gcpro1;
- unsigned char *str;
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. */
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. */
@@
-1411,23
+1409,15
@@
print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
}
PRINTCHAR ('\"');
}
PRINTCHAR ('\"');
- str = SDATA (obj);
size_byte = SBYTES (obj);
size_byte = SBYTES (obj);
- for (i_byte = 0; i_byte < size_byte;)
+ for (i
= 0, 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. */
{
/* Here, we must convert each multi-byte form to the
corresponding character code before handing it to PRINTCHAR. */
- int len;
int c;
int c;
- if (multibyte)
- {
- c = STRING_CHAR_AND_LENGTH (str + i_byte, len);
- i_byte += len;
- }
- else
- c = str[i_byte++];
+ FETCH_STRING_CHAR_ADVANCE (c, obj, i, i_byte);
QUIT;
QUIT;
@@
-1705,15
+1695,14
@@
print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
int len;
unsigned char c;
struct gcpro gcpro1;
int len;
unsigned char c;
struct gcpro gcpro1;
- ptrdiff_t size_in_chars
- = ((XBOOL_VECTOR (obj)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
- / BOOL_VECTOR_BITS_PER_CHAR);
-
+ EMACS_INT size = bool_vector_size (obj);
+ ptrdiff_t size_in_chars = bool_vector_bytes (size);
+ ptrdiff_t real_size_in_chars = size_in_chars;
GCPRO1 (obj);
PRINTCHAR ('#');
PRINTCHAR ('&');
GCPRO1 (obj);
PRINTCHAR ('#');
PRINTCHAR ('&');
- len = sprintf (buf, "%"pI"d",
XBOOL_VECTOR (obj)->
size);
+ len = sprintf (buf, "%"pI"d", size);
strout (buf, len, len, printcharfun);
PRINTCHAR ('\"');
strout (buf, len, len, printcharfun);
PRINTCHAR ('\"');
@@
-1727,7
+1716,7
@@
print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
for (i = 0; i < size_in_chars; i++)
{
QUIT;
for (i = 0; i < size_in_chars; i++)
{
QUIT;
- c =
XBOOL_VECTOR (obj)->data
[i];
+ c =
bool_vector_uchar_data (obj)
[i];
if (c == '\n' && print_escape_newlines)
{
PRINTCHAR ('\\');
if (c == '\n' && print_escape_newlines)
{
PRINTCHAR ('\\');
@@
-1753,6
+1742,9
@@
print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
PRINTCHAR (c);
}
}
PRINTCHAR (c);
}
}
+
+ if (size_in_chars < real_size_in_chars)
+ strout (" ...", 4, 4, printcharfun);
PRINTCHAR ('\"');
UNGCPRO;
PRINTCHAR ('\"');
UNGCPRO;
@@
-1767,7
+1759,7
@@
print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
{
int len;
strout ("#<window ", -1, -1, printcharfun);
{
int len;
strout ("#<window ", -1, -1, printcharfun);
- len = sprintf (buf, "%
p", XWINDOW (obj)
);
+ len = sprintf (buf, "%
d", XWINDOW (obj)->sequence_number
);
strout (buf, len, len, printcharfun);
if (BUFFERP (XWINDOW (obj)->contents))
{
strout (buf, len, len, printcharfun);
if (BUFFERP (XWINDOW (obj)->contents))
{
@@
-1798,6
+1790,7
@@
print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
ptrdiff_t real_size, size;
int len;
#if 0
ptrdiff_t real_size, size;
int len;
#if 0
+ void *ptr = h;
strout ("#<hash-table", -1, -1, printcharfun);
if (SYMBOLP (h->test))
{
strout ("#<hash-table", -1, -1, printcharfun);
if (SYMBOLP (h->test))
{
@@
-1810,9
+1803,8
@@
print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
len = sprintf (buf, "%"pD"d/%"pD"d", h->count, ASIZE (h->next));
strout (buf, len, len, printcharfun);
}
len = sprintf (buf, "%"pD"d/%"pD"d", h->count, ASIZE (h->next));
strout (buf, len, len, printcharfun);
}
- len = sprintf (buf, " %p
", h
);
+ len = sprintf (buf, " %p
>", ptr
);
strout (buf, len, len, printcharfun);
strout (buf, len, len, printcharfun);
- PRINTCHAR ('>');
#endif
/* Implement a readable output, e.g.:
#s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
#endif
/* Implement a readable output, e.g.:
#s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
@@
-1892,6
+1884,7
@@
print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
else if (FRAMEP (obj))
{
int len;
else if (FRAMEP (obj))
{
int len;
+ void *ptr = XFRAME (obj);
Lisp_Object frame_name = XFRAME (obj)->name;
strout ((FRAME_LIVE_P (XFRAME (obj))
Lisp_Object frame_name = XFRAME (obj)->name;
strout ((FRAME_LIVE_P (XFRAME (obj))
@@
-1907,9
+1900,8
@@
print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
frame_name = build_string ("*INVALID*FRAME*NAME*");
}
print_string (frame_name, printcharfun);
frame_name = build_string ("*INVALID*FRAME*NAME*");
}
print_string (frame_name, printcharfun);
- len = sprintf (buf, " %p
", XFRAME (obj)
);
+ len = sprintf (buf, " %p
>", ptr
);
strout (buf, len, len, printcharfun);
strout (buf, len, len, printcharfun);
- PRINTCHAR ('>');
}
else if (FONTP (obj))
{
}
else if (FONTP (obj))
{
@@
-2103,6
+2095,12
@@
print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
v->data[index].pointer);
break;
v->data[index].pointer);
break;
+ case SAVE_FUNCPOINTER:
+ i = sprintf (buf, "<funcpointer %p>",
+ ((void *) (intptr_t)
+ v->data[index].funcpointer));
+ break;
+
case SAVE_INTEGER:
i = sprintf (buf, "<integer %"pD"d>",
v->data[index].integer);
case SAVE_INTEGER:
i = sprintf (buf, "<integer %"pD"d>",
v->data[index].integer);
@@
-2112,6
+2110,9
@@
print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
print_object (v->data[index].object, printcharfun,
escapeflag);
continue;
print_object (v->data[index].object, printcharfun,
escapeflag);
continue;
+
+ default:
+ emacs_abort ();
}
strout (buf, i, i, printcharfun);
}
strout (buf, i, i, printcharfun);