with-standard-io-syntax

with-standard-io-syntax

[Sam Steingold]

The introduction of print-length and print-level requires the CL-like
macro with-standard-io-syntax which would bind these (and all the future
variables which break read-back consistency) to nil.
Right now, (rgrep "print-length nil" "*.el" "~/src/emacs/trunk/" nil)
produces two dozen places where print-length is bound to nil and a quick
examination shows that the set of variable which need to be bound to nil
for print-read consistency is not uniformly understood.
I already have been bitten by this, and I think others will be sooner
rather than later.

--
Sam Steingold (http://sds.podval.org/) on Ubuntu 12.04 (precise) X 11.0.11103000
http://www.childpsy.net/ http://camera.org http://mideasttruth.com
http://thereligionofpeace.com http://palestinefacts.org http://ffii.org
He who laughs last did not get the joke.

Re: with-standard-io-syntax

[Stefan Monnier]

> The introduction of print-length and print-level requires the CL-like
> macro with-standard-io-syntax which would bind these (and all the future
> variables which break read-back consistency) to nil.
> Right now, (rgrep "print-length nil" "*.el" "~/src/emacs/trunk/" nil)
> produces two dozen places where print-length is bound to nil and a quick
> examination shows that the set of variable which need to be bound to nil
> for print-read consistency is not uniformly understood.
> I already have been bitten by this, and I think others will be sooner
> rather than later.

We could/should probably ignore print-length when print-circle is
non-nil.


        Stefan

Re: with-standard-io-syntax

[Sam Steingold]

> * Stefan Monnier <zbaavre@veb.hzbagerny.pn> [2012-08-22 13:48:43 -0400]:
>
>> The introduction of print-length and print-level requires the CL-like
>> macro with-standard-io-syntax which would bind these (and all the future
>> variables which break read-back consistency) to nil.
>> Right now, (rgrep "print-length nil" "*.el" "~/src/emacs/trunk/" nil)
>> produces two dozen places where print-length is bound to nil and a quick
>> examination shows that the set of variable which need to be bound to nil
>> for print-read consistency is not uniformly understood.
>> I already have been bitten by this, and I think others will be sooner
>> rather than later.
>
> We could/should probably ignore print-length when print-circle is
> non-nil.

This is orthogonal (we can also introduce an all-encompassing
print-readably, but the issue will remain).

There are many variables affecting printing (and more might be added in
the future), and we need a macro which binds them in a way which ensures
read/write consistency, so that package developers do not have to update
their code every time a new variable is introduced.
(http://www.lispworks.com/documentation/HyperSpec/Body/m_w_std_.htm)

The mantra "don't touch these variables and you will be fine" does not
work because some packages (e.g., gnus) bind these vars temporarily and
then the callbacks from them (e.g., bbdb) are screwed wrt read/write
consistency.

-- 
Sam Steingold (http://sds.podval.org/) on Ubuntu 12.04 (precise) X 11.0.11103000
http://www.childpsy.net/ http://ffii.org http://truepeace.org
http://www.memritv.org http://palestinefacts.org http://jihadwatch.org
Our business is run on trust.  We trust you will pay in advance.

Re: with-standard-io-syntax

[Davis Herring]

> This is orthogonal (we can also introduce an all-encompassing
> print-readably, but the issue will remain).

I have a very old patch meant to provide support akin to
`print-readably' (which savehist.el tries to use, but Emacs doesn't
have).  It could obviously be extended to suppress print-length etc.
when it's set.

Davis

--- emacs-cvs/src/print.c.~2007-08-13~	2012-08-22 13:15:06.329475983 -0600
+++ emacs-cvs/src/.#print.c.1.237	2007-09-05 12:03:21.000000000 -0600
@@ -163,6 +163,12 @@
 int print_number_index;
 Lisp_Object Vprint_number_table;

+/* Function to call to print objects with no read syntax. */
+Lisp_Object Qprint_unreadable_function, Vprint_unreadable_function;
+/* We can't use do-while(0) here, so use a dangling else. */
+#define PRINT_UNREADABLE \
+  if (escapeflag && !NILP (Vprint_unreadable_function)) {unreadable =
1; break;} else
+
 /* PRINT_NUMBER_OBJECT returns the I'th object in Vprint_number_table
TABLE.
    PRINT_NUMBER_STATUS returns the status of the I'th object in TABLE.
    See the comment of the variable Vprint_number_table.  */
@@ -1475,6 +1481,9 @@
      int escapeflag;
 {
   char buf[40];
+  /* If we're asked to make readable output, and we can't, and there's a
+     handler for that, set this. */
+  int unreadable = 0;

   QUIT;

@@ -1883,9 +1892,13 @@
 	{
 	  if (escapeflag)
 	    {
-	      strout ("#<process ", -1, -1, printcharfun, 0);
-	      print_string (XPROCESS (obj)->name, printcharfun);
-	      PRINTCHAR ('>');
+	      if (NILP (Vprint_unreadable_function))
+		{
+		  strout ("#<process ", -1, -1, printcharfun, 0);
+		  print_string (XPROCESS (obj)->name, printcharfun);
+		  PRINTCHAR ('>');
+		}
+	      else unreadable = 1;
 	    }
 	  else
 	    print_string (XPROCESS (obj)->name, printcharfun);
@@ -1949,12 +1962,14 @@
 	}
       else if (SUBRP (obj))
 	{
+	  PRINT_UNREADABLE;
 	  strout ("#<subr ", -1, -1, printcharfun, 0);
 	  strout (XSUBR (obj)->symbol_name, -1, -1, printcharfun, 0);
 	  PRINTCHAR ('>');
 	}
       else if (WINDOWP (obj))
 	{
+	  PRINT_UNREADABLE;
 	  strout ("#<window ", -1, -1, printcharfun, 0);
 	  sprintf (buf, "%ld", (long) XFASTINT (XWINDOW (obj)->sequence_number));
 	  strout (buf, -1, -1, printcharfun, 0);
@@ -1967,6 +1982,7 @@
 	}
       else if (HASH_TABLE_P (obj))
 	{
+	  PRINT_UNREADABLE;
 	  struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
 	  strout ("#<hash-table", -1, -1, printcharfun, 0);
 	  if (SYMBOLP (h->test))
@@ -1987,6 +2003,7 @@
 	}
       else if (BUFFERP (obj))
 	{
+	  PRINT_UNREADABLE;
 	  if (NILP (XBUFFER (obj)->name))
 	    strout ("#<killed buffer>", -1, -1, printcharfun, 0);
 	  else if (escapeflag)
@@ -2000,10 +2017,12 @@
 	}
       else if (WINDOW_CONFIGURATIONP (obj))
 	{
+	  PRINT_UNREADABLE;
 	  strout ("#<window-configuration>", -1, -1, printcharfun, 0);
 	}
       else if (FRAMEP (obj))
 	{
+	  PRINT_UNREADABLE;
 	  strout ((FRAME_LIVE_P (XFRAME (obj))
 		   ? "#<frame " : "#<dead frame "),
 		  -1, -1, printcharfun, 0);
@@ -2062,6 +2081,7 @@
       switch (XMISCTYPE (obj))
 	{
 	case Lisp_Misc_Marker:
+	  PRINT_UNREADABLE;
 	  strout ("#<marker ", -1, -1, printcharfun, 0);
 	  /* Do you think this is necessary?  */
 	  if (XMARKER (obj)->insertion_type != 0)
@@ -2079,6 +2099,7 @@
 	  break;

 	case Lisp_Misc_Overlay:
+	  PRINT_UNREADABLE;
 	  strout ("#<overlay ", -1, -1, printcharfun, 0);
 	  if (! XMARKER (OVERLAY_START (obj))->buffer)
 	    strout ("in no buffer", -1, -1, printcharfun, 0);
@@ -2097,27 +2118,32 @@
       /* Remaining cases shouldn't happen in normal usage, but let's print
 	 them anyway for the benefit of the debugger.  */
 	case Lisp_Misc_Free:
+	  PRINT_UNREADABLE;
 	  strout ("#<misc free cell>", -1, -1, printcharfun, 0);
 	  break;

 	case Lisp_Misc_Intfwd:
+	  PRINT_UNREADABLE;
 	  sprintf (buf, "#<intfwd to %ld>", (long) *XINTFWD (obj)->intvar);
 	  strout (buf, -1, -1, printcharfun, 0);
 	  break;

 	case Lisp_Misc_Boolfwd:
+	  PRINT_UNREADABLE;
 	  sprintf (buf, "#<boolfwd to %s>",
 		   (*XBOOLFWD (obj)->boolvar ? "t" : "nil"));
 	  strout (buf, -1, -1, printcharfun, 0);
 	  break;

 	case Lisp_Misc_Objfwd:
+	  PRINT_UNREADABLE;
 	  strout ("#<objfwd to ", -1, -1, printcharfun, 0);
 	  print_object (*XOBJFWD (obj)->objvar, printcharfun, escapeflag);
 	  PRINTCHAR ('>');
 	  break;

 	case Lisp_Misc_Buffer_Objfwd:
+	  PRINT_UNREADABLE;
 	  strout ("#<buffer_objfwd to ", -1, -1, printcharfun, 0);
 	  print_object (PER_BUFFER_VALUE (current_buffer,
 					  XBUFFER_OBJFWD (obj)->offset),
@@ -2126,6 +2152,7 @@
 	  break;

 	case Lisp_Misc_Kboard_Objfwd:
+	  PRINT_UNREADABLE;
 	  strout ("#<kboard_objfwd to ", -1, -1, printcharfun, 0);
 	  print_object (*(Lisp_Object *) ((char *) current_kboard
 					  + XKBOARD_OBJFWD (obj)->offset),
@@ -2134,9 +2161,11 @@
 	  break;

 	case Lisp_Misc_Buffer_Local_Value:
+	  PRINT_UNREADABLE;
 	  strout ("#<buffer_local_value ", -1, -1, printcharfun, 0);
 	  goto do_buffer_local;
 	case Lisp_Misc_Some_Buffer_Local_Value:
+	  PRINT_UNREADABLE;
 	  strout ("#<some_buffer_local_value ", -1, -1, printcharfun, 0);
 	do_buffer_local:
 	  strout ("[realvalue] ", -1, -1, printcharfun, 0);
@@ -2167,6 +2196,7 @@
 	  break;

 	case Lisp_Misc_Save_Value:
+	  PRINT_UNREADABLE;
 	  strout ("#<save_value ", -1, -1, printcharfun, 0);
 	  sprintf(buf, "ptr=0x%08lx int=%d",
 		  (unsigned long) XSAVE_VALUE (obj)->pointer,
@@ -2198,6 +2228,20 @@
       }
     }

+  if (unreadable)
+    {
+      /* Suppress print-unreadable-function.  If we have a real handler, it
+	 has no need to call itself; if we're signaling, a debugger may need
+	 to print what's not printable with the signal enabled!  */
+      int count = SPECPDL_INDEX ();
+      Lisp_Object handler = Vprint_unreadable_function;
+      specbind (Qprint_unreadable_function, Qnil);
+      if (EQ (handler, Qt))
+	xsignal1 (Qinvalid_read_syntax, obj);
+      call2 (handler, obj, printcharfun);
+      unbind_to (count, Qnil);
+    }
+
   print_depth--;
 }
 \f
@@ -2332,6 +2376,15 @@
 that need to be recorded in the table.  */);
   Vprint_number_table = Qnil;

+  DEFVAR_LISP ("print-unreadable-function", &Vprint_unreadable_function,
+	       doc: /* A function to call to print objects having no read syntax.
+It is called with two arguments: the object to print and the output stream.
+If t, an error is signaled to prevent producing unreadable output.
+If nil, hash notation is used.  */);
+  Vprint_unreadable_function = Qnil;
+  Qprint_unreadable_function = intern ("print-unreadable-function");
+  staticpro (&Qprint_unreadable_function);
+
   /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
   staticpro (&Vprin1_to_string_buffer);