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

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))
participants (1)
-
Lukas Giessmann