[isidorus-cvs] r297 - branches/new-datamodel/src/xml/xtm

Lukas Giessmann lgiessmann at common-lisp.net
Sat Jun 12 20:55:30 UTC 2010


Author: lgiessmann
Date: Sat Jun 12 16:55:30 2010
New Revision: 297

Log:
new-datamodel: adapted exporter.lisp, exporter_xtm1.0.lisp and exporter_xtm2.0.lisp to the new datamodel

Modified:
   branches/new-datamodel/src/xml/xtm/exporter.lisp
   branches/new-datamodel/src/xml/xtm/exporter_xtm1.0.lisp
   branches/new-datamodel/src/xml/xtm/exporter_xtm2.0.lisp

Modified: branches/new-datamodel/src/xml/xtm/exporter.lisp
==============================================================================
--- branches/new-datamodel/src/xml/xtm/exporter.lisp	(original)
+++ branches/new-datamodel/src/xml/xtm/exporter.lisp	Sat Jun 12 16:55:30 2010
@@ -10,11 +10,6 @@
 (in-package :exporter)
 
 
-;; (defun instanceofs-to-elem (ios)
-;;   (when ios
-;;       (map 'list (lambda (io) (cxml:with-element "t:instanceOf" (ref-to-elem io))) ios)))
-
-
 (defun list-extern-associations ()
   "gets all instances of AssociationC - which does not realize an instanceOf relationship in the db"
   (let ((instance-topic 
@@ -30,6 +25,7 @@
 			  (eq type-topic (instance-of (second (roles item)))))))
        collect item)))
 
+
 (defmacro with-xtm2.0 (&body body)
   "helper macro to build the Topic Map element"
     `(cxml:with-namespace ("t" *xtm2.0-ns*)
@@ -109,7 +105,7 @@
       (cxml:with-xml-output  (cxml:make-string-sink :canonical nil)
 	(if (eq xtm-format '2.0)
 	    (with-xtm2.0
-              (to-elem fragment))
+              (to-elem fragment (revision fragment)))
 	    (with-xtm1.0
-              (to-elem-xtm1.0 fragment)))))))
+              (to-elem-xtm1.0 fragment (revision fragment))))))))
 	  
\ No newline at end of file

Modified: branches/new-datamodel/src/xml/xtm/exporter_xtm1.0.lisp
==============================================================================
--- branches/new-datamodel/src/xml/xtm/exporter_xtm1.0.lisp	(original)
+++ branches/new-datamodel/src/xml/xtm/exporter_xtm1.0.lisp	Sat Jun 12 16:55:30 2010
@@ -24,35 +24,38 @@
 
 (defparameter *export-tm* nil "TopicMap which is exported (nil if all is to be exported")
 
-(defgeneric to-elem-xtm1.0 (instance)
+(defgeneric to-elem-xtm1.0 (instance revision)
   (:documentation "converts the Topic Maps construct instance to an XTM 1.0 element"))
 
 
-(defun to-topicRef-elem-xtm1.0 (topic)
-  (declare (TopicC topic))
+(defun to-topicRef-elem-xtm1.0 (topic revision)
+  (declare (TopicC topic)
+	   (type (or integer nil) revision))
   (cxml:with-element "t:topicRef"
-    (cxml:attribute "xlink:href" (format nil "#~a" (topic-id topic)))))
+    (cxml:attribute "xlink:href" (format nil "#~a" (topic-id topic revision)))))
 
 
-(defun to-reifier-elem-xtm1.0 (reifiable-construct)
+(defun to-reifier-elem-xtm1.0 (reifiable-construct revision)
   "Exports an ID indicating a reifier.
    The reifier is only exported if the reifier-topic contains a PSI starting with #.
    This may cause differences since the xtm2.0 defines the referencing
    of reifiers with item-identifiers."
-  (declare (ReifiableConstructC reifiable-construct))
-  (when (reifier reifiable-construct)
+  (declare (ReifiableConstructC reifiable-construct)
+	   (type (or integer nil) revision))
+  (when (reifier reifiable-construct :revision revision)
     (let ((reifier-psi
 	   (find-if #'(lambda(x)
 			(when (and (stringp (uri x))
 				   (> (length (uri x)) 0))
 			  (eql (elt (uri x) 0) #\#)))
-		    (psis (reifier reifiable-construct)))))
+		    (psis (reifier reifiable-construct :revision revision) :revision revision))))
       (when reifier-psi
 	(cxml:attribute "id" (subseq (uri reifier-psi) 1 (length (uri reifier-psi))))))))
 		    
 
-(defun to-resourceX-elem-xtm1.0 (characteristic)
-  (declare (CharacteristicC characteristic))
+(defun to-resourceX-elem-xtm1.0 (characteristic revision)
+  (declare (CharacteristicC characteristic)
+	   (type (or integer nil) revision))
   (let ((characteristic-value
 	 (if (slot-boundp characteristic 'charvalue)
 	     (charvalue characteristic)
@@ -66,136 +69,175 @@
 	(cxml:attribute "xlink:href"
 			(let ((ref-topic (when (and (> (length characteristic-value) 0)
 						    (eql (elt characteristic-value 0) #\#))
-					   (get-item-by-id (subseq characteristic-value 1)))))
-			  (if ref-topic (concatenate 'string "#" (topic-id ref-topic)) characteristic-value))))
+					   (get-item-by-id (subseq characteristic-value 1) :revision revision))))
+			  (if ref-topic (concatenate 'string "#" (topic-id ref-topic revision)) characteristic-value))))
       (cxml:with-element "t:resourceData"
 	(cxml:text characteristic-value)))))
 
 
-(defmethod to-elem-xtm1.0 ((psi PersistentIdC))
+(defmethod to-elem-xtm1.0 ((psi PersistentIdC) revision)
   "subjectIndocatorRef = element subjectIndicatorRef { href }"
+  (declare (ignorable revision))
   (cxml:with-element "t:subjectIndicatorRef"
     (cxml:attribute "xlink:href" (uri psi))))
 
 
-(defun to-instanceOf-elem-xtm1.0 (topic)
+(defun to-instanceOf-elem-xtm1.0 (topic revision)
   "instanceOf = element instanceOf { topicRef | subjectIndicatorRef }"
-  (declare (TopicC topic))
+  (declare (TopicC topic)
+	   (type (or integer nil) revision))
   (cxml:with-element "t:instanceOf"
     (cxml:with-element "t:topicRef"
-      (cxml:attribute "xlink:href" (concatenate 'string "#" (topic-id topic))))))
+      (cxml:attribute "xlink:href" (concatenate 'string "#" (topic-id topic revision))))))
 
 
-(defun to-subjectIdentity-elem-xtm1.0 (psis locator)
+(defun to-subjectIdentity-elem-xtm1.0 (psis locator revision)
   "subjectIdentity = element subjectIdentity { resourceRef?,
                        (topicRef | subjectIndicatorRef)* }"
+  (declare (type (or integer nil) revision))
   (when (or psis locator)
     (cxml:with-element "t:subjectIdentity"
-      (map 'list #'to-elem-xtm1.0 psis)
+      (map 'list #'(lambda(x)
+		     (to-elem-xtm1.0 x revision))
+	   psis)
       (when locator
 	(cxml:with-element "t:resourceRef"
 	  (cxml:attribute "xlink:href" (uri locator)))))))
 
 
-(defun to-scope-elem-xtm1.0 (scopable)
+(defun to-scope-elem-xtm1.0 (scopable revision)
   "scope = element scope { (topicRef | resourceRef | subjectIndicatorRef)+ }"
-  (declare (ScopableC scopable))
+  (declare (ScopableC scopable)
+	   (type (or integer nil) revision))
   (cxml:with-element "t:scope"
-    (to-topicRef-elem-xtm1.0 (first (themes scopable)))))
+    (to-topicRef-elem-xtm1.0 (first (themes scopable :revision revision)) revision)))
 
 
-(defmethod to-elem-xtm1.0 ((variant VariantC))
+(defmethod to-elem-xtm1.0 ((variant VariantC) revision)
   "variant = element { parameters, variantName?, variant* }"
+  (declare (type (or integer nil) revision))
   (cxml:with-element "t:variant"
-    (to-reifier-elem-xtm1.0 variant)
-    (when (themes variant)
+    (to-reifier-elem-xtm1.0 variant revision)
+    (when (themes variant :revision revision)
       (cxml:with-element "t:parameters"
-	(map 'list #'to-topicRef-elem-xtm1.0 (themes variant))))
+	(map 'list #'(lambda(x)
+		       (to-topicRef-elem-xtm1.0 x revision))
+	     (themes variant :revision revision))))
     (cxml:with-element "t:variantName"
-      (to-resourceX-elem-xtm1.0 variant))))
+      (to-resourceX-elem-xtm1.0 variant revision))))
 
 
-(defmethod to-elem-xtm1.0 ((name NameC))
+(defmethod to-elem-xtm1.0 ((name NameC) revision)
   "baseName = element baseName { scope?, baseNameString, variant* }"
+  (declare (type (or integer nil) revision))
   (cxml:with-element "t:baseName"
-    (to-reifier-elem-xtm1.0 name)
-    (when (themes name)
-      (to-scope-elem-xtm1.0 name))
+    (to-reifier-elem-xtm1.0 name revision)
+    (when (themes name :revision revision)
+      (to-scope-elem-xtm1.0 name revision))
     (cxml:with-element "t:baseNameString"
       (cxml:text (if (slot-boundp name 'charvalue)
 		     (charvalue name)
 		     "")))
-    (when (variants name)
-      (map 'list #'to-elem-xtm1.0 (variants name)))))
+    (when (variants name :revision revision)
+      (map 'list #'(lambda(x)
+		     (to-elem-xtm1.0 x revision))
+	   (variants name :revision revision)))))
 
 
-(defmethod to-elem-xtm1.0 ((occurrence OccurrenceC))
+(defmethod to-elem-xtm1.0 ((occurrence OccurrenceC) revision)
   "occurrence = element occurrence { instanceOf?, scope?,
                    (resourceRef | resourceData) }"
+  (declare (type (or integer nil) revision))
   (cxml:with-element "t:occurrence"
-    (to-reifier-elem-xtm1.0 occurrence)
-    (when (instance-of occurrence)
-      (to-instanceOf-elem-xtm1.0 (instance-of occurrence)))
-    (when (themes occurrence)
-      (to-scope-elem-xtm1.0 occurrence))
-    (to-resourceX-elem-xtm1.0 occurrence)))
+    (to-reifier-elem-xtm1.0 occurrence revision)
+    (when (instance-of occurrence :revision revision)
+      (to-instanceOf-elem-xtm1.0 (instance-of occurrence :revision revision)
+				 revision))
+    (when (themes occurrence :revision revision)
+      (to-scope-elem-xtm1.0 occurrence revision))
+    (to-resourceX-elem-xtm1.0 occurrence revision)))
 
 
-(defmethod to-elem-xtm1.0 ((topic TopicC))
+(defmethod to-elem-xtm1.0 ((topic TopicC) revision)
   "topic = element topic { id, instanceOf*, subjectIdentity,
                            (baseName | occurrence)* }"
+  (declare (type (or integer nil) revision))
   (cxml:with-element "t:topic"
-    (cxml:attribute "id" (topic-id topic))
-    (when (list-instanceOf topic :tm *export-tm*)
-      (map 'list #'to-instanceOf-elem-xtm1.0 (list-instanceOf topic :tm *export-tm*)))
-    (when (or (psis topic) (locators topic))
-      (to-subjectIdentity-elem-xtm1.0 (psis topic) (first (locators topic))))
-    (when (names topic)
-      (map 'list #'to-elem-xtm1.0 (names topic)))
-    (when (occurrences topic)
-      (map 'list #'to-elem-xtm1.0 (occurrences topic)))))
+    (cxml:attribute "id" (topic-id topic revision))
+    (let ((ios (list-instanceOf topic :tm *export-tm* :revision revision)))
+      (when ios
+	(map 'list #'(lambda(x)
+		       (to-instanceOf-elem-xtm1.0 x revision))
+	     ios)))
+    (let ((t-psis (psis topic :revision revision))
+	  (first-locator (when (locators topic :revision revision)
+			   (first (locators topic :revision revision)))))
+      (when (or t-psis first-locator)
+	(to-subjectIdentity-elem-xtm1.0 t-psis first-locator topic)))
+    (when (names topic :revision revision)
+      (map 'list #'(lambda(x)
+		     (to-elem-xtm1.0 x revision))
+	   (names topic :revision revision)))
+    (when (occurrences topic :revision revision)
+      (map 'list #'(lambda(x)
+		     (to-elem-xtm1.0 x revision))
+	   (occurrences topic :revision revision)))))
 
 
-(defun to-roleSpec-elem-xtm1.0 (topic)
+(defun to-roleSpec-elem-xtm1.0 (topic revision)
   "roleSpec = element roleSpec { topicRef | subjectIndicatorRef }"
+  (declare (type (or integer nil) revision))
   (cxml:with-element "t:roleSpec"
-    (to-topicRef-elem-xtm1.0 topic)))
+    (to-topicRef-elem-xtm1.0 topic revision)))
 
 
-(defmethod to-elem-xtm1.0 ((role RoleC))
+(defmethod to-elem-xtm1.0 ((role RoleC) revision)
   "member = element member { roleSpec?,
               (topicRef | resourceRef | subjectIndicatorRef)+ }"
+  (declare (type (or integer nil) revision))
   (cxml:with-element "t:member"
-    (to-reifier-elem-xtm1.0 role)
-    (when (instance-of role)
-      (to-roleSpec-elem-xtm1.0 (instance-of role)))
-    (to-topicRef-elem-xtm1.0 (player role))))
+    (to-reifier-elem-xtm1.0 role revision)
+    (when (instance-of role :revision revision)
+      (to-roleSpec-elem-xtm1.0 (instance-of role :revision revision) revision))
+    (to-topicRef-elem-xtm1.0 (player role :revision revision) revision)))
 
 
-(defmethod to-elem-xtm1.0 ((association AssociationC))
+(defmethod to-elem-xtm1.0 ((association AssociationC) revision)
   "association = element association { instanceOf?, scope?, member+ }"
+  (declare (type (or integer nil) revision))
   (cxml:with-element "t:association"
-    (to-reifier-elem-xtm1.0 association)
-    (when (instance-of association)
-      (to-instanceOf-elem-xtm1.0 (instance-of association)))
-    (when (themes association)
-      (to-scope-elem-xtm1.0 association))
-    (map 'list #'to-elem-xtm1.0 (roles association))))
+    (to-reifier-elem-xtm1.0 association revision)
+    (when (instance-of association :revision revision)
+      (to-instanceOf-elem-xtm1.0 (instance-of association :revision revision) revision))
+    (when (themes association :revision revision)
+      (to-scope-elem-xtm1.0 association revision))
+    (map 'list #'(lambda(x)
+		   (to-elem-xtm1.0 x revision))
+	 (roles association :revision revision))))
 
 
-(defun to-stub-elem-xtm1.0 (topic)
+(defun to-stub-elem-xtm1.0 (topic revision)
   "transforms a TopicC object to a topic stub element
    with a topicid, psis and subjectLocators"
-  (declare (TopicC topic))
+  (declare (TopicC topic)
+	   (type (or integer nil) revision))
   (cxml:with-element "t:topic"
-    (cxml:attribute "id" (topic-id topic))
-    (to-subjectIdentity-elem-xtm1.0 (psis topic) (first (locators topic)))))
+    (cxml:attribute "id" (topic-id topic revision))
+    (to-subjectIdentity-elem-xtm1.0 (psis topic :revision revision)
+				    (when (locators topic :revision revision)
+				      (first (locators topic :revision revision)))
+				    revision)))
 
 
-(defmethod to-elem-xtm1.0 ((fragment FragmentC))
+(defmethod to-elem-xtm1.0 ((fragment FragmentC) revision)
   "transforms all sub-elements of the passed FragmentC instance"
-  (to-elem-xtm1.0 (topic fragment))
-  (map 'list #'to-stub-elem-xtm1.0 (referenced-topics fragment))
-  (map 'list #'to-elem-xtm1.0 (associations fragment)))
+  (declare (type (or integer nil) revision))
+  (to-elem-xtm1.0 (topic fragment) revision)
+  (map 'list #'(lambda(x)
+		 (to-stub-elem-xtm1.0 x revision))
+       (referenced-topics fragment))
+  (map 'list #'(lambda(x)
+		 (to-elem-xtm1.0 x revision))
+       (associations fragment)))
 
 

Modified: branches/new-datamodel/src/xml/xtm/exporter_xtm2.0.lisp
==============================================================================
--- branches/new-datamodel/src/xml/xtm/exporter_xtm2.0.lisp	(original)
+++ branches/new-datamodel/src/xml/xtm/exporter_xtm2.0.lisp	Sat Jun 12 16:55:30 2010
@@ -9,54 +9,67 @@
 
 (in-package :exporter)
 
-(defun to-reifier-elem (reifiable-construct)
+(defun to-reifier-elem (reifiable-construct revision)
   "Exports the reifier-attribute.
    The attribute is only exported if the reifier-topic contains at least
    one item-identifier."
-  (declare (ReifiableConstructC reifiable-construct))
-  (when (and (reifier reifiable-construct)
-	     (item-identifiers (reifier reifiable-construct)))
+  (declare (ReifiableConstructC reifiable-construct)
+	   (type (or integer nil) revision))
+  (when (and (reifier reifiable-construct :revision revision)
+	     (item-identifiers (reifier reifiable-construct :revision revision)
+			       :revision revision))
     (cxml:attribute "reifier"
-		    (uri (first (item-identifiers (reifier reifiable-construct)))))))
-
-(defun ref-to-elem (topic)
-  (declare (TopicC topic))
+		    (uri (first (item-identifiers (reifier reifiable-construct
+							   :revision revision)
+						  :revision revision))))))
+
+(defun ref-to-elem (topic revision)
+  (declare (TopicC topic)
+	   (type (or integer nil) revision))
   (cxml:with-element "t:topicRef"
     ;;TODO: this is pretty much of a hack that works only for local
     ;;references
     (cxml:attribute "href" 
-                    (format nil "#~a" (topic-id topic)))))
+                    (format nil "#~a" (topic-id topic revision)))))
 
-(defgeneric to-elem (instance)
+(defgeneric to-elem (instance revision)
   (:documentation "converts the Topic Maps construct instance to an XTM 2.0 element"))
 
-(defmethod to-elem ((psi PersistentIdC))
+(defmethod to-elem ((psi PersistentIdC) revision)
+  (declare (ignorable revision))
   (cxml:with-element "t:subjectIdentifier"
     (cxml:attribute "href" (uri psi))))
 
 
-(defmethod to-elem ((name NameC))
+(defmethod to-elem ((name NameC) revision)
   "name = element name { reifiable, 
                          type?, scope?, value, variant* }"
+  (declare (type (or integer nil) revision))
   (cxml:with-element "t:name"
-    (to-reifier-elem name)
-    (map 'list #'to-elem (item-identifiers name))
-    (when (slot-boundp name 'instance-of)
+    (to-reifier-elem name revision)
+    (map 'list #'(lambda(x)
+		   (to-elem x revision))
+	 (item-identifiers name :revision revision))
+    (when (instance-of name :revision revision)
       (cxml:with-element "t:type"
-	(ref-to-elem (instance-of name))))
-    (when (themes name)
+	(ref-to-elem (instance-of name :revision revision) revision)))
+    (when (themes name :revision revision)
       (cxml:with-element "t:scope"
-	(map 'list #'ref-to-elem (themes name))))
+	(map 'list #'(lambda(x)
+		       (ref-to-elem x revision))
+	     (themes name :revision revision))))
     (cxml:with-element "t:value"
       (cxml:text
        (if (slot-boundp name 'charvalue)
 	   (charvalue name)
 	   "")))
-    (when (variants name)
-      (map 'list #'to-elem (variants name)))))
+    (when (variants name :revision revision)
+      (map 'list #'(lambda(x)
+		     (to-elem x revision))
+	   (variants name :revision revision)))))
 
 
-(defun to-resourceX-elem (characteristic)
+(defun to-resourceX-elem (characteristic revision)
   "returns a resourceData or resourceRef element"
   (declare (CharacteristicC characteristic))
   (let ((characteristic-value
@@ -71,10 +84,11 @@
 	(cxml:with-element "t:resourceRef"
 	  (let ((ref-topic (when (and (> (length characteristic-value) 0)
 				      (eql (elt characteristic-value 0) #\#))
-			     (get-item-by-id (subseq characteristic-value 1)))))
+			     (get-item-by-id (subseq characteristic-value 1)
+					     :revision revision))))
 	    (cxml:attribute "href"
 			    (if ref-topic
-				(concatenate 'string "#" (topic-id ref-topic))
+				(concatenate 'string "#" (topic-id ref-topic revision))
 				characteristic-value))))
 	(cxml:with-element "t:resourceData"
 	  (when (slot-boundp characteristic 'datatype)
@@ -82,112 +96,151 @@
 	  (cxml:text characteristic-value)))))
 
 
-(defmethod to-elem ((variant VariantC))
+(defmethod to-elem ((variant VariantC) revision)
   "variant = element variant { reifiable, scope, (resourceRef | resourceData) }"
   (cxml:with-element "t:variant"
-    (to-reifier-elem variant)
-    (map 'list #'to-elem (item-identifiers variant))
-    (when (themes variant)
+    (to-reifier-elem variant revision)
+    (map 'list #'(lambda(x)
+		   (to-elem x revision))
+	 (item-identifiers variant :revision revision))
+    (when (themes variant :revision revision)
       (cxml:with-element "t:scope"
-	(map 'list #'ref-to-elem (themes variant))))
-    (to-resourceX-elem variant)))
+	(map 'list #'(lambda(x)
+		       (ref-to-elem x revision))
+	     (themes variant :revision revision))))
+    (to-resourceX-elem variant revision)))
 
 
-(defmethod to-elem ((ii ItemIdentifierC))
+(defmethod to-elem ((ii ItemIdentifierC) revision)
   "itemIdentity = element itemIdentity { href }"
+  (declare (ignorable revision))
   (cxml:with-element "t:itemIdentity" 
     (cxml:attribute "href" (uri ii))))
 
 
-(defmethod to-elem ((occ OccurrenceC))
+(defmethod to-elem ((occ OccurrenceC) revision)
   "occurrence = element occurrence { reifiable, 
                          type, scope?, (resourceRef | resourceData) }"
+  (declare (type (or integer nil) revision))
   (cxml:with-element "t:occurrence"
-    (to-reifier-elem occ)
-    (map 'list #'to-elem (item-identifiers occ))
+    (to-reifier-elem occ revision)
+    (map 'list #'(lambda(x)
+		   (to-elem x revision))
+	 (item-identifiers occ :revision revision))
     (cxml:with-element "t:type"
-      (ref-to-elem (instance-of occ)))
+      (ref-to-elem (instance-of occ :revision revision) revision))
     (map 'list #'(lambda(x)
 		   (cxml:with-element "t:scope"
-		     (ref-to-elem x))) (themes occ))
-    (to-resourceX-elem occ)))
+		     (ref-to-elem x revision))) (themes occ :revision revision))
+    (to-resourceX-elem occ revision)))
 
 
-(defmethod to-elem ((locator SubjectLocatorC))
+(defmethod to-elem ((locator SubjectLocatorC) revision)
   "subjectLocator = element subjectLocator { href }"
+  (declare (ignorable revision))
   (cxml:with-element "t:subjectLocator"
     (cxml:attribute "href" (uri locator))))
 
 
-(defmethod to-elem ((topic TopicC))
+(defmethod to-elem ((topic TopicC) revision)
   "topic = element topic { id, 
                         (itemIdentity | subjectLocator | subjectIdentifier)*,
                         instanceOf?, (name | occurrence)* }"
+  (declare (type (or integer nil) revision))
   (cxml:with-element "t:topic"
-    (cxml:attribute "id" (topic-id topic))
-    (map 'list #'to-elem (item-identifiers topic))
-    (map 'list #'to-elem (locators topic))
-    (map 'list #'to-elem (psis topic))
-    (when (list-instanceOf topic :tm *export-tm*)
-      (cxml:with-element "t:instanceOf"
-	(loop for item in (list-instanceOf topic :tm *export-tm*)
-	   do (cxml:with-element "t:topicRef"
-		(cxml:attribute "href" (concatenate 'string "#" (topic-id item)))))))
-    (map 'list #'to-elem (names topic))
-    (map 'list #'to-elem (occurrences topic))))
+    (cxml:attribute "id" (topic-id topic revision))
+    (map 'list #'(lambda(x)
+		   (to-elem x revision))
+	 (item-identifiers topic :revision revision))
+    (map 'list #'(lambda(x)
+		   (to-elem x revision))
+	 (locators topic :revision revision))
+    (map 'list #'(lambda(x)
+		   (to-elem x revision))
+	 (psis topic :revision revision))
+    (let ((ios (list-instanceOf topic :tm *export-tm* :revision revision)))
+      (when ios
+	(cxml:with-element "t:instanceOf"
+	  (loop for item in ios
+	     do (cxml:with-element "t:topicRef"
+		  (cxml:attribute "href" (concatenate 'string "#" (topic-id item revision))))))))
+    (map 'list #'(lambda(x)
+		   (to-elem x revision))
+	 (names topic :revision revision))
+    (map 'list #'(lambda(x)
+		   (to-elem x revision))
+	 (occurrences topic :revision revision))))
 
 
-(defun to-stub-elem (topic)
+(defun to-stub-elem (topic revision)
   "transforms a TopicC object to a topic stub element
    with a topicid, a subjectLocator and an itemIdentity element"
-  (declare (TopicC topic))
+  (declare (TopicC topic)
+	   (type (or nil integer) revision))
   (cxml:with-element "t:topic"
-    (cxml:attribute "id" (topic-id topic))
-    (map 'list #'to-elem (psis topic))
-    (map 'list #'to-elem (item-identifiers topic))
-    (map 'list #'to-elem (locators topic))))
+    (cxml:attribute "id" (topic-id topic revision))
+    (map 'list #'(lambda(x)
+		   (to-elem x revision))
+	 (psis topic :revision revision))
+    (map 'list #'(lambda(x)
+		   (to-elem x revision))
+	 (item-identifiers topic :revision revision))
+    (map 'list #'(lambda(x)
+		   (to-elem x revision))
+	 (locators topic :revision revision))))
 
 
-(defmethod to-elem ((role RoleC))
+(defmethod to-elem ((role RoleC) revision)
   "role = element role { reifiable, type, topicRef }"
+  (declare (type (or integer nil) revision))
   (cxml:with-element "t:role"
-    (to-reifier-elem role)
-    (map 'list #'to-elem (item-identifiers role))
+    (to-reifier-elem role revision)
+    (map 'list #'(lambda(x)
+		   (to-elem x revision))
+	 (item-identifiers role :revision revision))
     (cxml:with-element "t:type"
-      (ref-to-elem (instance-of role)))
-    (ref-to-elem (player role))))
+      (ref-to-elem (instance-of role) revision))
+    (ref-to-elem (player role :revision revision) revision)))
 
 
-(defmethod to-elem ((assoc AssociationC))
+(defmethod to-elem ((assoc AssociationC) revision)
   "association = element association { reifiable, type, scope?, role+ }"
+  (declare (type (or integer nil) revision))
   (cxml:with-element "t:association"
-    (to-reifier-elem assoc)
-    (map 'list #'to-elem (item-identifiers assoc))
+    (to-reifier-elem assoc revision)
+    (map 'list #'(lambda(x)
+		   (to-elem x revision))
+	 (item-identifiers assoc :revision revision))
     (cxml:with-element "t:type"
-      (ref-to-elem (instance-of assoc)))
-    (when (themes assoc)
+      (ref-to-elem (instance-of assoc :revision revision) revision))
+    (when (themes assoc :revision revision)
       (cxml:with-element "t:scope"
-	(map 'list #'ref-to-elem (themes assoc))))
-    (map 'list #'to-elem (roles assoc))))
-
+	(map 'list #'(lambda(x)
+		       (ref-to-elem x revision))
+	     (themes assoc :revision revision))))
+    (map 'list #'(lambda(x)
+		   (to-elem x revision))
+	 (roles assoc :revision revision))))
 
 
-(defmethod to-elem ((fragment FragmentC))
+(defmethod to-elem ((fragment FragmentC) revision)
   "transforms all sub-elements of the passed FragmentC instance"
-  (to-elem (topic fragment))
-  (map 'list #'to-stub-elem (referenced-topics fragment))
-  (map 'list #'to-elem (associations fragment)))
+  (declare (type (or integer nil) revision))
+  (to-elem (topic fragment) revision)
+  (map 'list #'(lambda(x)
+		 (to-stub-elem x revision))
+       (referenced-topics fragment))
+  (map 'list #'(lambda(x)
+		 (to-elem x revision))
+       (associations fragment)))
 
 
-(defgeneric to-string (construct)
+(defgeneric to-string (construct &key revision)
   (:documentation "Print the string representation of a TM element"))
 
-
-(defmethod to-string ((construct TopicMapConstructC))
+(defmethod to-string ((construct TopicMapConstructC) &key (revision *TM-REVISION*))
   (cxml:with-xml-output (cxml:make-string-sink :indentation 2 :canonical nil)
     (cxml:with-namespace ("t" *xtm2.0-ns*)
-      ;(sb-pcl:class-slots (find-class 'PersistentIdC))
-      ;(format t "~a" (length (dom:child-nodes (to-elem construct))))
-        (to-elem construct))))
+        (to-elem construct revision))))
 
 




More information about the Isidorus-cvs mailing list