X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/bd90dcd000bbc315b26153f091ce6a2ac592f1d7..cd987aaa0a8254a701886b3c32c269b09025c7a1:/src/print.c diff --git a/src/print.c b/src/print.c index d563580ddd..c81f99f643 100644 --- a/src/print.c +++ b/src/print.c @@ -1,7 +1,7 @@ /* Lisp object printing and output streams. Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, - 2005 Free Software Foundation, Inc. + 2005, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -182,6 +182,9 @@ static int max_print; void print_interval (); +/* GDB resets this to zero on W32 to disable OutputDebugString calls. */ +int print_output_debug_flag = 1; + /* Low level output routines for characters and strings */ @@ -213,7 +216,7 @@ void print_interval (); 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); \ @@ -272,6 +275,7 @@ void print_interval (); 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) \ { \ @@ -285,7 +289,7 @@ void print_interval (); 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); @@ -360,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) @@ -409,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 { @@ -493,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 { @@ -756,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. @@ -909,17 +936,27 @@ to make it write to the debugging output. */) #ifdef WINDOWSNT /* Send the output to a debugger (nothing happens if there isn't one). */ - { - char buf[2] = {(char) XINT (character), '\0'}; - OutputDebugString (buf); - } + if (print_output_debug_flag) + { + char buf[2] = {(char) XINT (character), '\0'}; + OutputDebugString (buf); + } #endif return character; } +/* This function is never called. Its purpose is to prevent + print_output_debug_flag from being optimized away. */ -#if defined(GNU_LINUX) +void +debug_output_compilation_hack (x) + int x; +{ + print_output_debug_flag = x; +} + +#if defined (GNU_LINUX) /* This functionality is not vitally important in general, so we rely on non-portable ability to use stderr as lvalue. */ @@ -939,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; @@ -947,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; @@ -1026,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) @@ -1314,7 +1353,7 @@ print_preprocess (obj) /* Give up if we go so deep that print_object will get an error. */ /* See similar code in print_object. */ if (print_depth >= PRINT_CIRCLE) - return; + error ("Apparently circular structure being printed"); /* Avoid infinite recursion for circular nested structure in the case where Vprint_circle is nil. */ @@ -1345,7 +1384,8 @@ print_preprocess (obj) { /* OBJ appears more than once. Let's remember that. */ PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt; - return; + print_depth--; + return; } /* OBJ is not yet recorded. Let's add to the table. */ @@ -2012,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 { @@ -2026,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 { @@ -2073,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; @@ -2160,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); }