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