(lisp-indent-defun-method): New variable.

(common-lisp-indent-function): Use it.
(lisp-indent-259): Uncomment the `&lambda' code.
(top-level let): Remove duplicate `catch' and `block'.  Use
`&lambda' when appropriate.  Now the lambda lists are indented appropriately.

diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el
index 04f89c2b0ce41eb379ad882170a42e4232b40f02..0b0de868811bc667f91d75a7704a1a860d923654 100644 (file)
--- a/lisp/emacs-lisp/cl-indent.el
+++ b/lisp/emacs-lisp/cl-indent.el
@@ -80,6 +80,7 @@ by `lisp-body-indent'."
 
 \f
 (defvar lisp-indent-error-function)
+(defvar lisp-indent-defun-method '(4 &lambda &body))
 
 ;;;###autoload
 (defun common-lisp-indent-function (indent-point state)
@@ -114,7 +115,8 @@ by `lisp-body-indent'."
                 (setq function nil method nil)
               (setq tem (point))
               (forward-sexp 1)
-              (setq function (downcase (buffer-substring tem (point))))
+              (setq function (downcase (buffer-substring-no-properties
+                                        tem (point))))
               (goto-char tem)
               (setq tem (intern-soft function)
                     method (get tem 'common-lisp-indent-function))
@@ -146,17 +148,17 @@ by `lisp-body-indent'."
             ;; backwards compatibility.
             (cond ((null function))
                   ((null method)
-                   (if (null (cdr path))
+                   (when (null (cdr path))
                        ;; (package prefix was stripped off above)
                        (setq method (cond ((string-match "\\`def"
                                                          function)
-                                           '(4 (&whole 4 &rest 1) &body))
+                                         lisp-indent-defun-method)
                                           ((string-match "\\`\\(with\\|do\\)-"
                                                          function)
-                                           '(4 &body))))))
+                                         '(&lambda &body))))))
                   ;; backwards compatibility.  Bletch.
                   ((eq method 'defun)
-                   (setq method '(4 (&whole 4 &rest 1) &body))))
+                   (setq method lisp-indent-defun-method)))
 
             (cond ((and (memq (char-after (1- containing-sexp)) '(?\' ?\`))
                         (not (eql (char-after (- containing-sexp 2)) ?\#)))
@@ -201,7 +203,7 @@ by `lisp-body-indent'."
                                       sexp-column normal-indent))))))
           (goto-char containing-sexp)
           (setq last-point containing-sexp)
-          (if (not calculated)
+          (unless calculated
               (condition-case ()
                    (progn (backward-up-list 1)
                           (setq depth (1+ depth)))
@@ -239,15 +241,15 @@ by `lisp-body-indent'."
           (setq tem (car method))
 
           (or (eq tem 'nil)             ;default indentation
-;             (eq tem '&lambda)         ;abbrev for (&whole 4 (&rest 1))
+          (eq tem '&lambda)     ;lambda list
               (and (eq tem '&body) (null (cdr method)))
               (and (eq tem '&rest)
-                   (consp (cdr method)) (null (cdr (cdr method))))
+               (consp (cdr method)) (null (cddr method)))
               (integerp tem)            ;explicit indentation specified
               (and (consp tem)          ;destructuring
                    (eq (car tem) '&whole)
-                   (or (symbolp (car (cdr tem)))
-                       (integerp (car (cdr tem)))))
+               (or (symbolp (cadr tem))
+                   (integerp (cadr tem))))
               (and (symbolp tem)        ;a function to call to do the work.
                    (null (cdr method)))
               (lisp-indent-report-bad-format method))
@@ -277,14 +279,13 @@ by `lisp-body-indent'."
                      (throw 'exit normal-indent)))
                 ((eq tem 'nil)
                  (throw 'exit (list normal-indent containing-form-start)))
-;               ((eq tem '&lambda)
-;                ;; abbrev for (&whole 4 &rest 1)
-;                (throw 'exit
-;                  (cond ((null p)
-;                         (list (+ sexp-column 4) containing-form-start))
-;                        ((null (cdr p))
-;                         (+ sexp-column 1))
-;                        (t normal-indent))))
+          ((eq tem '&lambda)
+           (throw 'exit
+             (cond ((null p)
+                    (list (+ sexp-column 4) containing-form-start))
+                   ((null (cdr p))
+                    (+ sexp-column 1))
+                   (t normal-indent))))
                 ((integerp tem)
                  (throw 'exit
                    (if (null p)         ;not in subforms
@@ -298,9 +299,9 @@ by `lisp-body-indent'."
                  ;; must be a destructing frob
                  (if (not (null p))
                      ;; descend
-                     (setq method (cdr (cdr tem))
+               (setq method (cddr tem)
                            n nil)
-                   (setq tem (car (cdr tem)))
+               (setq tem (cadr tem))
                    (throw 'exit
                      (cond (tail
                             normal-indent)
@@ -373,22 +374,21 @@ by `lisp-body-indent'."
 
 \f
 (let ((l '((block 1)
-          (catch 1)
           (case        (4 &rest (&whole 2 &rest 1)))
           (ccase . case) (ecase . case)
           (typecase . case) (etypecase . case) (ctypecase . case)
           (catch 1)
           (cond        (&rest (&whole 2 &rest 1)))
-          (block 1)
           (defvar      (4 2 2))
           (defconstant . defvar)
+           (defcustom (4 2 2 2))
           (defparameter . defvar)
           (define-modify-macro
                        (4 &body))
-          (define-setf-method
-                       (4 (&whole 4 &rest 1) &body))
-          (defsetf     (4 (&whole 4 &rest 1) 4 &body))
-          (defun       (4 (&whole 4 &rest 1) &body))
+          (defsetf     (4 &lambda 4 &body))
+          (defun       (4 &lambda &body))
+          (define-setf-method . defun)
+          (define-setf-expander . defun)
           (defmacro . defun) (deftype . defun)
           (defpackage  (4 2))
           (defstruct   ((&whole 4 &rest (&whole 2 &rest 1))
@@ -400,19 +400,16 @@ by `lisp-body-indent'."
           (dolist      ((&whole 4 2 1) &body))
           (dotimes . dolist)
           (eval-when   1)
-          (flet        ((&whole 4 &rest (&whole 1 (&whole 4 &rest 1) &body))
-                        &body))
+          (flet        ((&whole 4 &rest (&whole 1 &lambda &body)) &body))
           (labels . flet)
           (macrolet . flet)
-           (handler-case (4 &rest (&whole 2 (&whole 4 &rest 1) &body)))
+           (handler-case (4 &rest (&whole 2 &lambda &body)))
            (restart-case . handler-case)
           ;; `else-body' style
           (if          (nil nil &body))
           ;; single-else style (then and else equally indented)
           (if          (&rest nil))
-          ;; (lambda     ((&whole 4 &rest 1) &body))
-          (lambda      ((&whole 4 &rest 1)
-                        &rest lisp-indent-function-lambda-hack))
+          (lambda      (&lambda &rest lisp-indent-function-lambda-hack))
           (let         ((&whole 4 &rest (&whole 1 1 2)) &body))
           (let* . let)
           (compiler-let . let) ;barf
@@ -428,7 +425,7 @@ by `lisp-body-indent'."
                        (4 2))
           (multiple-value-setf . multiple-value-setq)
           ;; Combines the worst features of BLOCK, LET and TAGBODY
-          (prog        ((&whole 4 &rest 1) &rest lisp-indent-tagbody))
+          (prog        (&lambda &rest lisp-indent-tagbody))
           (prog* . prog)
           (prog1 1)
           (prog2 2)
@@ -443,10 +440,10 @@ by `lisp-body-indent'."
            (when 1)
            (with-standard-io-syntax (2)))))
   (while l
-    (put (car (car l)) 'common-lisp-indent-function
-        (if (symbolp (cdr (car l)))
-            (get (cdr (car l)) 'common-lisp-indent-function)
-            (car (cdr (car l)))))
+    (put (caar l) 'common-lisp-indent-function
+        (if (symbolp (cdar l))
+            (get (cdar l) 'common-lisp-indent-function)
+            (car (cdar l))))
     (setq l (cdr l))))
 
 \f