# HG changeset patch # User Erik Naggum # Date 842224745 0 # Node ID e7de214aac0128c55a77c571a5561fea796d398a # Parent f557fb19a26d982c66fbd7deaa5568521cd23e0d Add #n=object, #n#, and #:symbol constructs to printer. (PRINTDECLARE): New macro to declare required variables. (PRINTPREPARE, PRINTFINISH): Set printed_genyms to nil. (Fwrite_char, write_string, write_string_1, Fterpri, Fprin1, Fprin1_to_string, Fprinc, Fprint): Use new macro PRINTDECLARE. (print): Print uninterned symbols readable. (syms_of_print): Defvar `print-gensym', staticpro printed_gensyms. diff -r f557fb19a26d -r e7de214aac01 src/print.c --- a/src/print.c Sun Sep 08 11:53:34 1996 +0000 +++ b/src/print.c Sun Sep 08 23:19:05 1996 +0000 @@ -82,7 +82,15 @@ int print_quoted; -Lisp_Object Qprint_quoted; +/* Nonzero means print #: before uninterned symbols. */ + +int print_gensym; + +/* Association list of certain objects that are `eq' in the form being + printed and which should be `eq' when read back in, using the #n=object + and #n# reader forms. Each element has the form (object . n). */ + +Lisp_Object printed_gensyms; /* Nonzero means print newline to stdout before next minibuffer message. Defined in xdisp.c */ @@ -151,16 +159,18 @@ /* Low level output routines for characters and strings */ /* Lisp functions to do output using a stream - must have the stream in a variable called printcharfun - and must start with PRINTPREPARE and end with PRINTFINISH. - Use PRINTCHAR to output one character, - or call strout to output a block of characters. - Also, each one must have the declarations - struct buffer *old = current_buffer; - int old_point = -1, start_point; - Lisp_Object original; + must have the stream in a variable called printcharfun + and must start with PRINTPREPARE, end with PRINTFINISH, + and use PRINTDECLARE to declare common variables. + Use PRINTCHAR to output one character, + or call strout to output a block of characters. */ +#define PRINTDECLARE \ + struct buffer *old = current_buffer; \ + int old_point = -1, start_point; \ + Lisp_Object original + #define PRINTPREPARE \ original = printcharfun; \ if (NILP (printcharfun)) printcharfun = Qt; \ @@ -184,7 +194,8 @@ print_buffer = (char *) xmalloc (print_buffer_size); \ } \ else \ - print_buffer = 0; + print_buffer = 0; \ + printed_gensyms = Qnil #define PRINTFINISH \ if (NILP (printcharfun)) \ @@ -196,7 +207,8 @@ SET_PT (old_point + (old_point >= start_point \ ? PT - start_point : 0)); \ if (old != current_buffer) \ - set_buffer_internal (old) + set_buffer_internal (old); \ + printed_gensyms = Qnil #define PRINTCHAR(ch) printchar (ch, printcharfun) @@ -366,10 +378,7 @@ (character, printcharfun) Lisp_Object character, printcharfun; { - struct buffer *old = current_buffer; - int old_point = -1; - int start_point; - Lisp_Object original; + PRINTDECLARE; if (NILP (printcharfun)) printcharfun = Vstandard_output; @@ -388,11 +397,8 @@ char *data; int size; { - struct buffer *old = current_buffer; + PRINTDECLARE; Lisp_Object printcharfun; - int old_point = -1; - int start_point; - Lisp_Object original; printcharfun = Vstandard_output; @@ -410,10 +416,7 @@ int size; Lisp_Object printcharfun; { - struct buffer *old = current_buffer; - int old_point = -1; - int start_point; - Lisp_Object original; + PRINTDECLARE; PRINTPREPARE; strout (data, size, printcharfun); @@ -509,10 +512,7 @@ (printcharfun) Lisp_Object printcharfun; { - struct buffer *old = current_buffer; - int old_point = -1; - int start_point; - Lisp_Object original; + PRINTDECLARE; if (NILP (printcharfun)) printcharfun = Vstandard_output; @@ -530,10 +530,7 @@ (object, printcharfun) Lisp_Object object, printcharfun; { - struct buffer *old = current_buffer; - int old_point = -1; - int start_point; - Lisp_Object original; + PRINTDECLARE; #ifdef MAX_PRINT_CHARS max_print = 0; @@ -558,10 +555,8 @@ (object, noescape) Lisp_Object object, noescape; { - struct buffer *old = current_buffer; - int old_point = -1; - int start_point; - Lisp_Object original, printcharfun; + PRINTDECLARE; + Lisp_Object printcharfun; struct gcpro gcpro1, gcpro2; Lisp_Object tem; @@ -597,10 +592,7 @@ (object, printcharfun) Lisp_Object object, printcharfun; { - struct buffer *old = current_buffer; - int old_point = -1; - int start_point; - Lisp_Object original; + PRINTDECLARE; if (NILP (printcharfun)) printcharfun = Vstandard_output; @@ -619,10 +611,7 @@ (object, printcharfun) Lisp_Object object, printcharfun; { - struct buffer *old = current_buffer; - int old_point = -1; - int start_point; - Lisp_Object original; + PRINTDECLARE; struct gcpro gcpro1; #ifdef MAX_PRINT_CHARS @@ -978,6 +967,39 @@ confusing = (end == p); } + /* 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 (print_gensym && NILP (XSYMBOL (obj)->obarray)) + { + if (print_depth > 1) + { + Lisp_Object tem; + tem = Fassq (obj, printed_gensyms); + if (CONSP (tem)) + { + PRINTCHAR ('#'); + print (XCDR (tem), printcharfun, escapeflag); + PRINTCHAR ('#'); + break; + } + else + { + if (CONSP (printed_gensyms)) + XSETFASTINT (tem, XCDR (XCAR (printed_gensyms)) + 1); + else + XSETFASTINT (tem, 1); + printed_gensyms = Fcons (Fcons (obj, tem), printed_gensyms); + + PRINTCHAR ('#'); + print (tem, printcharfun, escapeflag); + PRINTCHAR ('='); + } + } + PRINTCHAR ('#'); + PRINTCHAR (':'); + } + p = XSYMBOL (obj)->name->data; while (p != end) { @@ -1397,6 +1419,11 @@ forms print in the new syntax."); print_quoted = 0; + DEFVAR_BOOL ("print-gensym", &print_gensym, + "Non-nil means print uninterned symbols so they will read as uninterned.\n\ +I.e., the value of (make-symbol "foobar") prints as #:foobar."); + print_gensym = 0; + /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */ staticpro (&Vprin1_to_string_buffer); @@ -1415,8 +1442,8 @@ Qprint_escape_newlines = intern ("print-escape-newlines"); staticpro (&Qprint_escape_newlines); - Qprint_quoted = intern ("print-quoted"); - staticpro (&Qprint_quoted); + staticpro (&printed_gensyms); + printed_gensyms = Qnil; #ifndef standalone defsubr (&Swith_output_to_temp_buffer);