]> code.delx.au - gnu-emacs/blobdiff - src/print.c
(MINI_WINDOW_P): Use NILP.
[gnu-emacs] / src / print.c
index 3c560855b4165e5cc49856a409c57f7e8a89043e..4937660e5e6eef7b1fbc41eeb46f16d00a9f9eb3 100644 (file)
@@ -1,5 +1,5 @@
 /* Lisp object printing and output streams.
-   Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 1998
+   Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 2001
        Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
@@ -25,16 +25,13 @@ Boston, MA 02111-1307, USA.  */
 #include "lisp.h"
 #include "buffer.h"
 #include "charset.h"
+#include "keyboard.h"
 #include "frame.h"
 #include "window.h"
 #include "process.h"
 #include "dispextern.h"
 #include "termchar.h"
-#include "keyboard.h"
-
-#ifdef USE_TEXT_PROPERTIES
 #include "intervals.h"
-#endif
 
 Lisp_Object Vstandard_output, Qstandard_output;
 
@@ -43,7 +40,6 @@ Lisp_Object Qtemp_buffer_setup_hook;
 /* These are used to print like we read.  */
 extern Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
 
-#ifdef LISP_FLOAT_TYPE
 Lisp_Object Vfloat_output_format, Qfloat_output_format;
 
 /* Work around a problem that happens because math.h on hpux 7
@@ -60,7 +56,6 @@ Lisp_Object Vfloat_output_format, Qfloat_output_format;
 
 #if STDC_HEADERS
 #include <float.h>
-#include <stdlib.h>
 #endif
 
 /* Default to values appropriate for IEEE floating point.  */
@@ -93,8 +88,6 @@ Lisp_Object Vfloat_output_format, Qfloat_output_format;
 #define DOUBLE_DIGITS_BOUND ((int) ceil (log10 (pow (FLT_RADIX, DBL_MANT_DIG))))
 #endif
 
-#endif /* LISP_FLOAT_TYPE */
-
 /* Avoid actual stack overflow in print.  */
 int print_depth;
 
@@ -197,8 +190,8 @@ void print_interval ();
 
 #define PRINTDECLARE                                                   \
    struct buffer *old = current_buffer;                                        \
-   int old_point = -1, start_point;                                    \
-   int old_point_byte, start_point_byte;                               \
+   int old_point = -1, start_point = -1;                               \
+   int old_point_byte = -1, start_point_byte = -1;                     \
    int specpdl_count = specpdl_ptr - specpdl;                          \
    int free_print_buffer = 0;                                          \
    int multibyte = !NILP (current_buffer->enable_multibyte_characters);        \
@@ -252,7 +245,7 @@ void print_interval ();
        print_buffer_pos = 0;                                           \
        print_buffer_pos_byte = 0;                                      \
      }                                                                 \
-   if (EQ (printcharfun, Qt))                                          \
+   if (EQ (printcharfun, Qt) && ! noninteractive)                      \
      setup_echo_area_for_printing (multibyte);
 
 #define PRINTFINISH                                                    \
@@ -290,13 +283,6 @@ void print_interval ();
 
 #define PRINTCHAR(ch) printchar (ch, printcharfun)
 
-/* Nonzero if there is no room to print any more characters
-   so print might as well return right away.  */
-
-#define PRINTFULLP()                                   \
- (EQ (printcharfun, Qt) && !noninteractive             \
-  && printbufidx >= FRAME_WIDTH (XFRAME (WINDOW_FRAME (XWINDOW (minibuf_window)))))
-
 /* This is used to restore the saved contents of print_buffer
    when there is a recursive call to print.  */
 
@@ -305,6 +291,7 @@ print_unwind (saved_text)
      Lisp_Object saved_text;
 {
   bcopy (XSTRING (saved_text)->data, print_buffer, XSTRING (saved_text)->size);
+  return Qnil;
 }
 
 
@@ -327,9 +314,9 @@ printchar (ch, fun)
     call1 (fun, make_number (ch));
   else
     {
-      unsigned char work[4], *str;
-      int len = CHAR_STRING (ch, work, str);
-    
+      unsigned char str[MAX_MULTIBYTE_LENGTH];
+      int len = CHAR_STRING (ch, str);
+
       QUIT;
       
       if (NILP (fun))
@@ -351,9 +338,7 @@ printchar (ch, fun)
          int multibyte_p
            = !NILP (current_buffer->enable_multibyte_characters);
          
-         if (!message_buf_print)
-           setup_echo_area_for_printing (multibyte_p);
-
+         setup_echo_area_for_printing (multibyte_p);
          insert_char (ch);
          message_dolog (str, len, 0, multibyte_p);
        }
@@ -396,7 +381,7 @@ strout (ptr, size, size_byte, printcharfun, multibyte)
         print_chars += size;
 #endif /* MAX_PRINT_CHARS */
     }
-  else if (noninteractive)
+  else if (noninteractive && EQ (printcharfun, Qt))
     {
       fwrite (ptr, 1, size_byte, stdout);
       noninteractive_need_newline = 1;
@@ -410,15 +395,13 @@ strout (ptr, size, size_byte, printcharfun, multibyte)
       int multibyte_p
        = !NILP (current_buffer->enable_multibyte_characters);
       
-      if (!message_buf_print)
-       setup_echo_area_for_printing (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)
-           insert_char (*ptr++);
+           insert_char ((unsigned char )*ptr++);
        }
       else
        {
@@ -482,8 +465,23 @@ print_string (string, printcharfun)
       else if (EQ (printcharfun, Qt)
               ? ! NILP (buffer_defaults.enable_multibyte_characters)
               : ! NILP (current_buffer->enable_multibyte_characters))
-       chars = multibyte_chars_in_text (XSTRING (string)->data,
-                                        STRING_BYTES (XSTRING (string)));
+       {
+         /* If unibyte string STRING contains 8-bit codes, we must
+            convert STRING to a multibyte string containing the same
+            character codes.  */
+         Lisp_Object newstr;
+         int bytes;
+
+         chars = STRING_BYTES (XSTRING (string));
+         bytes = parse_str_to_multibyte (XSTRING (string)->data, chars);
+         if (chars < bytes)
+           {
+             newstr = make_uninit_multibyte_string (chars, bytes);
+             bcopy (XSTRING (string)->data, XSTRING (newstr)->data, chars);
+             str_to_multibyte (XSTRING (newstr)->data, bytes, chars);
+             string = newstr;
+           }
+       }
       else
        chars = STRING_BYTES (XSTRING (string));
 
@@ -601,7 +599,8 @@ temp_output_buffer_setup (bufname)
   Ferase_buffer ();
   XSETBUFFER (buf, current_buffer);
 
-  call1 (Vrun_hooks, Qtemp_buffer_setup_hook);
+  if (!NILP (Vrun_hooks))
+    call1 (Vrun_hooks, Qtemp_buffer_setup_hook);
 
   unbind_to (count, Qnil);
 
@@ -677,9 +676,7 @@ buffer and calling the hook.  It gets one argument, the buffer to display.")
 \f
 static void print ();
 static void print_preprocess ();
-#ifdef USE_TEXT_PROPERTIES
 static void print_preprocess_string ();
-#endif /* USE_TEXT_PROPERTIES */
 static void print_object ();
 
 DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
@@ -702,7 +699,24 @@ DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0,
   "Output the printed representation of OBJECT, any Lisp object.\n\
 Quoting characters are printed when needed to make output that `read'\n\
 can handle, whenever this is possible.\n\
-Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
+\n\
+OBJECT is any of the Lisp data types: a number, a string, a symbol,\n\
+a list, a buffer, a window, a frame, etc.\n\
+\n\
+A printed representation of an object is text which describes that object.\n\
+\n\
+Optional argument PRINTCHARFUN is the output stream, which can be one\n\
+of these:\n\
+\n\
+   - a buffer, in which case output is inserted into that buffer at point;\n\
+   - a marker, in which case output is inserted at marker's position;\n\
+   - a function, in which case that function is called once for each\n\
+     character of OBJECT's printed representation;\n\
+   - a symbol, in which case that symbol's function definition is called; or\n\
+   - t, in which case the output is displayed in the echo area.\n\
+\n\
+If PRINTCHARFUN is omitted, the value of `standard-output' (which see)\n\
+is used instead.")
   (object, printcharfun)
      Lisp_Object object, printcharfun;
 {
@@ -726,7 +740,12 @@ DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0,
   "Return a string containing the printed representation of OBJECT,\n\
 any Lisp object.  Quoting characters are used when needed to make output\n\
 that `read' can handle, whenever this is possible, unless the optional\n\
-second argument NOESCAPE is non-nil.")
+second argument NOESCAPE is non-nil.\n\
+\n\
+OBJECT is any of the Lisp data types: a number, a string, a symbol,\n\
+a list, a buffer, a window, a frame, etc.\n\
+\n\
+A printed representation of an object is text which describes that object.")
   (object, noescape)
      Lisp_Object object, noescape;
 {
@@ -762,7 +781,24 @@ DEFUN ("princ", Fprinc, Sprinc, 1, 2, 0,
   "Output the printed representation of OBJECT, any Lisp object.\n\
 No quoting characters are used; no delimiters are printed around\n\
 the contents of strings.\n\
-Output stream is PRINTCHARFUN, or value of standard-output (which see).")
+\n\
+OBJECT is any of the Lisp data types: a number, a string, a symbol,\n\
+a list, a buffer, a window, a frame, etc.\n\
+\n\
+A printed representation of an object is text which describes that object.\n\
+\n\
+Optional argument PRINTCHARFUN is the output stream, which can be one\n\
+of these:\n\
+\n\
+   - a buffer, in which case output is inserted into that buffer at point;\n\
+   - a marker, in which case output is inserted at marker's position;\n\
+   - a function, in which case that function is called once for each\n\
+     character of OBJECT's printed representation;\n\
+   - a symbol, in which case that symbol's function definition is called; or\n\
+   - t, in which case the output is displayed in the echo area.\n\
+\n\
+If PRINTCHARFUN is omitted, the value of `standard-output' (which see)\n\
+is used instead.")
   (object, printcharfun)
      Lisp_Object object, printcharfun;
 {
@@ -780,7 +816,24 @@ DEFUN ("print", Fprint, Sprint, 1, 2, 0,
   "Output the printed representation of OBJECT, with newlines around it.\n\
 Quoting characters are printed when needed to make output that `read'\n\
 can handle, whenever this is possible.\n\
-Output stream is PRINTCHARFUN, or value of `standard-output' (which see).")
+\n\
+OBJECT is any of the Lisp data types: a number, a string, a symbol,\n\
+a list, a buffer, a window, a frame, etc.\n\
+\n\
+A printed representation of an object is text which describes that object.\n\
+\n\
+Optional argument PRINTCHARFUN is the output stream, which can be one\n\
+of these:\n\
+\n\
+   - a buffer, in which case output is inserted into that buffer at point;\n\
+   - a marker, in which case output is inserted at marker's position;\n\
+   - a function, in which case that function is called once for each\n\
+     character of OBJECT's printed representation;\n\
+   - a symbol, in which case that symbol's function definition is called; or\n\
+   - t, in which case the output is displayed in the echo area.\n\
+\n\
+If PRINTCHARFUN is omitted, the value of `standard-output' (which see)\n\
+is used instead.")
   (object, printcharfun)
      Lisp_Object object, printcharfun;
 {
@@ -849,7 +902,7 @@ DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
      Lisp_Object obj;
 {
   struct buffer *old = current_buffer;
-  Lisp_Object original, printcharfun, value;
+  Lisp_Object value;
   struct gcpro gcpro1;
 
   /* If OBJ is (error STRING), just return STRING.
@@ -874,8 +927,8 @@ DEFUN ("error-message-string", Ferror_message_string, Serror_message_string,
   return value;
 }
 
-/* Print an error message for the error DATA
-   onto Lisp output stream STREAM (suitable for the print functions).  */
+/* Print an error message for the error DATA onto Lisp output stream
+   STREAM (suitable for the print functions).  */
 
 void
 print_error_message (data, stream)
@@ -890,15 +943,17 @@ print_error_message (data, stream)
   if (EQ (errname, Qerror))
     {
       data = Fcdr (data);
-      if (!CONSP (data)) data = Qnil;
+      if (!CONSP (data))
+       data = Qnil;
       errmsg = Fcar (data);
       file_error = Qnil;
     }
   else
     {
+      Lisp_Object error_conditions;
       errmsg = Fget (errname, Qerror_message);
-      file_error = Fmemq (Qfile_error,
-                         Fget (errname, Qerror_conditions));
+      error_conditions = Fget (errname, Qerror_conditions);
+      file_error = Fmemq (Qfile_error, error_conditions);
     }
 
   /* Print an error message including the data items.  */
@@ -906,6 +961,16 @@ print_error_message (data, stream)
   tail = Fcdr_safe (data);
   GCPRO1 (tail);
 
+  /* If we know from where the error was signaled, show it in
+     *Messages*.  */
+  if (!NILP (Vsignaling_function) && SYMBOLP (Vsignaling_function))
+    {
+      char *name = XSYMBOL (Vsignaling_function)->name->data;
+      message_dolog (name, strlen (name), 0, 0);
+      message_dolog (": ", 2, 0, 0);
+      Vsignaling_function = Qnil;
+    }
+
   /* For file-error, make error message by concatenating
      all the data items.  They are all strings.  */
   if (!NILP (file_error) && CONSP (tail))
@@ -916,19 +981,23 @@ print_error_message (data, stream)
   else
     write_string_1 ("peculiar error", -1, stream);
 
-  for (i = 0; CONSP (tail); tail = Fcdr (tail), i++)
+  for (i = 0; CONSP (tail); tail = XCDR (tail), i++)
     {
+      Lisp_Object obj;
+
       write_string_1 (i ? ", " : ": ", 2, stream);
-      if (!NILP (file_error))
-       Fprinc (Fcar (tail), stream);
+      obj = XCAR (tail);
+      if (!NILP (file_error) || EQ (errname, Qend_of_file))
+       Fprinc (obj, stream);
       else
-       Fprin1 (Fcar (tail), stream);
+       Fprin1 (obj, stream);
     }
+  
   UNGCPRO;
 }
-\f
-#ifdef LISP_FLOAT_TYPE
 
+
+\f
 /*
  * The buffer should be at least as large as the max string size of the
  * largest float, printed in the biggest notation.  This is undoubtedly
@@ -967,6 +1036,19 @@ float_to_string (buf, data)
   /* Check for NaN in a way that won't fail if there are no NaNs.  */
   if (! (data * 0.0 >= 0.0))
     {
+      /* Prepend "-" if the NaN's sign bit is negative.
+        The sign bit of a double is the bit that is 1 in -0.0.  */
+      int i;
+      union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
+      u_data.d = data;
+      u_minus_zero.d = - 0.0;
+      for (i = 0; i < sizeof (double); i++)
+       if (u_data.c[i] & u_minus_zero.c[i])
+         {
+           *buf++ = '-';
+           break;
+         }
+      
       strcpy (buf, "0.0e+NaN");
       return;
     }
@@ -1053,7 +1135,7 @@ float_to_string (buf, data)
        }
     }
 }
-#endif /* LISP_FLOAT_TYPE */
+
 \f
 static void
 print (obj, printcharfun, escapeflag)
@@ -1076,12 +1158,13 @@ print (obj, printcharfun, escapeflag)
   /* Construct Vprint_number_table for print-gensym and print-circle.  */
   if (!NILP (Vprint_gensym) || !NILP (Vprint_circle))
     {
-      int i, index = 0;
+      int i, start, index;
       /* Construct Vprint_number_table.  */
+      start = index = print_number_index;
       print_preprocess (obj);
       /* Remove unnecessary objects, which appear only once in OBJ;
         that is, whose status is Qnil.  */
-      for (i = 0; i < print_number_index; 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)
@@ -1114,47 +1197,58 @@ print_preprocess (obj)
   if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
       || COMPILEDP (obj) || CHAR_TABLE_P (obj)
       || (! NILP (Vprint_gensym)
-         && SYMBOLP (obj) && NILP (XSYMBOL (obj)->obarray)))
+         && SYMBOLP (obj)
+         && !SYMBOL_INTERNED_P (obj)))
     {
-      for (i = 0; i < print_number_index; i++)
-       if (PRINT_NUMBER_OBJECT (Vprint_number_table, i) == obj)
-         {
-           /* OBJ appears more than once.  Let's remember that.  */
-           PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
-           return;
-         }
-
-      /* OBJ is not yet recorded.  Let's add to the table.  */
-      if (print_number_index == 0)
+      /* In case print-circle is nil and print-gensym is t,
+        add OBJ to Vprint_number_table only when OBJ is a symbol.  */
+      if (! NILP (Vprint_circle) || SYMBOLP (obj))
        {
-         /* Initialize the table.  */
-         Vprint_number_table = Fmake_vector (make_number (40), Qnil);
-       }
-      else if (XVECTOR (Vprint_number_table)->size == print_number_index * 2)
-       {
-         /* Reallocate the table.  */
-         int i = print_number_index * 4;
-         Lisp_Object old_table = Vprint_number_table;
-         Vprint_number_table = Fmake_vector (make_number (i), Qnil);
          for (i = 0; i < print_number_index; i++)
+           if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj))
+             {
+               /* OBJ appears more than once.  Let's remember that.  */
+               PRINT_NUMBER_STATUS (Vprint_number_table, i) = Qt;
+               return;
+             }
+
+         /* OBJ is not yet recorded.  Let's add to the table.  */
+         if (print_number_index == 0)
+           {
+             /* Initialize the table.  */
+             Vprint_number_table = Fmake_vector (make_number (40), Qnil);
+           }
+         else if (XVECTOR (Vprint_number_table)->size == print_number_index * 2)
            {
-             PRINT_NUMBER_OBJECT (Vprint_number_table, i)
-               = PRINT_NUMBER_OBJECT (old_table, i);
-             PRINT_NUMBER_STATUS (Vprint_number_table, i)
-               = PRINT_NUMBER_STATUS (old_table, i);
+             /* Reallocate the table.  */
+             int i = print_number_index * 4;
+             Lisp_Object old_table = Vprint_number_table;
+             Vprint_number_table = Fmake_vector (make_number (i), Qnil);
+             for (i = 0; i < print_number_index; i++)
+               {
+                 PRINT_NUMBER_OBJECT (Vprint_number_table, i)
+                   = PRINT_NUMBER_OBJECT (old_table, i);
+                 PRINT_NUMBER_STATUS (Vprint_number_table, i)
+                   = PRINT_NUMBER_STATUS (old_table, i);
+               }
            }
+         PRINT_NUMBER_OBJECT (Vprint_number_table, print_number_index) = obj;
+         /* If Vprint_continuous_numbering is non-nil and OBJ is a gensym,
+            always print the gensym with a number.  This is a special for
+            the lisp function byte-compile-output-docform.  */
+         if (!NILP (Vprint_continuous_numbering)
+             && SYMBOLP (obj)
+             && !SYMBOL_INTERNED_P (obj))
+           PRINT_NUMBER_STATUS (Vprint_number_table, print_number_index) = Qt;
+         print_number_index++;
        }
-      PRINT_NUMBER_OBJECT (Vprint_number_table, print_number_index) = obj;
-      print_number_index++;
 
       switch (XGCTYPE (obj))
        {
        case Lisp_String:
-#ifdef USE_TEXT_PROPERTIES
          /* A string may have text properties, which can be circular.  */
          traverse_intervals (XSTRING (obj)->intervals, 0, 0,
                              print_preprocess_string, Qnil);
-#endif /* USE_TEXT_PROPERTIES */
          break;
 
        case Lisp_Cons:
@@ -1166,11 +1260,14 @@ print_preprocess (obj)
          size = XVECTOR (obj)->size & PSEUDOVECTOR_SIZE_MASK;
          for (i = 0; i < size; i++)
            print_preprocess (XVECTOR (obj)->contents[i]);
+         break;
+
+       default:
+         break;
        }
     }
 }
 
-#ifdef USE_TEXT_PROPERTIES
 static void
 print_preprocess_string (interval, arg)
      INTERVAL interval;
@@ -1178,7 +1275,6 @@ print_preprocess_string (interval, arg)
 {
   print_preprocess (interval->plist);
 }
-#endif /* USE_TEXT_PROPERTIES */
 
 static void
 print_object (obj, printcharfun, escapeflag)
@@ -1194,7 +1290,8 @@ print_object (obj, printcharfun, escapeflag)
   if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
       || COMPILEDP (obj) || CHAR_TABLE_P (obj)
       || (! NILP (Vprint_gensym)
-         && SYMBOLP (obj) && NILP (XSYMBOL (obj)->obarray)))
+         && SYMBOLP (obj)
+         && !SYMBOL_INTERNED_P (obj)))
     {
       if (NILP (Vprint_circle) && NILP (Vprint_gensym))
        {
@@ -1214,7 +1311,7 @@ print_object (obj, printcharfun, escapeflag)
          /* With the print-circle feature.  */
          int i;
          for (i = 0; i < print_number_index; i++)
-           if (PRINT_NUMBER_OBJECT (Vprint_number_table, i) == obj)
+           if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i), obj))
              {
                if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
                  {
@@ -1255,13 +1352,12 @@ print_object (obj, printcharfun, escapeflag)
       if (sizeof (int) == sizeof (EMACS_INT))
        sprintf (buf, "%d", XINT (obj));
       else if (sizeof (long) == sizeof (EMACS_INT))
-       sprintf (buf, "%ld", XINT (obj));
+       sprintf (buf, "%ld", (long) XINT (obj));
       else
        abort ();
       strout (buf, -1, -1, printcharfun, 0);
       break;
 
-#ifdef LISP_FLOAT_TYPE
     case Lisp_Float:
       {
        char pigbuf[350];       /* see comments in float_to_string */
@@ -1270,7 +1366,6 @@ print_object (obj, printcharfun, escapeflag)
        strout (pigbuf, -1, -1, printcharfun, 0);
       }
       break;
-#endif
 
     case Lisp_String:
       if (!escapeflag)
@@ -1278,7 +1373,6 @@ print_object (obj, printcharfun, escapeflag)
       else
        {
          register int i, i_byte;
-         register unsigned char c;
          struct gcpro gcpro1;
          unsigned char *str;
          int size_byte;
@@ -1288,13 +1382,11 @@ print_object (obj, printcharfun, escapeflag)
 
          GCPRO1 (obj);
 
-#ifdef USE_TEXT_PROPERTIES
          if (!NULL_INTERVAL_P (XSTRING (obj)->intervals))
            {
              PRINTCHAR ('#');
              PRINTCHAR ('(');
            }
-#endif
 
          PRINTCHAR ('\"');
          str = XSTRING (obj)->data;
@@ -1372,14 +1464,12 @@ print_object (obj, printcharfun, escapeflag)
            }
          PRINTCHAR ('\"');
 
-#ifdef USE_TEXT_PROPERTIES
          if (!NULL_INTERVAL_P (XSTRING (obj)->intervals))
            {
              traverse_intervals (XSTRING (obj)->intervals,
                                  0, 0, print_interval, printcharfun);
              PRINTCHAR (')');
            }
-#endif
 
          UNGCPRO;
        }
@@ -1418,7 +1508,7 @@ print_object (obj, printcharfun, escapeflag)
        else
          confusing = 0;
 
-       if (! NILP (Vprint_gensym) && NILP (XSYMBOL (obj)->obarray))
+       if (! NILP (Vprint_gensym) && !SYMBOL_INTERNED_P (obj))
          {
            PRINTCHAR ('#');
            PRINTCHAR (':');
@@ -1430,12 +1520,7 @@ print_object (obj, printcharfun, escapeflag)
          {
            /* Here, we must convert each multi-byte form to the
               corresponding character code before handing it to PRINTCHAR.  */
-
-           if (STRING_MULTIBYTE (name))
-             FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte);
-           else
-             c = XSTRING (name)->data[i_byte++];
-
+           FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte);
            QUIT;
 
            if (escapeflag)
@@ -1483,12 +1568,17 @@ print_object (obj, printcharfun, escapeflag)
        {
          PRINTCHAR ('(');
          {
-           register int i = 0;
-           register int print_length = 0;
+           int print_length, i;
            Lisp_Object halftail = obj;
 
-           if (INTEGERP (Vprint_length))
-             print_length = XINT (Vprint_length);
+           /* Negative values of print-length are invalid in CL.
+              Treat them like nil, as CMUCL does.  */
+           if (NATNUMP (Vprint_length))
+             print_length = XFASTINT (Vprint_length);
+           else
+             print_length = 0;
+
+           i = 0;
            while (CONSP (obj))
              {
                /* Detect circular list.  */
@@ -1509,7 +1599,8 @@ print_object (obj, printcharfun, escapeflag)
                      {
                        int i;
                        for (i = 0; i < print_number_index; i++)
-                         if (PRINT_NUMBER_OBJECT (Vprint_number_table, i) == obj)
+                         if (EQ (PRINT_NUMBER_OBJECT (Vprint_number_table, i),
+                                 obj))
                            {
                              if (NILP (PRINT_NUMBER_STATUS (Vprint_number_table, i)))
                                {
@@ -1525,24 +1616,31 @@ print_object (obj, printcharfun, escapeflag)
                            }
                      }
                  }
+               
                if (i++)
                  PRINTCHAR (' ');
+               
                if (print_length && i > print_length)
                  {
                    strout ("...", 3, 3, printcharfun, 0);
                    goto end_of_list;
                  }
+               
                print_object (XCAR (obj), printcharfun, escapeflag);
+               
                obj = XCDR (obj);
                if (!(i & 1))
                  halftail = XCDR (halftail);
              }
          }
+
+         /* OBJ non-nil here means it's the end of a dotted list.  */
          if (!NILP (obj))
            {
              strout (" . ", 3, 3, printcharfun, 0);
              print_object (obj, printcharfun, escapeflag);
            }
+         
        end_of_list:
          PRINTCHAR (')');
        }
@@ -1576,10 +1674,12 @@ print_object (obj, printcharfun, escapeflag)
          strout (buf, -1, -1, printcharfun, 0);
          PRINTCHAR ('\"');
 
-         /* Don't print more characters than the specified maximum.  */
-         if (INTEGERP (Vprint_length)
-             && XINT (Vprint_length) < size_in_chars)
-           size_in_chars = XINT (Vprint_length);
+         /* Don't print more characters than the specified maximum.
+            Negative values of print-length are invalid.  Treat them
+            like a print-length of nil.  */
+         if (NATNUMP (Vprint_length)
+             && XFASTINT (Vprint_length) < size_in_chars)
+           size_in_chars = XFASTINT (Vprint_length);
 
          for (i = 0; i < size_in_chars; i++)
            {
@@ -1697,11 +1797,12 @@ print_object (obj, printcharfun, escapeflag)
          {
            register int i;
            register Lisp_Object tem;
+           int real_size = size;
 
            /* Don't print more elements than the specified maximum.  */
-           if (INTEGERP (Vprint_length)
-               && XINT (Vprint_length) < size)
-             size = XINT (Vprint_length);
+           if (NATNUMP (Vprint_length)
+               && XFASTINT (Vprint_length) < size)
+             size = XFASTINT (Vprint_length);
 
            for (i = 0; i < size; i++)
              {
@@ -1709,6 +1810,8 @@ print_object (obj, printcharfun, escapeflag)
                tem = XVECTOR (obj)->contents[i];
                print_object (tem, printcharfun, escapeflag);
              }
+           if (size < real_size)
+             strout (" ...", 4, 4, printcharfun, 0);
          }
          PRINTCHAR (']');
        }
@@ -1775,9 +1878,9 @@ print_object (obj, printcharfun, escapeflag)
 
        case Lisp_Misc_Buffer_Objfwd:
          strout ("#<buffer_objfwd to ", -1, -1, printcharfun, 0);
-         print_object (*(Lisp_Object *)((char *)current_buffer
-                                        + XBUFFER_OBJFWD (obj)->offset),
-                printcharfun, escapeflag);
+         print_object (PER_BUFFER_VALUE (current_buffer,
+                                         XBUFFER_OBJFWD (obj)->offset),
+                       printcharfun, escapeflag);
          PRINTCHAR ('>');
          break;
 
@@ -1785,7 +1888,7 @@ print_object (obj, printcharfun, escapeflag)
          strout ("#<kboard_objfwd to ", -1, -1, printcharfun, 0);
          print_object (*(Lisp_Object *)((char *) current_kboard
                                         + XKBOARD_OBJFWD (obj)->offset),
-                printcharfun, escapeflag);
+                       printcharfun, escapeflag);
          PRINTCHAR ('>');
          break;
 
@@ -1848,7 +1951,6 @@ print_object (obj, printcharfun, escapeflag)
   print_depth--;
 }
 \f
-#ifdef USE_TEXT_PROPERTIES
 
 /* Print a description of INTERVAL using PRINTCHARFUN.
    This is part of printing a string that has text properties.  */
@@ -1867,7 +1969,6 @@ print_interval (interval, printcharfun)
   print_object (interval->plist, printcharfun, 1);
 }
 
-#endif /* USE_TEXT_PROPERTIES */
 \f
 void
 syms_of_print ()
@@ -1885,7 +1986,6 @@ or the symbol t (output appears in the echo area).");
   Qstandard_output = intern ("standard-output");
   staticpro (&Qstandard_output);
 
-#ifdef LISP_FLOAT_TYPE
   DEFVAR_LISP ("float-output-format", &Vfloat_output_format,
     "The format descriptor string used to print floats.\n\
 This is a %-spec like those accepted by `printf' in C,\n\
@@ -1904,21 +2004,20 @@ that represents the number without losing information.");
   Vfloat_output_format = Qnil;
   Qfloat_output_format = intern ("float-output-format");
   staticpro (&Qfloat_output_format);
-#endif /* LISP_FLOAT_TYPE */
 
   DEFVAR_LISP ("print-length", &Vprint_length,
     "Maximum length of list to print before abbreviating.\n\
-A value of nil means no limit.");
+A value of nil means no limit.  See also `eval-expression-print-length'.");
   Vprint_length = Qnil;
 
   DEFVAR_LISP ("print-level", &Vprint_level,
     "Maximum depth of list nesting to print before abbreviating.\n\
-A value of nil means no limit.");
+A value of nil means no limit.  See also `eval-expression-print-level'.");
   Vprint_level = Qnil;
 
   DEFVAR_BOOL ("print-escape-newlines", &print_escape_newlines,
-    "Non-nil means print newlines in strings as backslash-n.\n\
-Also print formfeeds as backslash-f.");
+    "Non-nil means print newlines in strings as `\\n'.\n\
+Also print formfeeds as `\\f'.");
   print_escape_newlines = 0;
 
   DEFVAR_BOOL ("print-escape-nonascii", &print_escape_nonascii,
@@ -1929,20 +2028,20 @@ Only single-byte characters are affected, and only in `prin1'.");
 
   DEFVAR_BOOL ("print-escape-multibyte", &print_escape_multibyte,
     "Non-nil means print multibyte characters in strings as \\xXXXX.\n\
-\(XXX is the hex representation of the character code.)\n\
+\(XXXX is the hex representation of the character code.)\n\
 This affects only `prin1'.");
   print_escape_multibyte = 0;
 
   DEFVAR_BOOL ("print-quoted", &print_quoted,
     "Non-nil means print quoted forms with reader syntax.\n\
-I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and, backquoted\n\
-forms print in the new syntax.");
+I.e., (quote foo) prints as 'foo, (function foo) as #'foo, and backquoted\n\
+forms print as in the new syntax.");
   print_quoted = 0;
 
   DEFVAR_LISP ("print-gensym", &Vprint_gensym,
     "Non-nil means print uninterned symbols so they will read as uninterned.\n\
 I.e., the value of (make-symbol \"foobar\") prints as #:foobar.\n\
-When the uninterned symbol appears within a recursive data structure\n\
+When the uninterned symbol appears within a recursive data structure,\n\
 and the symbol appears more than once, in addition use the #N# and #N=\n\
 constructs as needed, so that multiple references to the same symbol are\n\
 shared once again when the text is read back.");
@@ -1961,15 +2060,19 @@ where N is a positive decimal integer.");
   Vprint_circle = Qnil;
 
   DEFVAR_LISP ("print-continuous-numbering", &Vprint_continuous_numbering,
-  "*Non-nil means keep numbering between several print functions.\n\
-See `print-gensym' nad `print-circle'.  See also `print-number-table'.");
+  "*Non-nil means number continuously across print calls.\n\
+This affects the numbers printed for #N= labels and #M# references.\n\
+See also `print-circle', `print-gensym', and `print-number-table'.\n\
+This variable should not be set with `setq'; bind it with a `let' instead.");
   Vprint_continuous_numbering = Qnil;
 
   DEFVAR_LISP ("print-number-table", &Vprint_number_table,
-  "A vector keeping the information of the current printed object.\n\
-This variable shouldn't be modified in Lisp level, but should be binded\n\
-with nil using let at the same position with `print-continuous-numbering',\n\
-so that the value of this variable can be freed after printing.");
+  "A vector used internally to produce `#N=' labels and `#N#' references.\n\
+The Lisp printer uses this vector to detect Lisp objects referenced more\n\
+than once.  When `print-continuous-numbering' is bound to t, you should\n\
+probably also bind `print-number-table' to nil.  This ensures that the\n\
+value of `print-number-table' can be garbage-collected once the printing\n\
+is done.");
   Vprint_number_table = Qnil;
 
   /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */