]> code.delx.au - gnu-emacs/blobdiff - src/print.c
Fix typo in previous change's ChangeLog.
[gnu-emacs] / src / print.c
index e3c56a6de62f466d5056b7385fc8d20eb21922c2..57fac7af378c1a541be42dff0e52aa24097df72b 100644 (file)
@@ -1,6 +1,6 @@
 /* Lisp object printing and output streams.
 
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2013 Free Software
+Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2014 Free Software
 Foundation, Inc.
 
 This file is part of GNU Emacs.
@@ -709,17 +709,36 @@ You can call print while debugging emacs, and pass it this function
 to make it write to the debugging output.  */)
   (Lisp_Object character)
 {
-  CHECK_NUMBER (character);
-  putc (XINT (character) & 0xFF, stderr);
+  unsigned int ch;
 
-#ifdef WINDOWSNT
-  /* Send the output to a debugger (nothing happens if there isn't one).  */
-  if (print_output_debug_flag)
+  CHECK_NUMBER (character);
+  ch = XINT (character);
+  if (ASCII_CHAR_P (ch))
     {
-      char buf[2] = {(char) XINT (character), '\0'};
-      OutputDebugString (buf);
+      putc (ch, stderr);
+#ifdef WINDOWSNT
+      /* Send the output to a debugger (nothing happens if there isn't
+        one).  */
+      if (print_output_debug_flag)
+       {
+         char buf[2] = {(char) XINT (character), '\0'};
+         OutputDebugString (buf);
+       }
+#endif
     }
+  else
+    {
+      unsigned char mbstr[MAX_MULTIBYTE_LENGTH];
+      ptrdiff_t len = CHAR_STRING (ch, mbstr);
+      Lisp_Object encoded_ch =
+       ENCODE_SYSTEM (make_multibyte_string ((char *) mbstr, 1, len));
+
+      fwrite (SSDATA (encoded_ch), SBYTES (encoded_ch), 1, stderr);
+#ifdef WINDOWSNT
+      if (print_output_debug_flag)
+       OutputDebugString (SSDATA (encoded_ch));
 #endif
+    }
 
   return character;
 }
@@ -1119,7 +1138,7 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
    string (its text properties will be traced), or a symbol that has
    no obarray (this is for the print-gensym feature).
    The status fields of Vprint_number_table mean whether each object appears
-   more than once in OBJ: Qnil at the first time, and Qt after that .  */
+   more than once in OBJ: Qnil at the first time, and Qt after that.  */
 static void
 print_preprocess (Lisp_Object obj)
 {
@@ -1209,7 +1228,8 @@ print_preprocess (Lisp_Object obj)
          size = ASIZE (obj);
          if (size & PSEUDOVECTOR_FLAG)
            size &= PSEUDOVECTOR_SIZE_MASK;
-         for (i = 0; i < size; i++)
+         for (i = (SUB_CHAR_TABLE_P (obj)
+                   ? SUB_CHAR_TABLE_OFFSET : 0); i < size; i++)
            print_preprocess (AREF (obj, i));
          if (HASH_TABLE_P (obj))
            { /* For hash tables, the key_and_value slot is past
@@ -1389,9 +1409,8 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
        print_string (obj, printcharfun);
       else
        {
-         register ptrdiff_t i_byte;
+         register ptrdiff_t i, i_byte;
          struct gcpro gcpro1;
-         unsigned char *str;
          ptrdiff_t size_byte;
          /* 1 means we must ensure that the next character we output
             cannot be taken as part of a hex character escape.  */
@@ -1410,23 +1429,15 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
            }
 
          PRINTCHAR ('\"');
-         str = SDATA (obj);
          size_byte = SBYTES (obj);
 
-         for (i_byte = 0; i_byte < size_byte;)
+         for (i = 0, i_byte = 0; i_byte < size_byte;)
            {
              /* Here, we must convert each multi-byte form to the
                 corresponding character code before handing it to PRINTCHAR.  */
-             int len;
              int c;
 
-             if (multibyte)
-               {
-                 c = STRING_CHAR_AND_LENGTH (str + i_byte, len);
-                 i_byte += len;
-               }
-             else
-               c = str[i_byte++];
+             FETCH_STRING_CHAR_ADVANCE (c, obj, i, i_byte);
 
              QUIT;
 
@@ -1462,7 +1473,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
                  strout (outbuf, len, len, printcharfun);
                }
              else if (! multibyte
-                      && SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c)
+                      && SINGLE_BYTE_CHAR_P (c) && ! ASCII_CHAR_P (c)
                       && print_escape_nonascii)
                {
                  /* When printing in a multibyte buffer
@@ -1766,8 +1777,9 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
        }
       else if (WINDOWP (obj))
        {
-         void *ptr = XWINDOW (obj);
-         int len = sprintf (buf, "#<window %p", ptr);
+         int len;
+         strout ("#<window ", -1, -1, printcharfun);
+         len = sprintf (buf, "%d", XWINDOW (obj)->sequence_number);
          strout (buf, len, len, printcharfun);
          if (BUFFERP (XWINDOW (obj)->contents))
            {
@@ -1957,7 +1969,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
                 Otherwise we'll make a line extremely long, which
                 results in slow redisplay.  */
              if (SUB_CHAR_TABLE_P (obj)
-                 && XINT (XSUB_CHAR_TABLE (obj)->depth) == 3)
+                 && XSUB_CHAR_TABLE (obj)->depth == 3)
                PRINTCHAR ('\n');
              PRINTCHAR ('#');
              PRINTCHAR ('^');
@@ -1970,16 +1982,24 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
 
          PRINTCHAR ('[');
          {
-           register int i;
+           int i, idx = SUB_CHAR_TABLE_P (obj) ? SUB_CHAR_TABLE_OFFSET : 0;
            register Lisp_Object tem;
            ptrdiff_t real_size = size;
 
+           /* For a sub char-table, print heading non-Lisp data first.  */
+           if (SUB_CHAR_TABLE_P (obj))
+             {
+               i = sprintf (buf, "%d %d", XSUB_CHAR_TABLE (obj)->depth,
+                            XSUB_CHAR_TABLE (obj)->min_char);
+               strout (buf, i, i, printcharfun);
+             }
+
            /* Don't print more elements than the specified maximum.  */
            if (NATNUMP (Vprint_length)
                && XFASTINT (Vprint_length) < size)
              size = XFASTINT (Vprint_length);
 
-           for (i = 0; i < size; i++)
+           for (i = idx; i < size; i++)
              {
                if (i) PRINTCHAR (' ');
                tem = AREF (obj, i);