From 1f01fe1e1531200a5b712a835f6915fbd8562d32 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 1 Nov 2020 15:48:55 +0100 Subject: justify: Turn '*margin*' into a parameter. * src/guile/skribilo/utils/justify.scm (*margin*): Turn into a parameter. (with-justification, with-justification/noflush): Use 'parameterize' instead of 'set!'. * src/guile/skribilo/engine/info.scm: Adjust accordingly. * doc/modules/skribilo/documentation/api.scm (doc-markup): Likewise. --- doc/modules/skribilo/documentation/api.scm | 5 ++-- src/guile/skribilo/engine/info.scm | 23 ++++++++--------- src/guile/skribilo/utils/justify.scm | 40 +++++++++++++++--------------- 3 files changed, 33 insertions(+), 35 deletions(-) diff --git a/doc/modules/skribilo/documentation/api.scm b/doc/modules/skribilo/documentation/api.scm index 21044a7..e7739fb 100644 --- a/doc/modules/skribilo/documentation/api.scm +++ b/doc/modules/skribilo/documentation/api.scm @@ -273,8 +273,7 @@ def @SkribiloExample named @Title {} right x { (let ((protos (markup-option n 'prototypes)) (opts (markup-option n 'options)) (params (markup-option n 'parameters)) - (see (markup-option n 'see-also)) - (margin *margin*)) + (see (markup-option n 'see-also))) (output (linebreak) e) (with-justification @@ -284,7 +283,7 @@ def @SkribiloExample named @Title {} right x { (output "-- Markup: " e) (output p e)) protos)) - (+ *margin* 1)) + 1) (and (pair? opts) (output 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 +;;; Copyright 2008, 2020 Ludovic Courtès ;;; 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* ... */ -- cgit v1.2.3