[isidorus-cvs] r265 - branches/new-datamodel/src/model

Lukas Giessmann lgiessmann at common-lisp.net
Tue Apr 6 19:44:44 UTC 2010

Author: lgiessmann
Date: Tue Apr  6 15:44:44 2010
New Revision: 265

new-datamodel: added "merge-constructs" --> "TopicMapC"


Modified: branches/new-datamodel/src/model/datamodel.lisp
--- branches/new-datamodel/src/model/datamodel.lisp	(original)
+++ branches/new-datamodel/src/model/datamodel.lisp	Tue Apr  6 15:44:44 2010
@@ -155,11 +155,12 @@
 (in-package :datamodel)
-;;TODO: mark-as-deleted should call mark as deleted for every owned
+;;TODO: mark-as-deleted should call mark-as-deleted for every owned
 ;;      versioned-construct of the called construct
-;;TODO: check for duplicate identifiers after topic-creation/merge
 ;;TODO: add: add-to-version-history (parent) to all
 ;;      "add-<construct>"/"delete-<construct>" generics
+;; ===>> adapt exist-in-revision-history
+;;TODO: check for duplicate identifiers after topic-creation/merge
 ;;TODO: check merge-constructs in add-topic-identifier,
 ;;      add-item-identifier/add-reifier (can merge the parent constructs
 ;;      and the parent's parent construct + the reifier constructs),
@@ -871,7 +872,7 @@
 ;;; VersionedConstructC
-(defgeneric does-not-exist-in-revision-history (versioned-construct)
+(defgeneric exist-in-revision-history-? (versioned-construct)
   (:documentation "Returns t if the passed construct does not exist in any
                    revision, i.e. the construct has no version-infos or exactly
                    one whose start-revision is equal to its end-revision.")
@@ -3527,7 +3528,7 @@
 	  (move-reified-construct newer-topic older-topic :revision revision)
 	  (merge-changed-constructs older-topic :revision revision)
 	  (mark-as-deleted newer-topic :revision revision)
-	  (when (does-not-exist-in-revision-history newer-topic)
+	  (when (exist-in-revision-history-? newer-topic)
 	    (delete-construct newer-topic))
@@ -3587,9 +3588,28 @@
+(defmethod merge-constructs ((construct-1 TopicMapC) (construct-2 TopicMapC)
+			     &key (revision *TM-REVISION*))
+  (declare (integer revision))
+  (if (eql construct-1 construct-2)
+      construct-1
+      (let ((older-tm (find-oldest-construct construct-1 construct-2)))
+	(let ((newer-tm (if (eql older-tm construct-1)
+			    construct-2
+			    construct-1)))
+	  (move-referenced-constructs newer-tm older-tm :revision revision)
+	  (dolist (top-or-assoc (append (topics newer-tm) (associations newer-tm)))
+	    (add-to-tm top-or-assoc top-or-assoc))
+	  (add-to-version-history older-tm :start-revision revision)
+	  (mark-as-deleted newer-tm :revision revision)
+	  (when (exist-in-revision-history-? newer-tm)
+	    (delete-construct newer-tm))
+	  older-tm))))
-;TODO: merge-constructs: RoleC (merge parents), AssociationC, TopicMapC,
+;TODO: merge-constructs: RoleC (merge parents), AssociationC

More information about the Isidorus-cvs mailing list