/* 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
#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>
+#ifdef WINDOWSNT
+# include <sys/socket.h> /* for F_DUPFD_CLOEXEC */
+#endif
+
+struct terminal;
+
/* Avoid actual stack overflow in print. */
static ptrdiff_t print_depth;
static void
printchar_to_stream (unsigned int ch, FILE *stream)
{
- Lisp_Object dv IF_LINT (= Qnil);
+ Lisp_Object dv UNINIT;
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))
{
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)
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);
printchar (ch, printcharfun);
i += len;
}
- UNGCPRO;
}
}
\f
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;
}
print_output_debug_flag = x;
}
-#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
-
-static FILE *initial_stderr_stream = NULL;
-
DEFUN ("redirect-debugging-output", Fredirect_debugging_output, Sredirect_debugging_output,
1, 2,
"FDebug output file: \nP",
append to existing target file. */)
(Lisp_Object file, Lisp_Object append)
{
- if (initial_stderr_stream != NULL)
- {
- block_input ();
- fclose (stderr);
- unblock_input ();
- }
- stderr = initial_stderr_stream;
- initial_stderr_stream = NULL;
+ /* If equal to STDERR_FILENO, stderr has not been duplicated and is OK as-is.
+ Otherwise, this is a close-on-exec duplicate of the original stderr. */
+ static int stderr_dup = STDERR_FILENO;
+ int fd = stderr_dup;
- if (STRINGP (file))
+ if (! NILP (file))
{
file = Fexpand_file_name (file, Qnil);
- initial_stderr_stream = stderr;
- stderr = emacs_fopen (SSDATA (file), NILP (append) ? "w" : "a");
- if (stderr == NULL)
+
+ if (stderr_dup == STDERR_FILENO)
{
- stderr = initial_stderr_stream;
- initial_stderr_stream = NULL;
- report_file_error ("Cannot open debugging output stream", file);
+ int n = fcntl (STDERR_FILENO, F_DUPFD_CLOEXEC, STDERR_FILENO + 1);
+ if (n < 0)
+ report_file_error ("dup", file);
+ stderr_dup = n;
}
+
+ fd = emacs_open (SSDATA (ENCODE_FILE (file)),
+ (O_WRONLY | O_CREAT
+ | (! NILP (append) ? O_APPEND : O_TRUNC)),
+ 0666);
+ if (fd < 0)
+ report_file_error ("Cannot open debugging output stream", file);
}
+
+ fflush (stderr);
+ if (dup2 (fd, STDERR_FILENO) < 0)
+ report_file_error ("dup2", file);
+ if (fd != stderr_dup)
+ emacs_close (fd);
return Qnil;
}
-#endif /* GNU_LINUX */
/* This is the interface for debugging printing. */
{
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
set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
value = Fbuffer_string ();
- GCPRO1 (value);
Ferase_buffer ();
set_buffer_internal (old);
- UNGCPRO;
return value;
}
Lisp_Object caller)
{
Lisp_Object errname, errmsg, file_error, tail;
- struct gcpro gcpro1;
if (context != 0)
write_string_1 (context, stream);
/* 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. */
Fprin1 (obj, stream);
}
}
-
- UNGCPRO;
}
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);
0, print_interval, printcharfun);
printchar (')', printcharfun);
}
-
- UNGCPRO;
}
break;
{
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);
if (size_in_chars < real_size_in_chars)
print_c_string (" ...", printcharfun);
printchar ('\"', printcharfun);
-
- UNGCPRO;
}
else if (SUBRP (obj))
{
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",
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))
{
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. */
}
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
{
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,
defsubr (&Sprint);
defsubr (&Sterpri);
defsubr (&Swrite_char);
-#ifdef WITH_REDIRECT_DEBUGGING_OUTPUT
defsubr (&Sredirect_debugging_output);
-#endif
DEFSYM (Qprint_escape_newlines, "print-escape-newlines");
DEFSYM (Qprint_escape_multibyte, "print-escape-multibyte");