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

[Lukas Giessmann]

Author: lgiessmann
Date: Thu Mar 18 08:50:36 2010
New Revision: 233

Log:
new-datamodel: added the handling of "ReifiableConstructC" to "make-construct"

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	Thu Mar 18 08:50:36 2010
@@ -122,11 +122,9 @@
 
 
 
-;;TODO: check merge-constructs in add-topic-identifier, add-item-identifier,
+;;TODO: check merge-constructs in add-topic-identifier, add-item-identifier
+;;      (can merge the parent construct and the parent's parent construct),
 ;;      add-psi, add-locator
-
-;;TODO: all add-<construct> methods hve to add an version info to the
-;;      owner-construct
 ;;TODO: finalize add-reifier
 ;;TODO: replace add-to-version-history in VersionedAssociationC with a pseudo
 ;;      initarg in make-construct
@@ -2329,14 +2327,33 @@
   (let ((start-revision (getf args :start-revision))
 	(uri (getf args :uri))
 	(xtm-id (getf args :xtm-id))
-	(identified-construct (getf args :identified-construct)))
+	(identified-construct (getf args :identified-construct))
+	(charvalue (getf args :charvalue))
+	(datatype (getf args :datatype))
+	(parent-construct (getf args :parent-construct))
+	(themes (getf args :themes))
+	(variants (getf args :variants))
+	(instance-of (getf args :instance-of))
+	(reifier-topic (getf args :reifier))
+	(item-identifiers (getf args :item-identifiers)))
     (let ((construct
 	   (cond
 	     ((PointerC-p class-symbol)
 	      (make-pointer class-symbol uri :start-revision start-revision
 			    :xtm-id xtm-id
-			    :identified-construct identified-construct)))))
-
+			    :identified-construct identified-construct))
+	     ((CharacteristicC-p class-symbol)
+	      (make-characteristic class-symbol charvalue
+				   :start-revision start-revision
+				   :datatype datatype :themes themes
+				   :instance-of instance-of :variants variants
+				   :parent-construct parent-construct)))))
+
+      (when (typep construct 'ReifiableConstructC)
+	(when reifier-topic
+	  (add-reifier construct reifier-topic :revision start-revision))
+	(dolist (ii item-identifiers)
+	  (add-item-identifier construct ii :revision start-revision)))
       construct)))