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

[Lukas Giessmann]

Author: lgiessmann
Date: Mon Apr  5 16:50:11 2010
New Revision: 260

Log:
new-datamodel: added "merge-constructs" for "OccurrenceC"

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	Mon Apr  5 16:50:11 2010
@@ -3459,7 +3459,6 @@
 	  (merge-all-constructs (append found-equivalent (list construct))))))))
 
 
-
 (defmethod merge-constructs ((construct-1 TopicC) (construct-2 TopicC)
 			     &key (revision *TM-REVISION*))
   (if (eql construct-1 construct-2)
@@ -3482,6 +3481,34 @@
 	  older-topic))))
 
 
+(defmethod merge-constructs ((construct-1 OccurrenceC) (construct-2 OccurrenceC)
+			     &key (revision *TM-REVISION*))
+  (if (eql construct-1 construct-2)
+      construct-1
+      (progn
+	(unless (strictly-equivalent-constructs construct-1 construct-2
+						:revision revision)
+	  (error "From merge-constructs(): ~a is not mergable with ~a"
+		 construct-1 construct-2))
+	(let ((parent-1 (parent construct-1 :revision revision))
+	      (parent-2 (parent construct-2 :revision revision)))
+	  (when (not (and parent-1 parent-2))
+	    (error "From merge-constructs():~a and ~a must be associated with a topic"
+		   construct-1 construct-2))
+	  (if (and parent-1 (eql parent-1 parent-2))
+	      (progn
+		(move-identifiers construct-1 construct-2 :revision revision)
+		(move-referenced-constructs construct-1 construct-2
+					    :revision revision)
+		(delete-occurrence parent-1 construct-1 :revision revision)
+		(add-occurrence parent-1 construct-2 :revision revision))
+	      (let ((active-topic
+		     (merge-constructs parent-1 parent-2 :revision revision)))
+		(if (find construct-1
+			  (occurrences active-topic :revision revision))
+		    construct-1
+		    construct-2)))))))
+