(fix 'defclass) -> DEFKENNY
- From: Ken Tilton <kentilton@xxxxxxxxx>
- Date: Fri, 30 Jun 2006 15:58:16 -0400
Linebreaks are your problem, as are nose demons. Your hard drive, however, should be safe:
(defmacro defkenny (class superclasses &rest class-spec)
`(defclass ,class ,superclasses
,@(let (definitargs class-options slots)
(loop with skip
for (spec next) on class-spec
if skip
do (setf skip nil)
else do (etypecase spec
(cons
(cond
((keywordp (car spec))
(assert (find (car spec) '(:documentation :metaclass)))
(push spec class-options))
((find (cadr spec) '(:initarg :type :initform :allocation :reader :writer :accessor :documentation))
(push (apply 'defkenny-canonicalize-slot spec) slots))
(t ;; must be shortform: (slotname initform &rest slotdef-key-values)
(push (apply 'defkenny-canonicalize-slot
(list* (car spec) :initform (cadr spec) (cddr spec))) slots))))
(keyword
(setf definitargs (append definitargs (list spec next)))
(setf skip t))
(symbol (push (list spec :initform nil
:initarg (intern (symbol-name spec) :keyword)
:accessor spec) slots)))
finally
(return (list* (nreverse slots)
(delete-if 'null
(list* `(:default-initargs ,@definitargs)
(nreverse class-options)))))))))
(defun defkenny-canonicalize-slot (slotname
&key
(type nil type-p)
(initform nil initform-p)
(initarg (intern (symbol-name slotname) :keyword))
(documentation nil documentation-p)
(unchanged-if nil unchanged-if-p)
(reader slotname reader-p)
(writer `(setf ,slotname) writer-p)
(accessor slotname accessor-p)
(allocation nil allocation-p))
(list* slotname :initarg initarg
(append
(when type-p (list :type type))
(when initform-p (list :initform initform))
(when unchanged-if-p (list :unchanged-if unchanged-if))
(when reader-p (list :reader reader))
(when writer-p (list :writer writer))
(when (or accessor-p
(not (and reader-p writer-p)))
(list :accessor accessor))
(when allocation-p (list :allocation allocation))
(when documentation-p (list :documentation documentation)))))
#+testkenny
(progn
(defclass md-test-super ()())
(defkenny defkenny-test (md-test-super)
(aaa :initform nil :initarg :aaa :accessor aaa)
(aa2 :documentation "hi mom")
bbb
(ccc 42 :allocation :class)
(ddd (c-in nil))
:superx 42 ;; default-initarg
(:documentation "as if!")))
=>
(defclass defkenny-test (md-test-super)
((aaa :initarg :aaa :initform nil :accessor aaa)
(aa2 :initarg :aa2 :accessor aa2 :documentation "hi mom")
(bbb :initform nil :initarg :bbb :accessor bbb)
(ccc :initarg :ccc :initform 42 :accessor ccc :allocation :class)
(ddd :initarg :ddd :initform (c-in nil) :accessor ddd))
(:default-initargs
:superx 42)
(:documentation "as if!"))
You are welcome.
kenny
--
Cells: http://common-lisp.net/project/cells/
"I'll say I'm losing my grip, and it feels terrific."
-- Smiling husband to scowling wife, New Yorker cartoon
.
- Prev by Date: Re: What language could be written "Matrix"
- Next by Date: Re: What language could be written "Matrix"
- Previous by thread: [ANN] ECL 0.9i
- Index(es):
Relevant Pages
|
