]> code.delx.au - gnu-emacs/blobdiff - src/print.c
Rework C source files to avoid ^(
[gnu-emacs] / src / print.c
index f396151eaa1c82dbebe8011c116f4ed01a3313c2..2b53d7580b1a089ff6e9eb66b9493b27eddbf575 100644 (file)
@@ -1,14 +1,14 @@
 /* Lisp object printing and output streams.
 
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2015 Free Software
+Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2016 Free Software
 Foundation, Inc.
 
 This file is part of GNU Emacs.
 
 GNU Emacs is free software: you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or
-(at your option) any later version.
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -24,24 +24,22 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 #include "lisp.h"
 #include "character.h"
+#include "coding.h"
 #include "buffer.h"
 #include "charset.h"
-#include "keyboard.h"
 #include "frame.h"
-#include "window.h"
 #include "process.h"
-#include "dispextern.h"
 #include "disptab.h"
-#include "termchar.h"
 #include "intervals.h"
 #include "blockinput.h"
-#include "termhooks.h"         /* For struct terminal.  */
-#include "font.h"
+#include "xwidget.h"
 
 #include <c-ctype.h>
 #include <float.h>
 #include <ftoastr.h>
 
+struct terminal;
+
 /* Avoid actual stack overflow in print.  */
 static ptrdiff_t print_depth;
 
@@ -203,6 +201,13 @@ printchar_to_stream (unsigned int ch, FILE *stream)
 {
   Lisp_Object dv IF_LINT (= Qnil);
   ptrdiff_t i = 0, n = 1;
+  Lisp_Object coding_system = Vlocale_coding_system;
+  bool encode_p = false;
+
+  if (!NILP (Vcoding_system_for_write))
+    coding_system = Vcoding_system_for_write;
+  if (!NILP (coding_system))
+    encode_p = true;
 
   if (CHAR_VALID_P (ch) && DISP_TABLE_P (Vstandard_display_table))
     {
@@ -231,8 +236,11 @@ printchar_to_stream (unsigned int ch, FILE *stream)
          unsigned char mbstr[MAX_MULTIBYTE_LENGTH];
          int len = CHAR_STRING (ch, mbstr);
          Lisp_Object encoded_ch =
-           ENCODE_SYSTEM (make_multibyte_string ((char *) mbstr, 1, len));
+           make_multibyte_string ((char *) mbstr, 1, len);
 
+         if (encode_p)
+           encoded_ch = code_convert_string_norecord (encoded_ch,
+                                                      coding_system, true);
          fwrite (SSDATA (encoded_ch), 1, SBYTES (encoded_ch), stream);
 #ifdef WINDOWSNT
          if (print_output_debug_flag && stream == stderr)
@@ -465,8 +473,6 @@ print_string (Lisp_Object string, Lisp_Object printcharfun)
       ptrdiff_t i;
       ptrdiff_t size = SCHARS (string);
       ptrdiff_t size_byte = SBYTES (string);
-      struct gcpro gcpro1;
-      GCPRO1 (string);
       if (size == size_byte)
        for (i = 0; i < size; i++)
          printchar (SREF (string, i), printcharfun);
@@ -480,7 +486,6 @@ print_string (Lisp_Object string, Lisp_Object printcharfun)
            printchar (ch, printcharfun);
            i += len;
          }
-      UNGCPRO;
     }
 }
 \f
@@ -739,17 +744,13 @@ If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
 is used instead.  */)
   (Lisp_Object object, Lisp_Object printcharfun)
 {
-  struct gcpro gcpro1;
-
   if (NILP (printcharfun))
     printcharfun = Vstandard_output;
-  GCPRO1 (object);
   PRINTPREPARE;
   printchar ('\n', printcharfun);
   print (object, printcharfun, 1);
   printchar ('\n', printcharfun);
   PRINTFINISH;
-  UNGCPRO;
   return object;
 }
 
@@ -854,7 +855,6 @@ error message is constructed.  */)
 {
   struct buffer *old = current_buffer;
   Lisp_Object value;
-  struct gcpro gcpro1;
 
   /* If OBJ is (error STRING), just return STRING.
      That is not only faster, it also avoids the need to allocate
@@ -870,10 +870,8 @@ error message is constructed.  */)
   set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
   value = Fbuffer_string ();
 
-  GCPRO1 (value);
   Ferase_buffer ();
   set_buffer_internal (old);
-  UNGCPRO;
 
   return value;
 }
@@ -888,7 +886,6 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
                     Lisp_Object caller)
 {
   Lisp_Object errname, errmsg, file_error, tail;
-  struct gcpro gcpro1;
 
   if (context != 0)
     write_string_1 (context, stream);
@@ -902,7 +899,7 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
       USE_SAFE_ALLOCA;
       char *name = SAFE_ALLOCA (cnamelen);
       memcpy (name, SDATA (cname), cnamelen);
-      message_dolog (name, cnamelen, 0, 0);
+      message_dolog (name, cnamelen, 0, STRING_MULTIBYTE (cname));
       message_dolog (": ", 2, 0, 0);
       SAFE_FREE ();
     }
@@ -927,7 +924,6 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
   /* Print an error message including the data items.  */
 
   tail = Fcdr_safe (data);
-  GCPRO1 (tail);
 
   /* For file-error, make error message by concatenating
      all the data items.  They are all strings.  */
@@ -940,7 +936,7 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
     if (!STRINGP (errmsg))
       write_string_1 ("peculiar error", stream);
     else if (SCHARS (errmsg))
-      Fprinc (errmsg, stream);
+      Fprinc (Fsubstitute_command_keys (errmsg), stream);
     else
       sep = NULL;
 
@@ -958,8 +954,6 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
          Fprin1 (obj, stream);
       }
   }
-
-  UNGCPRO;
 }
 
 
@@ -1428,16 +1422,13 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
        print_string (obj, printcharfun);
       else
        {
-         register ptrdiff_t i, i_byte;
-         struct gcpro gcpro1;
+         ptrdiff_t i, i_byte;
          ptrdiff_t size_byte;
          /* True means we must ensure that the next character we output
             cannot be taken as part of a hex character escape.  */
          bool need_nonhex = false;
          bool multibyte = STRING_MULTIBYTE (obj);
 
-         GCPRO1 (obj);
-
          if (! EQ (Vprint_charset_text_property, Qt))
            obj = print_prune_string_charset (obj);
 
@@ -1507,8 +1498,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
                                  0, print_interval, printcharfun);
              printchar (')', printcharfun);
            }
-
-         UNGCPRO;
        }
       break;
 
@@ -1702,11 +1691,9 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
        {
          ptrdiff_t i;
          unsigned char c;
-         struct gcpro gcpro1;
          EMACS_INT size = bool_vector_size (obj);
          ptrdiff_t size_in_chars = bool_vector_bytes (size);
          ptrdiff_t real_size_in_chars = size_in_chars;
-         GCPRO1 (obj);
 
          int len = sprintf (buf, "#&%"pI"d\"", size);
          strout (buf, len, len, printcharfun);
@@ -1743,8 +1730,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
          if (size_in_chars < real_size_in_chars)
            print_c_string (" ...", printcharfun);
          printchar ('\"', printcharfun);
-
-         UNGCPRO;
        }
       else if (SUBRP (obj))
        {
@@ -1752,6 +1737,11 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
          print_c_string (XSUBR (obj)->symbol_name, printcharfun);
          printchar ('>', printcharfun);
        }
+      else if (XWIDGETP (obj) || XWIDGET_VIEW_P (obj))
+       {
+         print_c_string ("#<xwidget ", printcharfun);
+         printchar ('>', printcharfun);
+       }
       else if (WINDOWP (obj))
        {
          int len = sprintf (buf, "#<window %"pI"d",
@@ -2016,6 +2006,19 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
          printchar ('>', printcharfun);
           break;
 
+#ifdef HAVE_MODULES
+       case Lisp_Misc_User_Ptr:
+         {
+           print_c_string ("#<user-ptr ", printcharfun);
+           int i = sprintf (buf, "ptr=%p finalizer=%p",
+                            XUSER_PTR (obj)->p,
+                            XUSER_PTR (obj)->finalizer);
+           strout (buf, i, i, printcharfun);
+           printchar ('>', printcharfun);
+           break;
+         }
+#endif
+
         case Lisp_Misc_Finalizer:
           print_c_string ("#<finalizer", printcharfun);
           if (NILP (XFINALIZER (obj)->function))
@@ -2041,8 +2044,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
              {
                ptrdiff_t amount = v->data[1].integer;
 
-#if GC_MARK_STACK
-
                /* valid_lisp_object_p is reliable, so try to print up
                   to 8 saved objects.  This code is rarely used, so
                   it's OK that valid_lisp_object_p is slow.  */
@@ -2067,16 +2068,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
                  }
                if (i == limit && i < amount)
                  print_c_string (" ...", printcharfun);
-
-#else /* not GC_MARK_STACK */
-
-               /* There is no reliable way to determine whether the objects
-                  are initialized, so do not try to print them.  */
-
-               i = sprintf (buf, "with %"pD"d objects", amount);
-               strout (buf, i, i, printcharfun);
-
-#endif /* GC_MARK_STACK */
              }
            else
              {
@@ -2247,7 +2238,7 @@ This affects only `prin1'.  */);
 
   DEFVAR_BOOL ("print-quoted", print_quoted,
               doc: /* Non-nil means print quoted forms with reader syntax.
-I.e., (quote foo) prints as 'foo, (function foo) as #'foo.  */);
+I.e., (quote foo) prints as \\='foo, (function foo) as #\\='foo.  */);
   print_quoted = 0;
 
   DEFVAR_LISP ("print-gensym", Vprint_gensym,