diff options
Diffstat (limited to 'src/print.c')
| -rw-r--r-- | src/print.c | 68 |
1 files changed, 52 insertions, 16 deletions
diff --git a/src/print.c b/src/print.c index 8d0a5e2bb3b..4b94d77e876 100644 --- a/src/print.c +++ b/src/print.c @@ -1,5 +1,5 @@ /* Lisp object printing and output streams. - Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 01, 2003 + Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 01, 03, 2004 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -601,6 +601,8 @@ temp_output_buffer_setup (bufname) eassert (current_buffer->overlays_after == NULL); current_buffer->enable_multibyte_characters = buffer_defaults.enable_multibyte_characters; + specbind (Qinhibit_read_only, Qt); + specbind (Qinhibit_modification_hooks, Qt); Ferase_buffer (); XSETBUFFER (buf, current_buffer); @@ -789,7 +791,7 @@ A printed representation of an object is text which describes that object. */) if (SBYTES (object) == SCHARS (object)) STRING_SET_UNIBYTE (object); - /* Note that this won't make prepare_to_modify_buffer call + /* Note that this won't make prepare_to_modify_buffer call ask-user-about-supersession-threat because this buffer does not visit a file. */ Ferase_buffer (); @@ -927,7 +929,7 @@ DEFUN ("redirect-debugging-output", Fredirect_debugging_output, Sredirect_debugg doc: /* Redirect debugging output (stderr stream) to file FILE. If FILE is nil, reset target to the initial stderr stream. Optional arg APPEND non-nil (interactively, with prefix arg) means -append to existing target file. */) +append to existing target file. */) (file, append) Lisp_Object file, append; { @@ -1218,7 +1220,6 @@ print (obj, printcharfun, escapeflag) register Lisp_Object printcharfun; int escapeflag; { - print_depth = 0; old_backquote_output = 0; /* Reset print_number_index and Vprint_number_table only when @@ -1238,6 +1239,7 @@ print (obj, printcharfun, escapeflag) start = index = print_number_index; /* Construct Vprint_number_table. This increments print_number_index for the objects added. */ + print_depth = 0; print_preprocess (obj); /* Remove unnecessary objects, which appear only once in OBJ; @@ -1262,6 +1264,7 @@ print (obj, printcharfun, escapeflag) print_number_index = index; } + print_depth = 0; print_object (obj, printcharfun, escapeflag); } @@ -1278,6 +1281,26 @@ print_preprocess (obj) { int i; EMACS_INT size; + int loop_count = 0; + Lisp_Object halftail; + + /* Avoid infinite recursion for circular nested structure + in the case where Vprint_circle is nil. */ + if (NILP (Vprint_circle)) + { + for (i = 0; i < print_depth; i++) + if (EQ (obj, being_printed[i])) + return; + being_printed[print_depth] = 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; + + print_depth++; + halftail = obj; loop: if (STRINGP (obj) || CONSP (obj) || VECTORP (obj) @@ -1338,8 +1361,15 @@ print_preprocess (obj) break; case Lisp_Cons: + /* Use HALFTAIL and LOOP_COUNT to detect circular lists, + just as in print_object. */ + if (loop_count && EQ (obj, halftail)) + break; print_preprocess (XCAR (obj)); obj = XCDR (obj); + loop_count++; + if (!(loop_count & 1)) + halftail = XCDR (halftail); goto loop; case Lisp_Vectorlike: @@ -1354,6 +1384,7 @@ print_preprocess (obj) break; } } + print_depth--; } static void @@ -1457,7 +1488,7 @@ print_object (obj, printcharfun, escapeflag) register Lisp_Object printcharfun; int escapeflag; { - char buf[30]; + char buf[40]; QUIT; @@ -1511,6 +1542,7 @@ print_object (obj, printcharfun, escapeflag) print_depth++; + /* See similar code in print_preprocess. */ if (print_depth > PRINT_CIRCLE) error ("Apparently circular structure being printed"); #ifdef MAX_PRINT_CHARS @@ -1876,18 +1908,14 @@ print_object (obj, printcharfun, escapeflag) register unsigned char c; struct gcpro gcpro1; int size_in_chars - = (XBOOL_VECTOR (obj)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR; + = ((XBOOL_VECTOR (obj)->size + BOOL_VECTOR_BITS_PER_CHAR - 1) + / BOOL_VECTOR_BITS_PER_CHAR); GCPRO1 (obj); PRINTCHAR ('#'); PRINTCHAR ('&'); - if (sizeof (int) == sizeof (EMACS_INT)) - sprintf (buf, "%d", XBOOL_VECTOR (obj)->size); - else if (sizeof (long) == sizeof (EMACS_INT)) - sprintf (buf, "%ld", XBOOL_VECTOR (obj)->size); - else - abort (); + sprintf (buf, "%ld", (long) XBOOL_VECTOR (obj)->size); strout (buf, -1, -1, printcharfun, 0); PRINTCHAR ('\"'); @@ -1917,6 +1945,14 @@ print_object (obj, printcharfun, escapeflag) PRINTCHAR ('\\'); PRINTCHAR ('f'); } + else if (c > '\177') + { + /* Use octal escapes to avoid encoding issues. */ + PRINTCHAR ('\\'); + PRINTCHAR ('0' + ((c >> 6) & 3)); + PRINTCHAR ('0' + ((c >> 3) & 7)); + PRINTCHAR ('0' + (c & 7)); + } else { if (c == '\"' || c == '\\') @@ -1937,7 +1973,7 @@ print_object (obj, printcharfun, escapeflag) else if (WINDOWP (obj)) { strout ("#<window ", -1, -1, printcharfun, 0); - sprintf (buf, "%d", XFASTINT (XWINDOW (obj)->sequence_number)); + sprintf (buf, "%ld", (long) XFASTINT (XWINDOW (obj)->sequence_number)); strout (buf, -1, -1, printcharfun, 0); if (!NILP (XWINDOW (obj)->buffer)) { @@ -1958,8 +1994,8 @@ print_object (obj, printcharfun, escapeflag) PRINTCHAR (' '); strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun, 0); PRINTCHAR (' '); - sprintf (buf, "%d/%d", XFASTINT (h->count), - XVECTOR (h->next)->size); + sprintf (buf, "%ld/%ld", (long) XFASTINT (h->count), + (long) XVECTOR (h->next)->size); strout (buf, -1, -1, printcharfun, 0); } sprintf (buf, " 0x%lx", (unsigned long) h); @@ -2082,7 +2118,7 @@ print_object (obj, printcharfun, escapeflag) break; case Lisp_Misc_Intfwd: - sprintf (buf, "#<intfwd to %d>", *XINTFWD (obj)->intvar); + sprintf (buf, "#<intfwd to %ld>", (long) *XINTFWD (obj)->intvar); strout (buf, -1, -1, printcharfun, 0); break; |