/* Lisp object printing and output streams.
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2013 Free Software
+Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2014 Free Software
Foundation, Inc.
This file is part of GNU Emacs.
Use PRINTCHAR to output one character,
or call strout to output a block of characters. */
+/* {{coccinelle:skip_start}} */
#define PRINTDECLARE \
struct buffer *old = current_buffer; \
ptrdiff_t old_point = -1, start_point = -1; \
ptrdiff_t old_point_byte = -1, start_point_byte = -1; \
- ptrdiff_t specpdl_count = SPECPDL_INDEX (); \
+ dynwind_begin (); \
bool free_print_buffer = 0; \
bool multibyte \
= !NILP (BVAR (current_buffer, enable_multibyte_characters)); \
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, \
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); \
- 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) \
else \
{ \
int new_size = 1000; \
- print_buffer = xmalloc (new_size); \
+ print_buffer = xmalloc_atomic (new_size); \
print_buffer_size = new_size; \
free_print_buffer = 1; \
} \
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, \
xfree (print_buffer); \
print_buffer = 0; \
} \
- unbind_to (specpdl_count, Qnil); \
+ dynwind_end (); \
if (MARKERP (original)) \
set_marker_both (original, Qnil, PT, PT_BYTE); \
if (old_point >= 0) \
set_buffer_internal (old);
#define PRINTCHAR(ch) printchar (ch, printcharfun)
+/* {{coccinelle:skip_end}} */
/* This is used to restore the saved contents of print_buffer
when there is a recursive call to print. */
void
temp_output_buffer_setup (const char *bufname)
{
- ptrdiff_t count = SPECPDL_INDEX ();
register struct buffer *old = current_buffer;
register Lisp_Object buf;
+ dynwind_begin ();
record_unwind_current_buffer ();
Fset_buffer (Fget_buffer_create (build_string (bufname)));
Frun_hooks (1, &Qtemp_buffer_setup_hook);
- unbind_to (count, Qnil);
+ dynwind_end ();
specbind (Qstandard_output, buf);
}
bool prev_abort_on_gc;
/* struct gcpro gcpro1, gcpro2; */
Lisp_Object save_deactivate_mark;
- ptrdiff_t count = SPECPDL_INDEX ();
struct buffer *previous;
+ dynwind_begin ();
specbind (Qinhibit_modification_hooks, Qt);
{
No need for specbind, since errors deactivate the mark. */
save_deactivate_mark = Vdeactivate_mark;
/* GCPRO2 (object, save_deactivate_mark); */
- prev_abort_on_gc = abort_on_gc;
- abort_on_gc = 1;
printcharfun = Vprin1_to_string_buffer;
PRINTPREPARE;
Vdeactivate_mark = save_deactivate_mark;
/* UNGCPRO; */
- abort_on_gc = prev_abort_on_gc;
- return unbind_to (count, object);
+ dynwind_end ();
+ return object;
}
DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
to make it write to the debugging output. */)
(Lisp_Object character)
{
- CHECK_NUMBER (character);
- putc (XINT (character) & 0xFF, stderr);
+ unsigned int ch;
-#ifdef WINDOWSNT
- /* Send the output to a debugger (nothing happens if there isn't one). */
- if (print_output_debug_flag)
+ CHECK_NUMBER (character);
+ ch = XINT (character);
+ if (ASCII_CHAR_P (ch))
{
- char buf[2] = {(char) XINT (character), '\0'};
- OutputDebugString (buf);
+ putc (ch, stderr);
+#ifdef WINDOWSNT
+ /* Send the output to a debugger (nothing happens if there isn't
+ one). */
+ if (print_output_debug_flag)
+ {
+ char buf[2] = {(char) XINT (character), '\0'};
+ OutputDebugString (buf);
+ }
+#endif
}
+ else
+ {
+ unsigned char mbstr[MAX_MULTIBYTE_LENGTH];
+ ptrdiff_t len = CHAR_STRING (ch, mbstr);
+ Lisp_Object encoded_ch =
+ ENCODE_SYSTEM (make_multibyte_string ((char *) mbstr, 1, len));
+
+ fwrite (SSDATA (encoded_ch), SBYTES (encoded_ch), 1, stderr);
+#ifdef WINDOWSNT
+ if (print_output_debug_flag)
+ OutputDebugString (SSDATA (encoded_ch));
#endif
+ }
return character;
}
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)
{
print_string (obj, printcharfun);
else
{
- register ptrdiff_t i_byte;
+ register ptrdiff_t i, i_byte;
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. */
}
PRINTCHAR ('\"');
- str = SDATA (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. */
- int len;
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;
strout (outbuf, len, len, printcharfun);
}
else if (! multibyte
- && SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c)
+ && SINGLE_BYTE_CHAR_P (c) && ! ASCII_CHAR_P (c)
&& print_escape_nonascii)
{
/* When printing in a multibyte buffer
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 ('&');
- len = sprintf (buf, "%"pI"d", XBOOL_VECTOR (obj)->size);
+ len = sprintf (buf, "%"pI"d", size);
strout (buf, len, len, printcharfun);
PRINTCHAR ('\"');
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 ('\\');
PRINTCHAR (c);
}
}
+
+ if (size_in_chars < real_size_in_chars)
+ strout (" ...", 4, 4, printcharfun);
PRINTCHAR ('\"');
UNGCPRO;
}
- else if (SUBRP (obj))
- {
- strout ("#<subr ", -1, -1, printcharfun);
- strout (XSUBR (obj)->symbol_name, -1, -1, printcharfun);
- PRINTCHAR ('>');
- }
else if (WINDOWP (obj))
{
- void *ptr = XWINDOW (obj);
- int len = sprintf (buf, "#<window %p", ptr);
+ int len;
+ strout ("#<window ", -1, -1, printcharfun);
+ len = sprintf (buf, "%d", XWINDOW (obj)->sequence_number);
strout (buf, len, len, printcharfun);
if (BUFFERP (XWINDOW (obj)->contents))
{
}
break;
+ case Lisp_Other:
+ {
+ SCM port = scm_open_output_string ();
+ if (escapeflag)
+ scm_display (obj, port);
+ else
+ scm_write (obj, port);
+ strout (scm_to_locale_string (scm_get_output_string (port)),
+ -1, -1, printcharfun);
+ scm_close_port (port);
+ }
+ break;
+
default:
badtype:
{
init_print_once (void)
{
DEFSYM (Qexternal_debugging_output, "external-debugging-output");
- defsubr (&Sexternal_debugging_output);
+ defsubr ("external-debugging-output", gsubr_Fexternal_debugging_output, 1, 1, 0);
}
void
syms_of_print (void)
{
+#include "print.x"
+
DEFSYM (Qtemp_buffer_setup_hook, "temp-buffer-setup-hook");
DEFVAR_LISP ("standard-output", Vstandard_output,
/* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
staticpro (&Vprin1_to_string_buffer);
- defsubr (&Sprin1);
- defsubr (&Sprin1_to_string);
- defsubr (&Serror_message_string);
- defsubr (&Sprinc);
- defsubr (&Sprint);
- defsubr (&Sterpri);
- defsubr (&Swrite_char);
-#ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
- defsubr (&Sredirect_debugging_output);
-#endif
-
DEFSYM (Qprint_escape_newlines, "print-escape-newlines");
DEFSYM (Qprint_escape_multibyte, "print-escape-multibyte");
DEFSYM (Qprint_escape_nonascii, "print-escape-nonascii");
HCoop / bpt / emacs.git / blobdiff