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