From lgiessmann at common-lisp.net  Sun May  2 12:00:43 2010
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Sun, 02 May 2010 08:00:43 -0400
Subject: [isidorus-cvs] r293 - branches/new-datamodel/src/model
Message-ID: <E1O8Xqk-0005dw-N3@common-lisp.net>

Author: lgiessmann
Date: Sun May  2 08:00:41 2010
New Revision: 293

Log:
new-datamodel: added helper-functions for creating conditions; modified all delete-<xy> methods, so the parents are now recursively added to the version-history; added to every delete-<xy> function a private one that does the same operation except adding the parent to the version history --> is needed for merging => to avoid mismatches of the versions; adapted changes.lisp except the method "changed-p" to the new datamodel

Modified:
   branches/new-datamodel/src/model/changes.lisp
   branches/new-datamodel/src/model/datamodel.lisp

Modified: branches/new-datamodel/src/model/changes.lisp
==============================================================================
--- branches/new-datamodel/src/model/changes.lisp	(original)
+++ branches/new-datamodel/src/model/changes.lisp	Sun May  2 08:00:41 2010
@@ -21,6 +21,7 @@
       (pushnew (start-revision vi) revision-set))
     (sort revision-set #'<)))
 
+
 (defun get-all-revisions-for-tm (tm-id)
   "Returns an ordered set of the start dates of all revisions in the
 engine for this Topic Map"
@@ -50,7 +51,7 @@
         (d:identified-construct
          (elephant:get-instance-by-value 'PersistentIdC
                                          'uri
-                                         "http://psi.topicmaps.org/iso13250/model/type-instance"))))
+					 constants:*type-instance-psi*))))
     (remove-if
      #'(lambda(assoc)
 	 (when (eql (instance-of assoc :revision revision)
@@ -59,41 +60,50 @@
      (find-all-associations-for-topic top :revision revision))))
   
 
-(defgeneric find-referenced-topics (construct)
+(defgeneric find-referenced-topics (construct &key revision)
   (:documentation "find all the topics that are references from this construct as type, scope or player, as the case may be"))
 
-(defmethod find-referenced-topics ((characteristic CharacteristicC))
-  "characteristics are scopable + typable"
+
+(defmethod find-referenced-topics ((characteristic CharacteristicC)
+				   &key (revision *TM-REVISION*))
+  "characteristics are scopable + typable + reifiable"
   (append
-   (when (reifier characteristic)
-     (list (reifier characteristic)))
-   (themes characteristic)
-   (when (instance-of-p characteristic)
-     (list (instance-of characteristic)))
+   (when (reifier characteristic :revision revision)
+     (list (reifier characteristic :revision revision)))
+   (themes characteristic :revision revision)
+   (when (instance-of-p characteristic :revision revision)
+     (list (instance-of characteristic :revision revision)))
    (when  (and (typep characteristic 'OccurrenceC)
               (> (length (charvalue characteristic)) 0)
               (eq #\# (elt (charvalue characteristic) 0)))
-     (list (get-item-by-id (subseq (charvalue characteristic)  1))))))
+     (list (get-item-by-id (subseq (charvalue characteristic)  1)
+			   :revision revision)))))
 
 
-(defmethod find-referenced-topics ((role RoleC))
+(defmethod find-referenced-topics ((role RoleC)
+				   &key (revision *TM-REVISION*))
   (append
-   (when (reifier role)
-     (list (reifier role)))
-   (list (instance-of role))
-   (list (player role))))
+   (when (reifier role :revision revision)
+     (list (reifier role :revision revision)))
+   (list (instance-of role :revision revision))
+   (list (player role :revision revision))))
+
 
-(defmethod find-referenced-topics ((association AssociationC))
+(defmethod find-referenced-topics ((association AssociationC)
+				   &key (revision *TM-REVISION*))
   "associations are scopable + typable"
   (append
-   (when (reifier association)
-     (list (reifier association)))
-   (list (instance-of association))
-   (themes association)
-   (mapcan #'find-referenced-topics (roles association))))
+   (when (reifier association :revision revision)
+     (list (reifier association :revision revision)))
+   (list (instance-of association :revision revision))
+   (themes association :revision revision)
+   (mapcan #'(lambda(role)
+	       (find-referenced-topics role :revision revision))
+	   (roles association :revision revision))))
   
 
-(defmethod find-referenced-topics ((top TopicC))
+(defmethod find-referenced-topics ((top TopicC)
+				   &key (revision *TM-REVISION*))
   "Part 1b of the eGov-Share spec states:
 # for each topicname in T export a topic stub for each scope topic
 # for each occurrence in T export a topic stub for the occurrence type (if it exists)
@@ -106,11 +116,19 @@
    (remove
     top
     (append
-     (list-instanceOf top)
-     (mapcan #'find-referenced-topics (names top))
-     (mapcan #'find-referenced-topics (mapcan #'variants (names top)))
-     (mapcan #'find-referenced-topics (occurrences top))
-     (mapcan #'find-referenced-topics (find-associations-for-topic top))))))
+     (list-instanceOf top :revision revision)
+     (mapcan #'(lambda(name)
+		 (find-referenced-topics name :revision revision))
+	     (names top :revision revision))
+     (mapcan #'(lambda(variant)
+		 (find-referenced-topics variant :revision revision))
+	     (mapcan #'variants (names top :revision revision)))
+     (mapcan #'(lambda(occ)
+		 (find-referenced-topics occ :revision revision))
+	     (occurrences top :revision revision))
+     (mapcan #'(lambda(assoc)
+		 (find-referenced-topics assoc :revision revision))
+	     (find-associations-for-topic top :revision revision))))))
    
 
 (defgeneric changed-p (construct revision)
@@ -204,8 +222,8 @@
                 (when (changed-p top revision)
                   (make-instance 'FragmentC
                                  :revision revision
-                                 :associations (find-associations-for-topic top) ;TODO: this quite probably introduces code duplication with query: Check!
-                                 :referenced-topics (find-referenced-topics top)
+                                 :associations (find-associations-for-topic top :revision revision) ;TODO: this quite probably introduces code duplication with query: Check!
+                                 :referenced-topics (find-referenced-topics top :revision revision)
                                  :topic top)))
               (elephant:get-instances-by-class 'TopicC))))))
 
@@ -220,31 +238,37 @@
   (:documentation "adds an item identifier to a given construct based on the source
                    locator and an internally generated id (ideally a uuid)"))
 
+
 (defmethod add-source-locator ((construct ReifiableConstructC) &key source-locator revision)
-  (declare (ignorable revision))
+  (declare (integer revision))
   (unless
-      (some (lambda (ii) (string-starts-with (uri ii) source-locator)) (item-identifiers construct))
+      (some (lambda (ii)
+	      (string-starts-with (uri ii) source-locator))
+	    (item-identifiers construct :revision revision))
     (let
         ((ii-uri (format nil "~a/~d" source-locator (internal-id construct))))
-      (make-instance 'ItemIdentifierC :uri ii-uri :identified-construct construct :start-revision revision))))
+      (make-construct 'ItemIdentifierC
+		      :uri ii-uri
+		      :identified-construct construct
+		      :start-revision revision))))
+
 
 (defmethod add-source-locator ((top TopicC) &key source-locator revision)
   ;topics already have the source locator in (at least) one PSI, so we
   ;do not need to add an extra item identifier to them. However, we
   ;need to do that for all their characteristics + associations
   (mapc (lambda (name) (add-source-locator name :revision revision :source-locator source-locator))
-          (names top))
+	(names top :revision revision))
   (mapc (lambda (occ) (add-source-locator occ :revision revision :source-locator source-locator))
-        (occurrences top))
+        (occurrences top :revision revision))
   (mapc (lambda (ass) (add-source-locator ass :revision revision :source-locator source-locator))
-        (find-associations-for-topic top)))
+        (find-associations-for-topic top :revision revision)))
 
 
 (defun create-latest-fragment-of-topic (topic-psi)
   "Returns the latest fragment of the passed topic-psi"
   (declare (string topic-psi))
-  (let ((topic
-	 (get-item-by-psi topic-psi)))
+  (let ((topic (get-latest-topic-by-psi topic-psi)))
     (when topic
       (let ((start-revision
 	     (start-revision
@@ -269,8 +293,7 @@
 (defun get-latest-fragment-of-topic (topic-psi)
   "Returns the latest existing fragment of the passed topic-psi."
   (declare (string topic-psi))
-  (let ((topic
-	 (get-item-by-psi topic-psi)))
+  (let ((topic (get-latest-topic-by-psi topic-psi)))
     (when topic
       (let ((existing-fragments
 	     (elephant:get-instances-by-value 'FragmentC 'topic topic)))

Modified: branches/new-datamodel/src/model/datamodel.lisp
==============================================================================
--- branches/new-datamodel/src/model/datamodel.lisp	(original)
+++ branches/new-datamodel/src/model/datamodel.lisp	Sun May  2 08:00:41 2010
@@ -160,8 +160,7 @@
 (in-package :datamodel)
 
 
-;;TODO: remove-<xy> --> add to version history???
-;;TODO: adapt changes-lisp
+;;TODO: adapt changes.lisp --> changed-p
 ;;TODO: implement a macro with-merge-constructs, that merges constructs
 ;;      after all operations in the body were called
 
@@ -251,11 +250,7 @@
 	:accessor uri
 	:inherit t
 	:type string
-	:initform (error
-		   (make-condition 'missing-argument-error
-				   :message "From PointerC(): uri must be set for a pointer"
-				   :argument-symbol 'uri
-				   :function-symbol ':uri))
+	:initform (error (make-missing-argument-condition "From PointerC(): uri must be set for a pointer" 'uri ':uri))
 	:index t
 	:documentation "The actual value of a pointer, i.e. uri or ID.")
    (identified-construct :associate (PointerAssociationC identifier)
@@ -275,11 +270,7 @@
   ((xtm-id :initarg :xtm-id
 	   :accessor xtm-id
 	   :type string
-	   :initform (error 
-		      (make-condition 'missing-argument-error
-				      :message "From TopicIdentificationC(): xtm-id must be seet for a topic-identifier"
-				      :argument-symbol 'xtm-id
-				      :function-symbol ':xtm-id))
+	   :initform (error (make-missing-argument-condition "From TopicIdentificationC(): xtm-id must be seet for a topic-identifier" 'xtm-id ':xtm-id))
 	   :index t
 	   :documentation "ID of the TM this identification came from."))
   (:index t)
@@ -437,21 +428,13 @@
 (defpclass TypeAssociationC(VersionedAssociationC)
   ((type-topic :initarg :type-topic
 	       :accessor type-topic
-	       :initform (error
-			  (make-condition 'missing-argument-error
-					  :message "From TypeAssociationC(): type-topic must be set"
-					  :argument-symbol 'type-topic
-					  :function-symbol ':type-topic))
+	       :initform (error (make-missing-argument-condition "From TypeAssociationC(): type-topic must be set" 'type-topic ':type-topic))
 	       :associate TopicC
 	       :documentation "Associates this object with a topic that is used
                                as type.")
    (typable-construct :initarg :typable-construct
 		      :accessor typable-construct
-		      :initform (error 
-				 (make-condition 'missing-argument-error
-						 :message "From TypeAssociationC(): typable-construct must be set"
-						 :argument-symbol 'typable-construct
-						 :function-symbol ':typable-construct))
+		      :initform (error (make-missing-argument-condition	"From TypeAssociationC(): typable-construct must be set" 'typable-construct ':typable-construct))
 		      :associate TypableC
 		      :documentation "Associates this object with the typable
                                       construct that is typed by the
@@ -464,21 +447,13 @@
 (defpclass ScopeAssociationC(VersionedAssociationC)
   ((theme-topic :initarg :theme-topic
 		:accessor theme-topic
-		:initform (error
-			   (make-condition 'missing-argument-error
-					   :message "From ScopeAssociationC(): theme-topic must be set"
-					   :argument-symbol 'theme-topic
-					   :function-symbol ':theme-topic))
+		:initform (error (make-missing-argument-condition "From ScopeAssociationC(): theme-topic must be set" 'theme-topic ':theme-topic))
 		:associate TopicC
 		:documentation "Associates this opbject with a topic that is a
                                 scopable construct.")
    (scopable-construct :initarg :scopable-construct
 		       :accessor scopable-construct
-		       :initform (error
-				  (make-condition 'missing-argument-error
-						  :message "From ScopeAssociationC(): scopable-construct must be set"
-						  :argument-symbol 'scopable-construct
-						  :function-symbol ':scopable-construct))
+		       :initform (error (make-missing-argument-condition "From ScopeAssociationC(): scopable-construct must be set" 'scopable-construct ':scopable-construct))
 		       :associate ScopableC
 		       :documentation "Associates this object with the socpable
                                        construct that is scoped by the
@@ -491,21 +466,13 @@
 (defpclass ReifierAssociationC(VersionedAssociationC)
   ((reifiable-construct :initarg :reifiable-construct
 			:accessor reifiable-construct
-			:initform (error
-				   (make-condition 'missing-argument-error
-						   :message "From ReifierAssociation(): reifiable-construct must be set"
-						   :argument-symbol 'reifiable-construct
-						   :function-symbol ':reifiable-construct))
+			:initform (error (make-missing-argument-condition "From ReifierAssociation(): reifiable-construct must be set" 'reifiable-construct ':reifiable-construct))
 			:associate ReifiableConstructC
 			:documentation "The actual construct which is reified
                                         by a topic.")
    (reifier-topic :initarg :reifier-topic
 		  :accessor reifier-topic
-		  :initform (error
-			     (make-condition 'missing-argument-error
-					     :message "From ReifierAssociationC(): reifier-topic must be set"
-					     :argument-symbol 'reifier-topic
-					     :function-symbol ':reifier-topic))
+		  :initform (error (make-missing-argument-condition "From ReifierAssociationC(): reifier-topic must be set" 'reifier-topic ':reifier-topic))
 		  :associate TopicC
 		  :documentation "The reifier-topic that reifies the
                                   reifiable-construct."))
@@ -518,11 +485,7 @@
   ((identifier :initarg :identifier
 	       :accessor identifier
 	       :inherit t
-	       :initform (error
-			  (make-condition 'missing-argument-error
-					  :message "From PointerAssociationC(): identifier must be set"
-					  :argument-symbol 'identifier
-					  :function-symbol ':identifier))
+	       :initform (error (make-missing-argument-condition "From PointerAssociationC(): identifier must be set" 'identifier ':identifier))
 	       :associate PointerC
 	       :documentation "The actual data that is associated with
                                the pointer-association's parent."))
@@ -533,11 +496,7 @@
 (defpclass SubjectLocatorAssociationC(PointerAssociationC)
   ((parent-construct :initarg :parent-construct
 		     :accessor parent-construct
-		     :initform (error
-				(make-condition 'missing-argument-error
-						:message "From SubjectLocatorAssociationC(): parent-construct must be set"
-						:argument-symbol 'parent-construct
-						:function-symbol ':parent-symbol))
+		     :initform (error (make-missing-argument-condition "From SubjectLocatorAssociationC(): parent-construct must be set" 'parent-construct ':parent-symbol))
 		     :associate TopicC
 		     :documentation "The actual topic which is associated
                                      with the subject-locator."))
@@ -548,11 +507,7 @@
 (defpclass PersistentIdAssociationC(PointerAssociationC)
   ((parent-construct :initarg :parent-construct
 		     :accessor parent-construct
-		     :initform (error
-				(make-condition 'missing-argument-error
-						:message "From PersistentIdAssociationC(): parent-construct must be set"
-						:argument-symbol 'parent-construct
-						:function-symbol ':parent-construct))
+		     :initform (error (make-missing-argument-condition "From PersistentIdAssociationC(): parent-construct must be set" 'parent-construct ':parent-construct))
 		     :associate TopicC
 		     :documentation "The actual topic which is associated
                                      with the subject-identifier/psi."))
@@ -563,11 +518,7 @@
 (defpclass TopicIdAssociationC(PointerAssociationC)
   ((parent-construct :initarg :parent-construct
 		     :accessor parent-construct
-		     :initform (error
-				(make-condition 'missing-arguement-error
-						:message "From TopicIdAssociationC(): parent-construct must be set"
-						:argument-symbol 'parent-construct
-						:function-symbol ':parent-construct))
+		     :initform (error (make-missing-argument-condition "From TopicIdAssociationC(): parent-construct must be set" 'parent-construct ':parent-construct))
 		     :associate TopicC
 		     :documentation "The actual topic which is associated
                                      with the topic-identifier."))
@@ -578,11 +529,7 @@
 (defpclass ItemIdAssociationC(PointerAssociationC)
   ((parent-construct :initarg :parent-construct
 		     :accessor parent-construct
-		     :initform (error 
-				(make-condition 'missing-argument-error
-						:message "From ItemIdAssociationC(): parent-construct must be set"
-						:argument-symbol 'parent-construct
-						:function-symbol ':parent-construct))
+		     :initform (error (make-missing-argument-condition "From ItemIdAssociationC(): parent-construct must be set" 'parent-construct ':parent-construct))
 		     :associate ReifiableConstructC
 		     :documentation "The actual parent which is associated
                                      with the item-identifier."))
@@ -595,11 +542,7 @@
   ((characteristic :initarg :characteristic
 		   :accessor characteristic
 		   :inherit t
-		   :initform (error
-			      (make-condition 'missing-argument-error
-					      :message "From CharacteristicCAssociation(): characteristic must be set"
-					      :argument-symbol 'characteristic
-					      :function-symbol ':characteristic))
+		   :initform (error (make-missing-argument-condition  "From CharacteristicCAssociation(): characteristic must be set" 'characteristic ':characteristic))
 		   :associate CharacteristicC
 		   :documentation "Associates this object with the actual
                                    characteristic object."))
@@ -610,11 +553,7 @@
 (defpclass VariantAssociationC(CharacteristicAssociationC)
   ((parent-construct :initarg :parent-construct
 		     :accessor parent-construct
-		     :initform (error
-				(make-condition 'missing-argument-error
-						:message "From VariantAssociationC(): parent-construct must be set"
-						:argument-symbol 'parent-construct
-						:function-symbol ':parent-construct))
+		     :initform (error (make-missing-argument-condition "From VariantAssociationC(): parent-construct must be set" 'parent-construct ':parent-construct))
 		     :associate NameC
 		     :documentation "Associates this object with a name."))
   (:documentation "Associates variant objects with name obejcts.
@@ -624,11 +563,7 @@
 (defpclass NameAssociationC(CharacteristicAssociationC)
   ((parent-construct :initarg :parent-construct
 		     :accessor parent-construct
-		     :initform (error
-				(make-condition 'missing-argument-error
-						:message "From NameAssociationC(): parent-construct must be set"
-						:argument-symbol 'parent-construct
-						:function-symbol ':parent-construct))
+		     :initform (error (make-missing-argument-condition "From NameAssociationC(): parent-construct must be set" 'parent-construct ':parent-construct))
 		     :associate TopicC
 		     :documentation "Associates this object with a topic."))
   (:documentation "Associates name objects with their parent topics.
@@ -638,11 +573,7 @@
 (defpclass OccurrenceAssociationC(CharacteristicAssociationC)
   ((parent-construct :initarg :parent-construct
 		     :accessor parent-construct
-		     :initform (error
-				(make-condition 'missing-argument-error
-						:message "From OccurrenceAssociationC(): parent-construct must be set"
-						:argument-symbol 'parent-construct
-						:function-symbol ':parent-construct))
+		     :initform (error (make-missing-argument-condition "From OccurrenceAssociationC(): parent-construct must be set" 'parent-construct ':parent-construct))
 		     :associate TopicC
 		     :documentation "Associates this object with a topic."))
   (:documentation "Associates occurrence objects with their parent topics.
@@ -654,21 +585,13 @@
   ((player-topic :initarg :player-topic
 		 :accessor player-topic
 		 :associate TopicC
-		 :initform (error
-			    (make-condition 'missing-argument-error
-					    :message "From PlayerAssociationC(): player-topic must be set"
-					    :argument-symbol 'player-topic
-					    :function-symbol ':player-topic))
+		 :initform (error (make-missing-argument-condition "From PlayerAssociationC(): player-topic must be set" 'player-topic ':player-topic))
 		 :documentation "Associates this object with a topic that is
                                  a player.")
    (parent-construct :initarg :parent-construct
 		     :accessor parent-construct
 		     :associate RoleC
-		     :initform (error
-				(make-condition 'missing-argument-error
-						:message "From PlayerAssociationC(): parent-construct must be set"
-						:argument-symbol 'parent-construct
-						:function-symbol ':parent-construct))
+		     :initform (error (make-missing-argument-condition "From PlayerAssociationC(): parent-construct must be set" 'parent-construct ':parent-construct))
 		     :documentation "Associates this object with the parent-association."))
   (:documentation "This class associates roles and their player in given
                    revisions."))
@@ -678,20 +601,12 @@
   ((role :initarg :role
 	 :accessor role
 	 :associate RoleC
-	 :initform (error
-		    (make-condition 'missing-argument-error
-				    :message "From RoleAssociationC(): role must be set"
-				    :argument-symbol 'role
-				    :function-symbol ':role))
+	 :initform (error (make-missing-argument-condition "From RoleAssociationC(): role must be set" 'role ':role))
 	 :documentation "Associates this objetc with a role-object.")
    (parent-construct :initarg :parent-construct
 		     :accessor parent-construct
 		     :associate AssociationC
-		     :initform (error
-				(make-condition 'missing-argument-error
-						:message "From RoleAssociationC(): parent-construct  must be set"
-						:argument-symbol 'parent-construct
-						:function-symbol ':parent-construct))
+		     :initform (error (make-missing-argument-condition "From RoleAssociationC(): parent-construct  must be set" 'parent-construct ':parent-construct))
 		     :documentation "Assocates thius object with an
                                      association-object."))
   (:documentation "Associates roles with assoications and adds some
@@ -699,6 +614,83 @@
 
 
 ;;; some helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun make-duplicate-identifier-condition (message uri)
+  "Returns an duplicate-identifier-condition with the passed arguments."
+  (make-condition 'duplicate-identifier-error
+		  :message message
+		  :uri uri))
+
+
+(defun make-object-not-found-condition (message)
+  "Returns an object-not-found-condition with the passed arguments."
+  (make-condition 'object-not-found-error
+		  :message message))
+
+
+(defun make-tm-reference-condition (message referenced-construct
+				    existing-reference new-reference)
+  "Returns a tm-reference-condition with the passed arguments."
+  (make-condition 'tm-reference-error
+		  :message message
+		  :referenced-construct referenced-construct
+		  :existing-reference existing-reference
+		  :new-reference new-reference))
+
+
+(defun make-not-mergable-condition (message construct-1 construct-2)
+  "Returns a not-mergable-condition with the passed arguments."
+  (make-condition 'not-mergable-error
+		  :message message
+		  :construct-1 construct-1
+		  :construct-2 construct-2))
+
+
+(defun make-missing-argument-condition (message argument-symbol function-symbol)
+  "Returns a missing-argument-condition with the passed arguments."
+  (make-condition 'missing-argument-error
+		  :message message
+		  :argument-symbol argument-symbol
+		  :function-symbol function-symbol))
+
+
+(defgeneric get-most-recent-versioned-assoc (construct slot-symbol)
+  (:documentation "Returns the most recent VersionedAssociationC
+                   object.")
+  (:method ((construct TopicMapConstructC) (slot-symbol Symbol))
+    (let ((all-assocs (slot-p construct slot-symbol)))
+      (let ((zero-assoc
+	     (find-if #'(lambda(assoc)
+			  (= (end-revision
+			      (get-most-recent-version-info assoc)) 0))
+		      all-assocs)))
+	(if zero-assoc
+	    zero-assoc
+	    (let ((ordered-assocs
+		   (sort all-assocs
+			 #'(lambda(x y)
+			     (> (end-revision
+				 (get-most-recent-version-info x))
+				(end-revision
+				 (get-most-recent-version-info y)))))))
+	      (when ordered-assocs
+		(first ordered-assocs))))))))
+
+
+(defun get-latest-topic-by-psi (topic-psi)
+  "Returns the latest topic bound to the PersistentIdC
+   object corresponding to the given uri."
+  (declare (String topic-psi))
+  (let ((psi-inst
+	 (elephant:get-instance-by-value
+	  'PersistentIdC 'uri topic-psi)))
+    (let ((latest-va
+	   (get-most-recent-versioned-assoc
+	    psi-inst 'identified-construct)))
+      (when latest-va
+	(identified-construct
+	 psi-inst :revision (start-revision latest-va))))))
+
+
 (defun get-db-instances-by-class (class-symbol &key (revision *TM-REVISION*))
   "Returns all instances of the given type and the given revision that are
    stored in the db."
@@ -905,12 +897,18 @@
                    Variants are added to names by calling add-name."))
 
 
-(defgeneric delete-characteristic (construct characteristic &key revision)
-  (:documentation "Deletes the passed characteristic oif the given topic by
+(defgeneric private-delete-characteristic (construct characteristic &key revision)
+  (:documentation "Deletes the passed characteristic of the given topic by
                    calling delete-name or delete-occurrence.
                    Variants are deleted from names by calling delete-variant."))
 
 
+(defgeneric delete-characteristic (construct characteristic &key revision)
+  (:documentation "See private-delete-characteristic but adds the parent
+                   (if it is a variant also the parent's parent) to the
+                   version history of this call's revision"))
+
+
 (defgeneric find-oldest-construct (construct-1 construct-2)
   (:documentation "Returns the construct which owns the oldes version info.
                    If a construct is not a versioned construct the oldest
@@ -925,11 +923,16 @@
                    with the changeds that are caused by this operation."))
 
 
-(defgeneric delete-parent (construct parent-construct &key revision)
+(defgeneric parent-delete-parent (construct parent-construct &key revision)
   (:documentation "Sets the assoication-object between the passed
                    constructs as marded-as-deleted."))
 
 
+(defgeneric delete-parent (construct parent-construct &key revision)
+  (:documentation "See private-delete-parent but adds the parent to
+                   the given version."))
+
+
 (defgeneric add-parent (construct parent-construct &key revision)
   (:documentation "Adds the parent-construct (TopicC or NameC) in form of
                    a corresponding association to the given object."))
@@ -1083,14 +1086,37 @@
       construct)))
 
 
+(defun add-version-info(construct start-revision)
+  "Adds 'construct' to the given version.
+   If the construct is a VersionedConstructC add-to-version-history
+   is called directly. Otherwise there is called a corresponding
+   add-<whatever> method that adds recursively 'construct' to its
+   parent and so on."
+  (declare (type (or TopicMapConstructC VersionedConstructC) construct)
+	   (integer start-revision))
+  (cond ((typep construct 'VersionedConstructC)
+	 (add-to-version-history construct :start-revision start-revision))
+	((typep construct 'VariantC)
+	 (let ((name (parent construct :revision start-revision)))
+	   (when name
+	     (add-variant name construct :revision start-revision)
+	     (let ((top (parent name :revision start-revision)))
+	       (when top
+		 (add-name top name :revision start-revision))))))
+	((typep construct 'CharacteristicC)
+	 (let ((top (parent construct :revision start-revision)))
+	   (when top
+	     (add-characteristic top construct :revision start-revision))))
+	((typep construct 'RoleC)
+	 (let ((assoc (parent construct :revision start-revision)))
+	   (when assoc
+	     (add-role assoc construct :revision start-revision))))))
+
+
 (defgeneric add-to-version-history (construct &key start-revision end-revision)
   (:documentation "Adds version history to a versioned construct")
   (:method ((construct VersionedConstructC)
-	    &key (start-revision (error
-				  (make-condition 'missing-argument-error
-						  :message "From add-to-version-history(): start revision must be present"
-						  :argument-symbol 'start-revision
-						  :function-symbol 'add-to-version-history)))
+	    &key (start-revision (error (make-missing-argument-condition "From add-to-version-history(): start revision must be present" 'start-revision 'add-to-version-history)))
 	    (end-revision 0))
     (let ((eql-version-info
 	   (find-if #'(lambda(vi)
@@ -1189,13 +1215,13 @@
   (let ((owner (identified-construct construct :revision 0)))
     (when owner
       (cond ((typep construct 'PersistentIdC)
-	     (delete-psi owner construct :revision revision))
+	     (private-delete-psi owner construct :revision revision))
 	    ((typep construct 'SubjectLocatorC)
-	     (delete-locator owner construct :revision revision))
+	     (private-delete-locator owner construct :revision revision))
 	    ((typep construct 'ItemIdentifierC)
-	     (delete-item-identifier owner construct :revision revision))
+	     (private-delete-item-identifier owner construct :revision revision))
 	    ((typep construct 'TopicIdentificationC)
-	     (delete-topic-identifier owner construct :revision revision))))))
+	     (private-delete-topic-identifier owner construct :revision revision))))))
 
 
 (defmethod marked-as-deleted-p ((construct PointerC))
@@ -1562,11 +1588,7 @@
 		    (string= (xtm-id top-id) xtm-id))
 		(topic-identifiers construct :revision revision))))
 	  (unless possible-identifiers
-	    (error (make-condition
-		    'object-not-found-error
-		    :message 
-		    (format nil "Could not find an object ~a in xtm-id ~a"
-			    construct xtm-id))))
+	    (error (make-object-not-found-condition (format nil "Could not find an object ~a in xtm-id ~a" construct xtm-id))))
 	  (uri (first possible-identifiers)))
 	(concatenate 'string "t" (write-to-string (internal-id construct))))))
 
@@ -1616,20 +1638,29 @@
 	merged-construct))))
 
 
-(defgeneric delete-topic-identifier (construct topic-identifier &key revision)
+(defgeneric private-delete-topic-identifier
+    (construct topic-identifier &key revision)
   (:documentation "Sets the association object between the passed constructs
                    as mark-as-deleted.")
   (:method ((construct TopicC) (topic-identifier TopicIdentificationC)
-	    &key (revision (error (make-condition 'missing-argument-error
-						  :message "From delete-topic-identifier(): revision must be set"
-						  :argument-symbol 'revision
-						  :function-symbol 'delete-topic-identifier))))
+	    &key (revision (error (make-missing-argument-condition "From private-delete-topic-identifier(): revision must be set" 'revision 'private-delete-topic-identifier))))
     (let ((assoc-to-delete (loop for ti-assoc in (slot-p construct 'topic-identifiers)
 			      when (eql (identifier ti-assoc) topic-identifier)
 			      return ti-assoc)))
       (when assoc-to-delete
 	(mark-as-deleted assoc-to-delete :revision revision)
-	(add-to-version-history construct :start-revision revision))
+	construct))))
+
+
+(defgeneric delete-topic-identifier
+    (construct topic-identifier &key revision)
+  (:documentation "See private-delete-topic-identifier but adds the parent
+                   construct to the given version")
+  (:method ((construct TopicC) (topic-identifier TopicIdentificationC)
+	    &key (revision (error (make-missing-argument-condition "From delete-topic-identifier(): revision must be set" 'revision 'delete-topic-identifier))))
+    (when (private-delete-topic-identifier construct topic-identifier
+					   :revision revision)
+      (add-to-version-history construct :start-revision revision)
       construct)))
 
 
@@ -1675,20 +1706,26 @@
 	merged-construct))))
 
 
-(defgeneric delete-psi (construct psi &key revision)
+(defgeneric private-delete-psi (construct psi &key revision)
   (:documentation "Sets the association object between the passed constructs
                    as mark-as-deleted.")
   (:method ((construct TopicC) (psi PersistentIdC)
-	    &key (revision (error (make-condition 'missing-argument-error
-						  :message "From delete-psi(): revision must be set"
-						  :argument-symbol 'revision
-						  :function-symbol 'delete-psi))))
+	    &key (revision (error (make-missing-argument-condition "From private-delete-psi(): revision must be set" 'revision 'private-delete-psi))))
     (let ((assoc-to-delete (loop for psi-assoc in (slot-p construct 'psis)
 			      when (eql (identifier psi-assoc) psi)
 			      return psi-assoc)))
       (when assoc-to-delete
 	(mark-as-deleted assoc-to-delete :revision revision)
-	(add-to-version-history construct :start-revision revision))
+	construct))))
+
+
+(defgeneric delete-psi (construct psi &key revision)
+  (:documentation "See private-delete-psis but adds the parent to the given
+                   version.")
+  (:method ((construct TopicC) (psi PersistentIdC)
+	    &key (revision (error (make-missing-argument-condition "From delete-psi(): revision must be set" 'revision 'delete-psi))))
+    (when (private-delete-psi construct psi :revision revision)
+      (add-to-version-history construct :start-revision revision)
       construct)))
 
 
@@ -1735,20 +1772,26 @@
 	merged-construct))))
 
 
-(defgeneric delete-locator (construct locator &key revision)
+(defgeneric private-delete-locator (construct locator &key revision)
   (:documentation "Sets the association object between the passed constructs
                    as mark-as-deleted.")
   (:method ((construct TopicC) (locator SubjectLocatorC)
-	    &key (revision (error (make-condition 'missing-argument-error
-						  :message "From delete-locator(): revision must be set"
-						  :argument-symbol 'revision
-						  :function-symbol 'delete-locator))))
+	    &key (revision (error (make-missing-argument-condition "From private-delete-locator(): revision must be set" 'revision  'private-delete-locator))))
     (let ((assoc-to-delete (loop for loc-assoc in (slot-p construct 'locators)
 			      when (eql (identifier loc-assoc) locator)
 			      return loc-assoc)))
       (when assoc-to-delete
 	(mark-as-deleted assoc-to-delete :revision revision)
-	(add-to-version-history construct :start-revision revision))
+	construct))))
+
+
+(defgeneric delete-locator (construct locator &key revision)
+  (:documentation "See private-delete-locator but add the parent construct
+                   to the given version.")
+  (:method ((construct TopicC) (locator SubjectLocatorC)
+	    &key (revision (error (make-missing-argument-condition "From delete-locator(): revision must be set" 'revision  'delete-locator))))
+    (when (private-delete-locator construct locator :revision revision)
+      (add-to-version-history construct :start-revision revision)
       construct)))
 
 
@@ -1779,12 +1822,9 @@
 	    &key (revision *TM-REVISION*))
     (when (and (parent name :revision revision)
 	       (not (eql (parent name :revision revision) construct)))
-      (error (make-condition 'tm-reference-error
-			     :message (format nil "From add-name(): ~a can't be owned by ~a since it is already owned by the topic ~a"
-					      name construct (parent name :revision revision))
-			     :referenced-construct name
-			     :existing-reference (parent name :revision revision)
-			     :new-reference construct)))
+      (error (make-tm-reference-condition (format nil "From add-name(): ~a can't be owned by ~a since it is already owned by the topic ~a"
+						  name construct (parent name :revision revision))
+					  name (parent name :revision revision) construct)))
     (if (merge-if-equivalent name construct :revision revision)
 	construct
 	(let ((all-names
@@ -1804,20 +1844,26 @@
 	  construct))))
 
 
-(defgeneric delete-name (construct name &key revision)
+(defgeneric private-delete-name (construct name &key revision)
   (:documentation "Sets the association object between the passed constructs
                    as mark-as-deleted.")
   (:method ((construct TopicC) (name NameC)
-	    &key (revision (error (make-condition 'missing-argument-error
-						  :message "From delete-name(): revision must be set"
-						  :argument-symbol 'revision
-						  :function-symbol 'delete-name))))
+	    &key (revision (error (make-missing-argument-condition "From private-delete-name(): revision must be set" 'revision 'private-delete-name))))
     (let ((assoc-to-delete (loop for name-assoc in (slot-p construct 'names)
 			      when (eql (characteristic name-assoc) name)
 			      return name-assoc)))
       (when assoc-to-delete
 	(mark-as-deleted assoc-to-delete :revision revision)
-	(add-to-version-history construct :start-revision revision))
+	construct))))
+
+
+(defgeneric delete-name (construct name &key revision)
+  (:documentation "See private-delete-name but adds the parent to
+                   the given version.")
+  (:method ((construct TopicC) (name NameC)
+	    &key (revision (error (make-missing-argument-condition "From delete-name(): revision must be set" 'revision 'delete-name))))
+    (when (private-delete-name construct name :revision revision)
+      (add-to-version-history construct :start-revision revision)
       construct)))
 
 
@@ -1840,12 +1886,9 @@
 	    &key (revision *TM-REVISION*))
     (when (and (parent occurrence :revision revision)
 	       (not (eql (parent occurrence :revision revision) construct)))
-      (error 'tm-reference-error
-	     :message (format nil "From add-occurrence(): ~a can't be owned by ~a since it is already owned by the topic ~a"
-			      occurrence construct (parent occurrence :revision revision))
-	     :referenced-construct occurrence
-	     :existing-reference (parent occurrence :revision revision)
-	     :new-reference construct))
+      (error (make-tm-reference-condition (format nil "From add-occurrence(): ~a can't be owned by ~a since it is already owned by the topic ~a"
+						  occurrence construct (parent occurrence :revision revision))
+					  occurrence (parent occurrence :revision revision) construct)))
     (if (merge-if-equivalent occurrence construct :revision revision)
 	construct
 	(let ((all-occurrences
@@ -1864,20 +1907,26 @@
 	  construct))))
 
 
-(defgeneric delete-occurrence (construct occurrence &key revision)
+(defgeneric private-delete-occurrence (construct occurrence &key revision)
   (:documentation "Sets the association object between the passed constructs
                    as mark-as-deleted.")
   (:method ((construct TopicC) (occurrence OccurrenceC)
-	    &key (revision (error (make-condition 'missing-argument-error
-						  :message "From delete-occurrence(): revision must be set"
-						  :argument-symbol 'revision
-						  :function-symbol 'delete-construct))))
+	    &key (revision (error (make-missing-argument-condition "From private-delete-occurrence(): revision must be set" 'revision 'private-delete-occurrence))))
     (let ((assoc-to-delete (loop for occ-assoc in (slot-p construct 'occurrences)
 			      when (eql (characteristic occ-assoc) occurrence)
 			      return occ-assoc)))
       (when assoc-to-delete
 	(mark-as-deleted assoc-to-delete :revision revision)
-	(add-to-version-history construct :start-revision revision))
+	construct))))
+
+
+(defgeneric delete-occurrence (construct occurrence &key revision)
+  (:documentation "See private-delete-occurrence but adds the parent
+                   to the given version history.")
+  (:method ((construct TopicC) (occurrence OccurrenceC)
+	    &key (revision (error (make-missing-argument-condition "From delete-occurrence(): revision must be set" 'revision 'delete-occurrence))))
+    (when (private-delete-occurrence construct occurrence :revision revision)
+      (add-to-version-history construct :start-revision revision)
       construct)))
 
 
@@ -1890,9 +1939,19 @@
       (add-occurrence construct characteristic :revision revision)))
 
 
+(defmethod private-delete-characteristic ((construct TopicC)
+					  (characteristic CharacteristicC)
+					  &key (revision (error (make-missing-argument-condition "From private-delete-characteristic(): revision must be set" 'revision 'private-delete-characteristic))))
+  (declare (integer revision) (type (or NameC OccurrenceC) characteristic))
+  (if (typep characteristic 'NameC)
+      (private-delete-name construct characteristic :revision revision)
+      (private-delete-occurrence construct characteristic
+				 :revision revision)))
+
+
 (defmethod delete-characteristic ((construct TopicC)
 				  (characteristic CharacteristicC)
-				  &key (revision *TM-REVISION*))
+				  &key (revision (error (make-missing-argument-condition "From delete-characteristic(): revision must be set" 'revision 'delete-characteristic))))
   (declare (integer revision) (type (or NameC OccurrenceC) characteristic))
   (if (typep characteristic 'NameC)
       (delete-name construct characteristic :revision revision)
@@ -1945,11 +2004,22 @@
     (add-reifier reified-construct construct :revision revision)))
 
 
-(defgeneric delete-reified-construct (construct reified-construct &key revision)
+(defgeneric private-delete-reified-construct
+    (construct reified-construct &key revision)
   (:documentation "Unsets the passed construct as reified-construct of the
                    given topic.")
   (:method ((construct TopicC) (reified-construct ReifiableConstructC)
-	    &key (revision *TM-REVISION*))
+	    &key (revision (error (make-missing-argument-condition "From private-delete-reified-construct(): revision must be set" 'revision 'private-delete-reified-construct))))
+    (declare (integer revision))
+    (private-delete-reifier reified-construct construct
+			    :revision revision)))
+
+
+(defgeneric delete-reified-construct (construct reified-construct &key revision)
+  (:documentation "See private-delete-reified-construct but adds the
+                   reifier to the given version.")
+  (:method ((construct TopicC) (reified-construct ReifiableConstructC)
+	    &key (revision (error (make-missing-argument-condition "From -delete-reified-construct(): revision must be set" 'revision '-delete-reified-construct))))
     (declare (integer revision))
     (delete-reifier reified-construct construct :revision revision)))
 
@@ -1984,11 +2054,7 @@
 			  (identified-construct (first possible-top-ids)
 						:revision revision))
 		 (unless (= (length possible-top-ids) 1)
-		   (error
-		    (make-condition 'duplicate-identifier-error
-				    :message (format nil "(length possible-items ~a) for id ~a and xtm-id ~a > 1"
-						     possible-top-ids topic-id xtm-id)
-				    :uri topic-id)))
+		   (error (make-duplicate-identifier-condition (format nil "(length possible-items ~a) for id ~a and xtm-id ~a > 1" possible-top-ids topic-id xtm-id) topic-id)))
 		 (identified-construct (first possible-top-ids)
 				       :revision revision)
  	 	 ;no revision need not to be chaecked, since the revision
@@ -2004,9 +2070,7 @@
 		 (when (find-item-by-revision top-from-oid revision)
 		   top-from-oid))))))
     (if (and error-if-nil (not result))
-        (error (make-condition 'object-not-found-error
-			       :message (format nil "No such item (id: ~a, tm: ~a, rev: ~a)"
-						topic-id xtm-id revision)))
+        (error (make-object-not-found-condition (format nil "No such item (id: ~a, tm: ~a, rev: ~a)" topic-id xtm-id revision)))
         result)))
 
 
@@ -2025,10 +2089,7 @@
 			  (identified-construct (first possible-ids)
 						:revision revision))
 	     (unless (= (length possible-ids) 1)
-	       (error (make-condition 'duplicate-identifier-error
-				      :message (format nil "(length possible-items ~a) for id ~a"
-						       possible-ids uri)
-				      :uri uri)))
+	       (error (make-duplicate-identifier-condition (format nil "(length possible-items ~a) for id ~a" possible-ids uri) uri)))
 	     (identified-construct (first possible-ids)
 				   :revision revision)))))
 	     ;no revision need to be checked, since the revision
@@ -2036,8 +2097,7 @@
     (if result
 	result
 	(when error-if-nil
-	  (error (make-condition 'object-not-found-error
-				 :message "No such item is bound to the given identifier uri."))))))
+	  (error (make-object-not-found-condition "No such item is bound to the given identifier uri."))))))
 
 
 (defun get-item-by-item-identifier (uri &key (revision *TM-REVISION*)
@@ -2123,7 +2183,7 @@
   (declare (ignorable source-locator))
   (let ((owner (parent construct :revision 0)))
     (when owner
-      (delete-characteristic owner construct :revision revision))))
+      (private-delete-characteristic owner construct :revision revision))))
 
 
 (defmethod marked-as-deleted-p ((construct CharacteristicC))
@@ -2273,12 +2333,9 @@
 	    return parent-assoc)))
     (when (and already-set-parent
 	       (not (eql already-set-parent parent-construct)))
-      (error (make-condition 'tm-reference-error
-			     :message (format nil "From add-parent(): ~a can't be owned by ~a since it is already owned by ~a"
+      (error (make-tm-reference-condition (format nil "From add-parent(): ~a can't be owned by ~a since it is already owned by ~a"
 					      construct parent-construct already-set-parent)
-			     :referenced-construct construct
-			     :existing-reference (parent construct :revision revision)
-			     :new-reference parent-construct)))
+					  construct (parent construct :revision revision) parent-construct)))
     (let ((merged-char
 	   (merge-if-equivalent construct parent-construct :revision revision)))
       (if merged-char
@@ -2311,21 +2368,26 @@
 	    construct)))))
 
 
-(defmethod delete-parent ((construct CharacteristicC)
-			  (parent-construct ReifiableConstructC)
-			  &key (revision (error (make-condition 'missing-argument-error
-								:message "From delete-parent(): revision must be set"
-								:argument-symbol 'revision
-								:function-symbol 'delete-parent))))
+(defmethod private-delete-parent ((construct CharacteristicC)
+				  (parent-construct ReifiableConstructC)
+				  &key (revision (error (make-missing-argument-condition "From private-delete-parent(): revision must be set" 'revision 'private-delete-parent))))
   (let ((assoc-to-delete
 	 (loop for parent-assoc in (slot-p construct 'parent)
 	    when (eql (parent-construct parent-assoc) parent-construct)
 	    return parent-assoc)))
     (when assoc-to-delete
       (mark-as-deleted assoc-to-delete :revision revision)
-      (when (typep parent-construct 'VersionedConstructC)
-	(add-to-version-history parent-construct :start-revision revision)))
-    construct))
+      construct)))
+
+
+(defmethod delete-parent ((construct CharacteristicC)
+			  (parent-construct ReifiableConstructC)
+			  &key (revision (error (make-missing-argument-condition "From delete-parent(): revision must be set" 'revision 'delete-parent))))
+  (let ((parent (parent construct :revision revision)))
+    (when (private-delete-parent construct parent-construct :revision revision)
+      (when parent
+	(add-version-info parent revision))
+      construct)))
 
 
 ;;; OccurrenceC
@@ -2461,12 +2523,9 @@
 	    &key (revision *TM-REVISION*))
     (when (and (parent variant :revision revision)
 	       (not (eql (parent variant :revision revision) construct)))
-      (error (make-condition 'tm-reference-error
-			     :message (format nil "From add-variant(): ~a can't be owned by ~a since it is already owned by the name ~a"
-					      variant construct (parent variant :revision revision))
-			     :referenced-construct variant
-			     :existing-reference (parent variant :revision revision)
-			     :new-reference construct)))
+      (error (make-tm-reference-condition (format nil "From add-variant(): ~a can't be owned by ~a since it is already owned by the name ~a"
+						  variant construct (parent variant :revision revision))
+					  variant (parent variant :revision revision) construct)))
     (if (merge-if-equivalent variant construct :revision revision)
 	construct
 	(let ((all-variants 
@@ -2487,21 +2546,30 @@
 	  construct))))
 
 
-(defgeneric delete-variant (construct variant &key revision)
+(defgeneric private-delete-variant (construct variant &key revision)
   (:documentation "Deletes the passed variant by marking it's association as
                    deleted in the passed revision.")
   (:method ((construct NameC) (variant VariantC)
-	    &key (revision (error (make-condition 'missing-argument-error
-						  :message "From delete-variant(): revision must be set"
-						  :argument-symbol 'revision
-						  :function-symbol 'delete-variant))))
+	    &key (revision (error (make-missing-argument-condition "From private-delete-variant(): revision must be set" 'revision 'private-delete-variant))))
     (let ((assoc-to-delete (loop for variant-assoc in (slot-p construct
 							      'variants)
 			      when (eql (characteristic variant-assoc) variant)
 			      return variant-assoc)))
       (when assoc-to-delete
-	(mark-as-deleted assoc-to-delete :revision revision))
-      construct)))
+	(mark-as-deleted assoc-to-delete :revision revision)
+	construct))))
+
+
+(defgeneric delete-variant (construct variant &key revision)
+  (:documentation "See private-delete-variant but adds a the parent
+                   and the parent's parent to the given version history.")
+  (:method ((construct NameC) (variant VariantC)
+	    &key (revision (error (make-missing-argument-condition "From delete-variant(): revision must be set" 'revision 'delete-variant))))
+    (when (private-delete-variant construct variant :revision revision)
+      (when (parent construct :revision revision)
+	(add-name (parent construct :revision revision) construct
+		  :revision revision)
+	construct))))
 
 
 (defmethod add-characteristic ((construct NameC) (characteristic VariantC)
@@ -2510,8 +2578,14 @@
   (add-variant construct characteristic :revision revision))
 
 
-(defmethod delete-characteristic ((construct NameC) (characteristic VariantC)
-				  &key (revision *TM-REVISION*))
+(defmethod private-delete-characteristic  ((construct NameC) (characteristic VariantC)
+					   &key (revision (error (make-missing-argument-condition "From private-delete-characteristic(): revision must be set" 'revision 'private-delete-characteristic))))
+  (declare (integer revision))
+  (private-delete-variant construct characteristic :revision revision))
+
+
+(defmethod delete-characteristic  ((construct NameC) (characteristic VariantC)
+					   &key (revision (error (make-missing-argument-condition "From delete-characteristic(): revision must be set" 'revision 'delete-characteristic))))
   (declare (integer revision))
   (delete-variant construct characteristic :revision revision))
 
@@ -2631,20 +2705,26 @@
 	  construct))))
 
 
-(defgeneric delete-role (construct role &key revision)
+(defgeneric private-delete-role (construct role &key revision)
   (:documentation "Deletes the passed role by marking it's association as
                    deleted in the passed revision.")
   (:method ((construct AssociationC) (role RoleC)
-	    &key (revision (error (make-condition 'missing-argument-error
-						  :message "From delete-role(): revision must be set"
-						  :argument-symbol 'revision
-						  :function-symbol 'delete-role))))
+	    &key (revision (error (make-missing-argument-condition "From private-delete-role(): revision must be set" 'revision 'private-delete-role))))
     (let ((assoc-to-delete (loop for role-assoc in (slot-p construct 'roles)
 			      when (eql (role role-assoc) role)
 			      return role-assoc)))
       (when assoc-to-delete
 	(mark-as-deleted assoc-to-delete :revision revision)
-	(add-to-version-history construct :start-revision revision))
+	construct))))
+
+
+(defgeneric delete-role (construct role &key revision)
+  (:documentation "See private-delete-role but adds the parent association
+                   to the given version.")
+  (:method ((construct AssociationC) (role RoleC)
+	    &key (revision (error (make-missing-argument-condition "From delete-role(): revision must be set" 'revision 'delete-role))))
+    (when (private-delete-role construct role :revision revision)
+      (add-to-version-history construct :start-revision revision)
       construct)))
 
 
@@ -2659,7 +2739,7 @@
   (declare (ignorable source-locator))
   (let ((owner (parent construct :revision 0)))
     (when owner
-      (delete-role owner construct :revision revision))))
+      (private-delete-role owner construct :revision revision))))
 
 
 (defmethod marked-as-deleted-p ((construct RoleC))
@@ -2803,12 +2883,9 @@
 			      return parent-assoc)))
     (when (and already-set-parent
 	       (not (eql already-set-parent parent-construct)))
-      (error (make-condition 'tm-reference-error
-			     :message (format nil "From add-parent(): ~a can't be owned by ~a since it is already owned by ~a"
-					      construct parent-construct already-set-parent)
-			     :referenced-construct construct
-			     :existing-reference (parent construct :revision revision)
-			     :new-reference parent-construct)))
+      (error (make-tm-reference-condition (format nil "From add-parent(): ~a can't be owned by ~a since it is already owned by ~a"
+						  construct parent-construct already-set-parent)
+					  construct (parent construct :revision revision) parent-construct)))
     (let ((merged-role
 	   (merge-if-equivalent construct parent-construct :revision revision)))
       (if merged-role
@@ -2834,18 +2911,21 @@
 	    construct)))))
 
 
-(defmethod delete-parent ((construct RoleC) (parent-construct AssociationC)
-	    &key (revision (error (make-condition 'missing-argument-error
-						  :message "From delete-parent(): revision must be set"
-						  :argument-symbol 'revision
-						  :function-symbol 'delete-parent))))
+(defmethod private-delete-parent ((construct RoleC) (parent-construct AssociationC)
+				  &key (revision (error (make-missing-argument-condition "From private-delete-parent(): revision must be set" 'revision 'private-delete-parent))))
   (let ((assoc-to-delete
 	 (loop for parent-assoc in (slot-p construct 'parent)
 	    when (eql (parent-construct parent-assoc) parent-construct)
 	    return parent-assoc)))
     (when assoc-to-delete
       (mark-as-deleted assoc-to-delete :revision revision)
-      (add-to-version-history parent-construct :start-revision revision))
+      construct)))
+
+
+(defmethod delete-parent ((construct RoleC) (parent-construct AssociationC)
+				  &key (revision (error (make-missing-argument-condition "From delete-parent(): revision must be set" 'revision 'delete-parent))))
+  (when (private-delete-parent construct parent-construct :revision revision)
+    (add-to-version-history parent-construct :start-revision revision)
     construct))
 
 
@@ -2871,12 +2951,8 @@
 	      return player-assoc)))
       (when (and already-set-player
 		 (not (eql already-set-player player-topic)))
-	(error (make-condition 'tm-reference-error
-			       :message (format nil "From add-player(): ~a can't be played by ~a since it is played by ~a"
-						construct player-topic already-set-player)
-			       :referenced-construct construct
-			       :existing-reference (player construct :revision revision)
-			       :new-reference player-topic)))
+	(error (make-tm-reference-condition (format nil "From add-player(): ~a can't be played by ~a since it is played by ~a" construct player-topic already-set-player)
+					    construct (player construct :revision revision) player-topic)))
       (cond (already-set-player
 	     (let ((player-assoc
 		    (loop for player-assoc in (slot-p construct 'player)
@@ -2893,21 +2969,30 @@
     construct))
 
 
-(defgeneric delete-player (construct player-topic &key revision)
+(defgeneric private-delete-player (construct player-topic &key revision)
   (:documentation "Deletes the passed topic as a player of the passed role 
                    object by marking its association-object as deleted.")
   (:method ((construct RoleC) (player-topic TopicC)
-	    &key (revision (error (make-condition 'missing-argument-error
-						  :message "From delete-parent(): revision must be set"
-						  :argument-symbol 'revision
-						  :function-symbol 'delete-player))))
+	    &key (revision (error (make-missing-argument-condition "From private-delete-player(): revision must be set" 'revision 'private-delete-player))))
     (let ((assoc-to-delete
 	   (loop for player-assoc in (slot-p construct 'player)
 	      when (eql (parent-construct player-assoc) construct)
 	      return player-assoc)))
       (when assoc-to-delete
-	(mark-as-deleted assoc-to-delete :revision revision))
-      construct)))
+	(mark-as-deleted assoc-to-delete :revision revision)
+	construct))))
+
+
+(defgeneric delete-player (construct player-topic &key revision)
+  (:documentation "See delete-player but adds the parent role to
+                   the given version.")
+  (:method ((construct RoleC) (player-topic TopicC)
+	    &key (revision (error (make-missing-argument-condition "From delete-player(): revision must be set" 'revision 'delete-player))))
+   (when (private-delete-player construct player-topic :revision revision)
+     (let ((assoc (parent construct :revision revision)))
+       (when assoc
+	 (add-role assoc construct :revision revision)
+	 construct)))))
 
 
 ;;; ReifiableConstructC
@@ -2917,7 +3002,7 @@
   (declare (ignorable source-locator))
   (call-next-method)
   (dolist (ii (item-identifiers construct :revision 0))
-    (delete-item-identifier construct ii :revision revision)))
+    (private-delete-item-identifier construct ii :revision revision)))
 
 
 (defmethod check-for-duplicate-identifiers ((construct ReifiableConstructC)
@@ -2932,10 +3017,7 @@
 	      (elephant:get-instances-by-value 'PersistentIdC 'uri (uri id))
 	      (elephant:get-instances-by-value 'SubjectLocatorC 'uri (uri id)))))
 	   1)
-      (error 
-       (make-condition 'duplicate-identifier-error 
-                       :message (format nil "Duplicate Identifier ~a has been found" (uri id))
-                       :uri (uri id))))))
+      (error (make-duplicate-identifier-condition (format nil "Duplicate Identifier ~a has been found" (uri id)) (uri id))))))
 
 
 (defgeneric ReifiableConstructC-p (class-symbol)
@@ -3047,34 +3129,33 @@
 			       :parent-construct construct
 			       :identifier item-identifier
 			       :start-revision revision)))
-	(cond ((typep merged-construct 'VersionedConstructC)
-	       (add-to-version-history merged-construct :start-revision revision))
-	      ((and (typep merged-construct 'CharacteristicC)
-		    (parent merged-construct :revision revision))
-	       (add-characteristic (parent merged-construct :revision revision)
-				   merged-construct :revision revision))
-	      ((and (typep merged-construct 'RoleC)
-		    (parent merged-construct :revision revision))
-	       (add-role (parent merged-construct :revision revision)
-			 merged-construct :revision revision)))
+	(add-version-info construct revision)
 	merged-construct))))
 
 
-(defgeneric delete-item-identifier (construct item-identifier &key revision)
+(defgeneric private-delete-item-identifier (construct item-identifier
+						      &key revision)
   (:documentation "Sets the association object between the passed constructs
                    as mark-as-deleted.")
   (:method ((construct ReifiableConstructC) (item-identifier ItemIdentifierC)
-	    &key (revision (error (make-condition 'missing-argument-error
-						  :message "From delete-item-identifier(): revision must be set"
-						  :argument-symbol 'revision
-						  :function-symbol 'delete-item-identifier))))
+	    &key (revision (error (make-missing-argument-condition "From private-delete-item-identifier(): revision must be set" 'revision 'private-delete-item-identifier))))
     (let ((assoc-to-delete (loop for ii-assoc in (slot-p construct 'item-identifiers)
 			      when (eql (identifier ii-assoc) item-identifier)
 			      return ii-assoc)))
       (when assoc-to-delete
 	(mark-as-deleted assoc-to-delete :revision revision)
-	(when (typep construct 'VersionedConstructC)
-	  (add-to-version-history construct :start-revision revision)))
+	construct))))
+
+
+(defgeneric delete-item-identifier (construct item-identifier
+						      &key revision)
+  (:documentation "See private-delete-item-identifier but adds the parent
+                   construct to the given version.")
+  (:method ((construct ReifiableConstructC) (item-identifier ItemIdentifierC)
+	    &key (revision (error (make-missing-argument-condition "From delete-item-identifier(): revision must be set" 'revision 'delete-item-identifier))))
+    (when (private-delete-item-identifier construct item-identifier
+					  :revision revision)
+      (add-version-info construct revision)
       construct)))
 
 
@@ -3090,11 +3171,9 @@
 	       (not (equivalent-constructs construct
 					   (reified-construct
 					    reifier-topic :revision revision))))
-      (error (make-condition 'not-mergable-error
-			     :message (format nil "From add-reifier(): ~a and ~a can't be merged since the reified-constructs (~a ~a) are not mergable"
-					      reifier-topic (reifier construct :revision revision) (reified-construct reifier-topic :revision revision) construct)
-			     :construct-1 construct
-			     :construct-2 (reified-construct reifier-topic :revision revision))))
+      (error (make-not-mergable-condition (format nil "From add-reifier(): ~a and ~a can't be merged since the reified-constructs (~a ~a) are not mergable"
+						  reifier-topic (reifier construct :revision revision) (reified-construct reifier-topic :revision revision) construct)
+					  construct (reified-construct reifier-topic :revision revision))))
     (let ((merged-reifier-topic
 	   (if (reifier construct :revision revision)
 	       (merge-constructs (reifier construct :revision revision)
@@ -3123,26 +3202,30 @@
 				 :reifiable-construct construct
 				 :reifier-topic merged-reifier-topic
 				 :start-revision revision)))
-	  (when (typep construct 'VersionedConstructC)
-	    (add-to-version-history merged-construct :start-revision revision))
+	  (add-version-info construct revision)
 	  merged-construct)))))
 
 
-(defgeneric delete-reifier (construct reifier &key revision)
+(defgeneric private-delete-reifier (construct reifier &key revision)
   (:documentation "Sets the association object between the passed constructs
                    as mark-as-deleted.")
   (:method ((construct ReifiableConstructC) (reifier TopicC)
-	    &key (revision (error (make-condition 'missing-argument-error
-						  :message "From delete-reifier(): revision must be set"
-						  :argument-symbol 'revision
-						  :function-symbol 'delete-reifier))))
+	    &key (revision (error (make-missing-argument-condition "From private-delete-reifier(): revision must be set" 'revision 'private-delete-reifier))))
     (let ((assoc-to-delete (loop for reifier-assoc in (slot-p construct 'reifier)
 			      when (eql (reifier-topic reifier-assoc) reifier)
 			      return reifier-assoc)))
       (when assoc-to-delete
 	(mark-as-deleted assoc-to-delete :revision revision)
-	(when (typep construct 'VersionedConstructC)
-	  (add-to-version-history construct :start-revision revision)))
+	construct))))
+
+
+(defgeneric delete-reifier (construct reifier &key revision)
+  (:documentation "See private-delete-reifier but adds the reified-construct
+                   to the given version.")
+  (:method ((construct ReifiableConstructC) (reifier TopicC)
+	    &key (revision (error (make-missing-argument-condition "From delete-reifier(): revision must be set" 'revision 'delete-reifier))))
+    (when (private-delete-reifier construct reifier :revision revision)
+      (add-version-info construct revision)
       construct)))
 
 
@@ -3249,21 +3332,26 @@
     construct))
 
 
-(defgeneric delete-theme (construct theme-topic &key revision)
+(defgeneric private-delete-theme (construct theme-topic &key revision)
   (:documentation "Deletes the passed theme by marking it's association as
                    deleted in the passed revision.")
   (:method ((construct ScopableC) (theme-topic TopicC)
-	    &key (revision (error (make-condition 'missing-argument-error
-						  :message "From delete-theme(): revision must be set"
-						  :argument-symbol 'revision
-						  :function-symbol 'delete-theme))))
+	    &key (revision (error (make-missing-argument-condition "From private-delete-theme(): revision must be set" 'revision 'private-delete-theme))))
     (let ((assoc-to-delete (loop for theme-assoc in (slot-p construct 'themes)
 			      when (eql (theme-topic theme-assoc) theme-topic)
 			      return theme-assoc)))
       (when assoc-to-delete
-	(mark-as-deleted assoc-to-delete :revision revision))
-      (when (typep construct 'VersionedConstructC)
-	(add-to-version-history construct :start-revision revision))
+	(mark-as-deleted assoc-to-delete :revision revision)
+	construct))))
+
+
+(defgeneric delete-theme (construct theme-topic &key revision)
+  (:documentation "See private-delete-theme but adds the parent construct
+                   to the given version.")
+  (:method ((construct ScopableC) (theme-topic TopicC)
+	    &key (revision (error (make-missing-argument-condition "From delete-theme(): revision must be set" 'revision 'delete-theme))))
+    (when (private-delete-theme construct theme-topic :revision revision)
+      (add-version-info construct revision)
       construct)))
 
 
@@ -3305,12 +3393,9 @@
 	      return type-assoc)))
       (when (and already-set-type
 		 (not (eql type-topic already-set-type)))
-	(error (make-condition 'tm-reference-error
-			       :message (format nil "From add-type(): ~a can't be typed by ~a since it is typed by ~a"
-						construct type-topic already-set-type)
-			       :referenced-construct construct
-			       :existing-reference (instance-of construct :revision revision)
-			       :new-reference type-topic)))
+	(error (make-tm-reference-condition (format nil "From add-type(): ~a can't be typed by ~a since it is typed by ~a"
+						    construct type-topic already-set-type)
+					    construct (instance-of construct :revision revision) type-topic)))
       (cond (already-set-type
 	     (let ((type-assoc
 		    (loop for type-assoc in (slot-p construct 'instance-of)
@@ -3329,22 +3414,27 @@
     construct))
 
 
-(defgeneric delete-type (construct type-topic &key revision)
+(defgeneric private-delete-type (construct type-topic &key revision)
   (:documentation "Deletes the passed type by marking it's association as
                    deleted in the passed revision.")
   (:method ((construct TypableC) (type-topic TopicC)
-	    &key (revision (error (make-condition 'missing-argument-error
-						  :message "From delete-type(): revision must be set"
-						  :argument-symbol 'revision
-						  :function-symbol 'delete-type))))
+	    &key (revision (error (make-missing-argument-condition "From private-delete-type(): revision must be set" 'revision 'private-delete-type))))
     (let ((assoc-to-delete
 	   (loop for type-assoc in (slot-p construct 'instance-of)
 	      when (eql (type-topic type-assoc) type-topic)
 	      return type-assoc)))
       (when assoc-to-delete
-	(mark-as-deleted assoc-to-delete :revision revision))
-      (when (typep construct 'VersionedConstructC)
-	(add-to-version-history construct :start-revision revision))
+	(mark-as-deleted assoc-to-delete :revision revision)
+	construct))))
+
+
+(defgeneric delete-type (construct type-topic &key revision)
+  (:documentation "See private-delete-type but adds the parent construct
+                   to the given version.")
+  (:method ((construct TypableC) (type-topic TopicC)
+	    &key (revision (error (make-missing-argument-condition "From private-delete-type(): revision must be set" 'revision 'private-delete-type))))
+    (when (private-delete-type construct type-topic :revision revision)
+      (add-version-info construct revision)
       construct)))
 
 
@@ -3425,10 +3515,7 @@
 		 (and (ReifiableConstructC-p class-symbol)
 		      (or (getf args :item-identifiers) (getf args :reifier))))
 	     (not (getf args :start-revision)))
-    (error (make-condition 'missing-argument-error
-			   :message "From make-construct(): start-revision must be set"
-			   :argument-symbol 'start-revision
-			   :function-symbol 'make-construct)))
+    (error (make-missing-argument-condition "From make-construct(): start-revision must be set" 'start-revision 'make-construct)))
   (let ((construct
 	 (cond
 	   ((PointerC-p class-symbol)
@@ -3476,10 +3563,7 @@
 	(roles (getf args :roles)))
     (when (and (or roles instance-of themes)
 	       (not start-revision))
-      (error (make-condition 'missing-argument-error
-			     :message "From make-association(): start-revision must be set"
-			     :argument-symbol 'start-revision
-			     :function-symbol 'make-association)))
+      (error (make-missing-argument-condition "From make-association(): start-revision must be set" 'start-revision 'make-association)))
     (let ((association
 	   (let ((existing-associations
 		  (remove-if
@@ -3517,10 +3601,7 @@
 	(start-revision (getf args :start-revision)))
     (when (and (or instance-of player parent)
 	       (not start-revision))
-      (error (make-condition 'missing-argument-error
-			     :message "From make-role(): start-revision must be set"
-			     :argument-symbol 'start-revision
-			     :function-symbol 'make-role)))
+      (error (make-missing-argument-condition "From make-role(): start-revision must be set" 'start-revision 'make-role)))
     (let ((role
 	   (let ((existing-roles
 		  (when parent
@@ -3562,10 +3643,7 @@
 	(start-revision (getf args :start-revision)))
     (when (and (or item-identifiers reifier)
 	       (not start-revision))
-      (error (make-condition 'missing-argument-error
-			     :message "From make-tm(): start-revision must be set"
-			     :argument-symbol 'start-revision
-			     :function-symbol 'make-tm)))
+      (error (make-missing-argument-condition "From make-tm(): start-revision must be set" 'start-revision 'make-tm)))
     (let ((tm
 	   (let ((existing-tms
 		  (remove-if
@@ -3603,10 +3681,7 @@
     (when (and (or psis locators item-identifiers topic-identifiers
 		   names occurrences)
 	       (not start-revision))
-      (error (make-condition 'missing-argument-error
-			     :message "From make-topic(): start-revision must be set"
-			     :argument-symbol 'start-revision
-			     :function-symbol 'make-topic)))
+      (error (make-missing-argument-condition "From make-topic(): start-revision must be set" 'start-revision 'make-topic)))
     (let ((topic
 	   (let ((existing-topics
 		  (remove-if
@@ -3662,10 +3737,7 @@
 	(parent (getf args :parent)))
     (when (and (or instance-of themes variants parent)
 	       (not start-revision))
-      (error (make-condition 'missing-argument-error
-			     :message "From make-characteristic(): start-revision must be set"
-			     :argument-symbol 'start-revision
-			     :function-symbol 'make-characgteristic)))
+      (error (make-missing-argument-condition "From make-characteristic(): start-revision must be set" 'start-revision 'make-characgteristic)))
     (let ((characteristic
 	   (let ((existing-characteristics
 		  (when parent
@@ -3708,21 +3780,12 @@
 	(identified-construct (getf args :identified-construct))
 	(err "From make-pointer(): "))
     (when (and identified-construct (not start-revision))
-      (error (make-condition 'missing-argument-error
-			     :message (format nil "~astart-revision must be set" err)
-			     :argument-symbol 'start-revision
-			     :function-symbol 'make-pointer)))
+      (error (make-missing-argument-condition (format nil "~astart-revision must be set" err) 'start-revision 'make-pointer)))
     (unless uri
-      (error (make-condition 'missing-argument-error
-			     :message (format nil "~auri must be set" err)
-			     :argument-symbol 'uri
-			     :function-symbol 'make-pointer)))
+      (error (make-missing-argument-condition (format nil "~auri must be set" err) 'uri 'make-pointer)))
     (when (and (TopicIdentificationC-p class-symbol)
 	       (not xtm-id))
-      (error (make-condition 'missing-argument-error
-			     :message (format nil "~axtm-id must be set" err)
-			     :argument-symbol 'xtm-id
-			     :function-symbol 'make-pointer)))
+      (error (make-missing-argument-condition (format nil "~axtm-id must be set" err) 'xtm-id 'make-pointer)))
     (let ((identifier
 	   (let ((existing-pointer
 		  (remove-if
@@ -3763,7 +3826,7 @@
   (declare (integer revision))
   (let ((iis (item-identifiers source :revision revision)))
     (dolist (ii iis)
-      (delete-item-identifier source ii :revision revision)
+      (private-delete-item-identifier source ii :revision revision)
       (add-item-identifier destination ii :revision revision))
     iis))
 
@@ -3776,13 +3839,13 @@
 	(psis (psis source :revision revision))
 	(sls (locators source :revision revision)))
     (dolist (tid tids)
-      (delete-topic-identifier source tid :revision revision)
+      (private-delete-topic-identifier source tid :revision revision)
       (add-topic-identifier destination tid :revision revision))
     (dolist (psi psis)
-      (delete-psi source psi :revision revision)
+      (private-delete-psi source psi :revision revision)
       (add-psi destination psi :revision revision))
     (dolist (sl sls)
-      (delete-locator source sl :revision revision)
+      (private-delete-locator source sl :revision revision)
       (add-locator destination sl :revision revision))
     (append tids iis psis sls)))
 
@@ -3804,10 +3867,10 @@
 	  (destination-reifier (reifier destination :revision revision)))
       (let ((result
 	     (cond ((and source-reifier destination-reifier)
-		    (delete-reifier (reified-construct source-reifier
+		    (private-delete-reifier (reified-construct source-reifier
 						       :revision revision)
 				    source-reifier :revision revision)
-		    (delete-reifier (reified-construct destination-reifier
+		    (private-delete-reifier (reified-construct destination-reifier
 						       :revision revision)
 				    destination-reifier :revision revision)
 		    (let ((merged-reifier
@@ -3816,7 +3879,7 @@
 		      (add-reifier destination merged-reifier :revision revision)
 		      merged-reifier))
 		   (source-reifier
-		    (delete-reifier (reified-construct source-reifier
+		    (private-delete-reifier (reified-construct source-reifier
 						       :revision revision)
 				    source-reifier :revision revision)
 		    (add-reifier destination source-reifier :revision revision)
@@ -3842,13 +3905,13 @@
 	(typables (used-as-type source :revision revision))
 	(ids (move-identifiers source destination :revision revision)))
     (dolist (role roles)
-      (delete-player role source :revision revision)
+      (private-delete-player role source :revision revision)
       (add-player role destination :revision revision))
     (dolist (scopable scopables)
-      (delete-theme scopable source :revision revision)
+      (private-delete-theme scopable source :revision revision)
       (add-theme scopable destination :revision revision))
     (dolist (typable typables)
-      (delete-type typable source :revision revision)
+      (private-delete-type typable source :revision revision)
       (add-type typable destination :revision revision))
     (remove-if #'null (append roles scopables typables ids))))
 
@@ -3864,21 +3927,19 @@
       (when (and source-reified destination-reified
 		 (not (eql (type-of source-reified)
 			   (type-of destination-reified))))
-	(error (make-condition 'not-mergable-error
-			       :message (format nil "From move-reified-construct(): ~a and ~a can't be merged since the reified-constructs are not of the same type ~a ~a"
-						source destination source-reified destination-reified)
-			       :construct-1 source
-			       :construct-2 destination)))
+	(error (make-not-mergable-condition (format nil "From move-reified-construct(): ~a and ~a can't be merged since the reified-constructs are not of the same type ~a ~a"
+						    source destination source-reified destination-reified)
+					    source destination)))
       (cond ((and source-reified destination-reified)
-	     (delete-reifier source-reified source :revision revision)
-	     (delete-reifier destination-reified destination :revision revision)
+	     (private-delete-reifier source-reified source :revision revision)
+	     (private-delete-reifier destination-reified destination :revision revision)
 	     (let ((merged-reified
 		    (merge-constructs source-reified destination-reified
 				      :revision revision)))
 	       (add-reifier merged-reified destination :revision revision)
 	       merged-reified))
 	    (source-reified
-	     (delete-reifier source source-reified :revision revision)
+	     (private-delete-reifier source source-reified :revision revision)
 	     (add-reifier  source-reified destination :revision revision)
 	     source-reified)
 	    (destination-reified
@@ -3894,7 +3955,7 @@
     (declare (integer revision))
     (let ((occs-to-move (occurrences source :revision revision)))
       (dolist (occ occs-to-move)
-	(delete-occurrence source occ :revision revision)
+	(private-delete-occurrence source occ :revision revision)
 	(let ((equivalent-occ
 	       (find-if #'(lambda (destination-occ)
 			    (when 
@@ -3919,7 +3980,7 @@
     (declare (integer revision))
     (let ((vars-to-move (variants source :revision revision)))
       (dolist (var vars-to-move)
-	(delete-variant source var :revision revision)
+	(private-delete-variant source var :revision revision)
 	(let ((equivalent-var
 	       (find-if #'(lambda (destination-var)
 			    (when 
@@ -3944,7 +4005,7 @@
     (declare (integer revision))
     (let ((names-to-move (names source :revision revision)))
       (dolist (name names-to-move)
-	(delete-name source name :revision revision)
+	(private-delete-name source name :revision revision)
 	(let ((equivalent-name
 	       (find-if #'(lambda (destination-name)
 			    (when 
@@ -4060,15 +4121,12 @@
 		(parent-2 (parent newer-char :revision revision)))
 	    (unless (strictly-equivalent-constructs construct-1 construct-2
 						    :revision revision)
-	      (error (make-condition 'not-mergable-error
-				     :message (format nil "From merge-constructs(): ~a and ~a are not mergable"
-						      construct-1 construct-2)
-				     :construct-1 construct-1
-				     :construct-2 construct-2)))
+	      (error (make-not-mergable-condition (format nil "From merge-constructs(): ~a and ~a are not mergable" construct-1 construct-2)
+						  construct-1 construct-2)))
 	    (cond ((and parent-1 (eql parent-1 parent-2))
 		   (move-referenced-constructs newer-char older-char
 					       :revision revision)
-		   (delete-characteristic parent-2 newer-char
+		   (private-delete-characteristic parent-2 newer-char
 					  :revision revision)
 		   (let ((c-assoc
 			  (find-if
@@ -4158,14 +4216,11 @@
 				      (themes construct-2 :revision revision))
 		    (not (eql (instance-of construct-1 :revision revision)
 			      (instance-of construct-2 :revision revision))))
-	    (error (make-condition 'not-mergable-error
-				   :message (format nil "From merge-constructs(): ~a and ~a are not mergable"
-						    construct-1 construct-2)
-				   :construct-1 construct-1
-				   :construct-2 construct-2)))
+	    (error (make-not-mergable-condition (format nil "From merge-constructs(): ~a and ~a are not mergable" construct-1 construct-2)
+						construct-1 construct-2)))
 	  (dolist (tm (in-topicmaps newer-assoc :revision revision))
 	    (add-to-tm tm older-assoc))
-	  (delete-type newer-assoc (instance-of newer-assoc :revision revision)
+	  (private-delete-type newer-assoc (instance-of newer-assoc :revision revision)
 		       :revision revision)
 	  (move-referenced-constructs newer-assoc older-assoc)
 	  (dolist (newer-role (roles newer-assoc :revision revision))
@@ -4177,7 +4232,7 @@
 	      (when equivalent-role
 		(move-referenced-constructs newer-role equivalent-role
 					    :revision revision))
-	      (delete-role newer-assoc newer-role :revision revision)
+	      (private-delete-role newer-assoc newer-role :revision revision)
 	      (add-role older-assoc (if equivalent-role
 					equivalent-role
 					newer-role)
@@ -4199,17 +4254,14 @@
 			       construct-1)))
 	  (unless (strictly-equivalent-constructs construct-1 construct-2
 						  :revision revision)
-	    (error (make-condition 'not-mergable-error
-				   :message (format nil "From merge-constructs(): ~a and ~a are not mergable"
-						    construct-1 construct-2)
-				   :construct-1 construct-1
-				   :construct-2 construct-2)))
+	    (error (make-not-mergable-condition (format nil "From merge-constructs(): ~a and ~a are not mergable" construct-1 construct-2)
+						construct-1 construct-2)))
 	  (let ((parent-1 (parent older-role :revision revision))
 		(parent-2 (parent newer-role :revision revision)))
 	    (cond ((and parent-1 (eql parent-1 parent-2))
 		   (move-referenced-constructs newer-role older-role
 					       :revision revision)
-		   (delete-role parent-2 newer-role :revision revision)
+		   (private-delete-role parent-2 newer-role :revision revision)
 		   (let ((r-assoc
 			  (find-if
 			   #'(lambda(r-assoc)



From lgiessmann at common-lisp.net  Tue May 25 17:04:57 2010
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Tue, 25 May 2010 13:04:57 -0400
Subject: [isidorus-cvs] r294 - trunk/src/json
Message-ID: <E1OGxYn-0001RG-AE@common-lisp.net>

Author: lgiessmann
Date: Tue May 25 13:04:57 2010
New Revision: 294

Log:
fixed a compilation problem in the json-importer with sbcl 1.0.34.0.debian

Modified:
   trunk/src/json/json_importer.lisp

Modified: trunk/src/json/json_importer.lisp
==============================================================================
--- trunk/src/json/json_importer.lisp	(original)
+++ trunk/src/json/json_importer.lisp	Tue May 25 13:04:57 2010
@@ -242,8 +242,8 @@
 	   (json-to-scope (getf json-decoded-list :scopes)))
 	  (instance-of
 	   (psis-to-topic (getf json-decoded-list :type))))
-      (declare (list json-decoded-list))
-      (declare (TopicC top))
+      ;(declare (list json-decoded-list)) causes problems with sbcl 1.0.34.0.debian
+      ;(declare (TopicC top))
       (unless namevalue
         (error "A name must have exactly one namevalue"))
       (let ((name (make-construct 'NameC 



From lgiessmann at common-lisp.net  Tue May 25 18:10:18 2010
From: lgiessmann at common-lisp.net (Lukas Giessmann)
Date: Tue, 25 May 2010 14:10:18 -0400
Subject: [isidorus-cvs] r295 - branches/new-datamodel/src
	branches/new-datamodel/src/json
	branches/new-datamodel/src/model trunk/src
Message-ID: <E1OGya2-0005Vf-DK@common-lisp.net>

Author: lgiessmann
Date: Tue May 25 14:10:18 2010
New Revision: 295

Log:
fixed a problem with sbcl/asdf and the sb-impl::*default-external-format* --> now it is set to :utf-8 during the loading process and then set to its old value

Modified:
   branches/new-datamodel/src/isidorus.asd
   branches/new-datamodel/src/json/json_importer.lisp
   branches/new-datamodel/src/model/changes.lisp
   trunk/src/isidorus.asd

Modified: branches/new-datamodel/src/isidorus.asd
==============================================================================
--- branches/new-datamodel/src/isidorus.asd	(original)
+++ branches/new-datamodel/src/isidorus.asd	Tue May 25 14:10:18 2010
@@ -12,6 +12,9 @@
   (:use :asdf :cl))
 (in-package :isidorus-system)
 
+(defvar *old-external-format* sb-impl::*default-external-format*)
+(setf sb-impl::*default-external-format* :UTF-8)
+
 (asdf:defsystem "isidorus"
   :description "The future ingenious, self-evaluating Lisp TM engine"
   :version "0.1"
@@ -202,6 +205,9 @@
                :uuid
 	       :cl-json))
 
+(setf sb-impl::*default-external-format* *old-external-format*)
+
+
 ;;
 ;; For the package pathnames, create a link from  ~/.sbcl/systems
 ;; to the file pathnames.asd in Seibel's pathname-library.

Modified: branches/new-datamodel/src/json/json_importer.lisp
==============================================================================
--- branches/new-datamodel/src/json/json_importer.lisp	(original)
+++ branches/new-datamodel/src/json/json_importer.lisp	Tue May 25 14:10:18 2010
@@ -244,12 +244,10 @@
 	   (json-to-scope (getf json-decoded-list :scopes)))
 	  (instance-of
 	   (psis-to-topic (getf json-decoded-list :type))))
-      (declare (list json-decoded-list))
-      (declare (TopicC top))
-  
+      ;(declare (list json-decoded-list)) causes problems with sbcl 1.0.34.0.debian
+      ;(declare (TopicC top))
       (unless namevalue
         (error "A name must have exactly one namevalue"))
-
       (let ((name (make-construct 'NameC 
 				  :start-revision start-revision
 				  :topic top

Modified: branches/new-datamodel/src/model/changes.lisp
==============================================================================
--- branches/new-datamodel/src/model/changes.lisp	(original)
+++ branches/new-datamodel/src/model/changes.lisp	Tue May 25 14:10:18 2010
@@ -140,7 +140,7 @@
     * (for topics) modified through the addition or removal of an association in which it is first player"))
 
 (defmethod changed-p ((construct TopicMapConstructC) (revision integer))
-  "The 'normal' case: changes only when new identifiers are added" 
+  "The 'normal' case: changes only when new identifiers are added"
   (find revision (versions construct) :test #'= :key #'start-revision))
 
 ;There is quite deliberately no method specialized on AssociationC as

Modified: trunk/src/isidorus.asd
==============================================================================
--- trunk/src/isidorus.asd	(original)
+++ trunk/src/isidorus.asd	Tue May 25 14:10:18 2010
@@ -12,6 +12,9 @@
   (:use :asdf :cl))
 (in-package :isidorus-system)
 
+(defvar *old-external-format* sb-impl::*default-external-format*)
+(setf sb-impl::*default-external-format* :UTF-8)
+
 (asdf:defsystem "isidorus"
   :description "The future ingenious, self-evaluating Lisp TM engine"
   :version "0.1"
@@ -201,6 +204,9 @@
                :uuid
 	       :cl-json))
 
+
+(setf sb-impl::*default-external-format* *old-external-format*)
+
 ;;
 ;; For the package pathnames, create a link from  ~/.sbcl/systems
 ;; to the file pathnames.asd in Seibel's pathname-library.