Commit | Line | Data |
---|---|---|
c8ca09d9 DC |
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)))))))) |