comparison lisp/modes/cl-indent.el @ 2:ac2d302a0011 r19-15b2

Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children cca96a509cfe
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
1 ;; Lisp mode, and its idiosyncratic commands. 1 ;;; cl-indent.el --- enhanced lisp-indent mode
2 ;; Copyright (C) 1987, 1993 Free Software Foundation, Inc. 2
3 ;; Written by Richard Mlynarik July 1987 3 ;; Copyright (C) 1987 Free Software Foundation, Inc.
4
5 ;; Author: Richard Mlynarik <mly@eddie.mit.edu>
6 ;; Created: July 1987
7 ;; Maintainer: FSF
8 ;; Keywords: lisp, tools
4 9
5 ;; This file is part of XEmacs. 10 ;; This file is part of XEmacs.
6 11
7 ;; XEmacs is free software; you can redistribute it and/or modify it 12 ;; XEmacs is free software; you can redistribute it and/or modify it
8 ;; under the terms of the GNU General Public License as published by 13 ;; under the terms of the GNU General Public License as published by
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 ;; General Public License for more details. 20 ;; General Public License for more details.
16 21
17 ;; You should have received a copy of the GNU General Public License 22 ;; You should have received a copy of the GNU General Public License
18 ;; along with XEmacs; see the file COPYING. If not, write to the Free 23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
19 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
25 ;; 02111-1307, USA.
26
27 ;;; Synched up with: FSF 19.34
28
29 ;;; Commentary:
30
31 ;; This package supplies a single entry point, common-lisp-indent-function,
32 ;; which performs indentation in the preferred style for Common Lisp code.
33 ;; To enable it:
34 ;;
35 ;; (setq lisp-indent-function 'common-lisp-indent-function)
20 36
21 ;;>> TODO 37 ;;>> TODO
22 ;; :foo 38 ;; :foo
23 ;; bar 39 ;; bar
24 ;; :baz 40 ;; :baz
30 ;; baz) 46 ;; baz)
31 ;; not (foo bar 47 ;; not (foo bar
32 ;; baz) 48 ;; baz)
33 ;; Need something better than &rest for such cases 49 ;; Need something better than &rest for such cases
34 50
35 51 ;;; Code:
36 ;;; Hairy lisp indentation.
37 52
38 (defvar lisp-indent-maximum-backtracking 3 53 (defvar lisp-indent-maximum-backtracking 3
39 "*Maximum depth to backtrack out from a sublist for structured indentation. 54 "*Maximum depth to backtrack out from a sublist for structured indentation.
40 If this variable is 0, no backtracking will occur and forms such as flet 55 If this variable is 0, no backtracking will occur and forms such as flet
41 may not be correctly indented.") 56 may not be correctly indented.")
42 57
43 (defvar lisp-tag-indentation 1 58 (defvar lisp-tag-indentation 1
44 "*Indentation of tags relative to containing list. 59 "*Indentation of tags relative to containing list.
45 This variable is used by the function lisp-indent-tagbody.") 60 This variable is used by the function `lisp-indent-tagbody'.")
46 61
47 (defvar lisp-tag-body-indentation 3 62 (defvar lisp-tag-body-indentation 3
48 "*Indentation of non-tagged lines relative to containing list. 63 "*Indentation of non-tagged lines relative to containing list.
49 This variable is used by the function lisp-indent-tagbody to indent normal 64 This variable is used by the function `lisp-indent-tagbody' to indent normal
50 lines (lines without tags). 65 lines (lines without tags).
51 The indentation is relative to the indentation of the parenthesis enclosing 66 The indentation is relative to the indentation of the parenthesis enclosing
52 he special form. If the value is t, the body of tags will be indented 67 the special form. If the value is t, the body of tags will be indented
53 as a block at the same indentation as the first s-expression following 68 as a block at the same indentation as the first s-expression following
54 the tag. In this case, any forms before the first tag are indented 69 the tag. In this case, any forms before the first tag are indented
55 by lisp-body-indent.") 70 by `lisp-body-indent'.")
56 71
57 72
58 ;;;###autoload 73 ;;;###autoload
59 (defun common-lisp-indent-function (indent-point state) 74 (defun common-lisp-indent-function (indent-point state)
60 (let ((normal-indent (current-column))) 75 (let ((normal-indent (current-column)))
61 ;; Walk up list levels until we see something 76 ;; Walk up list levels until we see something
62 ;; which does special things with subforms. 77 ;; which does special things with subforms.
63 (let ((depth 0) 78 (let ((depth 0)
64 ;; Path describes the position of point in terms of 79 ;; Path describes the position of point in terms of
65 ;; list-structure with respect to contining lists. 80 ;; list-structure with respect to containing lists.
66 ;; `foo' has a path of (0 4 1) in `((a b c (d foo) f) g)' 81 ;; `foo' has a path of (0 4 1) in `((a b c (d foo) f) g)'
67 (path ()) 82 (path ())
68 ;; set non-nil when somebody works out the indentation to use 83 ;; set non-nil when somebody works out the indentation to use
69 calculated 84 calculated
70 (last-point indent-point) 85 (last-point indent-point)
131 ;; backwards compatibility. Bletch. 146 ;; backwards compatibility. Bletch.
132 ((eq method 'defun) 147 ((eq method 'defun)
133 (setq method '(4 (&whole 4 &rest 1) &body)))) 148 (setq method '(4 (&whole 4 &rest 1) &body))))
134 149
135 (cond ((and (memq (char-after (1- containing-sexp)) '(?\' ?\`)) 150 (cond ((and (memq (char-after (1- containing-sexp)) '(?\' ?\`))
136 (not (eq (char-after (- containing-sexp 2)) ?\#))) 151 (not (eql (char-after (- containing-sexp 2)) ?\#)))
137 ;; No indentation for "'(...)" elements 152 ;; No indentation for "'(...)" elements
138 (setq calculated (1+ sexp-column))) 153 (setq calculated (1+ sexp-column)))
139 ((or (eq (char-after (1- containing-sexp)) ?\,) 154 ((or (eql (char-after (1- containing-sexp)) ?\,)
140 (and (eq (char-after (1- containing-sexp)) ?\@) 155 (and (eql (char-after (1- containing-sexp)) ?\@)
141 (eq (char-after (- containing-sexp 2)) ?\,))) 156 (eql (char-after (- containing-sexp 2)) ?\,)))
142 ;; ",(...)" or ",@(...)" 157 ;; ",(...)" or ",@(...)"
143 (setq calculated normal-indent)) 158 (setq calculated normal-indent))
144 ((eq (char-after (1- containing-sexp)) ?\#) 159 ((eql (char-after (1- containing-sexp)) ?\#)
145 ;; "#(...)" 160 ;; "#(...)"
146 (setq calculated (1+ sexp-column))) 161 (setq calculated (1+ sexp-column)))
147 ((null method)) 162 ((null method))
148 ((integerp method) 163 ((integerp method)
149 ;; convenient top-level hack. 164 ;; convenient top-level hack.
181 calculated))) 196 calculated)))
182 197
183 198
184 (defun lisp-indent-report-bad-format (m) 199 (defun lisp-indent-report-bad-format (m)
185 (error "%s has a badly-formed %s property: %s" 200 (error "%s has a badly-formed %s property: %s"
186 ;; Love them free variable references!! 201 ;; Love those free variable references!!
187 function 'common-lisp-indent-function m)) 202 function 'common-lisp-indent-function m))
188 203
189 ;; Blame the crufty control structure on dynamic scoping 204 ;; Blame the crufty control structure on dynamic scoping
190 ;; -- not on me! 205 ;; -- not on me!
191 (defun lisp-indent-259 (method path state indent-point 206 (defun lisp-indent-259 (method path state indent-point
206 ;; This while loop is for advancing along a method 221 ;; This while loop is for advancing along a method
207 ;; until the relevant (possibly &rest/&body) pattern 222 ;; until the relevant (possibly &rest/&body) pattern
208 ;; is reached. 223 ;; is reached.
209 ;; n is set to (1- n) and method to (cdr method) 224 ;; n is set to (1- n) and method to (cdr method)
210 ;; each iteration. 225 ;; each iteration.
211 ; (message "trying %s for %s %s" method p function) (sit-for 1)
212 (setq tem (car method)) 226 (setq tem (car method))
213 227
214 (or (eq tem 'nil) ;default indentation 228 (or (eq tem 'nil) ;default indentation
215 ; (eq tem '&lambda) ;abbrev for (&whole 4 (&rest 1)) 229 ; (eq tem '&lambda) ;abbrev for (&whole 4 (&rest 1))
216 (and (eq tem '&body) (null (cdr method))) 230 (and (eq tem '&body) (null (cdr method)))
318 (let ((lisp-tag-body-indentation lisp-body-indent)) 332 (let ((lisp-tag-body-indentation lisp-body-indent))
319 (funcall (function lisp-indent-tagbody) 333 (funcall (function lisp-indent-tagbody)
320 path state indent-point sexp-column normal-indent)) 334 path state indent-point sexp-column normal-indent))
321 (funcall (function lisp-indent-259) 335 (funcall (function lisp-indent-259)
322 '((&whole nil &rest 336 '((&whole nil &rest
323 ;; the following causes wierd indentation 337 ;; the following causes weird indentation
324 ;;(&whole 1 1 2 nil) 338 ;;(&whole 1 1 2 nil)
325 ) 339 )
326 (&whole nil &rest 1)) 340 (&whole nil &rest 1))
327 path state indent-point sexp-column normal-indent))) 341 path state indent-point sexp-column normal-indent)))
328 342
342 (if (looking-at "\\(lisp:+\\)?function\\(\\Sw\\|\\S_\\)") 356 (if (looking-at "\\(lisp:+\\)?function\\(\\Sw\\|\\S_\\)")
343 (+ lisp-body-indent -1 (current-column)) 357 (+ lisp-body-indent -1 (current-column))
344 (+ sexp-column lisp-body-indent))) 358 (+ sexp-column lisp-body-indent)))
345 (error (+ sexp-column lisp-body-indent))))) 359 (error (+ sexp-column lisp-body-indent)))))
346 360
361 ;; XEmacs change
347 (defun lisp-indent-defmethod (path state indent-point 362 (defun lisp-indent-defmethod (path state indent-point
348 sexp-column normal-indent) 363 sexp-column normal-indent)
349 ;; Look for a method combination specifier... 364 ;; Look for a method combination specifier...
350 (let* ((combined (if (and (>= (car path) 3) 365 (let* ((combined (if (and (>= (car path) 3)
351 (null (cdr path))) 366 (null (cdr path)))
364 '(4 4 (&whole 4 &rest 1) &body) 379 '(4 4 (&whole 4 &rest 1) &body)
365 '(4 (&whole 4 &rest 1) &body)))) 380 '(4 (&whole 4 &rest 1) &body))))
366 (funcall (function lisp-indent-259) 381 (funcall (function lisp-indent-259)
367 method 382 method
368 path state indent-point sexp-column normal-indent))) 383 path state indent-point sexp-column normal-indent)))
384
369 385
370 (let ((l '((block 1) 386 (let ((l '((block 1)
371 (catch 1) 387 (catch 1)
372 (case (4 &rest (&whole 2 &rest 1))) 388 (case (4 &rest (&whole 2 &rest 1)))
373 (ccase . case) (ecase . case) 389 (ccase . case) (ecase . case)
382 (define-setf-method 398 (define-setf-method
383 (4 (&whole 4 &rest 1) &body)) 399 (4 (&whole 4 &rest 1) &body))
384 (defsetf (4 (&whole 4 &rest 1) 4 &body)) 400 (defsetf (4 (&whole 4 &rest 1) 4 &body))
385 (defun (4 (&whole 4 &rest 1) &body)) 401 (defun (4 (&whole 4 &rest 1) &body))
386 (defmacro . defun) (deftype . defun) 402 (defmacro . defun) (deftype . defun)
403 ;; XEmacs change
387 (defmethod lisp-indent-defmethod) 404 (defmethod lisp-indent-defmethod)
388 (defstruct ((&whole 4 &rest (&whole 2 &rest 1)) 405 (defstruct ((&whole 4 &rest (&whole 2 &rest 1))
389 &rest (&whole 2 &rest 1))) 406 &rest (&whole 2 &rest 1)))
390 (destructuring-bind 407 (destructuring-bind
391 ((&whole 6 &rest 1) 4 &body)) 408 ((&whole 6 &rest 1) 4 &body))
480 ;(put 'restart-case 'common-lisp-indent-function '((1 4) (* 2 ((0 1) (* 1))))) 497 ;(put 'restart-case 'common-lisp-indent-function '((1 4) (* 2 ((0 1) (* 1)))))
481 ;(put 'define-condition 'common-lisp-indent-function '((1 6) (2 6 ((* 1))) (3 4 ((* 1))) (4 &body))) 498 ;(put 'define-condition 'common-lisp-indent-function '((1 6) (2 6 ((* 1))) (3 4 ((* 1))) (4 &body)))
482 ;(put 'with-condition-handler 'common-lisp-indent-function '((1 4 ((* 1))) (2 &body))) 499 ;(put 'with-condition-handler 'common-lisp-indent-function '((1 4 ((* 1))) (2 &body)))
483 ;(put 'condition-case 'common-lisp-indent-function '((1 4) (* 2 ((0 1) (1 3) (2 &body))))) 500 ;(put 'condition-case 'common-lisp-indent-function '((1 4) (* 2 ((0 1) (1 3) (2 &body)))))
484 501
485 502 ;;; cl-indent.el ends here
486 ;;;; Turn it on.
487 ;(setq lisp-indent-function 'common-lisp-indent-function)
488
489 ;; To disable this stuff, (setq lisp-indent-function 'lisp-indent-function)
490