summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorLudovic Courtès2020-11-01 16:38:18 +0100
committerLudovic Courtès2020-11-01 16:38:18 +0100
commit2f4e62c0a0d9e7cf02b93a598287e4ed7713cb2b (patch)
tree68e8b5557785d7aecc826be31c3f63a8e231cff0 /src
parent1f01fe1e1531200a5b712a835f6915fbd8562d32 (diff)
downloadskribilo-2f4e62c0a0d9e7cf02b93a598287e4ed7713cb2b.tar.gz
skribilo-2f4e62c0a0d9e7cf02b93a598287e4ed7713cb2b.tar.lz
skribilo-2f4e62c0a0d9e7cf02b93a598287e4ed7713cb2b.zip
justify: Turn the current justifier into a parameter.
* src/guile/skribilo/utils/justify.scm (*justifiers*): Remove. (*justifier*): New variable. (output-justified, output-token, output-newline) (output-flush, justification-width, with-justification) (with-justification/noflush): Adjust accordingly.
Diffstat (limited to 'src')
-rw-r--r--src/guile/skribilo/utils/justify.scm33
1 files changed, 14 insertions, 19 deletions
diff --git a/src/guile/skribilo/utils/justify.scm b/src/guile/skribilo/utils/justify.scm
index 09ac01f..3484bcf 100644
--- a/src/guile/skribilo/utils/justify.scm
+++ b/src/guile/skribilo/utils/justify.scm
@@ -96,7 +96,7 @@
;* output ... */
;*---------------------------------------------------------------------*/
(define (output-justified str)
- ((car *justifiers*) 'output str))
+ ((*justifier*) 'output str))
;*---------------------------------------------------------------------*/
;* output-token ... */
@@ -105,13 +105,13 @@
;* contains #\spaces. */
;*---------------------------------------------------------------------*/
(define (output-token str)
- ((car *justifiers*) 'output (string-replace-char str #\space #\bs)))
+ ((*justifier*) 'output (string-replace-char str #\space #\bs)))
;*---------------------------------------------------------------------*/
;* output-newline ... */
;*---------------------------------------------------------------------*/
(define (output-newline)
- ((car *justifiers*) 'newline))
+ ((*justifier*) 'newline))
;*---------------------------------------------------------------------*/
;* output-flush ... */
@@ -126,13 +126,13 @@
(lambda (x)
(display (text-string x))
(newline)))
- ((car *justifiers*) 'flush)))
+ ((*justifier*) 'flush)))
;*---------------------------------------------------------------------*/
;* justification-width ... */
;*---------------------------------------------------------------------*/
(define (justification-width)
- ((car *justifiers*) 'width))
+ ((*justifier*) 'width))
;*---------------------------------------------------------------------*/
;* with-justification ... */
@@ -141,11 +141,10 @@
(output-flush (*margin*))
(parameterize ((*margin* (if margin
(+ (*margin*) margin)
- (*margin*))))
- (set! *justifiers* (cons justifier *justifiers*))
+ (*margin*)))
+ (*justifier* justifier))
(thunk)
- (output-flush (*margin*))
- (set! *justifiers* (cdr *justifiers*))))
+ (output-flush (*margin*))))
;*---------------------------------------------------------------------*/
;* with-justification/noflush ... */
@@ -153,12 +152,10 @@
(define* (with-justification/noflush justifier thunk #:optional margin)
(parameterize ((*margin* (if margin
(+ (*margin*) margin)
- (*margin*))))
- (set! *justifiers* (cons justifier *justifiers*))
+ (*margin*)))
+ (*justifier* justifier))
(thunk)
- (let ((res ((car *justifiers*) 'flush)))
- (set! *justifiers* (cdr *justifiers*))
- res)))
+ ((*justifier*) 'flush)))
;*---------------------------------------------------------------------*/
;* *spaces* ... */
@@ -415,11 +412,9 @@
(else
(error "justifier" "Invalid command" cmd))))))))
-;*---------------------------------------------------------------------*/
-;* *justifiers* ... */
-;*---------------------------------------------------------------------*/
-(define *justifiers* (list (make-justifier *text-column-width*
- *text-justification*)))
+(define *justifier*
+ (make-parameter (make-justifier *text-column-width*
+ *text-justification*)))
;;; justify.scm ends here