From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Davis Herring Newsgroups: gmane.emacs.devel Subject: Re: with-standard-io-syntax Date: Wed, 22 Aug 2012 13:31:02 -0600 Organization: XCP-1 Message-ID: <50353376.5070801@lanl.gov> References: <87sjbgqply.fsf@gnu.org> <87y5l6ixts.fsf@gnu.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=ISO-8859-1 Content-Transfer-Encoding: 7bit X-Trace: ger.gmane.org 1345663886 4377 80.91.229.3 (22 Aug 2012 19:31:26 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 22 Aug 2012 19:31:26 +0000 (UTC) Cc: emacs-devel@gnu.org To: sds@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Aug 22 21:31:25 2012 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1T4GeB-00053B-8R for ged-emacs-devel@m.gmane.org; Wed, 22 Aug 2012 21:31:23 +0200 Original-Received: from localhost ([::1]:34351 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1T4Ge9-000702-Na for ged-emacs-devel@m.gmane.org; Wed, 22 Aug 2012 15:31:21 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:51600) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1T4Ge1-0006yp-Sm for emacs-devel@gnu.org; Wed, 22 Aug 2012 15:31:19 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1T4Ge0-0003nQ-IN for emacs-devel@gnu.org; Wed, 22 Aug 2012 15:31:13 -0400 Original-Received: from proofpoint4.lanl.gov ([204.121.3.52]:33144) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1T4Gdt-0003mK-Ow; Wed, 22 Aug 2012 15:31:06 -0400 Original-Received: from mailrelay2.lanl.gov (mailrelay2.lanl.gov [128.165.4.103]) by proofpoint4.lanl.gov (8.14.4/8.14.4) with ESMTP id q7MJV38V025965; Wed, 22 Aug 2012 13:31:03 -0600 Original-Received: from localhost (localhost.localdomain [127.0.0.1]) by mailrelay2.lanl.gov (Postfix) with ESMTP id 4FAE419BC7D7; Wed, 22 Aug 2012 13:31:03 -0600 (MDT) X-NIE-2-Virus-Scanner: amavisd-new at mailrelay2.lanl.gov Original-Received: from [128.165.123.145] (xray-r10.lanl.gov [128.165.123.145]) by mailrelay2.lanl.gov (Postfix) with ESMTP id 2CCE719BC7E0; Wed, 22 Aug 2012 13:31:03 -0600 (MDT) User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; en-US; rv:1.9.2.18) Gecko/20110717 Lanikai/3.1.11 In-Reply-To: <87y5l6ixts.fsf@gnu.org> X-Proofpoint-Virus-Version: vendor=fsecure engine=2.50.10432:5.7.7855, 1.0.260, 0.0.0000 definitions=2012-08-22_04:2012-08-22, 2012-08-22, 1970-01-01 signatures=0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6, seldom 2.4 (older, 4) X-Received-From: 204.121.3.52 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:152757 Archived-At: > 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 ("#name, printcharfun); - PRINTCHAR ('>'); + if (NILP (Vprint_unreadable_function)) + { + strout ("#name, printcharfun); + PRINTCHAR ('>'); + } + else unreadable = 1; } else print_string (XPROCESS (obj)->name, printcharfun); @@ -1949,12 +1962,14 @@ } else if (SUBRP (obj)) { + PRINT_UNREADABLE; strout ("#symbol_name, -1, -1, printcharfun, 0); PRINTCHAR ('>'); } else if (WINDOWP (obj)) { + PRINT_UNREADABLE; strout ("#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 ("#test)) @@ -1987,6 +2003,7 @@ } else if (BUFFERP (obj)) { + PRINT_UNREADABLE; if (NILP (XBUFFER (obj)->name)) strout ("#", -1, -1, printcharfun, 0); else if (escapeflag) @@ -2000,10 +2017,12 @@ } else if (WINDOW_CONFIGURATIONP (obj)) { + PRINT_UNREADABLE; strout ("#", -1, -1, printcharfun, 0); } else if (FRAMEP (obj)) { + PRINT_UNREADABLE; strout ((FRAME_LIVE_P (XFRAME (obj)) ? "#insertion_type != 0) @@ -2079,6 +2099,7 @@ break; case Lisp_Misc_Overlay: + PRINT_UNREADABLE; strout ("#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 ("#", -1, -1, printcharfun, 0); break; case Lisp_Misc_Intfwd: + PRINT_UNREADABLE; sprintf (buf, "#", (long) *XINTFWD (obj)->intvar); strout (buf, -1, -1, printcharfun, 0); break; case Lisp_Misc_Boolfwd: + PRINT_UNREADABLE; sprintf (buf, "#", (*XBOOLFWD (obj)->boolvar ? "t" : "nil")); strout (buf, -1, -1, printcharfun, 0); break; case Lisp_Misc_Objfwd: + PRINT_UNREADABLE; strout ("#objvar, printcharfun, escapeflag); PRINTCHAR ('>'); break; case Lisp_Misc_Buffer_Objfwd: + PRINT_UNREADABLE; strout ("#offset), @@ -2126,6 +2152,7 @@ break; case Lisp_Misc_Kboard_Objfwd: + PRINT_UNREADABLE; strout ("#offset), @@ -2134,9 +2161,11 @@ break; case Lisp_Misc_Buffer_Local_Value: + PRINT_UNREADABLE; strout ("#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--; } @@ -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);