diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/guile/skribilo/utils/justify.scm | 21 | ||||
| -rw-r--r-- | src/guile/skribilo/utils/text-table.scm | 25 |
2 files changed, 34 insertions, 12 deletions
diff --git a/src/guile/skribilo/utils/justify.scm b/src/guile/skribilo/utils/justify.scm index 733f53f..c47b14f 100644 --- a/src/guile/skribilo/utils/justify.scm +++ b/src/guile/skribilo/utils/justify.scm @@ -21,6 +21,9 @@ (define-module (skribilo utils justify) :use-module (srfi srfi-13) + :autoload (srfi srfi-34) (raise) + :use-module (srfi srfi-35) + :use-module (skribilo condition) :export (make-justifier output-flush *text-column-width* @@ -219,7 +222,7 @@ (nb-chars (apply + (map string-length tokens))) (all-spaces (- width nb-chars)) - (one-spaces (/ all-spaces + (one-spaces (/ all-spaces 1.0 (- nb-tokens 1))) (cursor (string-length (car tokens)))) (string-insert! result (car tokens) 0) @@ -268,12 +271,15 @@ ;* make-centered-line ... */ ;*---------------------------------------------------------------------*/ (define (make-centered-line tokens width) + (let ((width (if (inexact? width) + (inexact->exact (round width)) + (round width)))) (make-formated-line tokens width (quotient (- width (+ (apply + (map string-length tokens)) (- (length tokens) 1))) - 2))) + 2)))) ;*---------------------------------------------------------------------*/ ;* make-flushleft-line ... */ @@ -337,6 +343,11 @@ ;* make-justifier ... */ ;*---------------------------------------------------------------------*/ (define (make-justifier width policy) + (and (or (not (number? width)) (< width 0)) + (raise (condition + (&invalid-argument-error (proc-name "make-justifier") + (argument width))))) + (let ((tokens '())) (if (eq? policy 'verbatim) (lambda (cmd . vals) @@ -393,7 +404,11 @@ (if (pair? ntokens) (let ((toks (reverse! ntokens))) (set! tokens '()) - (tokens-justify justifier toks width)) + (tokens-justify justifier toks + (if (inexact? width) + (round + (inexact->exact width)) + (round width)))) '()))) ((width) width) diff --git a/src/guile/skribilo/utils/text-table.scm b/src/guile/skribilo/utils/text-table.scm index 2f6d2d2..b90517a 100644 --- a/src/guile/skribilo/utils/text-table.scm +++ b/src/guile/skribilo/utils/text-table.scm @@ -50,14 +50,14 @@ (awidth (- (cond ((integer? width) width) - ((inexact? width) + ((and (number? width) (inexact? width)) (inexact->exact (* width (justification-width)))) (else (justification-width))) ;; remove one characters per columns separation (- nc 1))) (colswidth (rows-requested-sizes obj nc awidth)) - (lcolswidth (vector->list colswidth)) + (lcolswidth (map round-to-exact (vector->list colswidth))) (nb-def-cols (length (filter (lambda (s) (= s 0)) lcolswidth))) (defcolwidth (if (= nb-def-cols 0) 0 @@ -81,7 +81,7 @@ (loop (+ i 1) (+ sum defcolwidth))) (loop (+ i 1) (+ sum (vector-ref colswidth i)))))) ;; at that point colswidth contains the width of each colums. - (let ((lcolswidth (vector->list colswidth)) + (let ((lcolswidth (map round-to-exact (vector->list colswidth))) (hrows (map (lambda (r) (table-row-format r nc colswidth scribe->ascii)) rows))) @@ -111,9 +111,10 @@ (define (table-row-format row nbcols colswidth scribe->ascii) (define (cell-width cnum cspan) (let ((v (do ((i cnum (+ i 1)) - (w 0 (+ w (vector-ref colswidth i)))) + (w 0 (+ w (round-to-exact (vector-ref colswidth i))))) ((= i (+ cnum cspan)) w)))) (+ v (- cspan 1)))) + (let ((cells (markup-body row))) (let loop ((cells cells) (cnum 0) @@ -192,7 +193,7 @@ (if (= lfmt nblines) fmt (let* ((new (- nblines lfmt)) - (new/2 (inexact->exact (/ new 2)))) + (new/2 (inexact->exact (round (/ new 2))))) (case (markup-option cell :valign) ((top) (append fmt (make-filler-lines new))) @@ -237,14 +238,20 @@ (loop (cdr cells) (+ col cspan))))))) (markup-body table)) rsizes)) - -;*---------------------------------------------------------------------*/ -;* smallest-map ... */ -;*---------------------------------------------------------------------*/ + + +;;; +;;; Convenience functions. +;;; + (define (smallest-map f l1 l2) (if (or (null? l1) (null? l2)) '() (cons (f (car l1) (car l2)) (smallest-map f (cdr l1) (cdr l2))))) +(define (round-to-exact w) + (if (inexact? w) + (inexact->exact (round w)) + (round w))) ;;; text-table.scm ends here |