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 @@
;;; 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.
......
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