From e1d8ec7c0f8cdbc1652a3b66530e7292a2289925 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Wed, 6 Oct 2004 22:55:57 +0000 Subject: [PATCH] 0.8.15.11: Fix ~< justification directive (patch essentially that applied by rtoy for cmucl 2004-08-27) --- NEWS | 2 ++ src/code/target-format.lisp | 9 ++++----- version.lisp-expr | 2 +- 3 files changed, 7 insertions(+), 6 deletions(-) diff --git a/NEWS b/NEWS index 33bd0ce..06d43e5 100644 --- a/NEWS +++ b/NEWS @@ -21,6 +21,8 @@ changes in sbcl-0.8.16 relative to sbcl-0.8.15: ** PPRINT-INDENT accepts a request for an indentation of any REAL. ** PPRINT-TAB (and the FORMAT ~T directive) now indent by the correct amounts. + ** The justification version of the FORMAT ~< directive treats + non-zero minpad parameter correctly. changes in sbcl-0.8.15 relative to sbcl-0.8.14: * incompatible change: SB-INT:*BEFORE-SAVE-INITIALIZATIONS* and diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp index 3860132..a31bc51 100644 --- a/src/code/target-format.lisp +++ b/src/code/target-format.lisp @@ -1113,8 +1113,6 @@ (defun format-justification (stream newline-prefix extra-space line-len strings pad-left pad-right mincol colinc minpad padchar) (setf strings (reverse strings)) - (when (and (not pad-left) (not pad-right) (null (cdr strings))) - (setf pad-left t)) (let* ((num-gaps (+ (1- (length strings)) (if pad-left 1 0) (if pad-right 1 0))) @@ -1125,18 +1123,19 @@ (length (if (> chars mincol) (+ mincol (* (ceiling (- chars mincol) colinc) colinc)) mincol)) - (padding (- length chars))) + (padding (+ (- length chars) (* num-gaps minpad)))) (when (and newline-prefix (> (+ (or (sb!impl::charpos stream) 0) length extra-space) line-len)) (write-string newline-prefix stream)) (flet ((do-padding () - (let ((pad-len (truncate padding num-gaps))) + (let ((pad-len + (if (zerop num-gaps) padding (truncate padding num-gaps)))) (decf padding pad-len) (decf num-gaps) (dotimes (i pad-len) (write-char padchar stream))))) - (when pad-left + (when (or pad-left (and (not pad-right) (null (cdr strings)))) (do-padding)) (when strings (write-string (car strings) stream) diff --git a/version.lisp-expr b/version.lisp-expr index c873ecc..53e4018 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.15.10" +"0.8.15.11" -- 1.7.10.4