aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès2020-11-01 15:48:55 +0100
committerLudovic Courtès2020-11-01 15:53:46 +0100
commit1f01fe1e1531200a5b712a835f6915fbd8562d32 (patch)
tree6abd2305860a59b00eb5d481ed0a00271663a494
parent5d0d8ca978630d9901700a858af25cdde051a2ee (diff)
downloadskribilo-1f01fe1e1531200a5b712a835f6915fbd8562d32.tar.gz
skribilo-1f01fe1e1531200a5b712a835f6915fbd8562d32.tar.lz
skribilo-1f01fe1e1531200a5b712a835f6915fbd8562d32.zip
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.
-rw-r--r--doc/modules/skribilo/documentation/api.scm5
-rw-r--r--src/guile/skribilo/engine/info.scm23
-rw-r--r--src/guile/skribilo/utils/justify.scm40
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 <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* ... */