1 (in-package :lisp-on-lines
)
6 (define-layered-function display-using-description
(description display object
&rest args
)
8 "Displays OBJECT via description using/in/with/on display"))
10 (defun display (display object
&rest args
)
11 (display-using-description (description-of object
) display object args
))
13 (define-layered-method display-using-description
14 :around
(description display object
&rest args
)
15 (let ((*display
* display
)
19 (define-layered-method display-using-description
(description display object
&rest args
)
20 (error "No DISPLAY-USING-DESCRIPTION methods are specified for: ~% DESCRIPTION: ~A ~% DISPLAY: ~A ~% OBJECT: ~A ~% ARGS: ~S
22 OMGWTF! If you didn't do this, it's a bug!" description display object args
))
24 (defun display-attribute (attribute)
25 (display-using-description attribute
*display
* *object
*))
27 (defmacro define-display
(&body body
)
28 (loop with in-layerp
= (eq (car body
) :in-layer
)
29 with layer
= (if in-layerp
(cadr body
) 't
)
30 for tail on
(if in-layerp
(cddr body
) body
)
31 until
(listp (car tail
))
32 collect
(car tail
) into qualifiers
34 (when (member :in-layer qualifiers
)
35 (error "Incorrect occurrence of :in-layer in defdisplay. Must occur before qualifiers."))
37 (destructuring-bind (description-spec &optional
(display-spec (gensym)) (object-spec (gensym)))
39 `(define-layered-method
40 display-using-description
43 (,(if (listp description-spec
)
44 (list (first description-spec
)
45 (if (eq 'description
(second description-spec
))
47 (defining-description (second description-spec
)))))
49 ,object-spec
&rest args
)
50 (declare (ignorable args
))