diff src/print.c @ 104162:d4c5482e3aa4

* lread.c (read1, syms_of_lread): Read hashtables back from the readable format. * print.c (print_preprocess, print_object): Print hashtables fully and readably. (syms_of_print): Provide 'hashtable-print-readable.

--- a/src/print.c	Wed Aug 05 00:43:34 2009 +0000
+++ b/src/print.c	Wed Aug 05 09:19:21 2009 +0000
@@ -1341,6 +1341,7 @@
  loop:
   if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
       || COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
+      || HASH_TABLE_P (obj)
       || (! NILP (Vprint_gensym)
 	  && SYMBOLP (obj)
 	  && !SYMBOL_INTERNED_P (obj)))
@@ -1536,6 +1537,7 @@
   /* Detect circularities and truncate them.  */
   if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
       || COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
+      || HASH_TABLE_P (obj)
       || (! NILP (Vprint_gensym)
 	  && SYMBOLP (obj)
 	  && !SYMBOL_INTERNED_P (obj)))
@@ -2031,6 +2033,7 @@
       else if (HASH_TABLE_P (obj))
 	{
 	  struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
+#if 0
 	  strout ("#<hash-table", -1, -1, printcharfun, 0);
 	  if (SYMBOLP (h->test))
 	    {
@@ -2047,6 +2050,67 @@
 	  sprintf (buf, " 0x%lx", (unsigned long) h);
 	  strout (buf, -1, -1, printcharfun, 0);
 	  PRINTCHAR ('>');
+#endif
+	  /* Implement a readable output, e.g.:
+	    #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
+	  /* Always print the size. */
+	  sprintf (buf, "#s(hash-table size %ld",
+		   (long) XVECTOR (h->next)->size);
+	  strout (buf, -1, -1, printcharfun, 0);
+
+	  if (!NILP (h->test))
+	    {
+	      strout (" test ", -1, -1, printcharfun, 0);
+	      print_object (h->test, printcharfun, 0);
+	    }
+
+	  if (!NILP (h->weak))
+	    {
+	      strout (" weakness ", -1, -1, printcharfun, 0);
+	      print_object (h->weak, printcharfun, 0);
+	    }
+
+	  if (!NILP (h->rehash_size))
+	    {
+	      strout (" rehash-size ", -1, -1, printcharfun, 0);
+	      print_object (h->rehash_size, printcharfun, 0);
+	    }
+
+	  if (!NILP (h->rehash_threshold))
+	    {
+	      strout (" rehash-threshold ", -1, -1, printcharfun, 0);
+	      print_object (h->rehash_threshold, printcharfun, 0);
+	    }
+
+	  strout (" data ", -1, -1, printcharfun, 0);
+
+	  /* Print the data here as a plist. */
+	  int i;
+
+	  int real_size = HASH_TABLE_SIZE (h);
+	  int size = real_size;
+
+	  /* Don't print more elements than the specified maximum.  */
+	  if (NATNUMP (Vprint_length)
+	      && XFASTINT (Vprint_length) < size)
+	    size = XFASTINT (Vprint_length);
+	  
+	  PRINTCHAR ('(');
+	  for (i = 0; i < size; i++)
+	    if (!NILP (HASH_HASH (h, i)))
+	      {
+		if (i) PRINTCHAR (' ');
+		print_object (HASH_KEY (h, i), printcharfun, 0);
+		PRINTCHAR (' ');
+		print_object (HASH_VALUE (h, i), printcharfun, 0);
+	      }
+
+	  if (size < real_size)
+	    strout (" ...", 4, 4, printcharfun, 0);
+
+	  PRINTCHAR (')');
+	  PRINTCHAR (')');
+
 	}
       else if (BUFFERP (obj))
 	{
@@ -2354,6 +2418,8 @@
   Qfloat_output_format = intern ("float-output-format");
   staticpro (&Qfloat_output_format);
 
+  Fprovide (intern ("hashtable-print-readable"), Qnil);
+  
   DEFVAR_LISP ("print-length", &Vprint_length,
 	       doc: /* Maximum length of list to print before abbreviating.
 A value of nil means no limit.  See also `eval-expression-print-length'.  */);