From 4afd6c86d00380090ff2b38b80f3726ac4bed27c Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Tue, 4 Nov 2014 20:38:29 -0600
Subject: [PATCH] fix control-[ when 'framework:automatic-parens pref is set

---
 .../gui-lib/framework/private/racket.rkt      | 13 ++-
 .../gui-test/framework/tests/racket.rkt       | 82 +++++++++++++++++++
 2 files changed, 92 insertions(+), 3 deletions(-)

diff --git a/pkgs/gui-pkgs/gui-lib/framework/private/racket.rkt b/pkgs/gui-pkgs/gui-lib/framework/private/racket.rkt
index 2ea853d50d..85a8498f1c 100644
--- a/pkgs/gui-pkgs/gui-lib/framework/private/racket.rkt
+++ b/pkgs/gui-pkgs/gui-lib/framework/private/racket.rkt
@@ -1485,12 +1485,19 @@
              (send text set-position start end)))))
 
   (let ([add/map-non-clever
-         (λ (name keystroke char)
+         (λ (name keystroke char [closer #f])
            (add-edit-function 
             name
-            (λ (e) (send e insert char (send e get-start-position) (send e get-end-position))))
+            (λ (e)
+              (send e begin-edit-sequence)
+              (define start (send e get-start-position))
+              (define stop (send e get-end-position))
+              (send e insert char start stop)
+              (when (and closer (preferences:get 'framework:automatic-parens))
+                (send e insert closer (+ start 1) (+ start 1)))
+              (send e end-edit-sequence)))
            (send keymap map-function keystroke name))])
-    (add/map-non-clever "non-clever-open-square-bracket" "c:[" #\[)
+    (add/map-non-clever "non-clever-open-square-bracket" "c:[" #\[ #\])
     (add/map-non-clever "non-clever-close-square-bracket" "c:]" #\])
     (add/map-non-clever "non-clever-close-curley-bracket" "c:}" #\})
     (add/map-non-clever "non-clever-close-round-paren" "c:)" #\)))
diff --git a/pkgs/gui-pkgs/gui-test/framework/tests/racket.rkt b/pkgs/gui-pkgs/gui-test/framework/tests/racket.rkt
index 358f4c7378..9239f8b0cf 100644
--- a/pkgs/gui-pkgs/gui-test/framework/tests/racket.rkt
+++ b/pkgs/gui-pkgs/gui-test/framework/tests/racket.rkt
@@ -3,6 +3,88 @@
 (require "test-suite-utils.rkt"
          (for-syntax racket/base))
 
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; testing inserting parens and the automatic-parens prefs
+;;
+
+(define (test-type-string/proc line to-type expected-result [control-down #f])
+  (test
+   (string->symbol (format "test-type-string line ~a" line))
+   (λ (x) (equal? x expected-result))
+   (λ ()
+     (queue-sexp-to-mred
+      `(let ()
+         (define f (new frame:basic% [label ""]))
+         (define t (new racket:text%))
+         (define ec (new canvas:basic%
+                         [parent (send f get-area-container)]
+                         [editor t]))
+         (send t on-char (new key-event% [key-code ,to-type] [control-down ,control-down]))
+         (send t get-text))))))
+
+(define-syntax (test-type-string stx)
+  (syntax-case stx ()
+    [(_ . rst)
+     (with-syntax ([line (syntax-line stx)])
+       #'(test-type-string/proc line . rst))]))
+
+(begin
+  (queue-sexp-to-mred `(preferences:set 'framework:fixup-parens #f))
+  (queue-sexp-to-mred `(preferences:set 'framework:fixup-open-parens #f))
+  
+  (queue-sexp-to-mred `(preferences:set 'framework:automatic-parens #f))
+  (test-type-string #\( "(")
+  (test-type-string #\[ "[")
+  (test-type-string #\" "\"")
+  (queue-sexp-to-mred `(preferences:set 'framework:automatic-parens #t))
+  (test-type-string #\( "()")
+  (test-type-string #\[ "[]")
+  (test-type-string #\" "\"\""))
+
+
+(begin
+  (queue-sexp-to-mred `(preferences:set 'framework:fixup-parens #f))
+  (queue-sexp-to-mred `(preferences:set 'framework:fixup-open-parens #t))
+  
+  (queue-sexp-to-mred `(preferences:set 'framework:automatic-parens #f))
+  (test-type-string #\( "(")
+  (test-type-string #\[ "(")
+  (test-type-string #\[ "[" #t)
+  (test-type-string #\" "\"")
+  (queue-sexp-to-mred `(preferences:set 'framework:automatic-parens #t))
+  (test-type-string #\( "()")
+  (test-type-string #\[ "()")
+  (test-type-string #\[ "[]" #t)
+  (test-type-string #\" "\"\""))
+
+(begin
+  (queue-sexp-to-mred `(preferences:set 'framework:fixup-parens #t))
+  (queue-sexp-to-mred `(preferences:set 'framework:fixup-open-parens #f))
+  
+  (queue-sexp-to-mred `(preferences:set 'framework:automatic-parens #f))
+  (test-type-string #\( "(")
+  (test-type-string #\[ "[")
+  (test-type-string #\" "\"")
+  (queue-sexp-to-mred `(preferences:set 'framework:automatic-parens #t))
+  (test-type-string #\( "()")
+  (test-type-string #\[ "[]")
+  (test-type-string #\" "\"\""))
+
+(begin
+  (queue-sexp-to-mred `(preferences:set 'framework:fixup-parens #t))
+  (queue-sexp-to-mred `(preferences:set 'framework:fixup-open-parens #t))
+  
+  (queue-sexp-to-mred `(preferences:set 'framework:automatic-parens #f))
+  (test-type-string #\( "(")
+  (test-type-string #\[ "(")
+  (test-type-string #\" "\"")
+  (queue-sexp-to-mred `(preferences:set 'framework:automatic-parens #t))
+  (test-type-string #\( "()")
+  (test-type-string #\[ "()")
+  (test-type-string #\" "\"\""))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;; testing highlight-range method