\f
/* 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.
- Use printchar to output one character,
- or call strout to output a block of characters. */
-
-#define PRINTPREPARE \
- ptrdiff_t old_point = -1, start_point = -1; \
- ptrdiff_t old_point_byte = -1, start_point_byte = -1; \
- specpdl_ref specpdl_count = SPECPDL_INDEX (); \
- bool multibyte \
- = !NILP (BVAR (current_buffer, enable_multibyte_characters)); \
- Lisp_Object original = printcharfun; \
- record_unwind_current_buffer (); \
- specbind(Qprint__unreadable_callback_buffer, Fcurrent_buffer ()); \
- if (NILP (printcharfun)) printcharfun = Qt; \
- if (BUFFERP (printcharfun)) \
- { \
- if (XBUFFER (printcharfun) != current_buffer) \
- Fset_buffer (printcharfun); \
- printcharfun = Qnil; \
- } \
- if (MARKERP (printcharfun)) \
- { \
- ptrdiff_t marker_pos; \
- if (! XMARKER (printcharfun)->buffer) \
- error ("Marker does not point anywhere"); \
- if (XMARKER (printcharfun)->buffer != current_buffer) \
- set_buffer_internal (XMARKER (printcharfun)->buffer); \
- marker_pos = marker_position (printcharfun); \
- if (marker_pos < BEGV || marker_pos > ZV) \
- 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, \
- marker_byte_position (printcharfun)); \
- start_point = PT; \
- start_point_byte = PT_BYTE; \
- printcharfun = Qnil; \
- } \
- if (NILP (printcharfun)) \
- { \
- Lisp_Object string; \
- if (NILP (BVAR (current_buffer, enable_multibyte_characters)) \
- && ! print_escape_multibyte) \
- specbind (Qprint_escape_multibyte, Qt); \
- if (! NILP (BVAR (current_buffer, enable_multibyte_characters)) \
- && ! print_escape_nonascii) \
- specbind (Qprint_escape_nonascii, Qt); \
- if (print_buffer != 0) \
- { \
- string = make_string_from_bytes (print_buffer, \
- print_buffer_pos, \
- print_buffer_pos_byte); \
- record_unwind_protect (print_unwind, string); \
- } \
- else \
- { \
- int new_size = 1000; \
- print_buffer = xmalloc (new_size); \
- print_buffer_size = new_size; \
- record_unwind_protect_void (print_free_buffer); \
- } \
- print_buffer_pos = 0; \
- print_buffer_pos_byte = 0; \
- } \
- if (EQ (printcharfun, Qt) && ! noninteractive) \
- setup_echo_area_for_printing (multibyte);
-
-#define PRINTFINISH \
- if (NILP (printcharfun)) \
- { \
- if (print_buffer_pos != print_buffer_pos_byte \
- && NILP (BVAR (current_buffer, enable_multibyte_characters)))\
- { \
- USE_SAFE_ALLOCA; \
- unsigned char *temp = SAFE_ALLOCA (print_buffer_pos + 1); \
- 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); \
- SAFE_FREE (); \
- } \
- else \
- insert_1_both (print_buffer, print_buffer_pos, \
- print_buffer_pos_byte, 0, 1, 0); \
- signal_after_change (PT - print_buffer_pos, 0, print_buffer_pos);\
- } \
- 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)); \
- unbind_to (specpdl_count, Qnil); \
-
/* This is used to free the print buffer; we don't simply record xfree
since print_buffer can be reallocated during the printing. */
-
static void
print_free_buffer (void)
{
/* This is used to restore the saved contents of print_buffer
when there is a recursive call to print. */
-
static void
print_unwind (Lisp_Object saved_text)
{
memcpy (print_buffer, SDATA (saved_text), SCHARS (saved_text));
}
+/* Lisp functions to do output using a stream must start with a call to
+ print_prepare, and end with calling print_finish.
+ Use printchar to output one character, or call strout to output a
+ block of characters. */
+
+/* State carried between print_prepare and print_finish. */
+struct print_context {
+ Lisp_Object printcharfun;
+ Lisp_Object old_printcharfun;
+ ptrdiff_t old_point, start_point;
+ ptrdiff_t old_point_byte, start_point_byte;
+ specpdl_ref specpdl_count;
+};
+
+static inline struct print_context
+print_prepare (Lisp_Object printcharfun)
+{
+ struct print_context pc = {
+ .old_printcharfun = printcharfun,
+ .old_point = -1,
+ .start_point = -1,
+ .old_point_byte = -1,
+ .start_point_byte = -1,
+ .specpdl_count = SPECPDL_INDEX (),
+ };
+ bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters));
+ record_unwind_current_buffer ();
+ specbind(Qprint__unreadable_callback_buffer, Fcurrent_buffer ());
+ if (NILP (printcharfun))
+ printcharfun = Qt;
+ if (BUFFERP (printcharfun))
+ {
+ if (XBUFFER (printcharfun) != current_buffer)
+ Fset_buffer (printcharfun);
+ printcharfun = Qnil;
+ }
+ if (MARKERP (printcharfun))
+ {
+ if (! XMARKER (printcharfun)->buffer)
+ error ("Marker does not point anywhere");
+ if (XMARKER (printcharfun)->buffer != current_buffer)
+ set_buffer_internal (XMARKER (printcharfun)->buffer);
+ ptrdiff_t marker_pos = marker_position (printcharfun);
+ if (marker_pos < BEGV || marker_pos > ZV)
+ signal_error ("Marker is outside the accessible part of the buffer",
+ printcharfun);
+ pc.old_point = PT;
+ pc.old_point_byte = PT_BYTE;
+ SET_PT_BOTH (marker_pos, marker_byte_position (printcharfun));
+ pc.start_point = PT;
+ pc.start_point_byte = PT_BYTE;
+ printcharfun = Qnil;
+ }
+ if (NILP (printcharfun))
+ {
+ if (NILP (BVAR (current_buffer, enable_multibyte_characters))
+ && ! print_escape_multibyte)
+ specbind (Qprint_escape_multibyte, Qt);
+ if (! NILP (BVAR (current_buffer, enable_multibyte_characters))
+ && ! print_escape_nonascii)
+ specbind (Qprint_escape_nonascii, Qt);
+ if (print_buffer != 0)
+ {
+ Lisp_Object string = make_string_from_bytes (print_buffer,
+ print_buffer_pos,
+ print_buffer_pos_byte);
+ record_unwind_protect (print_unwind, string);
+ }
+ else
+ {
+ int new_size = 1000;
+ print_buffer = xmalloc (new_size);
+ print_buffer_size = new_size;
+ record_unwind_protect_void (print_free_buffer);
+ }
+ print_buffer_pos = 0;
+ print_buffer_pos_byte = 0;
+ }
+ if (EQ (printcharfun, Qt) && ! noninteractive)
+ setup_echo_area_for_printing (multibyte);
+ pc.printcharfun = printcharfun;
+ return pc;
+}
+
+static inline void
+print_finish (struct print_context *pc)
+{
+ if (NILP (pc->printcharfun))
+ {
+ if (print_buffer_pos != print_buffer_pos_byte
+ && NILP (BVAR (current_buffer, enable_multibyte_characters)))
+ {
+ USE_SAFE_ALLOCA;
+ unsigned char *temp = SAFE_ALLOCA (print_buffer_pos + 1);
+ 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);
+ SAFE_FREE ();
+ }
+ else
+ insert_1_both (print_buffer, print_buffer_pos,
+ print_buffer_pos_byte, 0, 1, 0);
+ signal_after_change (PT - print_buffer_pos, 0, print_buffer_pos);
+ }
+ if (MARKERP (pc->old_printcharfun))
+ set_marker_both (pc->old_printcharfun, Qnil, PT, PT_BYTE);
+ if (pc->old_point >= 0)
+ SET_PT_BOTH (pc->old_point
+ + (pc->old_point >= pc->start_point
+ ? PT - pc->start_point : 0),
+ pc->old_point_byte
+ + (pc->old_point_byte >= pc->start_point_byte
+ ? PT_BYTE - pc->start_point_byte : 0));
+ unbind_to (pc->specpdl_count, Qnil);
+}
+
/* Print character CH to the stdio stream STREAM. */
static void
if (NILP (printcharfun))
printcharfun = Vstandard_output;
CHECK_FIXNUM (character);
- PRINTPREPARE;
- printchar (XFIXNUM (character), printcharfun);
- PRINTFINISH;
+ struct print_context pc = print_prepare (printcharfun);
+ printchar (XFIXNUM (character), pc.printcharfun);
+ print_finish (&pc);
return character;
}
/* Print the contents of a unibyte C string STRING using PRINTCHARFUN.
- The caller should arrange to put this inside PRINTPREPARE and PRINTFINISH.
+ The caller should arrange to put this inside print_prepare and print_finish.
Do not use this on the contents of a Lisp string. */
static void
static void
write_string (const char *data, Lisp_Object printcharfun)
{
- PRINTPREPARE;
- print_c_string (data, printcharfun);
- PRINTFINISH;
+ struct print_context pc = print_prepare (printcharfun);
+ print_c_string (data, pc.printcharfun);
+ print_finish (&pc);
}
if (NILP (printcharfun))
printcharfun = Vstandard_output;
- PRINTPREPARE;
+ struct print_context pc = print_prepare (printcharfun);
if (NILP (ensure))
val = Qt;
/* Difficult to check if at line beginning so abort. */
- else if (FUNCTIONP (printcharfun))
- signal_error ("Unsupported function argument", printcharfun);
- else if (noninteractive && !NILP (printcharfun))
+ else if (FUNCTIONP (pc.printcharfun))
+ signal_error ("Unsupported function argument", pc.printcharfun);
+ else if (noninteractive && !NILP (pc.printcharfun))
val = printchar_stdout_last == 10 ? Qnil : Qt;
else
val = NILP (Fbolp ()) ? Qt : Qnil;
if (!NILP (val))
- printchar ('\n', printcharfun);
- PRINTFINISH;
+ printchar ('\n', pc.printcharfun);
+ print_finish (&pc);
return val;
}
if (!NILP (overrides))
print_bind_overrides (overrides);
- PRINTPREPARE;
- print (object, printcharfun, 1);
- PRINTFINISH;
+ struct print_context pc = print_prepare (printcharfun);
+ print (object, pc.printcharfun, 1);
+ print_finish (&pc);
return unbind_to (count, object);
}
No need for specbind, since errors deactivate the mark. */
Lisp_Object save_deactivate_mark = Vdeactivate_mark;
- Lisp_Object printcharfun = Vprin1_to_string_buffer;
- PRINTPREPARE;
- print (object, printcharfun, NILP (noescape));
- /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINISH */
- PRINTFINISH;
+ struct print_context pc = print_prepare (Vprin1_to_string_buffer);
+ print (object, pc.printcharfun, NILP (noescape));
+ /* Make Vprin1_to_string_buffer be the default buffer after print_finish */
+ print_finish (&pc);
struct buffer *previous = current_buffer;
set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
{
if (NILP (printcharfun))
printcharfun = Vstandard_output;
- PRINTPREPARE;
+ struct print_context pc = print_prepare (printcharfun);
if (STRINGP (object)
&& !string_intervals (object)
&& NILP (Vprint_continuous_numbering))
/* fast path for plain strings */
- print_string (object, printcharfun);
+ print_string (object, pc.printcharfun);
else
- print (object, printcharfun, 0);
- PRINTFINISH;
+ print (object, pc.printcharfun, 0);
+ print_finish (&pc);
return object;
}
{
if (NILP (printcharfun))
printcharfun = Vstandard_output;
- PRINTPREPARE;
- printchar ('\n', printcharfun);
- print (object, printcharfun, 1);
- printchar ('\n', printcharfun);
- PRINTFINISH;
+ struct print_context pc = print_prepare (printcharfun);
+ printchar ('\n', pc.printcharfun);
+ print (object, pc.printcharfun, 1);
+ printchar ('\n', pc.printcharfun);
+ print_finish (&pc);
return object;
}
projects / emacs.git / commitdiff