This patch attempts to fix semantic indentation with clisp. I'm not
sure how great an idea it is, but it seems to work for me.
It works by changing the macro-functon on common-lisp:defmacro to one
that also stores the arglist on the defined macro's symbol-plist.
Strictly speaking, I don't believe you're meant to modify symbols in
the common-lisp package in this way, but it seems to work with clisp.
Any thoughts would be much appreciated!
2006-06-14 Damyan Pepper <damyanp(a)gmail.com>
* swank-clisp.lisp: Replace common-lisp:defmacro with a modified
version that stores the argument list in a way that can be
retrieved with swank-backend:arglist. This makes semantic
indentation work for macros with &body arguments.
$ cvs -q diff -u
Index: swank-clisp.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-clisp.lisp,v
retrieving revision 1.58
diff -u -r1.58 swank-clisp.lisp
--- swank-clisp.lisp 22 Mar 2006 16:40:01 -0000 1.58
+++ swank-clisp.lisp 14 Jun 2006 11:47:00 -0000
@@ -137,12 +137,13 @@
(defimplementation arglist (fname)
(block nil
- (or (ignore-errors
- (let ((exp (function-lambda-expression fname)))
- (and exp (return (second exp)))))
- (ignore-errors
- (return (ext:arglist fname)))
- :not-available)))
+ (or (get fname 'arglist)
+ (ignore-errors
+ (let ((exp (function-lambda-expression fname)))
+ (and exp (return (second exp)))))
+ (ignore-errors
+ (return (ext:arglist fname)))
+ :not-available)))
(defimplementation macroexpand-all (form)
(ext:expand-form form))
@@ -580,6 +581,22 @@
#+lisp=cl (ext:quit)
#-lisp=cl (lisp:quit))
+♀
+
+;;; Replace cl:defmacro with our own that stores the arglists
+(defvar *old-defmacro* (copy-symbol 'common-lisp:defmacro t))
+
+(defmacro defmymacro (&environment env &whole whole name params &body body)
+ (declare (ignore body))
+ `(progn
+ (setf (get ',name 'swank-backend::arglist) ',params)
+ ,(funcall (macro-function *old-defmacro*) whole env)
+ ',name))
+
+(setf *old-defmacro* (copy-symbol 'common-lisp:defmacro t))
+(setf (macro-function 'common-lisp:defmacro) (macro-function 'defmymacro))
+
+
;;; Local Variables:
;;; eval: (put 'compile-file-frobbing-notes 'lisp-indent-function 1)
;;; eval: (put 'dynamic-flet 'common-lisp-indent-function 1)