print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
char *buf)
{
+ /* First do all the vectorlike types that have a readable syntax. */
switch (PSEUDOVECTOR_TYPE (XVECTOR (obj)))
{
case PVEC_BIGNUM:
strout (str, len, len, printcharfun);
SAFE_FREE ();
}
+ return true;
+
+ case PVEC_BOOL_VECTOR:
+ {
+ EMACS_INT size = bool_vector_size (obj);
+ ptrdiff_t size_in_bytes = bool_vector_bytes (size);
+ ptrdiff_t real_size_in_bytes = size_in_bytes;
+ unsigned char *data = bool_vector_uchar_data (obj);
+
+ int len = sprintf (buf, "#&%"pI"d\"", size);
+ strout (buf, len, len, printcharfun);
+
+ /* Don't print more bytes than the specified maximum.
+ Negative values of print-length are invalid. Treat them
+ like a print-length of nil. */
+ if (FIXNATP (Vprint_length)
+ && XFIXNAT (Vprint_length) < size_in_bytes)
+ size_in_bytes = XFIXNAT (Vprint_length);
+
+ for (ptrdiff_t i = 0; i < size_in_bytes; i++)
+ {
+ maybe_quit ();
+ unsigned char c = data[i];
+ if (c == '\n' && print_escape_newlines)
+ print_c_string ("\\n", printcharfun);
+ else if (c == '\f' && print_escape_newlines)
+ print_c_string ("\\f", printcharfun);
+ else if (c > '\177'
+ || (print_escape_control_characters && c_iscntrl (c)))
+ {
+ /* Use octal escapes to avoid encoding issues. */
+ octalout (c, data, i + 1, size_in_bytes, printcharfun);
+ }
+ else
+ {
+ if (c == '\"' || c == '\\')
+ printchar ('\\', printcharfun);
+ printchar (c, printcharfun);
+ }
+ }
+
+ if (size_in_bytes < real_size_in_bytes)
+ print_c_string (" ...", printcharfun);
+ printchar ('\"', printcharfun);
+ }
+ return true;
+
+ case PVEC_HASH_TABLE:
+ {
+ struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
+ /* Implement a readable output, e.g.:
+ #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
+ /* Always print the size. */
+ int len = sprintf (buf, "#s(hash-table size %"pD"d",
+ HASH_TABLE_SIZE (h));
+ strout (buf, len, len, printcharfun);
+
+ if (!NILP (h->test.name))
+ {
+ print_c_string (" test ", printcharfun);
+ print_object (h->test.name, printcharfun, escapeflag);
+ }
+
+ if (!NILP (h->weak))
+ {
+ print_c_string (" weakness ", printcharfun);
+ print_object (h->weak, printcharfun, escapeflag);
+ }
+
+ print_c_string (" rehash-size ", printcharfun);
+ print_object (Fhash_table_rehash_size (obj),
+ printcharfun, escapeflag);
+
+ print_c_string (" rehash-threshold ", printcharfun);
+ print_object (Fhash_table_rehash_threshold (obj),
+ printcharfun, escapeflag);
+
+ if (h->purecopy)
+ {
+ print_c_string (" purecopy ", printcharfun);
+ print_object (h->purecopy ? Qt : Qnil, printcharfun, escapeflag);
+ }
+
+ print_c_string (" data ", printcharfun);
+
+ /* Print the data here as a plist. */
+ ptrdiff_t real_size = HASH_TABLE_SIZE (h);
+ ptrdiff_t size = h->count;
+
+ /* Don't print more elements than the specified maximum. */
+ if (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size)
+ size = XFIXNAT (Vprint_length);
+
+ printchar ('(', printcharfun);
+ ptrdiff_t j = 0;
+ for (ptrdiff_t i = 0; i < real_size; i++)
+ {
+ Lisp_Object key = HASH_KEY (h, i);
+ if (!EQ (key, Qunbound))
+ {
+ if (j++) printchar (' ', printcharfun);
+ print_object (key, printcharfun, escapeflag);
+ printchar (' ', printcharfun);
+ print_object (HASH_VALUE (h, i), printcharfun, escapeflag);
+ if (j == size)
+ break;
+ }
+ }
+
+ if (j < h->count)
+ {
+ if (j)
+ printchar (' ', printcharfun);
+ print_c_string ("...", printcharfun);
+ }
+
+ print_c_string ("))", printcharfun);
+ }
+ return true;
+
+ case PVEC_RECORD:
+ {
+ ptrdiff_t size = PVSIZE (obj);
+
+ /* Don't print more elements than the specified maximum. */
+ ptrdiff_t n
+ = (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size
+ ? XFIXNAT (Vprint_length) : size);
+
+ print_c_string ("#s(", printcharfun);
+ for (ptrdiff_t i = 0; i < n; i ++)
+ {
+ if (i) printchar (' ', printcharfun);
+ print_object (AREF (obj, i), printcharfun, escapeflag);
+ }
+ if (n < size)
+ print_c_string (" ...", printcharfun);
+ printchar (')', printcharfun);
+ }
+ return true;
+
+ case PVEC_SUB_CHAR_TABLE:
+ case PVEC_COMPILED:
+ case PVEC_CHAR_TABLE:
+ case PVEC_NORMAL_VECTOR:
+ {
+ ptrdiff_t size = ASIZE (obj);
+ if (COMPILEDP (obj))
+ {
+ printchar ('#', printcharfun);
+ size &= PSEUDOVECTOR_SIZE_MASK;
+ }
+ if (CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj))
+ {
+ /* Print a char-table as if it were a vector,
+ lumping the parent and default slots in with the
+ character slots. But 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)
+ && XSUB_CHAR_TABLE (obj)->depth == 3)
+ printchar ('\n', printcharfun);
+ print_c_string ("#^", printcharfun);
+ if (SUB_CHAR_TABLE_P (obj))
+ printchar ('^', printcharfun);
+ size &= PSEUDOVECTOR_SIZE_MASK;
+ }
+ if (size & PSEUDOVECTOR_FLAG)
+ return false;
+
+ printchar ('[', printcharfun);
+
+ int idx = SUB_CHAR_TABLE_P (obj) ? SUB_CHAR_TABLE_OFFSET : 0;
+ Lisp_Object tem;
+ ptrdiff_t real_size = size;
+
+ /* For a sub char-table, print heading non-Lisp data first. */
+ if (SUB_CHAR_TABLE_P (obj))
+ {
+ int i = sprintf (buf, "%d %d", XSUB_CHAR_TABLE (obj)->depth,
+ XSUB_CHAR_TABLE (obj)->min_char);
+ strout (buf, i, i, printcharfun);
+ }
+
+ /* Don't print more elements than the specified maximum. */
+ if (FIXNATP (Vprint_length)
+ && XFIXNAT (Vprint_length) < size)
+ size = XFIXNAT (Vprint_length);
+
+ for (int i = idx; i < size; i++)
+ {
+ if (i) printchar (' ', printcharfun);
+ tem = AREF (obj, i);
+ print_object (tem, printcharfun, escapeflag);
+ }
+ if (size < real_size)
+ print_c_string (" ...", printcharfun);
+ printchar (']', printcharfun);
+ }
+ return true;
+
+ default:
break;
+ }
+
+ /* Then do all the pseudovector types that don't have a readable
+ syntax. First check whether this is handled by
+ `print-unreadable-function'. */
+ if (!NILP (Vprint_unreadable_function)
+ && FUNCTIONP (Vprint_unreadable_function))
+ {
+ ptrdiff_t count = SPECPDL_INDEX ();
+ /* Bind `print-unreadable-function' to nil to avoid accidental
+ infinite recursion in the function called. */
+ Lisp_Object func = Vprint_unreadable_function;
+ specbind (Qprint_unreadable_function, Qnil);
+ Lisp_Object result = CALLN (Ffuncall, func, obj,
+ escapeflag? Qt: Qnil);
+ unbind_to (count, Qnil);
+
+ if (!NILP (result))
+ {
+ if (STRINGP (result))
+ print_string (result, printcharfun);
+ /* It's handled, so stop processing here. */
+ return true;
+ }
+ }
+ /* Not handled; print unreadable object. */
+ switch (PSEUDOVECTOR_TYPE (XVECTOR (obj)))
+ {
case PVEC_MARKER:
print_c_string ("#<marker ", printcharfun);
/* Do you think this is necessary? */
print_string (XPROCESS (obj)->name, printcharfun);
break;
- case PVEC_BOOL_VECTOR:
- {
- EMACS_INT size = bool_vector_size (obj);
- ptrdiff_t size_in_bytes = bool_vector_bytes (size);
- ptrdiff_t real_size_in_bytes = size_in_bytes;
- unsigned char *data = bool_vector_uchar_data (obj);
-
- int len = sprintf (buf, "#&%"pI"d\"", size);
- strout (buf, len, len, printcharfun);
-
- /* Don't print more bytes than the specified maximum.
- Negative values of print-length are invalid. Treat them
- like a print-length of nil. */
- if (FIXNATP (Vprint_length)
- && XFIXNAT (Vprint_length) < size_in_bytes)
- size_in_bytes = XFIXNAT (Vprint_length);
-
- for (ptrdiff_t i = 0; i < size_in_bytes; i++)
- {
- maybe_quit ();
- unsigned char c = data[i];
- if (c == '\n' && print_escape_newlines)
- print_c_string ("\\n", printcharfun);
- else if (c == '\f' && print_escape_newlines)
- print_c_string ("\\f", printcharfun);
- else if (c > '\177'
- || (print_escape_control_characters && c_iscntrl (c)))
- {
- /* Use octal escapes to avoid encoding issues. */
- octalout (c, data, i + 1, size_in_bytes, printcharfun);
- }
- else
- {
- if (c == '\"' || c == '\\')
- printchar ('\\', printcharfun);
- printchar (c, printcharfun);
- }
- }
-
- if (size_in_bytes < real_size_in_bytes)
- print_c_string (" ...", printcharfun);
- printchar ('\"', printcharfun);
- }
- break;
-
case PVEC_SUBR:
print_c_string ("#<subr ", printcharfun);
print_c_string (XSUBR (obj)->symbol_name, printcharfun);
}
break;
- case PVEC_HASH_TABLE:
- {
- struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
- /* Implement a readable output, e.g.:
- #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
- /* Always print the size. */
- int len = sprintf (buf, "#s(hash-table size %"pD"d",
- HASH_TABLE_SIZE (h));
- strout (buf, len, len, printcharfun);
-
- if (!NILP (h->test.name))
- {
- print_c_string (" test ", printcharfun);
- print_object (h->test.name, printcharfun, escapeflag);
- }
-
- if (!NILP (h->weak))
- {
- print_c_string (" weakness ", printcharfun);
- print_object (h->weak, printcharfun, escapeflag);
- }
-
- print_c_string (" rehash-size ", printcharfun);
- print_object (Fhash_table_rehash_size (obj),
- printcharfun, escapeflag);
-
- print_c_string (" rehash-threshold ", printcharfun);
- print_object (Fhash_table_rehash_threshold (obj),
- printcharfun, escapeflag);
-
- if (h->purecopy)
- {
- print_c_string (" purecopy ", printcharfun);
- print_object (h->purecopy ? Qt : Qnil, printcharfun, escapeflag);
- }
-
- print_c_string (" data ", printcharfun);
-
- /* Print the data here as a plist. */
- ptrdiff_t real_size = HASH_TABLE_SIZE (h);
- ptrdiff_t size = h->count;
-
- /* Don't print more elements than the specified maximum. */
- if (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size)
- size = XFIXNAT (Vprint_length);
-
- printchar ('(', printcharfun);
- ptrdiff_t j = 0;
- for (ptrdiff_t i = 0; i < real_size; i++)
- {
- Lisp_Object key = HASH_KEY (h, i);
- if (!EQ (key, Qunbound))
- {
- if (j++) printchar (' ', printcharfun);
- print_object (key, printcharfun, escapeflag);
- printchar (' ', printcharfun);
- print_object (HASH_VALUE (h, i), printcharfun, escapeflag);
- if (j == size)
- break;
- }
- }
-
- if (j < h->count)
- {
- if (j)
- printchar (' ', printcharfun);
- print_c_string ("...", printcharfun);
- }
-
- print_c_string ("))", printcharfun);
- }
- break;
-
case PVEC_BUFFER:
if (!BUFFER_LIVE_P (XBUFFER (obj)))
print_c_string ("#<killed buffer>", printcharfun);
printchar ('>', printcharfun);
break;
- case PVEC_RECORD:
- {
- ptrdiff_t size = PVSIZE (obj);
-
- /* Don't print more elements than the specified maximum. */
- ptrdiff_t n
- = (FIXNATP (Vprint_length) && XFIXNAT (Vprint_length) < size
- ? XFIXNAT (Vprint_length) : size);
-
- print_c_string ("#s(", printcharfun);
- for (ptrdiff_t i = 0; i < n; i ++)
- {
- if (i) printchar (' ', printcharfun);
- print_object (AREF (obj, i), printcharfun, escapeflag);
- }
- if (n < size)
- print_c_string (" ...", printcharfun);
- printchar (')', printcharfun);
- }
- break;
-
- case PVEC_SUB_CHAR_TABLE:
- case PVEC_COMPILED:
- case PVEC_CHAR_TABLE:
- case PVEC_NORMAL_VECTOR:
- {
- ptrdiff_t size = ASIZE (obj);
- if (COMPILEDP (obj))
- {
- printchar ('#', printcharfun);
- size &= PSEUDOVECTOR_SIZE_MASK;
- }
- if (CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj))
- {
- /* Print a char-table as if it were a vector,
- lumping the parent and default slots in with the
- character slots. But 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)
- && XSUB_CHAR_TABLE (obj)->depth == 3)
- printchar ('\n', printcharfun);
- print_c_string ("#^", printcharfun);
- if (SUB_CHAR_TABLE_P (obj))
- printchar ('^', printcharfun);
- size &= PSEUDOVECTOR_SIZE_MASK;
- }
- if (size & PSEUDOVECTOR_FLAG)
- return false;
-
- printchar ('[', printcharfun);
-
- int idx = SUB_CHAR_TABLE_P (obj) ? SUB_CHAR_TABLE_OFFSET : 0;
- Lisp_Object tem;
- ptrdiff_t real_size = size;
-
- /* For a sub char-table, print heading non-Lisp data first. */
- if (SUB_CHAR_TABLE_P (obj))
- {
- int i = sprintf (buf, "%d %d", XSUB_CHAR_TABLE (obj)->depth,
- XSUB_CHAR_TABLE (obj)->min_char);
- strout (buf, i, i, printcharfun);
- }
-
- /* Don't print more elements than the specified maximum. */
- if (FIXNATP (Vprint_length)
- && XFIXNAT (Vprint_length) < size)
- size = XFIXNAT (Vprint_length);
-
- for (int i = idx; i < size; i++)
- {
- if (i) printchar (' ', printcharfun);
- tem = AREF (obj, i);
- print_object (tem, printcharfun, escapeflag);
- }
- if (size < real_size)
- print_c_string (" ...", printcharfun);
- printchar (']', printcharfun);
- }
- break;
-
#ifdef HAVE_MODULES
case PVEC_MODULE_FUNCTION:
{
print_prune_charset_plist = Qnil;
staticpro (&print_prune_charset_plist);
+
+ DEFVAR_LISP ("print-unreadable-function", Vprint_unreadable_function,
+ doc: /* Function called when printing unreadable objects.
+By default, Emacs printing functions (like `prin1') print unreadable
+objects like \"#<...>\", where \"...\" describes the object (for
+instance, \"#<marker in no buffer>\"). If this variable is non-nil,
+it should be a function which will be called to print the object instead.
+
+It will be called with two arguments: The object to be printed, and
+noescape (see `prin1-to-string'). If this function returns nil, the
+object will be printed as normal. If it returns a string, that string
+will then be printed. If the function returns anything else, the
+object will not be printed. */);
+ Vprint_unreadable_function = Qnil;
+ DEFSYM (Qprint_unreadable_function, "print-unreadable-function");
}
projects / emacs.git / commitdiff