/* The subroutine object for external-debugging-output is kept here
for the convenience of the debugger. */
Lisp_Object Qexternal_debugging_output;
-Lisp_Object Qalternate_debugging_output;
/* Avoid actual stack overflow in print. */
static int print_depth;
/* Detect most circularities to print finite output. */
#define PRINT_CIRCLE 200
-Lisp_Object being_printed[PRINT_CIRCLE];
+static Lisp_Object being_printed[PRINT_CIRCLE];
/* Maximum length of list or vector to print in full; noninteger means
effectively infinity */
Lisp_Object Vprint_gensym;
Lisp_Object Vprint_gensym_alist;
-Lisp_Object Qprint_escape_newlines;
-Lisp_Object Qprint_readably;
-
Lisp_Object Qdisplay_error;
Lisp_Object Qprint_message_label;
{
int first = 1;
int speccount = specpdl_depth ();
+ Lisp_Object frame = Qnil;
+ struct gcpro gcpro1;
+ GCPRO1 (stream);
specbind (Qprint_message_label, Qerror);
+ stream = print_prepare (stream, &frame);
+
tail = Fcdr (error_object);
if (EQ (type, Qerror))
{
tail = Fcdr (tail);
first = 0;
}
+ print_finish (stream, frame);
+ UNGCPRO;
unbind_to (speccount, Qnil);
return;
/* not reached */
#ifdef LISP_FLOAT_TYPE
Lisp_Object Vfloat_output_format;
-Lisp_Object Qfloat_output_format;
/*
* This buffer should be at least as large as the max string size of the
faster.
BUFFER should accept 24 bytes. This should suffice for the longest
- numbers on 64-bit machines. */
+ numbers on 64-bit machines, including the `-' sign and the trailing
+ \0. */
void
long_to_string (char *buffer, long number)
{
- char *p;
- int i, len;
+#if (SIZEOF_LONG != 4) && (SIZEOF_LONG != 8)
+ /* Huh? */
+ sprintf (buffer, "%ld", number);
+#else /* (SIZEOF_LONG == 4) || (SIZEOF_LONG == 8) */
+ char *p = buffer;
+ int force = 0;
if (number < 0)
{
- *buffer++ = '-';
+ *p++ = '-';
number = -number;
}
- p = buffer;
- /* Print the digits to the string. */
- do
- {
- *p++ = number % 10 + '0';
- number /= 10;
- }
- while (number);
-
- /* And reverse them. */
- len = p - buffer - 1;
- for (i = len / 2; i >= 0; i--)
- {
- char c = buffer[i];
- buffer[i] = buffer[len - i];
- buffer[len - i] = c;
- }
- buffer[len + 1] = '\0';
+#define FROB(figure) do { \
+ if (force || number >= figure) \
+ *p++ = number / figure + '0', number %= figure, force = 1; \
+ } while (0)
+#if SIZEOF_LONG == 8
+ FROB (1000000000000000000L);
+ FROB (100000000000000000L);
+ FROB (10000000000000000L);
+ FROB (1000000000000000L);
+ FROB (100000000000000L);
+ FROB (10000000000000L);
+ FROB (1000000000000L);
+ FROB (100000000000L);
+ FROB (10000000000L);
+#endif /* SIZEOF_LONG == 8 */
+ FROB (1000000000);
+ FROB (100000000);
+ FROB (10000000);
+ FROB (1000000);
+ FROB (100000);
+ FROB (10000);
+ FROB (1000);
+ FROB (100);
+ FROB (10);
+#undef FROB
+ *p++ = number + '0';
+ *p = '\0';
+#endif /* (SIZEOF_LONG == 4) || (SIZEOF_LONG == 8) */
}
\f
static void
switch (XTYPE (obj))
{
-#ifdef USE_MINIMAL_TAGBITS
case Lisp_Type_Int_Even:
case Lisp_Type_Int_Odd:
-#else
- case Lisp_Type_Int:
-#endif
{
- char buf[24];
+ /* ASCII Decimal representation uses 2.4 times as many bits as
+ machine binary. */
+ char buf[3 * sizeof (EMACS_INT) + 5];
long_to_string (buf, XINT (obj));
write_c_string (buf, printcharfun);
break;
Emchar ch = XCHAR (obj);
char *p = buf;
*p++ = '?';
- if (ch == '\n')
- *p++ = '\\', *p++ = 'n';
- else if (ch == '\r')
- *p++ = '\\', *p++ = 'r';
- else if (ch == '\t')
- *p++ = '\\', *p++ = 't';
- else if (ch < 32)
+ if (ch < 32)
{
- *p++ = '\\', *p++ = '^';
- *p++ = ch + 64;
- if ((ch + 64) == '\\')
- *p++ = '\\';
+ *p++ = '\\';
+ switch (ch)
+ {
+ case '\t': *p++ = 't'; break;
+ case '\n': *p++ = 'n'; break;
+ case '\r': *p++ = 'r'; break;
+ default:
+ *p++ = '^';
+ *p++ = ch + 64;
+ if ((ch + 64) == '\\')
+ *p++ = '\\';
+ break;
+ }
+ }
+ else if (ch < 127)
+ {
+ /* syntactically special characters should be escaped. */
+ switch (ch)
+ {
+ case ' ':
+ case '"':
+ case '#':
+ case '\'':
+ case '(':
+ case ')':
+ case ',':
+ case '.':
+ case ';':
+ case '?':
+ case '[':
+ case '\\':
+ case ']':
+ case '`':
+ *p++ = '\\';
+ }
+ *p++ = ch;
}
else if (ch == 127)
- *p++ = '\\', *p++ = '^', *p++ = '?';
- else if (ch >= 128 && ch < 160)
{
- *p++ = '\\', *p++ = '^';
- p += set_charptr_emchar ((Bufbyte *)p, ch + 64);
+ *p++ = '\\', *p++ = '^', *p++ = '?';
}
- else if (ch < 127
- && !isdigit (ch)
- && !isalpha (ch)
- && ch != '^') /* must not backslash this or it will
- be interpreted as the start of a
- control char */
- *p++ = '\\', *p++ = ch;
- else
- p += set_charptr_emchar ((Bufbyte *)p, ch);
- output_string (printcharfun, (Bufbyte *)buf, Qnil, 0, p - buf);
- break;
- }
-
-#ifndef LRECORD_STRING
- case Lisp_Type_String:
- {
- print_string (obj, printcharfun, escapeflag);
- break;
- }
-#endif /* ! LRECORD_STRING */
-
-#ifndef LRECORD_CONS
- case Lisp_Type_Cons:
- {
- struct gcpro gcpro1, gcpro2;
-
- /* If deeper than spec'd depth, print placeholder. */
- if (INTP (Vprint_level)
- && print_depth > XINT (Vprint_level))
+ else if (ch < 160)
{
- GCPRO2 (obj, printcharfun);
- write_c_string ("...", printcharfun);
- UNGCPRO;
- break;
+ *p++ = '\\', *p++ = '^';
+ p += set_charptr_emchar ((Bufbyte *) p, ch + 64);
}
-
- print_cons (obj, printcharfun, escapeflag);
- break;
- }
-#endif /* ! LRECORD_CONS */
-
-#ifndef LRECORD_VECTOR
- case Lisp_Type_Vector:
- {
- /* If deeper than spec'd depth, print placeholder. */
- if (INTP (Vprint_level)
- && print_depth > XINT (Vprint_level))
+ else
{
- struct gcpro gcpro1, gcpro2;
- GCPRO2 (obj, printcharfun);
- write_c_string ("...", printcharfun);
- UNGCPRO;
- break;
+ p += set_charptr_emchar ((Bufbyte *) p, ch);
}
+
+ output_string (printcharfun, (Bufbyte *) buf, Qnil, 0, p - buf);
- /* God intended that this be #(...), you know. */
- print_vector_internal ("[", "]", obj, printcharfun, escapeflag);
break;
}
-#endif /* !LRECORD_VECTOR */
-
-#ifndef LRECORD_SYMBOL
- case Lisp_Type_Symbol:
- {
- print_symbol (obj, printcharfun, escapeflag);
- break;
- }
-#endif /* !LRECORD_SYMBOL */
case Lisp_Type_Record:
{
struct lrecord_header *lheader = XRECORD_LHEADER (obj);
struct gcpro gcpro1, gcpro2;
-#if defined(LRECORD_CONS) || defined(LRECORD_VECTOR)
if (CONSP (obj) || VECTORP(obj))
{
/* If deeper than spec'd depth, print placeholder. */
break;
}
}
-#endif
GCPRO2 (obj, printcharfun);
if (LHEADER_IMPLEMENTATION (lheader)->printer)
/* If we print an uninterned symbol as part of a complex object and
the flag print-gensym is non-nil, prefix it with #n= to read the
object back with the #n# reader syntax later if needed. */
- if (!NILP (Vprint_gensym) && NILP (XSYMBOL (obj)->obarray))
+ if (!NILP (Vprint_gensym)
+ /* #### Test whether this produces a noticable slow-down for
+ printing when print-gensym is non-nil. */
+ && !EQ (obj, oblookup (Vobarray,
+ string_data (symbol_name (XSYMBOL (obj))),
+ string_length (symbol_name (XSYMBOL (obj))))))
{
if (print_depth > 1)
{
getting rid of this function altogether? Does anything actually
*use* it? --hniksic */
-int alternate_do_pointer;
-char alternate_do_string[5000];
+static int alternate_do_pointer;
+static char alternate_do_string[5000];
DEFUN ("alternate-debugging-output", Falternate_debugging_output, 1, 1, 0, /*
Append CHARACTER to the array `alternate_do_string'.
if (DEVICE_TTY_P (XDEVICE (device)))
file = 0;
else if (!NILP (stdout_p))
- file = CONSOLE_STREAM_DATA (con)->outfd;
+ file = CONSOLE_STREAM_DATA (con)->out;
else
- file = CONSOLE_STREAM_DATA (con)->errfd;
+ file = CONSOLE_STREAM_DATA (con)->err;
}
if (STRINGP (char_or_string))
/* Debugging kludge -- unbuffered */
static int debug_print_length = 50;
static int debug_print_level = 15;
-Lisp_Object debug_temp;
static void
debug_print_no_newline (Lisp_Object debug_print_obj)
void
syms_of_print (void)
{
- defsymbol (&Qprint_escape_newlines, "print-escape-newlines");
- defsymbol (&Qprint_readably, "print-readably");
-
defsymbol (&Qstandard_output, "standard-output");
-#ifdef LISP_FLOAT_TYPE
- defsymbol (&Qfloat_output_format, "float-output-format");
-#endif
-
defsymbol (&Qprint_length, "print-length");
defsymbol (&Qprint_string_length, "print-string-length");
DEFSUBR (Fterpri);
DEFSUBR (Fwrite_char);
DEFSUBR (Falternate_debugging_output);
- defsymbol (&Qalternate_debugging_output, "alternate-debugging-output");
DEFSUBR (Fexternal_debugging_output);
DEFSUBR (Fopen_termscript);
defsymbol (&Qexternal_debugging_output, "external-debugging-output");
}
void
-vars_of_print (void)
+reinit_vars_of_print (void)
{
alternate_do_pointer = 0;
+}
+
+void
+vars_of_print (void)
+{
+ reinit_vars_of_print ();
DEFVAR_LISP ("standard-output", &Vstandard_output /*
Output stream `print' uses by default for outputting a character.
projects / chise / xemacs-chise.git.1 / blobdiff