From 1072ac68aa5e753a3e18cd674e1df26199759251 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 28 Apr 2006 08:57:05 +0000
Subject: [PATCH] added option to disable magic open parens separately from
 magic close ones

svn: r2833
---
 collects/framework/private/main.ss            |  1 +
 collects/framework/private/preferences.ss     |  6 ++++-
 collects/framework/private/scheme.ss          | 22 ++++++++++---------
 .../english-string-constants.ss               |  3 ++-
 collects/tests/framework/keys.ss              |  4 +++-
 5 files changed, 23 insertions(+), 13 deletions(-)

diff --git a/collects/framework/private/main.ss b/collects/framework/private/main.ss
index 9761d5dad5..2665781172 100644
--- a/collects/framework/private/main.ss
+++ b/collects/framework/private/main.ss
@@ -148,6 +148,7 @@
       
       (preferences:set-default 'framework:highlight-parens #t boolean?)
       (preferences:set-default 'framework:fixup-parens #t boolean?)
+      (preferences:set-default 'framework:fixup-open-parens #t boolean?)
       (preferences:set-default 'framework:paren-match #t boolean?)
       (let ([hash-table (make-hash-table)])
 	(for-each (λ (x) 
diff --git a/collects/framework/private/preferences.ss b/collects/framework/private/preferences.ss
index 47fe251fed..754b2da552 100644
--- a/collects/framework/private/preferences.ss
+++ b/collects/framework/private/preferences.ss
@@ -656,7 +656,11 @@ for the last one, need a global "no more initialization can happen" flag.
                                    values values)
                        (make-check scheme-panel
                                    'framework:fixup-parens
-                                   (string-constant fixup-parens)
+                                   (string-constant fixup-close-parens)
+                                   values values)
+                       (make-check scheme-panel
+                                   'framework:fixup-open-parens
+                                   (string-constant fixup-open-parens)
                                    values values)
                        (make-check scheme-panel
                                    'framework:paren-match
diff --git a/collects/framework/private/scheme.ss b/collects/framework/private/scheme.ss
index e62b45e660..9dc6c7cd20 100644
--- a/collects/framework/private/scheme.ss
+++ b/collects/framework/private/scheme.ss
@@ -975,7 +975,7 @@
           (inherit is-frozen? is-stopped?)
           (define/public (rewrite-square-paren)
             (cond
-              [(or (not (preferences:get 'framework:fixup-parens))
+              [(or (not (preferences:get 'framework:fixup-open-parens))
                    (is-frozen?)
                    (is-stopped?))
                (insert #\[
@@ -1248,10 +1248,10 @@
                        ;; we found a new expression, two steps back, so we don't use the sibling
                        ;; check here -- we just go with square brackets.
                        [(and backward-match2
-                             (text-between-equal? "new"
-                                                  text
-                                                  backward-match2
-                                                  before-whitespace-pos2))
+                             (ormap 
+                              (λ (x)
+                                (text-between-equal? x text backward-match2 before-whitespace-pos2))
+                              '("new" "case")))
                         (void)]
                        [(member b-m-char '(#\( #\[ #\{))
                         ;; found a "sibling" parenthesized sequence. use the parens it uses.
@@ -1305,11 +1305,13 @@
                                                                    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 [
+                                       (ormap (λ (x)
+                                                (text-between-equal? x 
+                                                                     text
+                                                                     second-backwards-match2
+                                                                     second-before-whitespace-pos2))
+                                              '("let")))
+                                  ;; found the `(let loop (' or `case' so we keep the [
                                   (void)]
                                  [else
                                   ;; otherwise, round.
diff --git a/collects/string-constants/english-string-constants.ss b/collects/string-constants/english-string-constants.ss
index 7977aa4b21..487fedb13d 100644
--- a/collects/string-constants/english-string-constants.ss
+++ b/collects/string-constants/english-string-constants.ss
@@ -382,7 +382,8 @@ please adhere to these guidelines:
  (editor-prefs-panel-label "Editing")
  (general-prefs-panel-label "General")
  (highlight-parens "Highlight between matching parens")
- (fixup-parens "Correct parens")
+ (fixup-open-parens "Automatically adjust opening parens")
+  (fixup-close-parens "Automatically adjust closing parens")
  (flash-paren-match "Flash paren match")
  (auto-save-files "Auto-save files")
  (backup-files "Backup files")
diff --git a/collects/tests/framework/keys.ss b/collects/tests/framework/keys.ss
index bc3d525d7c..b6bc2dffe3 100644
--- a/collects/tests/framework/keys.ss
+++ b/collects/tests/framework/keys.ss
@@ -139,7 +139,9 @@
      (build-open-bracket-spec "ab" 1 #\()
      (build-open-bracket-spec "|ab|" 2 #\[)
      (build-open-bracket-spec "(let loop " 10 #\()
-     (build-open-bracket-spec "(let loop (" 11 #\[)))
+     (build-open-bracket-spec "(let loop (" 11 #\[)
+     (build-open-bracket-spec "(case x " 8 #\[)
+     (build-open-bracket-spec "(case x [" 9 #\()))
   
   
   (send-sexp-to-mred `(send (make-object frame:basic% "dummy to trick frame group") show #t))