| 1 | (in-package :lisp-on-lines) |
| 2 | |
| 3 | (defmacro defdescription (name super-descriptions attributes &rest arguments) |
| 4 | "Create a description and any lines specified." |
| 5 | ;; Remove any existing lines |
| 6 | `(progn |
| 7 | (dolist (method (remove-if |
| 8 | (lambda (method) |
| 9 | (when (eql (contextl::get-layered-function-definer-name 'line-in) |
| 10 | (closer-mop:generic-function-name |
| 11 | (closer-mop:method-generic-function method))))) |
| 12 | (closer-mop:specializer-direct-methods (find-class ',name)))) |
| 13 | (remove-method (symbol-function (contextl::get-layered-function-definer-name 'line-in)) |
| 14 | method)) |
| 15 | ;; Create any attributes |
| 16 | (let ((occurence (find-occurence ',name))) |
| 17 | (initialize-occurence-for-instance occurence (make-instance ',name)) |
| 18 | ,@(mapcar #'(lambda (x) |
| 19 | `(ensure-attribute occurence :name ',(car x) ,@(cdr x))) |
| 20 | attributes) |
| 21 | ;; Add any layered lines specified. |
| 22 | ,@(when t #+ (or) (ignore-errors (find-class name)) |
| 23 | (loop for arg in arguments |
| 24 | when (eql (car arg) :in-layer) |
| 25 | collect `(defline line-in ((self ,name) :in-layer ,(second arg)) |
| 26 | (list ,@(cddr arg)))))))) |