/* Lisp object printing and output streams.
- Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98 Free Software Foundation, Inc.
+ Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 1998
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
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;
+
Lisp_Object Qprint_escape_newlines;
+Lisp_Object Qprint_escape_multibyte, Qprint_escape_nonascii;
/* Nonzero means print (quote foo) forms as 'foo, etc. */
if (NILP (printcharfun)) \
{ \
Lisp_Object string; \
+ if (NILP (current_buffer->enable_multibyte_characters) \
+ && ! print_escape_multibyte) \
+ specbind (Qprint_escape_multibyte, Qt); \
+ if (! NILP (current_buffer->enable_multibyte_characters) \
+ && ! print_escape_nonascii) \
+ specbind (Qprint_escape_nonascii, Qt); \
if (print_buffer != 0) \
{ \
- string = make_multibyte_string (print_buffer, \
- print_buffer_pos, \
- print_buffer_pos_byte); \
+ string = make_string_from_bytes (print_buffer, \
+ print_buffer_pos, \
+ print_buffer_pos_byte); \
record_unwind_protect (print_unwind, string); \
} \
else \
if (!CONSP (Vprint_gensym)) \
Vprint_gensym_alist = Qnil
-#define PRINTFINISH \
- if (NILP (printcharfun)) \
- insert_1_both (print_buffer, print_buffer_pos, \
- print_buffer_pos_byte, 0, 1, 0); \
- if (free_print_buffer) \
- { \
- xfree (print_buffer); \
- print_buffer = 0; \
- } \
- unbind_to (specpdl_count, Qnil); \
- if (MARKERP (original)) \
- set_marker_both (original, Qnil, PT, PT_BYTE); \
- if (old_point >= 0) \
- SET_PT_BOTH (old_point + (old_point >= start_point \
- ? PT - start_point : 0), \
+#define PRINTFINISH \
+ if (NILP (printcharfun)) \
+ { \
+ if (print_buffer_pos != print_buffer_pos_byte \
+ && NILP (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, \
+ print_buffer_pos, 0, 1, 0); \
+ } \
+ else \
+ insert_1_both (print_buffer, print_buffer_pos, \
+ print_buffer_pos_byte, 0, 1, 0); \
+ } \
+ if (free_print_buffer) \
+ { \
+ xfree (print_buffer); \
+ print_buffer = 0; \
+ } \
+ unbind_to (specpdl_count, Qnil); \
+ if (MARKERP (original)) \
+ set_marker_both (original, Qnil, PT, PT_BYTE); \
+ if (old_point >= 0) \
+ SET_PT_BOTH (old_point + (old_point >= start_point \
+ ? PT - start_point : 0), \
old_point_byte + (old_point_byte >= start_point_byte \
? PT_BYTE - start_point_byte : 0)); \
- if (old != current_buffer) \
- set_buffer_internal (old); \
- if (!CONSP (Vprint_gensym)) \
+ if (old != current_buffer) \
+ set_buffer_internal (old); \
+ if (!CONSP (Vprint_gensym)) \
Vprint_gensym_alist = Qnil
#define PRINTCHAR(ch) printchar (ch, printcharfun)
0, 1);
printbufidx = size;
if (printbufidx > FRAME_MESSAGE_BUF_SIZE (mini_frame))
- printbufidx = FRAME_MESSAGE_BUF_SIZE (mini_frame);
+ {
+ printbufidx = FRAME_MESSAGE_BUF_SIZE (mini_frame);
+ /* Rewind incomplete multi-byte form. */
+ while (printbufidx > 0 && tembuf[printbufidx] >= 0xA0)
+ printbufidx--;
+ }
bcopy (tembuf, FRAME_MESSAGE_BUF (mini_frame), printbufidx);
}
- message_enable_multibyte
- = ! NILP (current_buffer->enable_multibyte_characters);
+
+ /* Record whether the message buffer is multibyte.
+ (If at any point some multibyte characters are added, then it is.) */
+ if (len > 0 && ! NILP (current_buffer->enable_multibyte_characters))
+ message_enable_multibyte = 1;
if (printbufidx < FRAME_MESSAGE_BUF_SIZE (mini_frame) - len)
- bcopy (str, &FRAME_MESSAGE_BUF (mini_frame)[printbufidx], len),
- printbufidx += len;
+ {
+ bcopy (str, &FRAME_MESSAGE_BUF (mini_frame)[printbufidx], len);
+ printbufidx += len;
+ }
FRAME_MESSAGE_BUF (mini_frame)[printbufidx] = 0;
echo_area_glyphs_length = printbufidx;
}
message_dolog (ptr, size_byte, 0, multibyte);
+
+ /* Convert message to multibyte if we are now adding multibyte text. */
+ if (multibyte
+ && ! message_enable_multibyte
+ && printbufidx > 0)
+ {
+ int size = count_size_as_multibyte (FRAME_MESSAGE_BUF (mini_frame),
+ printbufidx);
+ unsigned char *tembuf = (unsigned char *) alloca (size + 1);
+ copy_text (FRAME_MESSAGE_BUF (mini_frame), tembuf, printbufidx,
+ 0, 1);
+ printbufidx = size;
+ if (printbufidx > FRAME_MESSAGE_BUF_SIZE (mini_frame))
+ {
+ printbufidx = FRAME_MESSAGE_BUF_SIZE (mini_frame);
+ /* Rewind incomplete multi-byte form. */
+ while (printbufidx > 0 && tembuf[printbufidx] >= 0xA0)
+ printbufidx--;
+ }
+
+ bcopy (tembuf, FRAME_MESSAGE_BUF (mini_frame), printbufidx);
+ }
+
+ if (multibyte)
+ message_enable_multibyte = 1;
+
+ /* Compute how much of the new text will fit there. */
if (size_byte > FRAME_MESSAGE_BUF_SIZE (mini_frame) - printbufidx - 1)
{
size_byte = FRAME_MESSAGE_BUF_SIZE (mini_frame) - printbufidx - 1;
/* Rewind incomplete multi-byte form. */
- while (size_byte && (unsigned char) ptr[size] >= 0xA0) size--;
+ while (size_byte && (unsigned char) ptr[size_byte] >= 0xA0)
+ size_byte--;
}
+
+ /* Put that part of the new text in. */
bcopy (ptr, &FRAME_MESSAGE_BUF (mini_frame) [printbufidx], size_byte);
printbufidx += size_byte;
- echo_area_glyphs_length = printbufidx;
FRAME_MESSAGE_BUF (mini_frame) [printbufidx] = 0;
+ echo_area_glyphs_length = printbufidx;
return;
}
Lisp_Object printcharfun;
{
if (EQ (printcharfun, Qt) || NILP (printcharfun))
- /* strout is safe for output to a frame (echo area) or to print_buffer. */
- strout (XSTRING (string)->data,
- XSTRING (string)->size,
- XSTRING (string)->size_byte,
- printcharfun, STRING_MULTIBYTE (string));
+ {
+ int chars;
+
+ if (STRING_MULTIBYTE (string))
+ chars = XSTRING (string)->size;
+ else if (EQ (printcharfun, Qt)
+ ? ! NILP (buffer_defaults.enable_multibyte_characters)
+ : ! NILP (current_buffer->enable_multibyte_characters))
+ chars = multibyte_chars_in_text (XSTRING (string)->data,
+ STRING_BYTES (XSTRING (string)));
+ else
+ chars = STRING_BYTES (XSTRING (string));
+
+ /* strout is safe for output to a frame (echo area) or to print_buffer. */
+ strout (XSTRING (string)->data,
+ chars, STRING_BYTES (XSTRING (string)),
+ printcharfun, STRING_MULTIBYTE (string));
+ }
else
{
/* Otherwise, string may be relocated by printing one char.
So re-fetch the string address for each character. */
int i;
int size = XSTRING (string)->size;
- int size_byte = XSTRING (string)->size_byte;
+ int size_byte = STRING_BYTES (XSTRING (string));
struct gcpro gcpro1;
GCPRO1 (string);
if (size == size_byte)
/* Here, we must convert each multi-byte form to the
corresponding character code before handing it to PRINTCHAR. */
int len;
- int ch = STRING_CHAR_AND_LENGTH (XSTRING (string)->data + i,
- size_byte - i, len);
-
+ int ch = STRING_CHAR_AND_CHAR_LENGTH (XSTRING (string)->data + i,
+ size_byte - i, len);
+ if (!CHAR_VALID_P (ch, 0))
+ {
+ ch = XSTRING (string)->data[i];
+ len = 1;
+ }
PRINTCHAR (ch);
i += len;
}
current_buffer->directory = old->directory;
current_buffer->read_only = Qnil;
+ current_buffer->filename = Qnil;
+ current_buffer->undo_list = Qt;
+ current_buffer->overlays_before = Qnil;
+ current_buffer->overlays_after = Qnil;
+ current_buffer->enable_multibyte_characters
+ = buffer_defaults.enable_multibyte_characters;
Ferase_buffer ();
XSETBUFFER (buf, current_buffer);
Lisp_Object
internal_with_output_to_temp_buffer (bufname, function, args)
char *bufname;
- Lisp_Object (*function) ();
+ Lisp_Object (*function) P_ ((Lisp_Object));
Lisp_Object args;
{
int count = specpdl_ptr - specpdl;
The buffer is cleared out initially, and marked as unmodified when done.\n\
All output done by BODY is inserted in that buffer by default.\n\
The buffer is displayed in another window, but not selected.\n\
+The hook `temp-buffer-show-hook' is run with that window selected\n\
+temporarily and its buffer current.\n\
The value of the last form in BODY is returned.\n\
If BODY does not finish normally, the buffer BUFNAME is not displayed.\n\n\
If variable `temp-buffer-show-function' is non-nil, call it at the end\n\
-to get the buffer displayed. It gets one argument, the buffer to display.")
+to get the buffer displayed instead of just displaying the non-selected\n\
+buffer and calling the hook. It gets one argument, the buffer to display.")
(args)
Lisp_Object args;
{
register int i, i_byte;
register unsigned char c;
struct gcpro gcpro1;
+ unsigned char *str;
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;
GCPRO1 (obj);
#endif
PRINTCHAR ('\"');
- size_byte = XSTRING (obj)->size_byte;
+ str = XSTRING (obj)->data;
+ size_byte = STRING_BYTES (XSTRING (obj));
for (i = 0, i_byte = 0; i_byte < size_byte;)
{
int c;
if (STRING_MULTIBYTE (obj))
- FETCH_STRING_CHAR_ADVANCE (c, obj, i, i_byte);
+ {
+ c = STRING_CHAR_AND_CHAR_LENGTH (str + i_byte,
+ size_byte - i_byte, len);
+ if (CHAR_VALID_P (c, 0))
+ i_byte += len;
+ else
+ c = str[i_byte++];
+ }
else
- c = XSTRING (obj)->data[i_byte++];
+ c = str[i_byte++];
QUIT;
PRINTCHAR ('\\');
PRINTCHAR ('f');
}
- else if ((! SINGLE_BYTE_CHAR_P (c)
- && NILP (current_buffer->enable_multibyte_characters)))
+ else if (! SINGLE_BYTE_CHAR_P (c) && print_escape_multibyte)
{
/* When multibyte is disabled,
print multibyte string chars using hex escapes. */
unsigned char outbuf[50];
sprintf (outbuf, "\\x%x", c);
strout (outbuf, -1, -1, printcharfun, 0);
+ need_nonhex = 1;
}
- else if (SINGLE_BYTE_CHAR_P (c)
- && ! ASCII_BYTE_P (c)
- && ! NILP (current_buffer->enable_multibyte_characters))
+ else if (SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c)
+ && print_escape_nonascii)
{
- /* When multibyte is enabled,
+ /* When printing in a multibyte buffer
+ or when explicitly requested,
print single-byte non-ASCII string chars
using octal escapes. */
unsigned char outbuf[5];
}
else
{
+ /* If we just had a hex escape, and this character
+ could be taken as part of it,
+ output `\ ' to prevent that. */
+ if (need_nonhex)
+ {
+ need_nonhex = 0;
+ if ((c >= 'a' && c <= 'f')
+ || (c >= 'A' && c <= 'F')
+ || (c >= '0' && c <= '9'))
+ strout ("\\ ", -1, -1, printcharfun, 0);
+ }
+
if (c == '\"' || c == '\\')
PRINTCHAR ('\\');
PRINTCHAR (c);
{
register int confusing;
register unsigned char *p = XSYMBOL (obj)->name->data;
- register unsigned char *end = p + XSYMBOL (obj)->name->size_byte;
+ register unsigned char *end = p + STRING_BYTES (XSYMBOL (obj)->name);
register int c;
int i, i_byte, size_byte;
Lisp_Object name;
PRINTCHAR (':');
}
- size_byte = XSTRING (name)->size_byte;
+ size_byte = STRING_BYTES (XSTRING (name));
for (i = 0, i_byte = 0; i_byte < size_byte;)
{
PRINTCHAR ('(');
{
register int i = 0;
- register int max = 0;
+ register int print_length = 0;
+ Lisp_Object halftail = obj;
if (INTEGERP (Vprint_length))
- max = XINT (Vprint_length);
- /* Could recognize circularities in cdrs here,
- but that would make printing of long lists quadratic.
- It's not worth doing. */
+ print_length = XINT (Vprint_length);
while (CONSP (obj))
{
+ /* Detect circular list. */
+ if (i != 0 && EQ (obj, halftail))
+ {
+ sprintf (buf, " . #%d", i / 2);
+ strout (buf, -1, -1, printcharfun, 0);
+ obj = Qnil;
+ break;
+ }
if (i++)
PRINTCHAR (' ');
- if (max && i > max)
+ if (print_length && i > print_length)
{
strout ("...", 3, 3, printcharfun, 0);
break;
}
print (XCAR (obj), printcharfun, escapeflag);
obj = XCDR (obj);
+ if (!(i & 1))
+ halftail = XCDR (halftail);
}
}
if (!NILP (obj))
strout ("#<some_buffer_local_value ", -1, -1, printcharfun, 0);
do_buffer_local:
strout ("[realvalue] ", -1, -1, printcharfun, 0);
- print (XBUFFER_LOCAL_VALUE (obj)->car, printcharfun, escapeflag);
- strout ("[buffer] ", -1, -1, printcharfun, 0);
- print (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->car,
+ print (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 (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 (XBUFFER_LOCAL_VALUE (obj)->frame,
+ printcharfun, escapeflag);
+ }
strout ("[alist-elt] ", -1, -1, printcharfun, 0);
- print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->cdr)->car,
+ print (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->car,
printcharfun, escapeflag);
strout ("[default-value] ", -1, -1, printcharfun, 0);
- print (XCONS (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->cdr)->cdr,
+ print (XCONS (XBUFFER_LOCAL_VALUE (obj)->cdr)->cdr,
printcharfun, escapeflag);
PRINTCHAR ('>');
break;
Also print formfeeds as backslash-f.");
print_escape_newlines = 0;
+ DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii,
+ "Non-nil means print unibyte non-ASCII chars in strings as \\OOO.\n\
+\(OOO is the octal representation of the character code.)\n\
+Only single-byte characters are affected, and only in `prin1'.");
+ print_escape_nonascii = 0;
+
+ DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte,
+ "Non-nil means print multibyte characters in strings as \\xXXXX.\n\
+\(XXX is the hex representation of the character code.)\n\
+This affects only `prin1'.");
+ print_escape_multibyte = 0;
+
DEFVAR_BOOL ("print-quoted", &print_quoted,
"Non-nil means print quoted forms with reader syntax.\n\
I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and, backquoted\n\
Qprint_escape_newlines = intern ("print-escape-newlines");
staticpro (&Qprint_escape_newlines);
+ Qprint_escape_multibyte = intern ("print-escape-multibyte");
+ staticpro (&Qprint_escape_multibyte);
+
+ Qprint_escape_nonascii = intern ("print-escape-nonascii");
+ staticpro (&Qprint_escape_nonascii);
+
#ifndef standalone
defsubr (&Swith_output_to_temp_buffer);
#endif /* not standalone */