From f3499346871c1234795da242add35c4cdb520964 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Tue, 27 Mar 2007 15:40:22 +0000
Subject: `diff' package: Compute diffs on selected options.

* src/guile/skribilo/package/diff.scm (%diffable-options): New.
  (make-diff-document)[make-diff-options]: New.
  Use it.

git-archimport-id: lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-29
---
 src/guile/skribilo/package/diff.scm | 28 ++++++++++++++++++++++++----
 1 file changed, 24 insertions(+), 4 deletions(-)

(limited to 'src')

diff --git a/src/guile/skribilo/package/diff.scm b/src/guile/skribilo/package/diff.scm
index 15fdcf2..3aeed08 100644
--- a/src/guile/skribilo/package/diff.scm
+++ b/src/guile/skribilo/package/diff.scm
@@ -189,6 +189,10 @@
     toc
     index &index-entry &the-index &the-index-header))
 
+(define %diffable-options
+  ;; List of diffable options.
+  '(:title :text))
+
 (define (annotated-string-diff str1 str2)
   ;; Return a list (actually an AST) denoting the differences between STR1
   ;; and STR2.  The returned text is actually that of STR2 augmented with
@@ -218,6 +222,18 @@
   (define (undiffable? kind)
     (memq kind %undiffable-markups))
 
+  (define (make-diff-options m1 m2 loop)
+    ;; Return a list of options based on that of markup M2.
+    (map (lambda (opt+val)
+           (let ((opt (car opt+val)))
+             (if (memq opt %diffable-options)
+                 (cons opt
+                       (loop (markup-option m1 opt)
+                             (cdr opt+val)))
+                 opt+val)))
+         (markup-options m2)))
+
+
   (let loop ((ast1 ast1)
              (ast2 ast2))
     ;;(format (current-error-port) "diff: ~a ~a~%" ast1 ast2)
@@ -252,14 +268,16 @@
           ((container? ast2)
            (let ((kind  (markup-markup ast2))
                  (ident (markup-ident ast2))
-                 (opts  (markup-options ast2))
                  (class (markup-class ast2))
                  (body  (markup-body ast2)))
              (new container
                   (markup  kind)
                   (ident   ident)
                   (class   class)
-                  (options opts)
+                  (options (if (or (undiffable? kind)
+                                   (not (container? ast1)))
+                               (markup-options ast2)
+                               (make-diff-options ast1 ast2 loop)))
                   (body (if (undiffable? kind)
                             body
                             (loop (if (and (container? ast1)
@@ -271,14 +289,16 @@
           ((markup? ast2)
            (let ((kind  (markup-markup ast2))
                  (ident (markup-ident ast2))
-                 (opts  (markup-options ast2))
                  (class (markup-class ast2))
                  (body  (markup-body ast2)))
              (new markup
                   (markup  kind)
                   (ident   ident)
                   (class   class)
-                  (options opts)
+                  (options (if (or (undiffable? kind)
+                                   (not (markup? ast1)))
+                               (markup-options ast2)
+                               (make-diff-options ast1 ast2 loop)))
                   (body (if (undiffable? kind)
                             body
                             (loop (if (is-markup? ast1 kind)
-- 
cgit v1.2.3