X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/945b01119fd383fd35b5d10d8d406d0ddaeec0ec..ee6bb6939fe507dc98986bfc23794da6110f61ef:/src/print.c diff --git a/src/print.c b/src/print.c index 3a286361a8..c81f99f643 100644 --- a/src/print.c +++ b/src/print.c @@ -216,7 +216,7 @@ int print_output_debug_flag = 1; if (MARKERP (printcharfun)) \ { \ EMACS_INT marker_pos; \ - if (!(XMARKER (printcharfun)->buffer)) \ + if (! XMARKER (printcharfun)->buffer) \ error ("Marker does not point anywhere"); \ if (XMARKER (printcharfun)->buffer != current_buffer) \ set_buffer_internal (XMARKER (printcharfun)->buffer); \ @@ -275,6 +275,7 @@ int print_output_debug_flag = 1; 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 (free_print_buffer) \ { \ @@ -288,7 +289,7 @@ int print_output_debug_flag = 1; 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)); \ + ? PT_BYTE - start_point_byte : 0)); \ if (old != current_buffer) \ set_buffer_internal (old); @@ -363,7 +364,10 @@ printchar (ch, fun) print_buffer. PRINTCHARFUN t means output to the echo area or to stdout if non-interactive. If neither nil nor t, call Lisp function PRINTCHARFUN for each character printed. MULTIBYTE - non-zero means PTR contains multibyte characters. */ + non-zero means PTR contains multibyte characters. + + In the case where PRINTCHARFUN is nil, it is safe for PTR to point + to data in a Lisp string. Otherwise that is not safe. */ static void strout (ptr, size, size_byte, printcharfun, multibyte) @@ -412,7 +416,7 @@ strout (ptr, size, size_byte, printcharfun, multibyte) if (size == size_byte) { for (i = 0; i < size; ++i) - insert_char ((unsigned char )*ptr++); + insert_char ((unsigned char) *ptr++); } else { @@ -496,10 +500,29 @@ print_string (string, printcharfun) else chars = SBYTES (string); - /* strout is safe for output to a frame (echo area) or to print_buffer. */ - strout (SDATA (string), - chars, SBYTES (string), - printcharfun, STRING_MULTIBYTE (string)); + if (EQ (printcharfun, Qt)) + { + /* Output to echo area. */ + int nbytes = SBYTES (string); + char *buffer; + + /* Copy the string contents so that relocation of STRING by + GC does not cause trouble. */ + USE_SAFE_ALLOCA; + + SAFE_ALLOCA (buffer, char *, nbytes); + bcopy (SDATA (string), buffer, nbytes); + + strout (buffer, chars, SBYTES (string), + printcharfun, STRING_MULTIBYTE (string)); + + SAFE_FREE (); + } + else + /* No need to copy, since output to print_buffer can't GC. */ + strout (SDATA (string), + chars, SBYTES (string), + printcharfun, STRING_MULTIBYTE (string)); } else { @@ -759,7 +782,8 @@ DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0, doc: /* Return a string containing the printed representation of OBJECT. OBJECT can be any Lisp object. This function outputs quoting characters when necessary to make output that `read' can handle, whenever possible, -unless the optional second argument NOESCAPE is non-nil. +unless the optional second argument NOESCAPE is non-nil. For complex objects, +the behavior is controlled by `print-level' and `print-length', which see. OBJECT is any of the Lisp data types: a number, a string, a symbol, a list, a buffer, a window, a frame, etc. @@ -922,8 +946,17 @@ to make it write to the debugging output. */) return character; } +/* This function is never called. Its purpose is to prevent + print_output_debug_flag from being optimized away. */ + +void +debug_output_compilation_hack (x) + int x; +{ + print_output_debug_flag = x; +} -#if defined(GNU_LINUX) +#if defined (GNU_LINUX) /* This functionality is not vitally important in general, so we rely on non-portable ability to use stderr as lvalue. */ @@ -943,7 +976,7 @@ append to existing target file. */) Lisp_Object file, append; { if (initial_stderr_stream != NULL) - fclose(stderr); + fclose (stderr); stderr = initial_stderr_stream; initial_stderr_stream = NULL; @@ -951,7 +984,7 @@ append to existing target file. */) { file = Fexpand_file_name (file, Qnil); initial_stderr_stream = stderr; - stderr = fopen(SDATA (file), NILP (append) ? "w" : "a"); + stderr = fopen (SDATA (file), NILP (append) ? "w" : "a"); if (stderr == NULL) { stderr = initial_stderr_stream; @@ -1030,7 +1063,9 @@ error message is constructed. */) } /* Print an error message for the error DATA onto Lisp output stream - STREAM (suitable for the print functions). */ + STREAM (suitable for the print functions). + CONTEXT is a C string describing the context of the error. + CALLER is the Lisp function inside which the error was signaled. */ void print_error_message (data, stream, context, caller) @@ -2017,7 +2052,7 @@ print_object (obj, printcharfun, escapeflag) /* Do you think this is necessary? */ if (XMARKER (obj)->insertion_type != 0) strout ("(moves after insertion) ", -1, -1, printcharfun, 0); - if (!(XMARKER (obj)->buffer)) + if (! XMARKER (obj)->buffer) strout ("in no buffer", -1, -1, printcharfun, 0); else { @@ -2031,7 +2066,7 @@ print_object (obj, printcharfun, escapeflag) case Lisp_Misc_Overlay: strout ("#buffer)) + if (! XMARKER (OVERLAY_START (obj))->buffer) strout ("in no buffer", -1, -1, printcharfun, 0); else { @@ -2078,8 +2113,8 @@ print_object (obj, printcharfun, escapeflag) case Lisp_Misc_Kboard_Objfwd: strout ("#offset), + print_object (*(Lisp_Object *) ((char *) current_kboard + + XKBOARD_OBJFWD (obj)->offset), printcharfun, escapeflag); PRINTCHAR ('>'); break; @@ -2165,7 +2200,7 @@ print_interval (interval, printcharfun) print_object (make_number (interval->position), printcharfun, 1); PRINTCHAR (' '); print_object (make_number (interval->position + LENGTH (interval)), - printcharfun, 1); + printcharfun, 1); PRINTCHAR (' '); print_object (interval->plist, printcharfun, 1); }