From c8ca09d949657cbf4bd98b179e1c2f9b5762db3f Mon Sep 17 00:00:00 2001
From: Drew Crampsie <drewc@tech.coop>
Date: Sat, 9 Jun 2007 19:56:19 -0700
Subject: [PATCH] Add forgotten defdescription form.

darcs-hash:20070610025619-5417e-c21b1dbbc32a5b4bdf5aaf6e72c3da25c7e86ecd.gz
---
 src/defdescription.lisp | 26 ++++++++++++++++++++++++++
 1 file changed, 26 insertions(+)
 create mode 100644 src/defdescription.lisp

diff --git a/src/defdescription.lisp b/src/defdescription.lisp
new file mode 100644
index 0000000..b433d47
--- /dev/null
+++ b/src/defdescription.lisp
@@ -0,0 +1,26 @@
+(in-package :lisp-on-lines)
+
+(defmacro defdescription (name super-descriptions attributes &rest arguments)
+  "Create a description and any lines specified."
+  ;; Remove any existing lines
+  `(progn 
+     (dolist (method (remove-if
+		      (lambda (method)
+			(when (eql (contextl::get-layered-function-definer-name 'line-in)
+				   (closer-mop:generic-function-name
+				    (closer-mop:method-generic-function method)))))
+		      (closer-mop:specializer-direct-methods (find-class ',name))))
+       (remove-method (symbol-function (contextl::get-layered-function-definer-name 'line-in))
+		      method))
+     ;; Create any attributes
+     (let ((occurence (find-occurence ',name)))
+       (initialize-occurence-for-instance occurence (make-instance ',name))
+       ,@(mapcar #'(lambda (x)
+		     `(ensure-attribute occurence :name ',(car x) ,@(cdr x)))
+		 attributes)
+       ;; Add any layered lines specified.
+       ,@(when t #+ (or) (ignore-errors (find-class name))
+	       (loop for arg in arguments
+		  when (eql (car arg) :in-layer)
+		  collect `(defline line-in ((self ,name) :in-layer  ,(second arg))
+			     (list ,@(cddr arg))))))))
\ No newline at end of file
-- 
2.20.1