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

[Lukas Giessmann]

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

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

Modified:
   branches/new-datamodel/src/model/datamodel.lisp

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))
 	  older-topic))))
 
@@ -3587,9 +3588,28 @@
 		   older-char)))))))
 
 
+(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