blob: fb02f086329cb2c4a7e0c39874a2806b70afcce4 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
|
;;;; units/unit.lisp
(in-package #:wheelwork)
(defclass/std unit ()
((cached-application :a)
(container :with :a)
(visiblep :with :std t)))
(defmethod (setf closer-mop:slot-value-using-class) :after
(newval class (unit unit) slot)
(case (closer-mop:slot-definition-name slot)
(container
(setf (cached-application unit) nil))))
(defun app-of-unit (unit)
"Returns the APPLICATION instance, if any, of which this UNIT is a
part. NIL indicates that the unit has not been added to any container
in this application."
(or (cached-application unit)
(setf (cached-application unit)
(labels ((rec (u)
(when-let (c (unit-container u))
(etypecase c
(application c)
(unit (rec c))
(null nil)))))
(rec unit)))))
(defmethod render :around ((unit unit))
(when (unit-visiblep unit)
(call-next-method)))
|
