Return to cl-indent.el CVS log

Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp

Annotation of 43BSDReno/contrib/emacs-18.55/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 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.