Skip to content
Snippets Groups Projects
Commit 6a5a1c87 authored by rtoy's avatar rtoy
Browse files

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.
parent d0eecd42
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (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 @@ ...@@ -389,14 +389,11 @@
(colnum (tab-colnum tab)) (colnum (tab-colnum tab))
(colinc (tab-colinc tab))) (colinc (tab-colinc tab)))
(cond ((tab-relativep tab) (cond ((tab-relativep tab)
(cond ((tab-sectionp tab) (unless (<= colinc 1)
(setf colnum (* colinc (ceiling colnum colinc)))) (let ((newposn (+ (- column origin) colnum)))
(t (let ((rem (rem newposn colinc)))
(unless (<= colinc 1) (unless (zerop rem)
(let ((newposn (+ column colnum))) (incf colnum (- colinc rem))))))
(let ((rem (rem newposn colinc)))
(unless (zerop rem)
(incf colnum (- colinc rem))))))))
colnum) colnum)
((< column (+ colnum origin)) ((< column (+ colnum origin))
(- (+ colnum origin) column)) (- (+ colnum origin) column))
...@@ -903,19 +900,15 @@ ...@@ -903,19 +900,15 @@
ATSIGN? is ignored (but allowed so that PPRINT-TABULAR can be used with ATSIGN? is ignored (but allowed so that PPRINT-TABULAR can be used with
the ~/.../ format directive." the ~/.../ format directive."
(declare (ignore atsign?)) (declare (ignore atsign?))
;; I (rtoy) think the given tabsize is one less than the colinc (pprint-logical-block (stream list
;; parameter to pprint-tab. (16 is the default tabsize.) :prefix (if colon? "(")
(let ((colinc (1+ (or tabsize 16)))) :suffix (if colon? ")"))
(pprint-logical-block (stream list (pprint-exit-if-list-exhausted)
:prefix (if colon? "(") (loop
:suffix (if colon? ")")) (output-object (pprint-pop) stream)
(pprint-exit-if-list-exhausted) (pprint-exit-if-list-exhausted)
(loop (pprint-tab :section-relative 0 (or tabsize 16) stream)
(output-object (pprint-pop) stream) (pprint-newline :fill stream))))
(pprint-exit-if-list-exhausted)
(write-char #\space stream)
(pprint-tab :section-relative 0 colinc stream)
(pprint-newline :fill stream)))))
;;;; Pprint-dispatch tables. ;;;; Pprint-dispatch tables.
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment