fix control-[ when 'framework:automatic-parens pref is set

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:)" #\)))

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