about summary refs log tree commit diff
path: root/src/guile
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 /src/guile
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.
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* ...                                                     */