/* Lisp object printing and output streams.
Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997,
1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This file is part of GNU Emacs.
-GNU Emacs is free software; you can redistribute it and/or modify
+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, 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
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
-the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
#include "lisp.h"
#include "buffer.h"
+#include "character.h"
#include "charset.h"
#include "keyboard.h"
#include "frame.h"
#include "termchar.h"
#include "intervals.h"
#include "blockinput.h"
+#include "termhooks.h" /* For struct terminal. */
+#include "font.h"
Lisp_Object Vstandard_output, Qstandard_output;
Lisp_Object Vfloat_output_format, Qfloat_output_format;
-/* Work around a problem that happens because math.h on hpux 7
- defines two static variables--which, in Emacs, are not really static,
- because `static' is defined as nothing. The problem is that they are
- defined both here and in lread.c.
- These macros prevent the name conflict. */
-#if defined (HPUX) && !defined (HPUX8)
-#define _MAXLDBL print_maxldbl
-#define _NMAXLDBL print_nmaxldbl
-#endif
-
#include <math.h>
#if STDC_HEADERS
extern int minibuffer_auto_raise;
-#ifdef MAX_PRINT_CHARS
-static int print_chars;
-static int max_print;
-#endif /* MAX_PRINT_CHARS */
-
void print_interval ();
/* GDB resets this to zero on W32 to disable OutputDebugString calls. */
unsigned int ch;
Lisp_Object fun;
{
-#ifdef MAX_PRINT_CHARS
- if (max_print)
- print_chars++;
-#endif /* MAX_PRINT_CHARS */
-
if (!NILP (fun) && !EQ (fun, Qt))
call1 (fun, make_number (ch));
else
bcopy (ptr, print_buffer + print_buffer_pos_byte, size_byte);
print_buffer_pos += size;
print_buffer_pos_byte += size_byte;
-
-#ifdef MAX_PRINT_CHARS
- if (max_print)
- print_chars += size;
-#endif /* MAX_PRINT_CHARS */
}
else if (noninteractive && EQ (printcharfun, Qt))
{
insert_char (ch);
}
}
-
-#ifdef MAX_PRINT_CHARS
- if (max_print)
- print_chars += size;
-#endif /* MAX_PRINT_CHARS */
}
else
{
{
int chars;
+ if (print_escape_nonascii)
+ string = string_escape_byte8 (string);
+
if (STRING_MULTIBYTE (string))
chars = SCHARS (string);
- else if (EQ (printcharfun, Qt)
- ? ! NILP (buffer_defaults.enable_multibyte_characters)
- : ! NILP (current_buffer->enable_multibyte_characters))
+ else if (! print_escape_nonascii
+ && (EQ (printcharfun, Qt)
+ ? ! NILP (buffer_defaults.enable_multibyte_characters)
+ : ! NILP (current_buffer->enable_multibyte_characters)))
{
/* If unibyte string STRING contains 8-bit codes, we must
convert STRING to a multibyte string containing the same
int len;
int ch = STRING_CHAR_AND_LENGTH (SDATA (string) + i,
size_byte - i, len);
- if (!CHAR_VALID_P (ch, 0))
- {
- ch = SREF (string, i);
- len = 1;
- }
PRINTCHAR (ch);
i += len;
}
Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer,
1, UNEVALLED, 0,
doc: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer.
-The buffer is cleared out initially, and marked as unmodified when done.
-All output done by BODY is inserted in that buffer by default.
-The buffer is displayed in another window, but not selected.
-The value of the last form in BODY is returned.
-If BODY does not finish normally, the buffer BUFNAME is not displayed.
-
-The hook `temp-buffer-setup-hook' is run before BODY,
-with the buffer BUFNAME temporarily current.
-The hook `temp-buffer-show-hook' is run after the buffer is displayed,
-with the buffer temporarily current, and the window that was used
-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
-buffer and calling the hook. It gets one argument, the buffer to display.
+
+This construct makes buffer BUFNAME empty before running BODY.
+It does not make the buffer current for BODY.
+Instead it binds `standard-output' to that buffer, so that output
+generated with `prin1' and similar functions in BODY goes into
+the buffer.
+
+At the end of BODY, this marks buffer BUFNAME unmodifed and displays
+it in a window, but does not select it. The normal way to do this is
+by calling `display-buffer', then running `temp-buffer-show-hook'.
+However, if `temp-buffer-show-function' is non-nil, it calls that
+function instead (and does not run `temp-buffer-show-hook'). The
+function gets one argument, the buffer to display.
+
+The return value of `with-output-to-temp-buffer' is the value of the
+last form in BODY. If BODY does not finish normally, the buffer
+BUFNAME is not displayed.
+
+This runs the hook `temp-buffer-setup-hook' before BODY,
+with the buffer BUFNAME temporarily current. It runs the hook
+`temp-buffer-show-hook' after displaying buffer BUFNAME, with that
+buffer temporarily current, and the window that was used to display it
+temporarily selected. But it doesn't run `temp-buffer-show-hook'
+if it uses `temp-buffer-show-function'.
usage: (with-output-to-temp-buffer BUFNAME BODY...) */)
(args)
{
PRINTDECLARE;
-#ifdef MAX_PRINT_CHARS
- max_print = 0;
-#endif /* MAX_PRINT_CHARS */
if (NILP (printcharfun))
printcharfun = Vstandard_output;
PRINTPREPARE;
PRINTDECLARE;
struct gcpro gcpro1;
-#ifdef MAX_PRINT_CHARS
- print_chars = 0;
- max_print = MAX_PRINT_CHARS;
-#endif /* MAX_PRINT_CHARS */
if (NILP (printcharfun))
printcharfun = Vstandard_output;
GCPRO1 (object);
print (object, printcharfun, 1);
PRINTCHAR ('\n');
PRINTFINISH;
-#ifdef MAX_PRINT_CHARS
- max_print = 0;
- print_chars = 0;
-#endif /* MAX_PRINT_CHARS */
UNGCPRO;
return object;
}
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
+ (unsigned long) XHASH (arg)
);
}
loop:
if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
- || COMPILEDP (obj) || CHAR_TABLE_P (obj)
+ || COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
|| (! NILP (Vprint_gensym)
&& SYMBOLP (obj)
&& !SYMBOL_INTERNED_P (obj)))
print_number_index++;
}
- switch (XGCTYPE (obj))
+ switch (XTYPE (obj))
{
case Lisp_String:
/* A string may have text properties, which can be circular. */
print_preprocess (interval->plist);
}
+/* A flag to control printing of `charset' text property.
+ The default value is Qdefault. */
+Lisp_Object Vprint_charset_text_property;
+extern Lisp_Object Qdefault;
+
+static void print_check_string_charset_prop ();
+
+#define PRINT_STRING_NON_CHARSET_FOUND 1
+#define PRINT_STRING_UNSAFE_CHARSET_FOUND 2
+
+/* Bitwize or of the abobe macros. */
+static int print_check_string_result;
+
+static void
+print_check_string_charset_prop (interval, string)
+ INTERVAL interval;
+ Lisp_Object string;
+{
+ Lisp_Object val;
+
+ if (NILP (interval->plist)
+ || (print_check_string_result == (PRINT_STRING_NON_CHARSET_FOUND
+ | PRINT_STRING_UNSAFE_CHARSET_FOUND)))
+ return;
+ for (val = interval->plist; CONSP (val) && ! EQ (XCAR (val), Qcharset);
+ val = XCDR (XCDR (val)));
+ if (! CONSP (val))
+ {
+ print_check_string_result |= PRINT_STRING_NON_CHARSET_FOUND;
+ return;
+ }
+ if (! (print_check_string_result & PRINT_STRING_NON_CHARSET_FOUND))
+ {
+ if (! EQ (val, interval->plist)
+ || CONSP (XCDR (XCDR (val))))
+ print_check_string_result |= PRINT_STRING_NON_CHARSET_FOUND;
+ }
+ if (NILP (Vprint_charset_text_property)
+ || ! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
+ {
+ int i, c;
+ int charpos = interval->position;
+ int bytepos = string_char_to_byte (string, charpos);
+ Lisp_Object charset;
+
+ charset = XCAR (XCDR (val));
+ for (i = 0; i < LENGTH (interval); i++)
+ {
+ FETCH_STRING_CHAR_ADVANCE (c, string, charpos, bytepos);
+ if (! ASCII_CHAR_P (c)
+ && ! EQ (CHARSET_NAME (CHAR_CHARSET (c)), charset))
+ {
+ print_check_string_result |= PRINT_STRING_UNSAFE_CHARSET_FOUND;
+ break;
+ }
+ }
+ }
+}
+
+/* The value is (charset . nil). */
+static Lisp_Object print_prune_charset_plist;
+
+static Lisp_Object
+print_prune_string_charset (string)
+ Lisp_Object string;
+{
+ print_check_string_result = 0;
+ traverse_intervals (STRING_INTERVALS (string), 0,
+ print_check_string_charset_prop, string);
+ if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
+ {
+ string = Fcopy_sequence (string);
+ if (print_check_string_result & PRINT_STRING_NON_CHARSET_FOUND)
+ {
+ if (NILP (print_prune_charset_plist))
+ print_prune_charset_plist = Fcons (Qcharset, Qnil);
+ Fremove_text_properties (make_number (0),
+ make_number (SCHARS (string)),
+ print_prune_charset_plist, string);
+ }
+ else
+ Fset_text_properties (make_number (0), make_number (SCHARS (string)),
+ Qnil, string);
+ }
+ return string;
+}
+
static void
print_object (obj, printcharfun, escapeflag)
Lisp_Object obj;
QUIT;
+ /* See similar code in print_preprocess. */
+ if (print_depth >= PRINT_CIRCLE)
+ error ("Apparently circular structure being printed");
+
/* Detect circularities and truncate them. */
if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
- || COMPILEDP (obj) || CHAR_TABLE_P (obj)
+ || COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
|| (! NILP (Vprint_gensym)
&& SYMBOLP (obj)
&& !SYMBOL_INTERNED_P (obj)))
print_depth++;
- /* See similar code in print_preprocess. */
- if (print_depth > PRINT_CIRCLE)
- error ("Apparently circular structure being printed");
-#ifdef MAX_PRINT_CHARS
- if (max_print && print_chars > max_print)
- {
- PRINTCHAR ('\n');
- print_chars = 0;
- }
-#endif /* MAX_PRINT_CHARS */
-
- switch (XGCTYPE (obj))
+ switch (XTYPE (obj))
{
case Lisp_Int:
if (sizeof (int) == sizeof (EMACS_INT))
- sprintf (buf, "%d", XINT (obj));
+ sprintf (buf, "%d", (int) XINT (obj));
else if (sizeof (long) == sizeof (EMACS_INT))
sprintf (buf, "%ld", (long) XINT (obj));
else
GCPRO1 (obj);
+ if (! EQ (Vprint_charset_text_property, Qt))
+ obj = print_prune_string_charset (obj);
+
if (!NULL_INTERVAL_P (STRING_INTERVALS (obj)))
{
PRINTCHAR ('#');
{
c = STRING_CHAR_AND_LENGTH (str + i_byte,
size_byte - i_byte, len);
- if (CHAR_VALID_P (c, 0))
- i_byte += len;
- else
- c = str[i_byte++];
+ i_byte += len;
}
else
c = str[i_byte++];
PRINTCHAR ('f');
}
else if (multibyte
- && ! ASCII_BYTE_P (c)
- && (SINGLE_BYTE_CHAR_P (c) || print_escape_multibyte))
+ && (CHAR_BYTE8_P (c)
+ || (! ASCII_CHAR_P (c) && print_escape_multibyte)))
{
/* When multibyte is disabled,
print multibyte string chars using hex escapes.
when found in a multibyte string, always use a hex escape
so it reads back as multibyte. */
unsigned char outbuf[50];
- sprintf (outbuf, "\\x%x", c);
+
+ if (CHAR_BYTE8_P (c))
+ sprintf (outbuf, "\\%03o", CHAR_TO_BYTE8 (c));
+ else
+ {
+ sprintf (outbuf, "\\x%04x", c);
+ need_nonhex = 1;
+ }
strout (outbuf, -1, -1, printcharfun, 0);
- need_nonhex = 1;
}
else if (! multibyte
&& SINGLE_BYTE_CHAR_P (c) && ! ASCII_BYTE_P (c)
{
QUIT;
c = XBOOL_VECTOR (obj)->data[i];
- if (c == '\n' && print_escape_newlines)
+ if (! ASCII_BYTE_P (c))
+ {
+ sprintf (buf, "\\%03o", c);
+ strout (buf, -1, -1, printcharfun, 0);
+ }
+ else if (c == '\n' && print_escape_newlines)
{
PRINTCHAR ('\\');
PRINTCHAR ('n');
}
PRINTCHAR ('>');
}
+ else if (TERMINALP (obj))
+ {
+ struct terminal *t = XTERMINAL (obj);
+ strout ("#<terminal ", -1, -1, printcharfun, 0);
+ sprintf (buf, "%d", t->id);
+ strout (buf, -1, -1, printcharfun, 0);
+ if (t->name)
+ {
+ strout (" on ", -1, -1, printcharfun, 0);
+ strout (t->name, -1, -1, printcharfun, 0);
+ }
+ PRINTCHAR ('>');
+ }
else if (HASH_TABLE_P (obj))
{
struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
PRINTCHAR (' ');
strout (SDATA (SYMBOL_NAME (h->weak)), -1, -1, printcharfun, 0);
PRINTCHAR (' ');
- sprintf (buf, "%ld/%ld", (long) XFASTINT (h->count),
+ sprintf (buf, "%ld/%ld", (long) h->count,
(long) XVECTOR (h->next)->size);
strout (buf, -1, -1, printcharfun, 0);
}
strout (buf, -1, -1, printcharfun, 0);
PRINTCHAR ('>');
}
+ else if (FONTP (obj))
+ {
+ EMACS_INT i;
+
+ if (! FONT_OBJECT_P (obj))
+ {
+ if (FONT_SPEC_P (obj))
+ strout ("#<font-spec", -1, -1, printcharfun, 0);
+ else
+ strout ("#<font-entity", -1, -1, printcharfun, 0);
+ for (i = 0; i < FONT_SPEC_MAX; i++)
+ {
+ PRINTCHAR (' ');
+ if (i < FONT_WEIGHT_INDEX || i > FONT_WIDTH_INDEX)
+ print_object (AREF (obj, i), printcharfun, escapeflag);
+ else
+ print_object (font_style_symbolic (obj, i, 0),
+ printcharfun, escapeflag);
+ }
+ }
+ else
+ {
+ strout ("#<font-object ", -1, -1, printcharfun, 0);
+ print_object (AREF (obj, FONT_NAME_INDEX), printcharfun,
+ escapeflag);
+ }
+ PRINTCHAR ('>');
+ }
else
{
EMACS_INT size = XVECTOR (obj)->size;
PRINTCHAR ('#');
size &= PSEUDOVECTOR_SIZE_MASK;
}
- if (CHAR_TABLE_P (obj))
+ if (CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj))
{
/* We print a char-table as if it were a vector,
lumping the parent and default slots in with the
case Lisp_Misc_Buffer_Local_Value:
strout ("#<buffer_local_value ", -1, -1, printcharfun, 0);
- goto do_buffer_local;
- case Lisp_Misc_Some_Buffer_Local_Value:
- strout ("#<some_buffer_local_value ", -1, -1, printcharfun, 0);
- do_buffer_local:
+ if (XBUFFER_LOCAL_VALUE (obj)->local_if_set)
+ strout ("[local-if-set] ", -1, -1, printcharfun, 0);
strout ("[realvalue] ", -1, -1, printcharfun, 0);
print_object (XBUFFER_LOCAL_VALUE (obj)->realvalue,
printcharfun, escapeflag);
INTERVAL interval;
Lisp_Object printcharfun;
{
+ if (NILP (interval->plist))
+ return;
PRINTCHAR (' ');
print_object (make_number (interval->position), printcharfun, 1);
PRINTCHAR (' ');
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, and backquoted
-forms print as in the new syntax. */);
+I.e., (quote foo) prints as 'foo, (function foo) as #'foo. */);
print_quoted = 0;
DEFVAR_LISP ("print-gensym", &Vprint_gensym,
that need to be recorded in the table. */);
Vprint_number_table = Qnil;
+ DEFVAR_LISP ("print-charset-text-property", &Vprint_charset_text_property,
+ doc: /* A flag to control printing of `charset' text property on printing a string.
+The value must be nil, t, or `default'.
+
+If the value is nil, don't print the text property `charset'.
+
+If the value is t, always print the text property `charset'.
+
+If the value is `default', print the text property `charset' only when
+the value is different from what is guessed in the current charset
+priorities. */);
+ Vprint_charset_text_property = Qdefault;
+
/* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
staticpro (&Vprin1_to_string_buffer);
Qprint_escape_nonascii = intern ("print-escape-nonascii");
staticpro (&Qprint_escape_nonascii);
+ print_prune_charset_plist = Qnil;
+ staticpro (&print_prune_charset_plist);
+
defsubr (&Swith_output_to_temp_buffer);
}
HCoop / bpt / emacs.git / blobdiff