aboutsummaryrefslogtreecommitdiff
path: root/src/guile
diff options
context:
space:
mode:
Diffstat (limited to 'src/guile')
-rw-r--r--src/guile/skribilo/utils/justify.scm21
-rw-r--r--src/guile/skribilo/utils/text-table.scm25
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