Fix "double body indent" feature of special forms so that it works in
authorChris Hanson <org/chris-hanson/cph>
Fri, 28 Apr 1989 03:53:45 +0000 (03:53 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 28 Apr 1989 03:53:45 +0000 (03:53 +0000)
all cases.

v7/src/edwin/linden.scm

index d55211397fcd34c3ad2d51cfc198f1bcc02500b3..7a7a3c044d5093fa938135368d6e5da1ac87889b 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/linden.scm,v 1.116 1989/04/15 00:51:00 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/linden.scm,v 1.117 1989/04/28 03:53:45 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
 (define (lisp-indent-special-form n state indent-point normal-indent)
   (if (negative? n) (error "Special form indent hook negative" n))
   (let ((container (parse-state-containing-sexp state)))
-    (let ((body-indent (+ (ref-variable lisp-body-indent)
-                         (mark-column container)))
+    (let ((body-indent
+          (+ (mark-column container) (ref-variable lisp-body-indent)))
          (normal-indent (mark-column normal-indent)))
-      (let ((second-sexp
-            (forward-to-sexp-start (forward-one-sexp (mark1+ container)
-                                                     indent-point)
-                                   indent-point)))
-       (cond ((mark< second-sexp indent-point)
-              (let loop ((n n) (mark second-sexp))
-                (cond ((not mark)
-                       (cons normal-indent container))
-                      ((zero? n)
-                       (if (forward-one-sexp mark indent-point)
-                           normal-indent
-                           (min body-indent normal-indent)))
-                      (else
-                       (loop (-1+ n) (forward-one-sexp mark indent-point))))))
-             ((zero? n)
-              body-indent)
-             (else
-              (cons (if (< n 3)
-                        (+ body-indent (ref-variable lisp-body-indent))
-                        normal-indent)
-                    container)))))))
+      (let loop ((count n) (mark (mark1+ container)))
+       (let ((mark
+              (let ((mark (forward-one-sexp mark indent-point)))
+                (and mark
+                     (forward-to-sexp-start mark indent-point)))))
+         (cond ((and mark (mark< mark indent-point))
+                (loop (-1+ count) mark))
+               ((positive? count)
+                (cons (+ body-indent (ref-variable lisp-body-indent))
+                      (mark-permanent! container)))
+               ((and (zero? count)
+                     (or (zero? n)
+                         (<= body-indent normal-indent)))
+                body-indent)
+               (else
+                normal-indent)))))))
 \f
 ;;;; Indent Line
 
          (let next-line-start ((index index) (state false))
            (let ((start (line-start index 1)))
              (let ((state (parse-partial-sexp index start false false state)))
-               (if (or (not (or (parse-state-in-string? state)
-                                (parse-state-in-comment? state)))
-                       (mark= start end))
-                   (let ((stack
-                          (adjust-stack (parse-state-depth state) stack)))
-                     (cond ((mark= start end)
-                            (if (not (or (parse-state-in-string? state)
-                                         (parse-state-in-comment? state)))
-                                (indent-expression-line start stack)))
-                           ((indent-comment-line start stack)
-                            (loop start stack))
-                           ((line-blank? start)
-                            (delete-horizontal-space start)
-                            (loop start stack))
-                           (else
-                            (indent-expression-line start stack)
-                            (loop start stack))))
-                   (next-line-start start state)))))))))
+               (let ((stack (adjust-stack (parse-state-depth state) stack)))
+                 (cond ((not (mark= start end))
+                        (let ((start (mark-right-inserting start)))
+                          (if (or (parse-state-in-string? state)
+                                  (parse-state-in-comment? state))
+                              (next-line-start start state)
+                              (begin
+                                (cond ((indent-comment-line start stack)
+                                       unspecific)
+                                      ((line-blank? start)
+                                       (delete-horizontal-space start))
+                                      (else
+                                       (indent-expression-line start stack)))
+                                (loop start stack)))))
+                       ((not (or (parse-state-in-string? state)
+                                 (parse-state-in-comment? state)))
+                        (indent-expression-line start stack)))))))))))
 
 (define (indent-comment-line start stack)
   (let ((mark (horizontal-space-end start)))