From b8816e691f5787dc0a249fa4521efb4dc36ec43f Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Thu, 13 Apr 2006 22:01:56 +0000
Subject: [PATCH] added let loop recognition to [ thingy

svn: r2671

original commit: ae20c75e1882280be0a2cead102e192195a9a142
---
 collects/framework/private/scheme.ss | 23 ++++++++++++++++++++---
 collects/tests/framework/keys.ss     |  4 +++-
 2 files changed, 23 insertions(+), 4 deletions(-)

diff --git a/collects/framework/private/scheme.ss b/collects/framework/private/scheme.ss
index 03fd2eeb..a9663b5e 100644
--- a/collects/framework/private/scheme.ss
+++ b/collects/framework/private/scheme.ss
@@ -1268,8 +1268,6 @@
                   [(not (zero? before-whitespace-pos))
                    ;; this is the first thing in the sequence
                    ;; pop out one layer and look for a keyword.
-                   ;; if we find a let<mumble> keyword, we get a square bracket, 
-                   ;; otherwise a round paren
                    (let ([b-w-p-char (send text get-character (- before-whitespace-pos 1))])
                      (cond
                        [(equal? b-w-p-char #\()
@@ -1292,9 +1290,28 @@
                                            "let*" "let-values" "let-syntax" "let-struct" "let-syntaxes"
                                            "letrec"
                                            "letrec-syntaxes" "letrec-syntaxes+values" "letrec-values")))
+                             ;; we found a let<mumble> keyword, so we get a square bracket
                              (void)]
                             [else
-                             (change-to #\()]))]
+                             ;; go back one more sexp in the same row, looking for `let loop' pattern
+                             (let* ([second-before-whitespace-pos2 (send text skip-whitespace 
+                                                                         second-backwards-match
+                                                                         'backward
+                                                                         #t)]
+                                    [second-backwards-match2 (send text backward-match
+                                                                   second-before-whitespace-pos2
+                                                                   0)])
+                               (cond
+                                 [(and second-backwards-match2
+                                       (text-between-equal? "let" 
+                                                            text
+                                                            second-backwards-match2
+                                                            second-before-whitespace-pos2))
+                                  ;; found the `(let loop (' so we keep the [
+                                  (void)]
+                                 [else
+                                  ;; otherwise, round.
+                                  (change-to #\()]))]))]
                        [else 
                         (change-to #\()]))]
                   [else 
diff --git a/collects/tests/framework/keys.ss b/collects/tests/framework/keys.ss
index af947bb3..bc3d525d 100644
--- a/collects/tests/framework/keys.ss
+++ b/collects/tests/framework/keys.ss
@@ -137,7 +137,9 @@
      (build-open-bracket-spec "#\\a" 2 #\[)
      (build-open-bracket-spec "(let ([let (" 12 #\()
      (build-open-bracket-spec "ab" 1 #\()
-     (build-open-bracket-spec "|ab|" 2 #\[)))
+     (build-open-bracket-spec "|ab|" 2 #\[)
+     (build-open-bracket-spec "(let loop " 10 #\()
+     (build-open-bracket-spec "(let loop (" 11 #\[)))
   
   
   (send-sexp-to-mred `(send (make-object frame:basic% "dummy to trick frame group") show #t))