Commit b4058627 authored by Alastair Bridgewater's avatar Alastair Bridgewater
Browse files

sheet/: Fix SHEET-{ADOPT,DISOWN}-CHILD mechanism.

  * I, having rarely done clever things like this with a
multimethod, completely screwed up the responsibilities for each
side of the dispatch.

  * The PARENT sheet is supposed to be the one to CALL-NEXT-METHOD,
and there should be no :AROUND qualifier anywhere.

  * Fixed existing code to conform to the new (correct) scheme.
parent ba790f05
......@@ -64,9 +64,9 @@
(:method ((sheet sheet) child)
(error "~S cannot adopt ~S because it does not support children"
sheet child))
(:method :around (sheet (child sheet))
(error "~S cannot be adopted by ~S because it does not accept parenting"
child sheet)))
(:method (sheet (child sheet))
(error "~S cannot be adopted by ~S because it does not accept parenting"
child sheet)))
(defgeneric sheet-disown-child (sheet child &key errorp)
(:documentation
......@@ -77,9 +77,9 @@
(:method ((sheet sheet) child &key (errorp t))
(when errorp
(error 'sheet-is-not-child :parent sheet :sheet child)))
(:method :around (sheet (child sheet) &key (errorp t))
(when errorp
(error 'sheet-is-not-child :parent sheet :sheet child))))
(:method (sheet (child sheet) &key (errorp t))
(when errorp
(error 'sheet-is-not-child :parent sheet :sheet child))))
(defgeneric sheet-siblings (sheet)
(:documentation
......
......@@ -14,17 +14,14 @@
(defclass sheet-parent-mixin ()
((parent :initform nil :reader sheet-parent)))
(defmethod sheet-adopt-child :around (sheet (child sheet-parent-mixin))
(defmethod sheet-adopt-child (sheet (child sheet-parent-mixin))
(when (sheet-parent child)
(error 'sheet-already-has-parent :sheet child))
(call-next-method)
(setf (slot-value child 'parent) sheet))
(defmethod sheet-disown-child :around (sheet (child sheet-parent-mixin) &key (errorp t))
(defmethod sheet-disown-child (sheet (child sheet-parent-mixin) &key (errorp t))
(if (eq (sheet-parent child) sheet)
(progn
(call-next-method)
(setf (slot-value child 'parent) nil))
(setf (slot-value child 'parent) nil)
(when errorp
(error 'sheet-is-not-child :parent sheet :sheet child))))
......
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