changeset 16140:e7de214aac01

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.

--- 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);