Added `markup-option-set!'.

* src/guile/skribilo/ast.scm (markup-option-set!): New.

* src/guile/skribilo/engine/lout.scm (markup-option-set!): Removed.
  (lout-start-large-scale-structure): Don't invoke `markup-option-set!'
  on markups that are not a large-scale structure.

git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-80

2 files changed, 21 insertions, 19 deletions

diff --git a/src/guile/skribilo/ast.scm b/src/guile/skribilo/ast.scm
index 3968b18..f335dbd 100644
--- a/src/guile/skribilo/ast.scm
+++ b/src/guile/skribilo/ast.scm
@@ -22,6 +22,7 @@
 (define-module (skribilo ast)
   :use-module (oop goops)
   :autoload (skribilo location) (location?)
+  :autoload (skribilo lib) (skribe-type-error skribe-error)
   :use-module (skribilo utils syntax)
   :export (<ast> ast? ast-loc ast-loc-set!
 		 ast-parent ast->string ast->file-location
@@ -36,7 +37,8 @@
 	   <markup> markup? bind-markup! markup-options is-markup?
 		    markup-markup markup-body markup-ident markup-class
 		    find-markups
-		    markup-option markup-option-add! markup-output
+		    markup-option markup-option-set!
+		    markup-option-add! markup-output
 		    markup-parent markup-document markup-chapter
 
 	   <container> container? container-options
@@ -222,6 +224,14 @@
 	     (cadr c)))
       (skribe-type-error 'markup-option "Illegal markup: " m "markup")))
 
+(define (markup-option-set! m opt val)
+  (if (markup? m)
+      (let ((c (assq opt (slot-ref m 'options))))
+	(if (and (pair? c) (pair? (cdr c)))
+	    (set-cdr! c (list val))
+	    (skribe-error 'markup-option-set! "unknown option: "
+			  m)))
+      (skribe-type-error 'markup-option-set! "Illegal markup: " m "markup")))
 
 (define (markup-option-add! m opt val)
   (if (markup? m)
diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm
index 8727df8..3b62224 100644
--- a/src/guile/skribilo/engine/lout.scm
+++ b/src/guile/skribilo/engine/lout.scm
@@ -1136,7 +1136,7 @@
 			 (lout-make-doc-cover-sheet n e))))
 
 	       (if doc-style?
-		   ;; Putting it here will only works with `doc' documents.
+		   ;; Putting it here will only work with `doc' documents.
 		   (lout-output-pdf-meta-info n e))))
 
    :after (lambda (n e)
@@ -1363,21 +1363,6 @@
 	 (printf "\n\n@End @~a\n\n" lout-markup))))
 
 
-(define (markup-option-set! m opt val)
-  ;; Sets the value of markup option `opt' of markup `m' to `val'.
-  (let ((o (assoc opt (markup-options m))))
-    (if o
-	(begin
-;	  (set-cdr! o val)
-	  (markup-option-add! m opt val) ;; FIXME: the above method fails
-	  (if (not (eq? (markup-option m opt) val))
-	      (skribe-error 'markup-option-set!
-			    "Doesn't work!" (markup-option m opt))))
-	(begin
-	  (lout-debug "markup-option-set!: markup ~a doesn't have option ~a"
-		      m opt)
-	  #f))))
-
 (define (lout-markup-child-type skribe-markup)
   ;; Return the child markup type of `skribe-markup' (e.g. for `chapter',
   ;; return `section').
@@ -1413,8 +1398,15 @@
 	      ;; first section while other styles don't.
 	      (printf "\n@Begin~as\n" lout-markup-name))
 
-	  ;; update the `&substructs-started?' option of the parent
-	  (markup-option-set! parent '&substructs-started? #t)
+	  ;; FIXME: We need to make sure that PARENT is a large-scale
+	  ;; structure, otherwise it won't have the `&substructs-started?'
+	  ;; option (e.g., if PARENT is a `color' markup).  I need to clarify
+	  ;; this.
+	  (if (memq (markup-markup parent)
+		    '(document chapter section subsection subsubsection))
+	      ;; update the `&substructs-started?' option of the parent
+	      (markup-option-set! parent '&substructs-started? #t))
+
 	  (lout-debug "start-struct: updated parent: ~a"
 		      (markup-option parent '&substructs-started?))))