... and again a question related to this:
Suppose I have :
(defmd kid-test-2 (family) (a-slot (c-in nil)) :kids (list (make-instance 'my-kid) (make-instance 'my-kid)))
Now - this completely bypasses the control mechanism inserted into fm- kid-add - which is not what I wanted ;-) So, I am asking myself if it would be better to insert the check into the .kids observer ...
I now have:
(defmodel family (model) ((.kid-slots :cell nil :initform nil :accessor kid-slots :initarg :kid-slots) (.kids :initform (c-in nil) ;; most useful :owning t :accessor kids :initarg :kids) (registry? :cell nil :initform nil :initarg :registry? :accessor registry?) (registry :cell nil :initform nil :accessor registry) ;; added: frgo, 2008-10-30 (control-hooks :cell nil :accessor control-hooks :initform (make-hash-table :test 'eql) :initarg :control-hooks)))
(defmethod get-control-hooks ((self family) hook-id) (gethash hook-id (control-hooks self)))
(defmethod add-hook ((self family) id hook) (setf (gethash id (control-hooks self)) hook))
(defun call-control-hook (hook self &rest args) ;;; to be completed here )
(eval-when (:compile-time :load-toplevel) (proclaim '(inline mklist)) (if (not (fboundp 'mklist)) (defun mklist (obj) (if (listp obj) obj (list obj)))))
(defun run-control-hooks (id self &rest args) (c-assert (typep self 'family)) (let ((hooks (get-control-hooks self id))) (if hooks (loop for hook in (get-control-hooks self id) collect (call-control-hook hook self args) into result finally (return (mklist result))) (mklist t))))
and
(define-condition cells-adding-kid-not-allowed-error (error) ((text :initarg :text :reader text)))
(defun kid-add-allowed? (fm-parent kid) (notany #'null (run-control-hooks 'fm-kid-add-control fm-parent kid)))
(defun fm-kid-add (fm-parent kid &optional before) (c-assert (or (null (fm-parent kid)) (eql fm-parent (fm-parent kid)))) (c-assert (typep fm-parent 'family)) ;; Added: frgo, 2008-10-30 (if (kid-add-allowed? fm-parent kid) (progn ;; (trc "Adding kid to parent" kid fm-parent) (setf (fm-parent kid) fm-parent) (fm-kid-insert kid before)) (error 'cells-adding-kid-not-allowed-error :text (format nil "ERROR: Kid ~s not allowed for parent ~s." kid fm-parent))))
- which is incomplete, of course, but shows the basic idea, or so I hope.
Any thoughts if I should use the observer or do some clever slot trickery using MOP ?
Thanks for feedback!
Regards Frank
Am 30.10.2008 um 13:15 schrieb Frank Goenninger:
- PGP Signed: 10/30/08 at 13:15:51
Hi -
I want to control if a kid is added to a parent based on the execution of a check function. The check function is supposed to throw an condition when the check fails.
Current use case:
Control which classes of kids are added to a parent. I do have a model of class BOM (bill of material) that only can accept classes Assembly and Part as kids.
I found two places at which I could insert a call to the check function:
function fm-kid-add (higher level interface) function fm-kid-insert (lower level interface)
Question now is: Why would one be better than the other?
Idea here is based on adding a new slot to class family:
(defmodel family (model) ((.kid-slots :cell nil :initform nil :accessor kid-slots :initarg :kid-slots) (.kids :initform (c-in nil) ;; most useful :owning t :accessor kids :initarg :kids) (registry? :cell nil :initform nil :initarg :registry? :accessor registry?) (registry :cell nil :initform nil :accessor registry) ;; added: frgo, 2008-10-30 ----- (kid-add-control-hook :cell nil :initform nil :initarg: kid-add-control-hook)))
and then do run the check functions that have been added to the control hook (= list of functions to be funcalled).
Right approach? Any comments? (It works but I'd like to know if am on the right track).
Thanks for feedback.
Cheers Frank
- Frank Goenninger frgo@me.com
- 0xE6BDA9B9:0x6AEA9601
cells-devel site list cells-devel@common-lisp.net http://common-lisp.net/mailman/listinfo/cells-devel
- PGP Signed: 10/30/08 at 13:15:51
- text/plain body
- Frank Goenninger frgo@me.com
- 0xE6BDA9B9:0x6AEA9601