![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to cl-indent.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / lisp|
Return to cl-indent.el CVS log | Up to [Apple XNU] / GNUtools / emacs / lisp |
1.1 root 1: ;; Lisp mode, and its idiosyncratic commands.
2: ;; Copyright (C) 1987 Free Software Foundation, Inc.
3: ;; Written by Richard Mlynarik July 1987
4:
5: ;; This file is part of GNU Emacs.
6:
7: ;; GNU Emacs is free software; you can redistribute it and/or modify
8: ;; it under the terms of the GNU General Public License as published by
9: ;; the Free Software Foundation; either version 1, or (at your option)
10: ;; any later version.
11:
12: ;; GNU Emacs is distributed in the hope that it will be useful,
13: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15: ;; GNU General Public License for more details.
16:
17: ;; You should have received a copy of the GNU General Public License
18: ;; along with GNU Emacs; see the file COPYING. If not, write to
19: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
20:
21: ;;>> TODO
22: ;; :foo
23: ;; bar
24: ;; :baz
25: ;; zap
26: ;; &key (like &body)??
27:
28: ;; &rest 1 in lambda-lists doesn't work
29: ;; -- really want (foo bar
30: ;; baz)
31: ;; not (foo bar
32: ;; baz)
33: ;; Need something better than &rest for such cases
34:
35:
36: ;;; Hairy lisp indentation.
37:
38: (defvar lisp-indent-maximum-backtracking 3
39: "*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
41: may not be correctly indented.")
42:
43: (defvar lisp-tag-indentation 1
44: "*Indentation of tags relative to containing list.
45: This variable is used by the function lisp-indent-tagbody.")
46:
47: (defvar lisp-tag-body-indentation 3
48: "*Indentation of non-tagged lines relative to containing list.
49: This variable is used by the function lisp-indent-tagbody to indent normal
50: lines (lines without tags).
51: 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
53: 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
55: by lisp-body-indent.")
56:
57:
58: (defun common-lisp-indent-hook (indent-point state)
59: (let ((normal-indent (current-column)))
60: ;; Walk up list levels until we see something
61: ;; which does special things with subforms.
62: (let ((depth 0)
63: ;; Path describes the position of point in terms of
64: ;; list-structure with respect to contining lists.
65: ;; `foo' has a path of (0 4 1) in `((a b c (d foo) f) g)'
66: (path ())
67: ;; set non-nil when somebody works out the indentation to use
68: calculated
69: (last-point indent-point)
70: ;; the position of the open-paren of the innermost containing list
71: (containing-form-start (elt state 1))
72: ;; the column of the above
73: sexp-column)
74: ;; Move to start of innermost containing list
75: (goto-char containing-form-start)
76: (setq sexp-column (current-column))
77: ;; Look over successively less-deep containing forms
78: (while (and (not calculated)
79: (< depth lisp-indent-maximum-backtracking))
80: (let ((containing-sexp (point)))
81: (forward-char 1)
82: (parse-partial-sexp (point) indent-point 1 t)
83: ;; Move to the car of the relevant containing form
84: (let (tem function method)
85: (if (not (looking-at "\\sw\\|\\s_"))
86: ;; This form doesn't seem to start with a symbol
87: (setq function nil method nil)
88: (setq tem (point))
89: (forward-sexp 1)
90: (setq function (downcase (buffer-substring tem (point))))
91: (goto-char tem)
92: (setq tem (intern-soft function)
93: method (get tem 'common-lisp-indent-hook))
94: (cond ((and (null method)
95: (string-match ":[^:]+" function))
96: ;; The pleblisp package feature
97: (setq function (substring function
98: (1+ (match-beginning 0)))
99: method (get (intern-soft function)
100: 'common-lisp-indent-hook)))
101: ((and (null method))
102: ;; backwards compatibility
103: (setq method (get tem 'lisp-indent-hook)))))
104: (let ((n 0))
105: ;; How far into the containing form is the current form?
106: (if (< (point) indent-point)
107: (while (condition-case ()
108: (progn
109: (forward-sexp 1)
110: (if (>= (point) indent-point)
111: nil
112: (parse-partial-sexp (point)
113: indent-point 1 t)
114: (setq n (1+ n))
115: t))
116: (error nil))))
117: (setq path (cons n path)))
118:
119: ;; backwards compatibility.
120: (cond ((null function))
121: ((null method)
122: (if (null (cdr path))
123: ;; (package prefix was stripped off above)
124: (setq method (cond ((string-match "\\`def"
125: function)
126: '(4 (&whole 4 &rest 1) &body))
127: ((string-match "\\`\\(with\\|do\\)-"
128: function)
129: '(4 &body))))))
130: ;; backwards compatibility. Bletch.
131: ((eq method 'defun)
132: (setq method '(4 (&whole 4 &rest 1) &body))))
133:
134: (cond ((and (memq (char-after (1- containing-sexp)) '(?\' ?\`))
135: (not (eql (char-after (- containing-sexp 2)) ?\#)))
136: ;; No indentation for "'(...)" elements
137: (setq calculated (1+ sexp-column)))
138: ((eql (char-after (1- containing-sexp)) ?\#)
139: ;; "#(...)"
140: (setq calculated (1+ sexp-column)))
141: ((null method))
142: ((integerp method)
143: ;; convenient top-level hack.
144: ;; (also compatible with lisp-indent-hook)
145: ;; The number specifies how many `distinguished'
146: ;; forms there are before the body starts
147: ;; Equivalent to (4 4 ... &body)
148: (setq calculated (cond ((cdr path)
149: normal-indent)
150: ((<= (car path) method)
151: ;; `distinguished' form
152: (list (+ sexp-column 4)
153: containing-form-start))
154: ((= (car path) (1+ method))
155: ;; first body form.
156: (+ sexp-column lisp-body-indent))
157: (t
158: ;; other body form
159: normal-indent))))
160: ((symbolp method)
161: (setq calculated (funcall method
162: path state indent-point
163: sexp-column normal-indent)))
164: (t
165: (setq calculated (lisp-indent-259
166: method path state indent-point
167: sexp-column normal-indent)))))
168: (goto-char containing-sexp)
169: (setq last-point containing-sexp)
170: (if (not calculated)
171: (condition-case ()
172: (progn (backward-up-list 1)
173: (setq depth (1+ depth)))
174: (error (setq depth lisp-indent-maximum-backtracking))))))
175: calculated)))
176:
177:
178: (defun lisp-indent-report-bad-format (m)
179: (error "%s has a badly-formed %s property: %s"
180: ;; Love them free variable references!!
181: function 'common-lisp-indent-hook m))
182:
183: ;; Blame the crufty control structure on dynamic scoping
184: ;; -- not on me!
185: (defun lisp-indent-259 (method path state indent-point
186: sexp-column normal-indent)
187: (catch 'exit
188: (let ((p path)
189: (containing-form-start (elt state 1))
190: n tem tail)
191: ;; Isn't tail-recursion wonderful?
192: (while p
193: ;; This while loop is for destructuring.
194: ;; p is set to (cdr p) each iteration.
195: (if (not (consp method)) (lisp-indent-report-bad-format method))
196: (setq n (1- (car p))
197: p (cdr p)
198: tail nil)
199: (while n
200: ;; This while loop is for advancing along a method
201: ;; until the relevant (possibly &rest/&body) pattern
202: ;; is reached.
203: ;; n is set to (1- n) and method to (cdr method)
204: ;; each iteration.
205: ; (message "trying %s for %s %s" method p function) (sit-for 1)
206: (setq tem (car method))
207:
208: (or (eq tem 'nil) ;default indentation
209: ; (eq tem '&lambda) ;abbrev for (&whole 4 (&rest 1))
210: (and (eq tem '&body) (null (cdr method)))
211: (and (eq tem '&rest)
212: (consp (cdr method)) (null (cdr (cdr method))))
213: (integerp tem) ;explicit indentation specified
214: (and (consp tem) ;destructuring
215: (eq (car tem) '&whole)
216: (or (symbolp (car (cdr tem)))
217: (integerp (car (cdr tem)))))
218: (and (symbolp tem) ;a function to call to do the work.
219: (null (cdr method)))
220: (lisp-indent-report-bad-format method))
221:
222: (cond ((and tail (not (consp tem)))
223: ;; indent tail of &rest in same way as first elt of rest
224: (throw 'exit normal-indent))
225: ((eq tem '&body)
226: ;; &body means (&rest <lisp-body-indent>)
227: (throw 'exit
228: (if (and (= n 0) ;first body form
229: (null p)) ;not in subforms
230: (+ sexp-column
231: lisp-body-indent)
232: normal-indent)))
233: ((eq tem '&rest)
234: ;; this pattern holds for all remaining forms
235: (setq tail (> n 0)
236: n 0
237: method (cdr method)))
238: ((> n 0)
239: ;; try next element of pattern
240: (setq n (1- n)
241: method (cdr method))
242: (if (< n 0)
243: ;; Too few elements in pattern.
244: (throw 'exit normal-indent)))
245: ((eq tem 'nil)
246: (throw 'exit (list normal-indent containing-form-start)))
247: ; ((eq tem '&lambda)
248: ; ;; abbrev for (&whole 4 &rest 1)
249: ; (throw 'exit
250: ; (cond ((null p)
251: ; (list (+ sexp-column 4) containing-form-start))
252: ; ((null (cdr p))
253: ; (+ sexp-column 1))
254: ; (t normal-indent))))
255: ((integerp tem)
256: (throw 'exit
257: (if (null p) ;not in subforms
258: (list (+ sexp-column tem) containing-form-start)
259: normal-indent)))
260: ((symbolp tem) ;a function to call
261: (throw 'exit
262: (funcall tem path state indent-point
263: sexp-column normal-indent)))
264: (t
265: ;; must be a destructing frob
266: (if (not (null p))
267: ;; descend
268: (setq method (cdr (cdr tem))
269: n nil)
270: (setq tem (car (cdr tem)))
271: (throw 'exit
272: (cond (tail
273: normal-indent)
274: ((eq tem 'nil)
275: (list normal-indent
276: containing-form-start))
277: ((integerp tem)
278: (list (+ sexp-column tem)
279: containing-form-start))
280: (t
281: (funcall tem path state indent-point
282: sexp-column normal-indent))))))))))))
283:
284: (defun lisp-indent-tagbody (path state indent-point sexp-column normal-indent)
285: (if (not (null (cdr path)))
286: normal-indent
287: (save-excursion
288: (goto-char indent-point)
289: (beginning-of-line)
290: (skip-chars-forward " \t")
291: (list (cond ((looking-at "\\sw\\|\\s_")
292: ;; a tagbody tag
293: (+ sexp-column lisp-tag-indentation))
294: ((integerp lisp-tag-body-indentation)
295: (+ sexp-column lisp-tag-body-indentation))
296: ((eq lisp-tag-body-indentation 't)
297: (condition-case ()
298: (progn (backward-sexp 1) (current-column))
299: (error (1+ sexp-column))))
300: (t (+ sexp-column lisp-body-indent)))
301: ; (cond ((integerp lisp-tag-body-indentation)
302: ; (+ sexp-column lisp-tag-body-indentation))
303: ; ((eq lisp-tag-body-indentation 't)
304: ; normal-indent)
305: ; (t
306: ; (+ sexp-column lisp-body-indent)))
307: (elt state 1)
308: ))))
309:
310: (defun lisp-indent-do (path state indent-point sexp-column normal-indent)
311: (if (>= (car path) 3)
312: (let ((lisp-tag-body-indentation lisp-body-indent))
313: (funcall (function lisp-indent-tagbody)
314: path state indent-point sexp-column normal-indent))
315: (funcall (function lisp-indent-259)
316: '((&whole nil &rest
317: ;; the following causes wierd indentation
318: ;;(&whole 1 1 2 nil)
319: )
320: (&whole nil &rest 1))
321: path state indent-point sexp-column normal-indent)))
322:
323: (defun lisp-indent-function-lambda-hack (path state indent-point
324: sexp-column normal-indent)
325: ;; indent (function (lambda () <newline> <body-forms>)) kludgily.
326: (if (or (cdr path) ; wtf?
327: (> (car path) 3))
328: ;; line up under previous body form
329: normal-indent
330: ;; line up under function rather than under lambda in order to
331: ;; conserve horizontal space. (Which is what #' is for.)
332: (condition-case ()
333: (save-excursion
334: (backward-up-list 2)
335: (forward-char 1)
336: (if (looking-at "\\(lisp:+\\)?function\\(\\Sw\\|\\S_\\)")
337: (+ lisp-body-indent -1 (current-column))
338: (+ sexp-column lisp-body-indent)))
339: (error (+ sexp-column lisp-body-indent)))))
340:
341:
342: (let ((l '((block 1)
343: (catch 1)
344: (case (4 &rest (&whole 2 &rest 1)))
345: (ccase . case) (ecase . case)
346: (typecase . case) (etypecase . case) (ctypecase . case)
347: (catch 1)
348: (cond (&rest (&whole 2 &rest 1)))
349: (block 1)
350: (defvar (4 2 2))
351: (defconstant . defvar) (defparameter . defvar)
352: (define-modify-macro
353: (4 &body))
354: (define-setf-method
355: (4 (&whole 4 &rest 1) &body))
356: (defsetf (4 (&whole 4 &rest 1) 4 &body))
357: (defun (4 (&whole 4 &rest 1) &body))
358: (defmacro . defun) (deftype . defun)
359: (defstruct ((&whole 4 &rest (&whole 2 &rest 1))
360: &rest (&whole 2 &rest 1)))
361: (destructuring-bind
362: ((&whole 6 &rest 1) 4 &body))
363: (do lisp-indent-do)
364: (do* . do)
365: (dolist ((&whole 4 2 1) &body))
366: (dotimes . dolist)
367: (eval-when 1)
368: (flet ((&whole 4 &rest (&whole 1 (&whole 4 &rest 1) &body))
369: &body))
370: (labels . flet)
371: (macrolet . flet)
372: ;; `else-body' style
373: (if (nil nil &body))
374: ;; single-else style (then and else equally indented)
375: (if (&rest nil))
376: ;(lambda ((&whole 4 &rest 1) &body))
377: (lambda ((&whole 4 &rest 1)
378: &rest lisp-indent-function-lambda-hack))
379: (let ((&whole 4 &rest (&whole 1 1 2)) &body))
380: (let* . let)
381: (locally 1)
382: ;(loop ...)
383: (multiple-value-bind
384: ((&whole 6 &rest 1) 4 &body))
385: (multiple-value-call
386: (4 &body))
387: (multiple-value-list 1)
388: (multiple-value-prog1 1)
389: (multiple-value-setq
390: (4 2))
391: ;; Combines the worst features of BLOCK, LET and TAGBODY
392: (prog ((&whole 4 &rest 1) &rest lisp-indent-tagbody))
393: (prog* . prog)
394: (prog1 1)
395: (prog2 2)
396: (progn 0)
397: (progv (4 4 &body))
398: (return 0)
399: (return-from (nil &body))
400: (tagbody lisp-indent-tagbody)
401: (throw 1)
402: (unless 1)
403: (unwind-protect
404: (5 &body))
405: (when 1))))
406: (while l
407: (put (car (car l)) 'common-lisp-indent-hook
408: (if (symbolp (cdr (car l)))
409: (get (cdr (car l)) 'common-lisp-indent-hook)
410: (car (cdr (car l)))))
411: (setq l (cdr l))))
412:
413:
414: ;(defun foo (x)
415: ; (tagbody
416: ; foo
417: ; (bar)
418: ; baz
419: ; (when (losing)
420: ; (with-big-loser
421: ; (yow)
422: ; ((lambda ()
423: ; foo)
424: ; big)))
425: ; (flet ((foo (bar baz zap)
426: ; (zip))
427: ; (zot ()
428: ; quux))
429: ; (do ()
430: ; ((lose)
431: ; (foo 1))
432: ; (quux)
433: ; foo
434: ; (lose))
435: ; (cond ((x)
436: ; (win 1 2
437: ; (foo)))
438: ; (t
439: ; (lose
440: ; 3))))))
441:
442:
443: ;(put 'while 'common-lisp-indent-hook 1)
444: ;(put 'defwrapper'common-lisp-indent-hook ...)
445: ;(put 'def 'common-lisp-indent-hook ...)
446: ;(put 'defflavor 'common-lisp-indent-hook ...)
447: ;(put 'defsubst 'common-lisp-indent-hook ...)
448:
449: ;;(put 'define-restart-name 'common-lisp-indent-hook '1)
450: ;(put 'with-restart 'common-lisp-indent-hook '((1 4 ((* 1))) (2 &body)))
451: ;(put 'restart-case 'common-lisp-indent-hook '((1 4) (* 2 ((0 1) (* 1)))))
452: ;(put 'define-condition 'common-lisp-indent-hook '((1 6) (2 6 ((* 1))) (3 4 ((* 1))) (4 &body)))
453: ;(put 'with-condition-handler 'common-lisp-indent-hook '((1 4 ((* 1))) (2 &body)))
454: ;(put 'condition-case 'common-lisp-indent-hook '((1 4) (* 2 ((0 1) (1 3) (2 &body)))))
455:
456:
457: ;;;; Turn it on.
458: ;(setq lisp-indent-hook 'common-lisp-indent-hook)
459:
460: ;; To disable this stuff, (setq lisp-indent-hook 'lisp-indent-hook)
461:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.