From 6a5a1c87c834a5a860882f36b3296dfda02774bc Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Mon, 30 Aug 2004 21:40:17 +0000
Subject: [PATCH] COMPUTE-TAB-SIZE: o Previous changes were wrong.  This
 version handles relative and   section-relative columns correctly,  I think.

PPRINT-TABULAR
o The computation of colinc was wrong---I don't think we need to add
  one to tabsize.
o I don't think we should output the space character.  It results in
  one extra space.

With these changes, the format tests in ansi-tests for ~T and friends
pass.  I think these are right now, but I'm not 100% sure.
---
 code/pprint.lisp | 37 +++++++++++++++----------------------
 1 file changed, 15 insertions(+), 22 deletions(-)

diff --git a/code/pprint.lisp b/code/pprint.lisp
index 50d1b10b4..2dbcb9237 100644
--- a/code/pprint.lisp
+++ b/code/pprint.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pprint.lisp,v 1.37 2004/08/28 05:13:35 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pprint.lisp,v 1.38 2004/08/30 21:40:17 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -389,14 +389,11 @@
 	(colnum (tab-colnum tab))
 	(colinc (tab-colinc tab)))
     (cond ((tab-relativep tab)
-	   (cond ((tab-sectionp tab)
-		  (setf colnum (* colinc (ceiling colnum colinc))))
-		 (t
-		  (unless (<= colinc 1)
-		    (let ((newposn (+ column colnum)))
-		      (let ((rem (rem newposn colinc)))
-			(unless (zerop rem)
-			  (incf colnum (- colinc rem))))))))
+	   (unless (<= colinc 1)
+	     (let ((newposn (+ (- column origin) colnum)))
+	       (let ((rem (rem newposn colinc)))
+		 (unless (zerop rem)
+		   (incf colnum (- colinc rem))))))
 	   colnum)
 	  ((< column (+ colnum origin))
 	   (- (+ colnum origin) column))
@@ -903,19 +900,15 @@
    ATSIGN? is ignored (but allowed so that PPRINT-TABULAR can be used with
    the ~/.../ format directive."
   (declare (ignore atsign?))
-  ;; I (rtoy) think the given tabsize is one less than the colinc
-  ;; parameter to pprint-tab. (16 is the default tabsize.)
-  (let ((colinc (1+ (or tabsize 16))))
-    (pprint-logical-block (stream list
-				  :prefix (if colon? "(")
-				  :suffix (if colon? ")"))
-      (pprint-exit-if-list-exhausted)
-      (loop
-	 (output-object (pprint-pop) stream)
-	 (pprint-exit-if-list-exhausted)
-	 (write-char #\space stream)
-	 (pprint-tab :section-relative 0 colinc stream)
-	 (pprint-newline :fill stream)))))
+  (pprint-logical-block (stream list
+				:prefix (if colon? "(")
+				:suffix (if colon? ")"))
+    (pprint-exit-if-list-exhausted)
+    (loop
+       (output-object (pprint-pop) stream)
+       (pprint-exit-if-list-exhausted)
+       (pprint-tab :section-relative 0 (or tabsize 16) stream)
+       (pprint-newline :fill stream))))
 
 
 ;;;; Pprint-dispatch tables.
-- 
GitLab