Commit bbf1ae49 authored by Richard M. Stallman's avatar Richard M. Stallman

(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.
parent ae659ad5
......@@ -80,6 +80,7 @@ by `lisp-body-indent'."
(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'."
(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))))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment