aboutsummaryrefslogtreecommitdiff
path: root/src/guile
diff options
context:
space:
mode:
Diffstat (limited to 'src/guile')
-rw-r--r--src/guile/skribilo/engine/info.scm23
-rw-r--r--src/guile/skribilo/utils/justify.scm40
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* ... */