Commit 883224be authored by Dave Cooper's avatar Dave Cooper

fixed args passing for not-handled for chase-up-trickle-downs

parent ed20e049
......@@ -48,14 +48,14 @@
(gethash keyword (the-object parent %trickle-down-slots%))
(apply (symbol-function slot-symbol) parent args))
(t (apply (symbol-function (glisp:intern slot-symbol :gdl-trickle-downs)) parent args))))))
(if (eql result 'gdl-rule:%not-handled%) (not-handled self keyword) result))
(if (eql result 'gdl-rule:%not-handled%) (not-handled self keyword args) result))
result))))))
(defun trickle-down-basis (self slot args)
(let ((keyword (make-keyword slot)))
(let (*error-on-not-handled?* (parent (the parent)))
(cond ((null parent) (not-handled self keyword))
(cond ((null parent) (not-handled self keyword args))
(;;(member keyword (the-object parent %trickle-down-slots%))
(gethash keyword (the-object parent %trickle-down-slots%))
(apply (symbol-function (glisp:intern slot :gdl-slots)) parent args))
......
......@@ -19,6 +19,11 @@
;; <http://www.gnu.org/licenses/>.
;;
These changes have been merged into codebase.
#|
(in-package :gdl)
......@@ -292,3 +297,5 @@ The path to the containing object is: ~s"
(if (null ,parent-arg) (not-handled ,self-arg ,(make-keyword key) ,args-arg)
(,(glisp:intern key :gdl-inputs)
,parent-arg (the-object ,self-arg :%name%) ,self-arg)))))) object-input-keys))))))
|#
(in-package :gdl)
(excl:without-package-locks
(excl:without-redefinition-warnings
(defun chase-up-trickle-down (slot-symbol self args)
(let ((keyword (make-keyword slot-symbol)))
(let ((parent (the-object self parent)))
(if (null parent) (not-handled self keyword)
(let ((result
(let (*error-on-not-handled?*)
(funcall (symbol-function (glisp:intern slot-symbol :gdl-inputs)) parent (the %name%) self))))
(if (eql result 'gdl-rule:%not-handled%)
(let ((result
(let (*error-on-not-handled?*)
(cond ( ;;(member keyword (the-object parent %trickle-down-slots%))
(gethash keyword (the-object parent %trickle-down-slots%))
(apply (symbol-function slot-symbol) parent args))
(t (apply (symbol-function (glisp:intern slot-symbol :gdl-trickle-downs)) parent args))))))
(if (eql result 'gdl-rule:%not-handled%) (not-handled self keyword args) result))
result))))))
(defun trickle-down-basis (self slot args)
(let ((keyword (make-keyword slot)))
(let (*error-on-not-handled?* (parent (the parent)))
(cond ((null parent) (not-handled self keyword args))
( ;;(member keyword (the-object parent %trickle-down-slots%))
(gethash keyword (the-object parent %trickle-down-slots%))
(apply (symbol-function (glisp:intern slot :gdl-slots)) parent args))
(t (apply (symbol-function (glisp:intern slot :gdl-trickle-downs)) parent args))))))))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment