From b594657ce02d1d79a1eec77178637436d5703462 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Tue, 13 Mar 2007 18:58:42 +0000
Subject: `diff' package: Various fixes.

* src/guile/skribilo/package/diff.scm (%undiffable-markups): Added
  `numref' and `eq'.
  (make-diff-document)[undiffable?]: New.
  For containers, check whether they are undiffable.
  For lists, iterate until AST2 is empty, not until the smallest is
  empty.
  Added an `(equal? ast1 ast2)' cond clause.

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

(limited to 'src')

diff --git a/src/guile/skribilo/package/diff.scm b/src/guile/skribilo/package/diff.scm
index 6e8c60b..116a6bd 100644
--- a/src/guile/skribilo/package/diff.scm
+++ b/src/guile/skribilo/package/diff.scm
@@ -166,7 +166,8 @@
 
 (define %undiffable-markups
   ;; List of markups to not diff.
-  '(ref url-ref bib-ref bib-ref+ line-ref unref
+  '(ref url-ref bib-ref bib-ref+ line-ref unref numref
+    eq     ;; XXX: not supported because of the `eq-evaluate' thing
     figref ;; non-standard
     mark
     image symbol lout-illustration
@@ -197,7 +198,12 @@
 
 (define (make-diff-document ast1 ast2)
   ;; Return a document based on AST2 that highlights differences between AST1
-  ;; and AST2, enclosing unchanged parts in `unchanged' markups, etc.
+  ;; and AST2, enclosing unchanged parts in `unchanged' markups, etc.  AST2
+  ;; is used as the "reference" tree, thus changes from AST1 to AST2 are
+  ;; shown in the resulting document.
+  (define (undiffable? kind)
+    (memq kind %undiffable-markups))
+
   (let loop ((ast1 ast1)
              (ast2 ast2))
     ;;(format (current-error-port) "diff: ~a ~a~%" ast1 ast2)
@@ -240,10 +246,13 @@
                   (ident   ident)
                   (class   class)
                   (options opts)
-                  (body (loop (if (markup? ast1)
-                                  (markup-body ast1)
-                                  ast1)
-                              body)))))
+                  (body (if (undiffable? kind)
+                            body
+                            (loop (if (and (container? ast1)
+                                           (is-markup? ast1 kind))
+                                      (markup-body ast1)
+                                      ast1)
+                                  body))))))
 
           ((markup? ast2)
            (let ((kind  (markup-markup ast2))
@@ -256,20 +265,32 @@
                   (ident   ident)
                   (class   class)
                   (options opts)
-                  (body (if (memq kind %undiffable-markups)
+                  (body (if (undiffable? kind)
                             body
-                            (loop (if (markup? ast1)
+                            (loop (if (is-markup? ast1 kind)
                                       (markup-body ast1)
                                       ast1)
                                   body))))))
 
           ((list? ast2)
            (if (list? ast1)
-               (map loop ast1 ast2)
+               (let liip ((ast1 ast1)
+                          (ast2 ast2)
+                          (result '()))
+                 (if (null? ast2)
+                     (reverse! result)
+                     (liip (if (null? ast1) ast1 (cdr ast1))
+                           (cdr ast2)
+                           (cons (loop (if (null? ast1) #f (car ast1))
+                                       (car ast2))
+                                 result))))
                (map (lambda (x)
                       (loop ast1 x))
                     ast2)))
 
+          ((equal? ast1 ast2)
+           (unchanged ast1))
+
           (else
            (insertion ast2)))))
 
-- 
cgit v1.2.3