diff options
Diffstat (limited to 'src/guile')
| -rw-r--r-- | src/guile/skribilo/engine/info.scm | 23 | ||||
| -rw-r--r-- | src/guile/skribilo/utils/justify.scm | 40 |
2 files changed, 31 insertions, 32 deletions
diff --git a/src/guile/skribilo/engine/info.scm b/src/guile/skribilo/engine/info.scm index 1aca881..184f31f 100644 --- a/src/guile/skribilo/engine/info.scm +++ b/src/guile/skribilo/engine/info.scm @@ -313,7 +313,7 @@ (output-newline) (info-authors authors) (output-newline) - (output-flush *margin*)))) + (output-flush (*margin*))))) (let ((category (markup-option obj :info-dir-category)) (entry (markup-option obj :info-dir-entry)) @@ -653,7 +653,7 @@ :action (lambda (n e) (let ((body (markup-body n))) (output-newline) - (output-flush *margin*) + (output-flush (*margin*)) (let ((t (block-title n e :number? #t))) (receive (next prev top) (node-next+prev+up n e) @@ -672,7 +672,7 @@ :options '(:title :info-node :number :toc :env :file) :action (lambda (n e) (let ((body (markup-body n))) - (output-flush *margin*) + (output-flush (*margin*)) (let ((t (block-title n e :number? #t))) (receive (next prev top) (node-next+prev+up n e) @@ -688,7 +688,7 @@ :options '(:title :info-node :number :toc :env :file) :action (lambda (n e) (let ((body (markup-body n))) - (output-flush *margin*) + (output-flush (*margin*)) (let ((t (block-title n e :number? #t))) (receive (next prev top) (node-next+prev+up n e) @@ -704,7 +704,7 @@ :action (lambda (n e) (unless (first-paragraph? n) (output-newline)) - (output-flush *margin*) + (output-flush (*margin*)) (unless (first-paragraph? n) (display " ")) (output (markup-body n) e))) @@ -717,7 +717,7 @@ :action (lambda (n e) (let ((body (markup-body n))) (output-newline) - (output-flush *margin*) + (output-flush (*margin*)) (let ((t (block-title n e :number? #t))) (receive (next prev top) (node-next+prev+up n e) @@ -750,12 +750,12 @@ :frame :rules :cellpadding :rulecolor) :action (lambda (n e) (let ((border (markup-option n :border))) - (output-flush *margin*) + (output-flush (*margin*)) (if border (border-table->info n) (table->ascii n (lambda (obj) (output obj e)))) - (output-flush *margin*)))) + (output-flush (*margin*))))) ;*---------------------------------------------------------------------*/ ;* info ::&the-bibliography ... */ @@ -811,12 +811,11 @@ :action (lambda (n e) ;; Skip a line and indent the program. (newline) - (set! *margin* (+ 2 *margin*)) (with-justification (make-justifier *text-column-width* 'verbatim) (lambda () - (output (markup-body n) e))) - (set! *margin* (- *margin* 2)))) + (output (markup-body n) e)) + 2))) (markup-writer '&prog-line info-engine :action (lambda (n e) @@ -825,7 +824,7 @@ (and (number? num) (output-justified (format #f "~3d: " num)))) (output (markup-body n) e) - (output-flush *margin*))) + (output-flush (*margin*)))) ;*---------------------------------------------------------------------*/ ;* info ::%image ... */ diff --git a/src/guile/skribilo/utils/justify.scm b/src/guile/skribilo/utils/justify.scm index 4833e0a..09ac01f 100644 --- a/src/guile/skribilo/utils/justify.scm +++ b/src/guile/skribilo/utils/justify.scm @@ -1,6 +1,6 @@ ;;; justify.scm -- Producing justified text. ;;; -;;; Copyright 2008 Ludovic Courtès <ludo@gnu.org> +;;; Copyright 2008, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright 2001 Manuel Serrano ;;; ;;; @@ -90,7 +90,7 @@ (lambda () (output-justified str))))) -(define *margin* 0) +(define *margin* (make-parameter 0)) ;*---------------------------------------------------------------------*/ ;* output ... */ @@ -137,28 +137,28 @@ ;*---------------------------------------------------------------------*/ ;* with-justification ... */ ;*---------------------------------------------------------------------*/ -(define (with-justification justifier thunk . margin) - (output-flush *margin*) - (let ((old-margin *margin*)) - (if (pair? margin) (set! *margin* (+ *margin* (car margin)))) - (set! *justifiers* (cons justifier *justifiers*)) - (thunk) - (output-flush *margin*) - (set! *justifiers* (cdr *justifiers*)) - (set! *margin* old-margin))) +(define* (with-justification justifier thunk #:optional margin) + (output-flush (*margin*)) + (parameterize ((*margin* (if margin + (+ (*margin*) margin) + (*margin*)))) + (set! *justifiers* (cons justifier *justifiers*)) + (thunk) + (output-flush (*margin*)) + (set! *justifiers* (cdr *justifiers*)))) ;*---------------------------------------------------------------------*/ ;* with-justification/noflush ... */ ;*---------------------------------------------------------------------*/ -(define (with-justification/noflush justifier thunk . margin) - (let ((old-margin *margin*)) - (if (pair? margin) (set! *margin* (+ *margin* (car margin)))) - (set! *justifiers* (cons justifier *justifiers*)) - (thunk) - (let ((res ((car *justifiers*) 'flush))) - (set! *justifiers* (cdr *justifiers*)) - (set! *margin* old-margin) - res))) +(define* (with-justification/noflush justifier thunk #:optional margin) + (parameterize ((*margin* (if margin + (+ (*margin*) margin) + (*margin*)))) + (set! *justifiers* (cons justifier *justifiers*)) + (thunk) + (let ((res ((car *justifiers*) 'flush))) + (set! *justifiers* (cdr *justifiers*)) + res))) ;*---------------------------------------------------------------------*/ ;* *spaces* ... */ |