/* 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, 2008 Free Software Foundation, Inc.
+ 2005, 2006, 2007, 2008, 2009, 2010 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 <setjmp.h>
#include "lisp.h"
#include "buffer.h"
#include "character.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))
{
int len;
for (i = 0; i < size_byte; i += len)
{
- int ch = STRING_CHAR_AND_LENGTH (ptr + i, size_byte - i, len);
+ int ch = STRING_CHAR_AND_LENGTH (ptr + i, len);
insert_char (ch);
}
}
-
-#ifdef MAX_PRINT_CHARS
- if (max_print)
- print_chars += size;
-#endif /* MAX_PRINT_CHARS */
}
else
{
corresponding character code before handing it to
PRINTCHAR. */
int len;
- int ch = STRING_CHAR_AND_LENGTH (ptr + i, size_byte - i, len);
+ int ch = STRING_CHAR_AND_LENGTH (ptr + i, len);
PRINTCHAR (ch);
i += len;
}
/* Here, we must convert each multi-byte form to the
corresponding character code before handing it to PRINTCHAR. */
int len;
- int ch = STRING_CHAR_AND_LENGTH (SDATA (string) + i,
- size_byte - i, len);
+ int ch = STRING_CHAR_AND_LENGTH (SDATA (string) + i, len);
PRINTCHAR (ch);
i += len;
}
{
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;
}
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)
+ || HASH_TABLE_P (obj)
|| (! NILP (Vprint_gensym)
&& SYMBOLP (obj)
&& !SYMBOL_INTERNED_P (obj)))
size &= PSEUDOVECTOR_SIZE_MASK;
for (i = 0; i < size; i++)
print_preprocess (XVECTOR (obj)->contents[i]);
+ if (HASH_TABLE_P (obj))
+ { /* For hash tables, the key_and_value slot is past
+ `size' because it needs to be marked specially in case
+ the table is weak. */
+ struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
+ print_preprocess (h->key_and_value);
+ }
break;
default:
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) || SUB_CHAR_TABLE_P (obj)
+ || HASH_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 (XTYPE (obj))
{
- case Lisp_Int:
+ case_Lisp_Int:
if (sizeof (int) == sizeof (EMACS_INT))
sprintf (buf, "%d", (int) XINT (obj));
else if (sizeof (long) == sizeof (EMACS_INT))
if (multibyte)
{
- c = STRING_CHAR_AND_LENGTH (str + i_byte,
- size_byte - i_byte, len);
+ c = STRING_CHAR_AND_LENGTH (str + i_byte, len);
i_byte += len;
}
else
{
while (p != end && ((*p >= '0' && *p <= '9')
/* Needed for \2e10. */
- || *p == 'e'))
+ || *p == 'e' || *p == 'E'))
p++;
confusing = (end == p);
}
{
QUIT;
c = XBOOL_VECTOR (obj)->data[i];
- if (! ASCII_BYTE_P (c))
- {
- sprintf (buf, "\\%03o", c);
- strout (buf, -1, -1, printcharfun, 0);
- }
- else if (c == '\n' && print_escape_newlines)
+ if (c == '\n' && print_escape_newlines)
{
PRINTCHAR ('\\');
PRINTCHAR ('n');
else if (HASH_TABLE_P (obj))
{
struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
+ int i, real_size, size;
+#if 0
strout ("#<hash-table", -1, -1, printcharfun, 0);
if (SYMBOLP (h->test))
{
sprintf (buf, " 0x%lx", (unsigned long) h);
strout (buf, -1, -1, printcharfun, 0);
PRINTCHAR ('>');
+#endif
+ /* Implement a readable output, e.g.:
+ #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
+ /* Always print the size. */
+ sprintf (buf, "#s(hash-table size %ld",
+ (long) XVECTOR (h->next)->size);
+ strout (buf, -1, -1, printcharfun, 0);
+
+ if (!NILP (h->test))
+ {
+ strout (" test ", -1, -1, printcharfun, 0);
+ print_object (h->test, printcharfun, 0);
+ }
+
+ if (!NILP (h->weak))
+ {
+ strout (" weakness ", -1, -1, printcharfun, 0);
+ print_object (h->weak, printcharfun, 0);
+ }
+
+ if (!NILP (h->rehash_size))
+ {
+ strout (" rehash-size ", -1, -1, printcharfun, 0);
+ print_object (h->rehash_size, printcharfun, 0);
+ }
+
+ if (!NILP (h->rehash_threshold))
+ {
+ strout (" rehash-threshold ", -1, -1, printcharfun, 0);
+ print_object (h->rehash_threshold, printcharfun, 0);
+ }
+
+ strout (" data ", -1, -1, printcharfun, 0);
+
+ /* Print the data here as a plist. */
+ real_size = HASH_TABLE_SIZE (h);
+ size = real_size;
+
+ /* Don't print more elements than the specified maximum. */
+ if (NATNUMP (Vprint_length)
+ && XFASTINT (Vprint_length) < size)
+ size = XFASTINT (Vprint_length);
+
+ PRINTCHAR ('(');
+ for (i = 0; i < size; i++)
+ if (!NILP (HASH_HASH (h, i)))
+ {
+ if (i) PRINTCHAR (' ');
+ print_object (HASH_KEY (h, i), printcharfun, 1);
+ PRINTCHAR (' ');
+ print_object (HASH_VALUE (h, i), printcharfun, 1);
+ }
+
+ if (size < real_size)
+ strout (" ...", 4, 4, printcharfun, 0);
+
+ PRINTCHAR (')');
+ PRINTCHAR (')');
+
}
else if (BUFFERP (obj))
{
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;
/* We print a char-table as if it were a vector,
lumping the parent and default slots in with the
character slots. But we add #^ as a prefix. */
+
+ /* Make each lowest sub_char_table start a new line.
+ 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)
+ PRINTCHAR ('\n');
PRINTCHAR ('#');
PRINTCHAR ('^');
if (SUB_CHAR_TABLE_P (obj))
void
syms_of_print ()
{
- Qtemp_buffer_setup_hook = intern ("temp-buffer-setup-hook");
+ Qtemp_buffer_setup_hook = intern_c_string ("temp-buffer-setup-hook");
staticpro (&Qtemp_buffer_setup_hook);
DEFVAR_LISP ("standard-output", &Vstandard_output,
or a marker (output is inserted and the marker is advanced)
or the symbol t (output appears in the echo area). */);
Vstandard_output = Qt;
- Qstandard_output = intern ("standard-output");
+ Qstandard_output = intern_c_string ("standard-output");
staticpro (&Qstandard_output);
DEFVAR_LISP ("float-output-format", &Vfloat_output_format,
A value of nil means to use the shortest notation
that represents the number without losing information. */);
Vfloat_output_format = Qnil;
- Qfloat_output_format = intern ("float-output-format");
+ Qfloat_output_format = intern_c_string ("float-output-format");
staticpro (&Qfloat_output_format);
DEFVAR_LISP ("print-length", &Vprint_length,
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,
defsubr (&Sredirect_debugging_output);
#endif
- Qexternal_debugging_output = intern ("external-debugging-output");
+ Qexternal_debugging_output = intern_c_string ("external-debugging-output");
staticpro (&Qexternal_debugging_output);
- Qprint_escape_newlines = intern ("print-escape-newlines");
+ Qprint_escape_newlines = intern_c_string ("print-escape-newlines");
staticpro (&Qprint_escape_newlines);
- Qprint_escape_multibyte = intern ("print-escape-multibyte");
+ Qprint_escape_multibyte = intern_c_string ("print-escape-multibyte");
staticpro (&Qprint_escape_multibyte);
- Qprint_escape_nonascii = intern ("print-escape-nonascii");
+ Qprint_escape_nonascii = intern_c_string ("print-escape-nonascii");
staticpro (&Qprint_escape_nonascii);
print_prune_charset_plist = Qnil;
HCoop / bpt / emacs.git / blobdiff