[isidorus-cvs] r353 - in trunk/src: json model

[Lukas Giessmann]

Author: lgiessmann
Date: Fri Nov 26 10:46:50 2010
New Revision: 353

Log:
datamodel: fixed ticket #97 => all classes are finalized manually after they are defined

Modified:
   trunk/src/json/json_exporter.lisp
   trunk/src/model/datamodel.lisp

Modified: trunk/src/json/json_exporter.lisp
==============================================================================
--- trunk/src/json/json_exporter.lisp	(original)
+++ trunk/src/json/json_exporter.lisp	Fri Nov 26 10:46:50 2010
@@ -382,18 +382,12 @@
 	(tm-ids
 	 (concatenate
 	  'string "\"tmIds\":"
-	  (if (in-topicmaps (topic instance))
-	      (let ((j-tm-ids "["))
-		(loop for item in (in-topicmaps (topic instance))
-		   do (setf j-tm-ids
-			    (concatenate
-			     'string j-tm-ids 
-			     (json:encode-json-to-string
-			      (d:uri (first (d:item-identifiers item
-								:revision revision))))
-			     ",")))
-		(concatenate 'string (subseq j-tm-ids 0 (- (length j-tm-ids) 1)) "]"))
-	      "null"))))
+	  (let ((uris
+		 (loop for tm in (in-topicmaps (topic instance))
+		    collect (map 'list #'d:uri
+				 (item-identifiers tm :revision revision)))))
+	    (concatenate 'string (json:encode-json-to-string
+				  (remove-if #'null uris)))))))
     (concatenate 'string "{" main-topic "," topicStubs "," associations
 		 "," tm-ids "}")))
 

Modified: trunk/src/model/datamodel.lisp
==============================================================================
--- trunk/src/model/datamodel.lisp	(original)
+++ trunk/src/model/datamodel.lisp	Fri Nov 26 10:46:50 2010
@@ -280,11 +280,6 @@
   (:documentation "An abstract base class for all pointers."))
 
 
-(defpclass IdentifierC(PointerC)
-  ()
-  (:documentation "An abstract base class for all TM-Identifiers."))
-
-
 (defpclass TopicIdentificationC(PointerC)
   ((xtm-id :initarg :xtm-id
 	   :accessor xtm-id
@@ -298,6 +293,11 @@
                    representing one of them."))
 
 
+(defpclass IdentifierC(PointerC)
+  ()
+  (:documentation "An abstract base class for all TM-Identifiers."))
+
+
 (defpclass SubjectLocatorC(IdentifierC)
   ()
   (:index t)
@@ -3159,6 +3159,7 @@
 		   construct 'reifier :start-revision revision)))
       (when assocs ;assocs must be nil or a list with exactly one item
 	(reifier-topic (first assocs))))))
+1
 
 
 (defgeneric add-item-identifier (construct item-identifier &key revision)
@@ -4417,4 +4418,21 @@
 		   possible-characteristics))))
 	(when equivalent-construct
 	  (merge-constructs (first equivalent-construct) new-characteristic
-			    :revision revision))))))
\ No newline at end of file
+			    :revision revision))))))
+
+
+;; fixes a bug in elephant, where sb-mop:finalize-inheritance is called too late
+(let ((classes
+       (map 'list #'find-class
+	    (list 'TopicMapConstructC 'PointerC 'IdentifierC 'PersistentIdC
+		  'ItemIdentifierC 'SubjectLocatorC 'TopicIdentificationC
+		  'ReifiableConstructC 'TopicC 'TopicMapC 'AssociationC
+		  'RoleC 'CharacteristicC 'ScopableC 'TypableC 'NameC
+		  'OccurrenceC 'VariantC 'DatatypableC 'VersionedConstructC
+		  'VersionedAssociationC 'PointerAssociationC 'ItemIdAssociationC
+		  'TopicIdAssociationC 'PersistentIdAssociationC
+		  'SubjectLocatorAssociationC 'ReifierAssociationC
+		  'CharacteristicAssociationC 'OccurrenceAssociationC
+		  'NameAssociationC 'VariantAssociationC 'RoleAssociationC
+		  'ScopeAssociationC 'TypeAssociationC 'PlayerAssociationC))))
+  (map 'list #'sb-mop:finalize-inheritance classes))
\ No newline at end of file