X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/880e615853d4074937795850b279338720618431..9f62b5dd0e873f6048630e1e59a371112bdcf720:/src/print.c diff --git a/src/print.c b/src/print.c index 80e010ee0f..6ed0f51cbe 100644 --- a/src/print.c +++ b/src/print.c @@ -1,6 +1,6 @@ /* 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. @@ -100,7 +100,7 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1; 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)); \ @@ -153,7 +153,7 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1; 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; \ } \ @@ -185,7 +185,7 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1; 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) \ @@ -478,10 +478,10 @@ write_string_1 (const char *data, int size, Lisp_Object printcharfun) 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))); @@ -503,7 +503,7 @@ temp_output_buffer_setup (const char *bufname) Frun_hooks (1, &Qtemp_buffer_setup_hook); - unbind_to (count, Qnil); + dynwind_end (); specbind (Qstandard_output, buf); } @@ -583,9 +583,9 @@ A printed representation of an object is text which describes that object. */) 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); { @@ -596,8 +596,6 @@ A printed representation of an object is text which describes that object. */) 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; @@ -621,8 +619,8 @@ A printed representation of an object is text which describes that object. */) 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, @@ -709,17 +707,36 @@ You can call print while debugging emacs, and pass it this function 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; } @@ -1119,7 +1136,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 - 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) { @@ -1389,9 +1406,8 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) 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. */ @@ -1410,23 +1426,15 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) } 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; @@ -1462,7 +1470,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) 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 @@ -2189,6 +2197,8 @@ init_print_once (void) void syms_of_print (void) { +#include "print.x" + DEFSYM (Qtemp_buffer_setup_hook, "temp-buffer-setup-hook"); DEFVAR_LISP ("standard-output", Vstandard_output, @@ -2310,17 +2320,6 @@ priorities. */); /* 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");