Annotation of GNUtools/emacs/lisp/cl-indent.el, revision 1.1

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: 

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.