diff options
| author | Ludovic Courtès | 2020-11-01 16:38:18 +0100 |
|---|---|---|
| committer | Ludovic Courtès | 2020-11-01 16:38:18 +0100 |
| commit | 2f4e62c0a0d9e7cf02b93a598287e4ed7713cb2b (patch) | |
| tree | 68e8b5557785d7aecc826be31c3f63a8e231cff0 | |
| parent | 1f01fe1e1531200a5b712a835f6915fbd8562d32 (diff) | |
| download | skribilo-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.
| -rw-r--r-- | src/guile/skribilo/utils/justify.scm | 33 |
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 |