diff options
| author | Stefan Monnier <monnier@iro.umontreal.ca> | 2017-02-23 21:06:54 -0500 |
|---|---|---|
| committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2017-02-23 21:06:54 -0500 |
| commit | 407e650413c0296f5873a1399c2306b25f81f310 (patch) | |
| tree | 7ef40c77b1a38cf127c07cf4662497b8170a658b /src/print.c | |
| parent | f6d2ba74f80b9a055a3d8072d49475aec45c2dbe (diff) | |
| download | emacs-407e650413c0296f5873a1399c2306b25f81f310.tar.gz | |
* lisp/emacs-lisp/cl-print.el: New file
* lisp/emacs-lisp/nadvice.el (advice--where): New function.
(advice--make-docstring): Use it.
* src/print.c (print_number_index): Don't declare here any more.
(Fprint_preprocess): New function.
* test/lisp/emacs-lisp/cl-print-tests.el: New file.
Diffstat (limited to 'src/print.c')
| -rw-r--r-- | src/print.c | 32 |
1 files changed, 22 insertions, 10 deletions
diff --git a/src/print.c b/src/print.c index 8c4bb24555e..d8acf838749 100644 --- a/src/print.c +++ b/src/print.c @@ -640,7 +640,7 @@ is used instead. */) return object; } -/* a buffer which is used to hold output being built by prin1-to-string */ +/* A buffer which is used to hold output being built by prin1-to-string. */ Lisp_Object Vprin1_to_string_buffer; DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0, @@ -1140,14 +1140,14 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) print_object (obj, printcharfun, escapeflag); } -#define PRINT_CIRCLE_CANDIDATE_P(obj) \ - (STRINGP (obj) || CONSP (obj) \ - || (VECTORLIKEP (obj) \ - && (VECTORP (obj) || COMPILEDP (obj) \ - || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) \ - || HASH_TABLE_P (obj) || FONTP (obj))) \ - || (! NILP (Vprint_gensym) \ - && SYMBOLP (obj) \ +#define PRINT_CIRCLE_CANDIDATE_P(obj) \ + (STRINGP (obj) || CONSP (obj) \ + || (VECTORLIKEP (obj) \ + && (VECTORP (obj) || COMPILEDP (obj) \ + || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) \ + || HASH_TABLE_P (obj) || FONTP (obj))) \ + || (! NILP (Vprint_gensym) \ + && SYMBOLP (obj) \ && !SYMBOL_INTERNED_P (obj))) /* Construct Vprint_number_table according to the structure of OBJ. @@ -1260,6 +1260,16 @@ print_preprocess (Lisp_Object obj) print_depth--; } +DEFUN ("print--preprocess", Fprint_preprocess, Sprint_preprocess, 1, 1, 0, + doc: /* Extract sharing info from OBJECT needed to print it. +Fills `print-number-table'. */) + (Lisp_Object object) +{ + print_number_index = 0; + print_preprocess (object); + return Qnil; +} + static void print_preprocess_string (INTERVAL interval, Lisp_Object arg) { @@ -1537,7 +1547,8 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) size_byte = SBYTES (name); - if (! NILP (Vprint_gensym) && !SYMBOL_INTERNED_P (obj)) + if (! NILP (Vprint_gensym) + && !SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (obj)) print_c_string ("#:", printcharfun); else if (size_byte == 0) { @@ -2344,6 +2355,7 @@ priorities. */); defsubr (&Sterpri); defsubr (&Swrite_char); defsubr (&Sredirect_debugging_output); + defsubr (&Sprint_preprocess); DEFSYM (Qprint_escape_newlines, "print-escape-newlines"); DEFSYM (Qprint_escape_multibyte, "print-escape-multibyte"); |