floss/stoe
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add a method to get to the root of a node tree

Browse source
This commit is contained in:
Renaud Casenave-Péré 2016-04-09 13:03:18 +02:00
parent 8838362c26
commit dfe1b3940c
1 changed files with 7 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
core/utils.lisp
View file

@ -10,7 +10,7 @@
#:progress-step
#:loop-with-progress
#:add-hook #:remove-hook #:run-hook
#:node #:parent #:children #:attach-node #:detach-node
#:node #:parent #:children #:attach-node #:detach-node #:root
#:shared-object #:refcount #:inc-ref #:dec-ref
#:extend-array #:shrink-array
#:error-implementation-unsupported
@ -106,6 +106,12 @@
(setf children (delete node children)))))
node)
(defgeneric root (node))
(defmethod root ((node node))
(if (parent node)
(root (parent node))
node))
(defmethod initialize-instance :after ((node node) &key parent)
(attach-node node parent))