From 6e582c71d76ea95dbd76e94af83af0e1ebeb5ed9 Mon Sep 17 00:00:00 2001
From: vdhoeven <vdhoeven@64cb5145-927a-446d-8aed-2fb7b4773692>
Date: Thu, 22 Apr 2010 17:52:41 +0000
Subject: [PATCH] Version comparison grain control

git-svn-id: svn://svn.savannah.gnu.org/texmacs/trunk@2970 64cb5145-927a-446d-8aed-2fb7b4773692
---
 src/TeXmacs/progs/version/version-compare.scm | 33 +++++++++++++++++++++------
 src/TeXmacs/progs/version/version-menu.scm    | 12 ++++++----
 2 files changed, 34 insertions(+), 11 deletions(-)

diff --git a/src/TeXmacs/progs/version/version-compare.scm b/src/TeXmacs/progs/version/version-compare.scm
index f99fc0fa..0ff88d1b 100644
--- a/src/TeXmacs/progs/version/version-compare.scm
+++ b/src/TeXmacs/progs/version/version-compare.scm
@@ -15,6 +15,21 @@
   (:use (version version-edit)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Versioning grain
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define version-grain "detailed")
+
+(tm-define (version-test-grain? w)
+  (== version-grain w))
+
+(tm-define (version-set-grain w)
+  (:synopsis "Set versioning grain.")
+  (:argument w "detailed")
+  (:check-mark "*" version-test-grain?)
+  (set! version-grain w))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Useful subroutines for document comparison
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -178,6 +193,12 @@
 (tm-define (compare-versions t1 t2)
   ;;(display* "compare-versions " t1 ", " t2 "\n\n")
   (cond ((== t1 t2) t1)
+	((== version-grain "rough") (diff t1 t2))
+	((and (== version-grain "block")
+	      (not (tree-multi-paragraph? (tm->tree t1)))
+	      (not (tree-multi-paragraph? (tm->tree t2))))
+	 (diff (if (tree-multi-paragraph? (tm->tree t1)) t1 `(document ,t1))
+	       (if (tree-multi-paragraph? (tm->tree t2)) t2 `(document ,t2))))
 	((and (string? t1) (string? t2))
 	 (compare-versions `(concat ,t1) `(concat ,t2)))
 	((and (not (tm-is? t1 'concat)) (tm-is? t2 'concat))
@@ -234,7 +255,7 @@
 	  (with args (map (lambda (x) (version-get x which)) (cdr t))
 	    (normalize (cons (car t) args))))))
 
-(define (reactualize-differences-sub rough?)
+(define (reactualize-differences-sub)
   (when (selection-active-any?)
     (let* ((t (selection-tree))
 	   (v1 (version-get (tree->stree t) 0))
@@ -242,13 +263,11 @@
       (if (== v1 v2) (insert t)
 	  (begin
 	    (clipboard-cut "dummy")
-	    (if rough?
-		(insert (diff v1 v2))
-		(insert (compare-versions v1 v2))))))))
+	    (insert (compare-versions v1 v2)))))))
 
-(tm-define (reactualize-differences rough?)
+(tm-define (reactualize-differences)
   (if (selection-active-any?)
-      (reactualize-differences-sub rough?)
+      (reactualize-differences-sub)
       (when (inside-version?)
 	(tree-select (tree-innermost version-context?))
-	(reactualize-differences-sub rough?))))
+	(reactualize-differences-sub))))
diff --git a/src/TeXmacs/progs/version/version-menu.scm b/src/TeXmacs/progs/version/version-menu.scm
index 92f512f8..c326d692 100644
--- a/src/TeXmacs/progs/version/version-menu.scm
+++ b/src/TeXmacs/progs/version/version-menu.scm
@@ -48,7 +48,11 @@
     (-> "Retain"
 	("Current version" (version-retain 'current))
 	("Old version" (version-retain 0))
-	("New version" (version-retain 1)))
-    (-> "Reactualize"
-	("Differences" (reactualize-differences #f))
-	("Rough differences" (reactualize-differences #t)))))
+	("New version" (version-retain 1))))
+  ---
+  (-> "Grain"
+      ("Detailed" (version-set-grain "detailed"))
+      ("Block" (version-set-grain "block"))
+      ("Rough" (version-set-grain "rough")))
+  (when (or (inside-version?) (selection-active-any?))
+    ("Reactualize" (reactualize-differences))))
-- 
2.11.4.GIT