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

[Lukas Giessmann]

Author: lgiessmann
Date: Tue Mar  9 12:24:52 2010
New Revision: 220

Log:
new-datamodel: finalized "delete-construct"

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

Modified: branches/new-datamodel/src/model/datamodel.lisp
==============================================================================
--- branches/new-datamodel/src/model/datamodel.lisp	(original)
+++ branches/new-datamodel/src/model/datamodel.lisp	Tue Mar  9 12:24:52 2010
@@ -853,6 +853,18 @@
   (delete-1-n-association construct 'parent-construct))
 
 
+;;; RoleAssociationC
+(defmethod delete-construct :before ((construct RoleAssociationC))
+  (delete-1-n-association construct 'role)
+  (delete-1-n-association construct 'parent-construct))
+
+
+;;; PlayerAssociationC
+(defmethod delete-construct :before ((construct PlayerAssociationC))
+  (delete-1-n-association construct 'player-topic)
+  (delete-1-n-association construct 'parent-construct))
+
+
 ;;; TopicC
 (defmethod delete-construct :before ((construct TopicC))
   (let ((psis-to-delete
@@ -862,7 +874,8 @@
 	(names-to-delete
 	 (map 'list #'characteristic (slot-p construct 'names)))
 	(occurrences-to-delete (slot-p construct 'occurrences))
-	;TODO: roles -> associations?
+	(roles-to-delete
+	 (map 'list #'parent-construct (slot-p construct 'player-in-roles)))
 	(typables-to-delete
 	 (map 'list #'typable-construct (slot-p construct 'used-as-type)))
 	(reifier-assocs-to-delete (slot-p construct 'reified-construct)))
@@ -870,6 +883,7 @@
 					 sls-to-delete
 					 names-to-delete
 					 occurrences-to-delete
+					 roles-to-delete
 					 typables-to-delete
 					 reifier-assocs-to-delete))
       (delete-construct construct-to-delete)))
@@ -1417,6 +1431,14 @@
 
 
 ;;; AssociationC
+(defmethod delete-construct :before ((construct AssociationC))
+  (dolist (role-to-delete
+	    (map 'list #'role (slot-p construct 'roles)))
+    (delete-construct role-to-delete))
+  (dolist (tm (slot-p construct 'in-topicmaps))
+    (remove-association construct 'in-topicmaps tm)))
+
+
 (defmethod owned-p ((construct AssociationC))
   (when (slot-p construct 'in-topicmaps)
     t))
@@ -1470,6 +1492,13 @@
 
 
 ;;; RoleC
+(defmethod delete-construct :before ((construct RoleC))
+  (dolist (role-assoc-to-delete (slot-p construct 'parent))
+    (delete-construct role-assoc-to-delete))
+  (dolist (player-assoc-to-delete (slot-p construct 'player))
+    (delete-construct player-assoc-to-delete)))
+
+
 (defmethod owned-p ((construct RoleC))
   (when (slot-p construct 'parent)
     t))