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