X-Git-Url: https://git.hcoop.net/clinton/lisp-on-lines.git/blobdiff_plain/b1c8f43be32503f3911e60696dba8c9194f28ca5..f56d6e7e926f9c3f968325e244794ff748435ac3:/src/display.lisp diff --git a/src/display.lisp b/src/display.lisp index a0be611..6078e83 100644 --- a/src/display.lisp +++ b/src/display.lisp @@ -17,11 +17,20 @@ (dolist (d activate context) (setf context (adjoin-layer (find-description d) context)))) - - +(defun funcall-with-attribute-context (attribute thunk) + (funcall-with-layer-context + (modify-layer-context (current-layer-context) + :activate (attribute-active-descriptions attribute) + :deactivate (attribute-inactive-descriptions attribute)) + thunk)) +(defmacro with-attribute-context ((attribute) &body body) + `(funcall-with-attribute-context ,attribute (lambda () ,@body))) + + (defun display (display object &rest args &key deactivate activate &allow-other-keys) + (funcall-with-layer-context (modify-layer-context (current-layer-context) :activate activate @@ -32,6 +41,7 @@ (define-layered-method display-using-description :around (description display object &rest args) (declare (ignorable args)) +#+nil (break "Entering DISPLAY for ~A on ~A using ~A" object display description) (let ((*display* display)) (apply #'funcall-with-described-object (lambda () @@ -40,8 +50,6 @@ - - (defun display/d (&rest args) (apply #'display-using-description args))