... 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