aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-08-28 00:59:14 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-08-28 00:59:14 +0200
commita418a180b9eb1c542ab3fc1f3651ce6244965862 (patch)
treee133bcc50a170a97c82a57d7a411dac22faa621e
parentRemove unused (sxml html). (diff)
downloadcalp-a418a180b9eb1c542ab3fc1f3651ce6244965862.tar.gz
calp-a418a180b9eb1c542ab3fc1f3651ce6244965862.tar.xz
Some clarifications in text submodules.
-rw-r--r--module/text/flow.scm47
-rw-r--r--module/text/markup.scm7
-rw-r--r--module/text/util.scm11
3 files changed, 40 insertions, 25 deletions
diff --git a/module/text/flow.scm b/module/text/flow.scm
index b9f0e387..528650a5 100644
--- a/module/text/flow.scm
+++ b/module/text/flow.scm
@@ -1,3 +1,8 @@
+;;; Commentary:
+;;; @var{flow-text} take a (multiline) string, and justifies
+;;; its contents. All linebreaks are treated as hard line breaks.
+;;; Code:
+
(define-module (text flow)
:use-module (calp util)
:use-module (text util)
@@ -5,22 +10,11 @@
)
-
-;; (str) -> str
-(define* (justify-line-helper words #:key (width 70))
- (let* ((phrase-length (true-string-length (string-concatenate/shared words)))
- (needed-spaces (- width phrase-length))
- (slots (1- (length words)))
- (space-list
- (let loop ((n needed-spaces) (d slots))
- (unless (zero? d)
- (let ((v (round (/ n d))))
- (cons v (loop (- n v)
- (1- d))))))))
- (string-concatenate/shared
- (merge words (map (lambda (n) (make-string n #\space))
- space-list)
- (let ((f #t)) (lambda _ (set/r! f = not)))))))
+;; str -> (str)
+(define*-public (flow-text str #:key (width 70))
+ (flatten
+ (map (lambda (line) (justify-line line #:width width))
+ (lines str))))
@@ -44,8 +38,19 @@
(else (cons (justify-line-helper head #:width width)
(recur tail)))))))
-;; str -> (str)
-(define*-public (flow-text str #:key (width 70))
- (flatten
- (map (lambda (line) (justify-line line #:width width))
- (lines str))))
+;; (str) -> str
+(define* (justify-line-helper words #:key (width 70))
+ (let* ((phrase-length (true-string-length (string-concatenate/shared words)))
+ (needed-spaces (- width phrase-length))
+ (slots (1- (length words)))
+ (space-list
+ (let loop ((n needed-spaces) (d slots))
+ (unless (zero? d)
+ (let ((v (round (/ n d))))
+ (cons v (loop (- n v)
+ (1- d))))))))
+ (string-concatenate/shared
+ (merge words (map (lambda (n) (make-string n #\space))
+ space-list)
+ (let ((f #t)) (lambda _ (set/r! f = not)))))))
+
diff --git a/module/text/markup.scm b/module/text/markup.scm
index 7e625725..b74fd169 100644
--- a/module/text/markup.scm
+++ b/module/text/markup.scm
@@ -7,6 +7,11 @@
:use-module (text flow)
:use-module (texinfo string-utils))
+;; Takes an HTML-like sxml coded tree, and produces a string with
+;; appropriate spacing and ANSI-escapes for different tags.
+(define-public (sxml->ansi-text tree)
+ ((parse-tree ontree onleaf) tree))
+
(define (esc . effect)
(format #f "\x1b[~am"
@@ -117,5 +122,3 @@
[any (leaf-callback any)]))
-(define-public (sxml->ansi-text tree)
- ((parse-tree ontree onleaf) tree))
diff --git a/module/text/util.scm b/module/text/util.scm
index b2560bf4..b87e29f2 100644
--- a/module/text/util.scm
+++ b/module/text/util.scm
@@ -1,5 +1,10 @@
+;;; Commentary:
+;;; Small utility functions which helps the rest of the text processing.
+;;; Code:
+
(define-module (text util)
- :use-module (calp util))
+ :use-module ((calp util) :select (define*-public intersperce) )
+ )
(define-public (words str) (string-split str #\space))
(define-public (unwords list) (string-join list " " 'infix))
@@ -40,6 +45,8 @@
(cond [(null? list) ""]
[(= 1 (length list)) (car list)]
[else
- (let* (((tail . rest) (reverse list)))
+ (let* ((rev (reverse list))
+ (tail (car rev))
+ (rest (cdr rev)))
(reverse (cons* tail " " final-delim " "
(intersperce ", " rest))))]))