]> code.delx.au - gnu-emacs/blobdiff - src/print.c
(x_set_name_internal): Set icon to `text', derived from name, when
[gnu-emacs] / src / print.c
index dbbeec97b4e88449ac2b02b873d05604c114789e..3f8982849d4f2ff4fdef47281d519934d11f5439 100644 (file)
@@ -1,6 +1,7 @@
 /* Lisp object printing and output streams.
 /* Lisp object printing and output streams.
-   Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 2001
-       Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997,
+                 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+                 2005, 2006 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
 
 This file is part of GNU Emacs.
 
@@ -16,8 +17,8 @@ GNU General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to
 
 You should have received a copy of the GNU General Public License
 along with GNU Emacs; see the file COPYING.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA.  */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
 
 
 #include <config.h>
 
 
 #include <config.h>
@@ -91,6 +92,9 @@ Lisp_Object Vfloat_output_format, Qfloat_output_format;
 /* Avoid actual stack overflow in print.  */
 int print_depth;
 
 /* Avoid actual stack overflow in print.  */
 int print_depth;
 
+/* Nonzero if inside outputting backquote in old style.  */
+int old_backquote_output;
+
 /* Detect most circularities to print finite output.  */
 #define PRINT_CIRCLE 200
 Lisp_Object being_printed[PRINT_CIRCLE];
 /* Detect most circularities to print finite output.  */
 #define PRINT_CIRCLE 200
 Lisp_Object being_printed[PRINT_CIRCLE];
@@ -178,6 +182,9 @@ static int max_print;
 
 void print_interval ();
 
 
 void print_interval ();
 
+/* GDB resets this to zero on W32 to disable OutputDebugString calls.  */
+int print_output_debug_flag = 1;
+
 \f
 /* Low level output routines for characters and strings */
 
 \f
 /* Low level output routines for characters and strings */
 
@@ -186,7 +193,7 @@ void print_interval ();
    and must start with PRINTPREPARE, end with PRINTFINISH,
    and use PRINTDECLARE to declare common variables.
    Use PRINTCHAR to output one character,
    and must start with PRINTPREPARE, end with PRINTFINISH,
    and use PRINTDECLARE to declare common variables.
    Use PRINTCHAR to output one character,
-   or call strout to output a block of characters. */ 
+   or call strout to output a block of characters. */
 
 #define PRINTDECLARE                                                   \
    struct buffer *old = current_buffer;                                        \
 
 #define PRINTDECLARE                                                   \
    struct buffer *old = current_buffer;                                        \
@@ -208,13 +215,17 @@ void print_interval ();
      }                                                                 \
    if (MARKERP (printcharfun))                                         \
      {                                                                 \
      }                                                                 \
    if (MARKERP (printcharfun))                                         \
      {                                                                 \
-       if (!(XMARKER (original)->buffer))                              \
+       EMACS_INT marker_pos;                                           \
+       if (!(XMARKER (printcharfun)->buffer))                          \
          error ("Marker does not point anywhere");                     \
          error ("Marker does not point anywhere");                     \
-       if (XMARKER (original)->buffer != current_buffer)               \
-         set_buffer_internal (XMARKER (original)->buffer);             \
+       if (XMARKER (printcharfun)->buffer != current_buffer)           \
+         set_buffer_internal (XMARKER (printcharfun)->buffer);         \
+       marker_pos = marker_position (printcharfun);                    \
+       if (marker_pos < BEGV || marker_pos > ZV)                       \
+        error ("Marker is outside the accessible part of the buffer"); \
        old_point = PT;                                                 \
        old_point_byte = PT_BYTE;                                       \
        old_point = PT;                                                 \
        old_point_byte = PT_BYTE;                                       \
-       SET_PT_BOTH (marker_position (printcharfun),                    \
+       SET_PT_BOTH (marker_pos,                                                \
                    marker_byte_position (printcharfun));               \
        start_point = PT;                                               \
        start_point_byte = PT_BYTE;                                     \
                    marker_byte_position (printcharfun));               \
        start_point = PT;                                               \
        start_point_byte = PT_BYTE;                                     \
@@ -264,6 +275,7 @@ void print_interval ();
        else                                                            \
         insert_1_both (print_buffer, print_buffer_pos,                 \
                        print_buffer_pos_byte, 0, 1, 0);                \
        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)                                              \
      {                                                                 \
      }                                                                 \
    if (free_print_buffer)                                              \
      {                                                                 \
@@ -318,7 +330,7 @@ printchar (ch, fun)
       int len = CHAR_STRING (ch, str);
 
       QUIT;
       int len = CHAR_STRING (ch, str);
 
       QUIT;
-      
+
       if (NILP (fun))
        {
          if (print_buffer_pos_byte + len >= print_buffer_size)
       if (NILP (fun))
        {
          if (print_buffer_pos_byte + len >= print_buffer_size)
@@ -337,7 +349,7 @@ printchar (ch, fun)
        {
          int multibyte_p
            = !NILP (current_buffer->enable_multibyte_characters);
        {
          int multibyte_p
            = !NILP (current_buffer->enable_multibyte_characters);
-         
+
          setup_echo_area_for_printing (multibyte_p);
          insert_char (ch);
          message_dolog (str, len, 0, multibyte_p);
          setup_echo_area_for_printing (multibyte_p);
          insert_char (ch);
          message_dolog (str, len, 0, multibyte_p);
@@ -394,10 +406,10 @@ strout (ptr, size, size_byte, printcharfun, multibyte)
       int i;
       int multibyte_p
        = !NILP (current_buffer->enable_multibyte_characters);
       int i;
       int multibyte_p
        = !NILP (current_buffer->enable_multibyte_characters);
-      
+
       setup_echo_area_for_printing (multibyte_p);
       message_dolog (ptr, size_byte, 0, multibyte_p);
       setup_echo_area_for_printing (multibyte_p);
       message_dolog (ptr, size_byte, 0, multibyte_p);
-      
+
       if (size == size_byte)
        {
          for (i = 0; i < size; ++i)
       if (size == size_byte)
        {
          for (i = 0; i < size; ++i)
@@ -412,7 +424,7 @@ strout (ptr, size, size_byte, printcharfun, multibyte)
              insert_char (ch);
            }
        }
              insert_char (ch);
            }
        }
-      
+
 #ifdef MAX_PRINT_CHARS
       if (max_print)
         print_chars += size;
 #ifdef MAX_PRINT_CHARS
       if (max_print)
         print_chars += size;
@@ -503,7 +515,7 @@ print_string (string, printcharfun)
        for (i = 0; i < size; i++)
          PRINTCHAR (SREF (string, i));
       else
        for (i = 0; i < size; i++)
          PRINTCHAR (SREF (string, i));
       else
-       for (i = 0; i < size_byte; i++)
+       for (i = 0; i < size_byte; )
          {
            /* Here, we must convert each multi-byte form to the
               corresponding character code before handing it to PRINTCHAR.  */
          {
            /* Here, we must convert each multi-byte form to the
               corresponding character code before handing it to PRINTCHAR.  */
@@ -578,7 +590,7 @@ write_string_1 (data, size, printcharfun)
 
 void
 temp_output_buffer_setup (bufname)
 
 void
 temp_output_buffer_setup (bufname)
-    char *bufname;
+    const char *bufname;
 {
   int count = SPECPDL_INDEX ();
   register struct buffer *old = current_buffer;
 {
   int count = SPECPDL_INDEX ();
   register struct buffer *old = current_buffer;
@@ -589,14 +601,17 @@ temp_output_buffer_setup (bufname)
   Fset_buffer (Fget_buffer_create (build_string (bufname)));
 
   Fkill_all_local_variables ();
   Fset_buffer (Fget_buffer_create (build_string (bufname)));
 
   Fkill_all_local_variables ();
+  delete_all_overlays (current_buffer);
   current_buffer->directory = old->directory;
   current_buffer->read_only = Qnil;
   current_buffer->filename = Qnil;
   current_buffer->undo_list = Qt;
   current_buffer->directory = old->directory;
   current_buffer->read_only = Qnil;
   current_buffer->filename = Qnil;
   current_buffer->undo_list = Qt;
-  current_buffer->overlays_before = Qnil;
-  current_buffer->overlays_after = Qnil;
+  eassert (current_buffer->overlays_before == NULL);
+  eassert (current_buffer->overlays_after == NULL);
   current_buffer->enable_multibyte_characters
     = buffer_defaults.enable_multibyte_characters;
   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);
 
   Ferase_buffer ();
   XSETBUFFER (buf, current_buffer);
 
@@ -609,7 +624,7 @@ temp_output_buffer_setup (bufname)
 
 Lisp_Object
 internal_with_output_to_temp_buffer (bufname, function, args)
 
 Lisp_Object
 internal_with_output_to_temp_buffer (bufname, function, args)
-     char *bufname;
+     const char *bufname;
      Lisp_Object (*function) P_ ((Lisp_Object));
      Lisp_Object args;
 {
      Lisp_Object (*function) P_ ((Lisp_Object));
      Lisp_Object args;
 {
@@ -650,9 +665,9 @@ to display it temporarily selected.
 
 If variable `temp-buffer-show-function' is non-nil, call it at the end
 to get the buffer displayed instead of just displaying the non-selected
 
 If variable `temp-buffer-show-function' is non-nil, call it at the end
 to get the buffer displayed instead of just displaying the non-selected
-buffer and calling the hook.  It gets one argument, the buffer to display.  
+buffer and calling the hook.  It gets one argument, the buffer to display.
 
 
-usage: (with-output-to-temp-buffer BUFFNAME BODY ...)  */)
+usage: (with-output-to-temp-buffer BUFNAME BODY ...)  */)
      (args)
      Lisp_Object args;
 {
      (args)
      Lisp_Object args;
 {
@@ -745,7 +760,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,
        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.
 
 OBJECT is any of the Lisp data types: a number, a string, a symbol,
 a list, a buffer, a window, a frame, etc.
@@ -754,32 +770,48 @@ A printed representation of an object is text which describes that object.  */)
      (object, noescape)
      Lisp_Object object, noescape;
 {
      (object, noescape)
      Lisp_Object object, noescape;
 {
-  PRINTDECLARE;
   Lisp_Object printcharfun;
   Lisp_Object printcharfun;
-  struct gcpro gcpro1, gcpro2;
-  Lisp_Object tem;
+  /* struct gcpro gcpro1, gcpro2; */
+  Lisp_Object save_deactivate_mark;
+  int count = specpdl_ptr - specpdl;
+  struct buffer *previous;
 
 
-  /* Save and restore this--we are altering a buffer
-     but we don't want to deactivate the mark just for that.
-     No need for specbind, since errors deactivate the mark.  */
-  tem = Vdeactivate_mark;
-  GCPRO2 (object, tem);
+  specbind (Qinhibit_modification_hooks, Qt);
 
 
-  printcharfun = Vprin1_to_string_buffer;
-  PRINTPREPARE;
-  print (object, printcharfun, NILP (noescape));
-  /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
-  PRINTFINISH;
+  {
+    PRINTDECLARE;
+
+    /* Save and restore this--we are altering a buffer
+       but we don't want to deactivate the mark just for that.
+       No need for specbind, since errors deactivate the mark.  */
+    save_deactivate_mark = Vdeactivate_mark;
+    /* GCPRO2 (object, save_deactivate_mark); */
+    abort_on_gc++;
+
+    printcharfun = Vprin1_to_string_buffer;
+    PRINTPREPARE;
+    print (object, printcharfun, NILP (noescape));
+    /* Make Vprin1_to_string_buffer be the default buffer after PRINTFINSH */
+    PRINTFINISH;
+  }
+
+  previous = current_buffer;
   set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
   object = Fbuffer_string ();
   set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
   object = Fbuffer_string ();
+  if (SBYTES (object) == SCHARS (object))
+    STRING_SET_UNIBYTE (object);
 
 
+  /* 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 ();
   Ferase_buffer ();
-  set_buffer_internal (old);
+  set_buffer_internal (previous);
 
 
-  Vdeactivate_mark = tem;
-  UNGCPRO;
+  Vdeactivate_mark = save_deactivate_mark;
+  /* UNGCPRO; */
 
 
-  return object;
+  abort_on_gc--;
+  return unbind_to (count, object);
 }
 
 DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
 }
 
 DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
@@ -882,15 +914,59 @@ to make it write to the debugging output.  */)
 
 #ifdef WINDOWSNT
   /* Send the output to a debugger (nothing happens if there isn't one).  */
 
 #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;
 }
 
 #endif
 
   return character;
 }
 
+
+#if defined(GNU_LINUX)
+
+/* This functionality is not vitally important in general, so we rely on
+   non-portable ability to use stderr as lvalue.  */
+
+#define WITH_REDIRECT_DEBUGGING_OUTPUT 1
+
+FILE *initial_stderr_stream = NULL;
+
+DEFUN ("redirect-debugging-output", Fredirect_debugging_output, Sredirect_debugging_output,
+       1, 2,
+       "FDebug output file: \nP",
+       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.  */)
+     (file, append)
+     Lisp_Object file, append;
+{
+  if (initial_stderr_stream != NULL)
+    fclose(stderr);
+  stderr = initial_stderr_stream;
+  initial_stderr_stream = NULL;
+
+  if (STRINGP (file))
+    {
+      file = Fexpand_file_name (file, Qnil);
+      initial_stderr_stream = stderr;
+      stderr = fopen(SDATA (file), NILP (append) ? "w" : "a");
+      if (stderr == NULL)
+       {
+         stderr = initial_stderr_stream;
+         initial_stderr_stream = NULL;
+         report_file_error ("Cannot open debugging output stream",
+                            Fcons (file, Qnil));
+       }
+    }
+  return Qnil;
+}
+#endif /* GNU_LINUX */
+
+
 /* This is the interface for debugging printing.  */
 
 void
 /* This is the interface for debugging printing.  */
 
 void
@@ -900,10 +976,32 @@ debug_print (arg)
   Fprin1 (arg, Qexternal_debugging_output);
   fprintf (stderr, "\r\n");
 }
   Fprin1 (arg, Qexternal_debugging_output);
   fprintf (stderr, "\r\n");
 }
+
+void
+safe_debug_print (arg)
+     Lisp_Object arg;
+{
+  int valid = valid_lisp_object_p (arg);
+
+  if (valid > 0)
+    debug_print (arg);
+  else
+    fprintf (stderr, "#<%s_LISP_OBJECT 0x%08lx>\r\n",
+            !valid ? "INVALID" : "SOME",
+#ifdef NO_UNION_TYPE
+            (unsigned long) arg
+#else
+            (unsigned long) arg.i
+#endif
+            );
+}
+
 \f
 DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
        1, 1, 0,
 \f
 DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
        1, 1, 0,
-       doc: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.  */)
+       doc: /* Convert an error value (ERROR-SYMBOL . DATA) to an error message.
+See Info anchor `(elisp)Definition of signal' for some details on how this
+error message is constructed.  */)
      (obj)
      Lisp_Object obj;
 {
      (obj)
      Lisp_Object obj;
 {
@@ -920,7 +1018,7 @@ DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
       && NILP (XCDR (XCDR (obj))))
     return XCAR (XCDR (obj));
 
       && NILP (XCDR (XCDR (obj))))
     return XCAR (XCDR (obj));
 
-  print_error_message (obj, Vprin1_to_string_buffer);
+  print_error_message (obj, Vprin1_to_string_buffer, 0, Qnil);
 
   set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
   value = Fbuffer_string ();
 
   set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
   value = Fbuffer_string ();
@@ -937,13 +1035,29 @@ DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
    STREAM (suitable for the print functions).  */
 
 void
    STREAM (suitable for the print functions).  */
 
 void
-print_error_message (data, stream)
+print_error_message (data, stream, context, caller)
      Lisp_Object data, stream;
      Lisp_Object data, stream;
+     char *context;
+     Lisp_Object caller;
 {
   Lisp_Object errname, errmsg, file_error, tail;
   struct gcpro gcpro1;
   int i;
 
 {
   Lisp_Object errname, errmsg, file_error, tail;
   struct gcpro gcpro1;
   int i;
 
+  if (context != 0)
+    write_string_1 (context, -1, stream);
+
+  /* If we know from where the error was signaled, show it in
+   *Messages*.  */
+  if (!NILP (caller) && SYMBOLP (caller))
+    {
+      Lisp_Object cname = SYMBOL_NAME (caller);
+      char *name = alloca (SBYTES (cname));
+      bcopy (SDATA (cname), name, SBYTES (cname));
+      message_dolog (name, SBYTES (cname), 0, 0);
+      message_dolog (": ", 2, 0, 0);
+    }
+
   errname = Fcar (data);
 
   if (EQ (errname, Qerror))
   errname = Fcar (data);
 
   if (EQ (errname, Qerror))
@@ -988,7 +1102,7 @@ print_error_message (data, stream)
       else
        Fprin1 (obj, stream);
     }
       else
        Fprin1 (obj, stream);
     }
-  
+
   UNGCPRO;
 }
 
   UNGCPRO;
 }
 
@@ -999,9 +1113,9 @@ print_error_message (data, stream)
  * largest float, printed in the biggest notation.  This is undoubtedly
  * 20d float_output_format, with the negative of the C-constant "HUGE"
  * from <math.h>.
  * largest float, printed in the biggest notation.  This is undoubtedly
  * 20d float_output_format, with the negative of the C-constant "HUGE"
  * from <math.h>.
- * 
+ *
  * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
  * On the vax the worst case is -1e38 in 20d format which takes 61 bytes.
- * 
+ *
  * I assume that IEEE-754 format numbers can take 329 bytes for the worst
  * case of -1e307 in 20d float_output_format. What is one to do (short of
  * re-writing _doprnt to be more sane)?
  * I assume that IEEE-754 format numbers can take 329 bytes for the worst
  * case of -1e307 in 20d float_output_format. What is one to do (short of
  * re-writing _doprnt to be more sane)?
@@ -1015,7 +1129,7 @@ float_to_string (buf, data)
 {
   unsigned char *cp;
   int width;
 {
   unsigned char *cp;
   int width;
-      
+
   /* Check for plus infinity in a way that won't lose
      if there is no plus infinity.  */
   if (data == data / 2 && data > 1.0)
   /* Check for plus infinity in a way that won't lose
      if there is no plus infinity.  */
   if (data == data / 2 && data > 1.0)
@@ -1044,7 +1158,7 @@ float_to_string (buf, data)
            *buf++ = '-';
            break;
          }
            *buf++ = '-';
            break;
          }
-      
+
       strcpy (buf, "0.0e+NaN");
       return;
     }
       strcpy (buf, "0.0e+NaN");
       return;
     }
@@ -1139,7 +1253,7 @@ print (obj, printcharfun, escapeflag)
      register Lisp_Object printcharfun;
      int escapeflag;
 {
      register Lisp_Object printcharfun;
      int escapeflag;
 {
-  print_depth = 0;
+  old_backquote_output = 0;
 
   /* Reset print_number_index and Vprint_number_table only when
      the variable Vprint_continuous_numbering is nil.  Otherwise,
 
   /* Reset print_number_index and Vprint_number_table only when
      the variable Vprint_continuous_numbering is nil.  Otherwise,
@@ -1155,24 +1269,35 @@ print (obj, printcharfun, escapeflag)
   if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))
     {
       int i, start, index;
   if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))
     {
       int i, start, index;
-      /* Construct Vprint_number_table.  */
       start = index = print_number_index;
       start = index = print_number_index;
+      /* Construct Vprint_number_table.
+        This increments print_number_index for the objects added.  */
+      print_depth = 0;
       print_preprocess (obj);
       print_preprocess (obj);
+
       /* Remove unnecessary objects, which appear only once in OBJ;
       /* Remove unnecessary objects, which appear only once in OBJ;
-        that is, whose status is Qnil.  */
+        that is, whose status is Qnil.  Compactify the necessary objects.  */
       for (i = start; i < print_number_index; i++)
        if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
          {
            PRINT_NUMBER_OBJECT (Vprint_number_table, index)
              = PRINT_NUMBER_OBJECT (Vprint_number_table, i);
       for (i = start; i < print_number_index; i++)
        if (!NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
          {
            PRINT_NUMBER_OBJECT (Vprint_number_table, index)
              = PRINT_NUMBER_OBJECT (Vprint_number_table, i);
-           /* Reset the status field for the next print step.  Now this
-              field means whether the object has already been printed.  */
-           PRINT_NUMBER_STATUS (Vprint_number_table, index) = Qnil;
            index++;
          }
            index++;
          }
+
+      /* Clear out objects outside the active part of the table.  */
+      for (i = index; i < print_number_index; i++)
+       PRINT_NUMBER_OBJECT (Vprint_number_table, i) = Qnil;
+
+      /* Reset the status field for the next print step.  Now this
+        field means whether the object has already been printed.  */
+      for (i = start; i < print_number_index; i++)
+       PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qnil;
+
       print_number_index = index;
     }
 
       print_number_index = index;
     }
 
+  print_depth = 0;
   print_object (obj, printcharfun, escapeflag);
 }
 
   print_object (obj, printcharfun, escapeflag);
 }
 
@@ -1187,7 +1312,28 @@ static void
 print_preprocess (obj)
      Lisp_Object obj;
 {
 print_preprocess (obj)
      Lisp_Object obj;
 {
-  int i, size;
+  int i;
+  EMACS_INT size;
+  int loop_count = 0;
+  Lisp_Object halftail;
+
+  /* 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)
+    error ("Apparently circular structure being printed");
+
+  /* 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;
+    }
+
+  print_depth++;
+  halftail = obj;
 
  loop:
   if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
 
  loop:
   if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
@@ -1205,7 +1351,8 @@ print_preprocess (obj)
              {
                /* OBJ appears more than once.  Let's remember that.  */
                PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
              {
                /* 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.  */
              }
 
          /* OBJ is not yet recorded.  Let's add to the table.  */
@@ -1248,12 +1395,21 @@ print_preprocess (obj)
          break;
 
        case Lisp_Cons:
          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);
          print_preprocess (XCAR (obj));
          obj = XCDR (obj);
+         loop_count++;
+         if (!(loop_count & 1))
+           halftail = XCDR (halftail);
          goto loop;
 
        case Lisp_Vectorlike:
          goto loop;
 
        case Lisp_Vectorlike:
-         size = XVECTOR (obj)->size & PSEUDOVECTOR_SIZE_MASK;
+         size = XVECTOR (obj)->size;
+         if (size & PSEUDOVECTOR_FLAG)
+           size &= PSEUDOVECTOR_SIZE_MASK;
          for (i = 0; i < size; i++)
            print_preprocess (XVECTOR (obj)->contents[i]);
          break;
          for (i = 0; i < size; i++)
            print_preprocess (XVECTOR (obj)->contents[i]);
          break;
@@ -1262,6 +1418,7 @@ print_preprocess (obj)
          break;
        }
     }
          break;
        }
     }
+  print_depth--;
 }
 
 static void
 }
 
 static void
@@ -1278,7 +1435,7 @@ print_object (obj, printcharfun, escapeflag)
      register Lisp_Object printcharfun;
      int escapeflag;
 {
      register Lisp_Object printcharfun;
      int escapeflag;
 {
-  char buf[30];
+  char buf[40];
 
   QUIT;
 
 
   QUIT;
 
@@ -1332,6 +1489,7 @@ print_object (obj, printcharfun, escapeflag)
 
   print_depth++;
 
 
   print_depth++;
 
+  /* See similar code in print_preprocess.  */
   if (print_depth > PRINT_CIRCLE)
     error ("Apparently circular structure being printed");
 #ifdef MAX_PRINT_CHARS
   if (print_depth > PRINT_CIRCLE)
     error ("Apparently circular structure being printed");
 #ifdef MAX_PRINT_CHARS
@@ -1559,6 +1717,7 @@ print_object (obj, printcharfun, escapeflag)
          print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
        }
       else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
          print_object (XCAR (XCDR (obj)), printcharfun, escapeflag);
        }
       else if (print_quoted && CONSP (XCDR (obj)) && NILP (XCDR (XCDR (obj)))
+              && ! old_backquote_output
               && ((EQ (XCAR (obj), Qbackquote)
                    || EQ (XCAR (obj), Qcomma)
                    || EQ (XCAR (obj), Qcomma_at)
               && ((EQ (XCAR (obj), Qbackquote)
                    || EQ (XCAR (obj), Qcomma)
                    || EQ (XCAR (obj), Qcomma_at)
@@ -1570,6 +1729,29 @@ print_object (obj, printcharfun, escapeflag)
       else
        {
          PRINTCHAR ('(');
       else
        {
          PRINTCHAR ('(');
+
+         /* If the first element is a backquote form,
+            print it old-style so it won't be misunderstood.  */
+         if (print_quoted && CONSP (XCAR (obj))
+             && CONSP (XCDR (XCAR (obj)))
+             && NILP (XCDR (XCDR (XCAR (obj))))
+             && EQ (XCAR (XCAR (obj)), Qbackquote))
+           {
+             Lisp_Object tem;
+             tem = XCAR (obj);
+             PRINTCHAR ('(');
+
+             print_object (Qbackquote, printcharfun, 0);
+             PRINTCHAR (' ');
+
+             ++old_backquote_output;
+             print_object (XCAR (XCDR (tem)), printcharfun, 0);
+             --old_backquote_output;
+             PRINTCHAR (')');
+
+             obj = XCDR (obj);
+           }
+
          {
            int print_length, i;
            Lisp_Object halftail = obj;
          {
            int print_length, i;
            Lisp_Object halftail = obj;
@@ -1619,18 +1801,18 @@ print_object (obj, printcharfun, escapeflag)
                            }
                      }
                  }
                            }
                      }
                  }
-               
+
                if (i++)
                  PRINTCHAR (' ');
                if (i++)
                  PRINTCHAR (' ');
-               
+
                if (print_length && i > print_length)
                  {
                    strout ("...", 3, 3, printcharfun, 0);
                    goto end_of_list;
                  }
                if (print_length && i > print_length)
                  {
                    strout ("...", 3, 3, printcharfun, 0);
                    goto end_of_list;
                  }
-               
+
                print_object (XCAR (obj), printcharfun, escapeflag);
                print_object (XCAR (obj), printcharfun, escapeflag);
-               
+
                obj = XCDR (obj);
                if (!(i & 1))
                  halftail = XCDR (halftail);
                obj = XCDR (obj);
                if (!(i & 1))
                  halftail = XCDR (halftail);
@@ -1643,7 +1825,7 @@ print_object (obj, printcharfun, escapeflag)
              strout (" . ", 3, 3, printcharfun, 0);
              print_object (obj, printcharfun, escapeflag);
            }
              strout (" . ", 3, 3, printcharfun, 0);
              print_object (obj, printcharfun, escapeflag);
            }
-         
+
        end_of_list:
          PRINTCHAR (')');
        }
        end_of_list:
          PRINTCHAR (')');
        }
@@ -1667,13 +1849,14 @@ print_object (obj, printcharfun, escapeflag)
          register unsigned char c;
          struct gcpro gcpro1;
          int size_in_chars
          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 ('&');
 
          GCPRO1 (obj);
 
          PRINTCHAR ('#');
          PRINTCHAR ('&');
-         sprintf (buf, "%d", XBOOL_VECTOR (obj)->size);
+         sprintf (buf, "%ld", (long) XBOOL_VECTOR (obj)->size);
          strout (buf, -1, -1, printcharfun, 0);
          PRINTCHAR ('\"');
 
          strout (buf, -1, -1, printcharfun, 0);
          PRINTCHAR ('\"');
 
@@ -1698,6 +1881,14 @@ print_object (obj, printcharfun, escapeflag)
                  PRINTCHAR ('\\');
                  PRINTCHAR ('f');
                }
                  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 == '\\')
              else
                {
                  if (c == '\"' || c == '\\')
@@ -1718,7 +1909,7 @@ print_object (obj, printcharfun, escapeflag)
       else if (WINDOWP (obj))
        {
          strout ("#<window ", -1, -1, printcharfun, 0);
       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))
            {
          strout (buf, -1, -1, printcharfun, 0);
          if (!NILP (XWINDOW (obj)->buffer))
            {
@@ -1739,8 +1930,8 @@ print_object (obj, printcharfun, escapeflag)
              PRINTCHAR (' ');
              strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun, 0);
              PRINTCHAR (' ');
              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);
              strout (buf, -1, -1, printcharfun, 0);
            }
          sprintf (buf, " 0x%lx", (unsigned long) h);
@@ -1776,7 +1967,7 @@ print_object (obj, printcharfun, escapeflag)
        }
       else
        {
        }
       else
        {
-         int size = XVECTOR (obj)->size;
+         EMACS_INT size = XVECTOR (obj)->size;
          if (COMPILEDP (obj))
            {
              PRINTCHAR ('#');
          if (COMPILEDP (obj))
            {
              PRINTCHAR ('#');
@@ -1863,7 +2054,7 @@ print_object (obj, printcharfun, escapeflag)
          break;
 
        case Lisp_Misc_Intfwd:
          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;
 
          strout (buf, -1, -1, printcharfun, 0);
          break;
 
@@ -1928,6 +2119,15 @@ print_object (obj, printcharfun, escapeflag)
          PRINTCHAR ('>');
          break;
 
          PRINTCHAR ('>');
          break;
 
+       case Lisp_Misc_Save_Value:
+         strout ("#<save_value ", -1, -1, printcharfun, 0);
+         sprintf(buf, "ptr=0x%08lx int=%d",
+                 (unsigned long) XSAVE_VALUE (obj)->pointer,
+                 XSAVE_VALUE (obj)->integer);
+         strout (buf, -1, -1, printcharfun, 0);
+         PRINTCHAR ('>');
+         break;
+
        default:
          goto badtype;
        }
        default:
          goto badtype;
        }
@@ -2027,7 +2227,9 @@ Also print formfeeds as `\\f'.  */);
   DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii,
               doc: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
 \(OOO is the octal representation of the character code.)
   DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii,
               doc: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
 \(OOO is the octal representation of the character code.)
-Only single-byte characters are affected, and only in `prin1'.  */);
+Only single-byte characters are affected, and only in `prin1'.
+When the output goes in a multibyte buffer, this feature is
+enabled regardless of the value of the variable.  */);
   print_escape_nonascii = 0;
 
   DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte,
   print_escape_nonascii = 0;
 
   DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte,
@@ -2073,10 +2275,14 @@ This variable should not be set with `setq'; bind it with a `let' instead.  */);
   DEFVAR_LISP ("print-number-table", &Vprint_number_table,
               doc: /* A vector used internally to produce `#N=' labels and `#N#' references.
 The Lisp printer uses this vector to detect Lisp objects referenced more
   DEFVAR_LISP ("print-number-table", &Vprint_number_table,
               doc: /* A vector used internally to produce `#N=' labels and `#N#' references.
 The Lisp printer uses this vector to detect Lisp objects referenced more
-than once.  When `print-continuous-numbering' is bound to t, you should
-probably also bind `print-number-table' to nil.  This ensures that the
-value of `print-number-table' can be garbage-collected once the printing
-is done.  */);
+than once.
+
+When you bind `print-continuous-numbering' to t, you should probably
+also bind `print-number-table' to nil.  This ensures that the value of
+`print-number-table' can be garbage-collected once the printing is
+done.  If all elements of `print-number-table' are nil, it means that
+the printing done so far has not found any shared structure or objects
+that need to be recorded in the table.  */);
   Vprint_number_table = Qnil;
 
   /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
   Vprint_number_table = Qnil;
 
   /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
@@ -2090,6 +2296,9 @@ is done.  */);
   defsubr (&Sterpri);
   defsubr (&Swrite_char);
   defsubr (&Sexternal_debugging_output);
   defsubr (&Sterpri);
   defsubr (&Swrite_char);
   defsubr (&Sexternal_debugging_output);
+#ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
+  defsubr (&Sredirect_debugging_output);
+#endif
 
   Qexternal_debugging_output = intern ("external-debugging-output");
   staticpro (&Qexternal_debugging_output);
 
   Qexternal_debugging_output = intern ("external-debugging-output");
   staticpro (&Qexternal_debugging_output);
@@ -2105,3 +2314,6 @@ is done.  */);
 
   defsubr (&Swith_output_to_temp_buffer);
 }
 
   defsubr (&Swith_output_to_temp_buffer);
 }
+
+/* arch-tag: bc797170-94ae-41de-86e3-75e20f8f7a39
+   (do not change this comment) */