redo square-bracket related bug fixes from master

collects/browser/private/hyper.rkt

@@ -617,14 +617,14 @@ A test case:
 (send hyper-keymap map-function "d:left" "rewind")
 (send hyper-keymap map-function "a:left" "rewind")
 (send hyper-keymap map-function "c:left" "rewind")
-(send hyper-keymap map-function "m:left" "rewind")
+(send hyper-keymap map-function "~c:m:left" "rewind")
 (send hyper-keymap map-function "d:]" "forward")
 (send hyper-keymap map-function "a:]" "forward")
 (send hyper-keymap map-function "c:]" "forward")
 (send hyper-keymap map-function "d:right" "forward")
 (send hyper-keymap map-function "a:right" "forward")
 (send hyper-keymap map-function "c:right" "forward")
-(send hyper-keymap map-function "m:right" "forward")
+(send hyper-keymap map-function "~c:m:right" "forward")
 (send hyper-keymap map-function "wheelup" "do-wheel")
 (send hyper-keymap map-function "pageup" "previous-page")
 (send hyper-keymap map-function "wheeldown" "do-wheel")

collects/drracket/private/frame.rkt

@@ -278,7 +278,7 @@
          help/bug-report
          setup/unpack
          mrlib/terminal
-         pkg
+         (prefix-in pkg: pkg)
          (submod "." install-pkg))
 (provide frame@)
 (define-unit frame@  
@@ -455,8 +455,8 @@
                      #:title (string-constant install-pkg-dialog-title)
                      (λ (cust parent) 
                        (define action (case (car res)
-                                        [(install) install]
+                                        [(install) pkg:install]
-                                        [(update) update]))
+                                        [(update) pkg:update]))
                        (apply action (cdr res)))))))])
         (super file-menu:between-open-and-revert file-menu))
       

collects/drracket/private/rep.rkt

@@ -205,8 +205,8 @@ TODO
     (add-drs-function "send-selection-to-repl-and-go" (λ (frame) (send frame send-selection-to-repl #t)))
     (add-drs-function "move-to-interactions" (λ (frame) (send frame move-to-interactions))))
   
-  (send drs-bindings-keymap map-function "m:p" "jump-to-previous-error-loc")
+  (send drs-bindings-keymap map-function "~c:m:p" "jump-to-previous-error-loc")
-  (send drs-bindings-keymap map-function "m:n" "jump-to-next-error-loc")
+  (send drs-bindings-keymap map-function "~c:m:n" "jump-to-next-error-loc")
   (send drs-bindings-keymap map-function "esc;p" "jump-to-previous-error-loc")
   (send drs-bindings-keymap map-function "esc;n" "jump-to-next-error-loc")
   (send drs-bindings-keymap map-function "c:x;`" "jump-to-next-error-loc")
@@ -228,7 +228,7 @@ TODO
           (format "a:~a" i) 
           (format "show-tab-~a" i))
     (send drs-bindings-keymap map-function 
-          (format "m:~a" i) 
+          (format "~~c:m:~a" i) 
           (format "show-tab-~a" i)))
   
   (define (get-drs-bindings-keymap) drs-bindings-keymap)

collects/framework/private/color.rkt

@@ -968,7 +968,7 @@ added get-regions
                  (cond
                    [m (loop m)]
                    [else (values #f #f #f)])])]
-             [(<= b (last-position))
+             [(< b (last-position))
               (loop b)]
              [else
               (values #f #f #f)])]

collects/framework/private/keymap.rkt

@@ -165,30 +165,32 @@
         table)
       
       (define/private (on-this-platform? cs)
-        (let* ([splits (map (λ (x) (all-but-last (split-out #\: x))) (split-out #\; (string->list cs)))]
+        (define splits
-               [has-key? (λ (k) (ormap (λ (x) (member (list k) x)) splits))])
+          (for/list ([x (in-list (split-out #\; (string->list cs)))])
-          (cond
+            (all-but-last (split-out #\: x))))
-            [(eq? (system-type) 'windows)
+        (define (has-key? k) (ormap (λ (x) (member (list k) x)) splits))
-             (cond
+        (cond
-               [(or (regexp-match #rx"a:c" cs)
+          [(eq? (system-type) 'windows)
-                    (regexp-match #rx"c:m" cs))
+           (cond
-                #f]
+             [(or (regexp-match #rx"a:c" cs)
-               [(or (has-key? #\a) (has-key? #\d))
+                  (regexp-match #rx"c:m" cs))
-                #f]
+              #f]
-               [else #t])]
+             [(or (has-key? #\a) (has-key? #\d))
-            [(eq? (system-type) 'macosx)
+              #f]
-             (cond
+             [else #t])]
-               [(has-key? #\m)
+          [(eq? (system-type) 'macosx)
-                #f]
+           (cond
-               [else #t])]
+             [(has-key? #\m)
-            [(eq? (system-type) 'unix)
+              #f]
-             (cond
+             [else #t])]
-               [(or (has-key? #\a) (has-key? #\d))
+          [(eq? (system-type) 'unix)
-                #f]
+           (cond
-               [else #t])]
+             [(or (has-key? #\a) (has-key? #\d))
-            [else 
+              #f]
-             ;; just in case new platforms come along .... 
+             [else #t])]
-             #t])))
+          [else 
+           ;; just in case new platforms come along .... 
+           #t]))
       
       (define/private (all-but-last l)
         (cond
@@ -320,14 +322,17 @@
   ;;;;;;;                                                     ;;;;;;;;
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   
-  (define (make-meta-prefix-list key)
+  (define (make-meta-prefix-list key [mask-control? #f])
-    (list (string-append "m:" key)
+    (list (if mask-control?
+              (string-append "m:" key)
+              (string-append "~c:m:" key))
           (string-append "ESC;" key)))
   
-  (define send-map-function-meta
+  (define (send-map-function-meta keymap key func [mask-control? #f])
-    (λ (keymap key func)
+    (for ([key (in-list (make-meta-prefix-list key mask-control?))])
-      (for-each (λ (key) (send keymap map-function key func))
+      (send keymap map-function key func)))
-                (make-meta-prefix-list key))))
+  
+  (define has-control-regexp #rx"(?:^|:)c:")
   
   (define add-to-right-button-menu (make-parameter void))
   (define add-to-right-button-menu/before (make-parameter void))
@@ -959,29 +964,30 @@
               (define (meet s t)
                 (substring s 0 (string-prefix-length s t 0)))
               (λ (text event)
-                (let ([pos (send text get-start-position)])
+                (define pos (send text get-start-position))
-                  (when (= pos (send text get-end-position))
+                (when (= pos (send text get-end-position))
-                    (let ([slash (send text find-string "\\" 'backward pos (max 0 (- pos biggest 1)))])
+                  (define slash (send text find-string "\\" 'backward pos (max 0 (- pos biggest 1))))
-                      (when slash
+                  (when slash
-                        (define entered (send text get-text slash pos))
+                    (define entered (send text get-text slash pos))
-                        (define completions
+                    (define completions
-                          (filter (λ (shortcut) (string-prefix? entered (first shortcut)))
+                      (filter (λ (shortcut) (string-prefix? entered (first shortcut)))
-                                  tex-shortcut-table))
+                              tex-shortcut-table))
-                        (unless (empty? completions)
+                    (unless (empty? completions)
-                          (define-values (replacement partial?)
+                      (define-values (replacement partial?)
-                            (let ([complete-match 
+                        (let ([complete-match 
-                                   (findf (λ (shortcut) (equal? entered (first shortcut)))
+                               (findf (λ (shortcut) (equal? entered (first shortcut)))
-                                          completions)])
+                                      completions)])
-                              (if complete-match
+                          (if complete-match
-                                  (values (second complete-match) #f)
+                              (values (second complete-match) #f)
-                                  (if (= 1 (length completions))
+                              (if (= 1 (length completions))
-                                      (values (second (first completions)) #f)
+                                  (values (second (first completions)) #f)
-                                      (let ([tex-names (map first completions)])
+                                  (let ([tex-names (map first completions)])
-                                        (values (foldl meet (first tex-names) (rest tex-names)) #t))))))
+                                    (values (foldl meet (first tex-names) (rest tex-names))
-                          (send text begin-edit-sequence)
+                                            #t))))))
-                          (send text delete (if partial? slash (- slash 1)) pos)
+                      (send text begin-edit-sequence)
-                          (send text insert replacement)
+                      (send text delete (if partial? slash (- slash 1)) pos)
-                          (send text end-edit-sequence))))))))]
+                      (send text insert replacement)
+                      (send text end-edit-sequence))))))]
            
            [greek-letters "αβγδεζηθι κλμνξοπρςστυφχψω"]
            [Greek-letters "ΑΒΓΔΕΖΗΘΙ ΚΛΜΝΞΟΠΡ ΣΤΥΦΧΨΩ"]
@@ -1039,7 +1045,8 @@
         (let* ([map (λ (key func) 
                       (send kmap map-function key func))]
                [map-meta (λ (key func)
-                           (send-map-function-meta kmap key func))]
+                           (send-map-function-meta kmap key func
+                                                   (regexp-match has-control-regexp key)))]
                [add (λ (name func)
                       (send kmap add-function name func))]
                [add-m (λ (name func)
@@ -1139,7 +1146,7 @@
                                           (if shift? "s:" "")
                                           roman-char)
                                   (format "insert ~a" greek-char))
-                             (map (format "m:x;c:g;~a~a" 
+                             (map (format "~~c:m:x;c:g;~a~a" 
                                           (if shift? "s:" "")
                                           roman-char)
                                   (format "insert ~a" greek-char))
@@ -1345,7 +1352,8 @@
         (let* ([map (λ (key func) 
                       (send kmap map-function key func))]
                [map-meta (λ (key func)
-                           (send-map-function-meta kmap key func))]
+                           (send-map-function-meta kmap key func
+                                                   (regexp-match has-control-regexp key)))]
                [add (λ (name func)
                       (send kmap add-function name func))]
                [add-m (λ (name func)
@@ -1411,7 +1419,8 @@
         (let* ([map (λ (key func) 
                       (send kmap map-function key func))]
                [map-meta (λ (key func)
-                           (send-map-function-meta kmap key func))]
+                           (send-map-function-meta kmap key func 
+                                                   (regexp-match has-control-regexp key)))]
                [add (λ (name func)
                       (send kmap add-function name func))]
                [add-m (λ (name func)

collects/scribblings/drracket/incremental-keybindings.rkt

@@ -4,8 +4,8 @@
 
 (keybinding "c:c;c:e" (lambda (ed evt) (send-toplevel-form ed #f)))
 (keybinding "c:c;c:r" (lambda (ed evt) (send-selection ed #f)))
-(keybinding "c:c;m:e" (lambda (ed evt) (send-toplevel-form ed #t)))
+(keybinding "c:c;~c:m:e" (lambda (ed evt) (send-toplevel-form ed #t)))
-(keybinding "c:c;m:r" (lambda (ed evt) (send-selection ed #t)))
+(keybinding "c:c;~c:m:r" (lambda (ed evt) (send-selection ed #t)))
 
 (define/contract (send-toplevel-form defs shift-focus?)
   (-> any/c boolean? any)

collects/scribblings/drracket/keybindings.scrbl

@@ -304,7 +304,7 @@ s-exp framework/keybinding-lang
   (apply string-append
          (map (λ (p)
                 (case p
-                  [(ctl) "c:"] [(cmd) "d:"] [(alt meta) "m:"]
+                  [(ctl) "c:"] [(cmd) "d:"] [(alt meta) "~c:m:"]
                   [(shift) "s:"] [(option) "a:"]))
               (get-default-shortcut-prefix))))
 

collects/tests/framework/racket.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 
-(require "test-suite-utils.rkt")
+(require "test-suite-utils.rkt"
+         (for-syntax racket/base))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -93,6 +94,37 @@
 (test-magic-square-bracket 'local2 "(local [(define x 1)] " "(local [(define x 1)] (")
 
 
+(define (test-insert-close-paren/proc line
+                                      pos char flash? fixup? smart-skip
+                                      before after)
+  (test
+   (string->symbol (format "line ~a: ~s"
+                           line
+                           `(test-insert-close-paren ,pos ,char ,flash? ,fixup? ',smart-skip
+                                                     ,before ,after)))
+   (λ (x) (equal? x after))
+   (λ ()
+     (queue-sexp-to-mred
+      `(let ()
+         (define f (new frame% [label ""]))
+         (define t (new racket:text%))
+         (define ec (new editor-canvas% [parent f] [editor t]))
+         (send t insert ,before)
+         (send t set-position ,pos)
+         (send t insert-close-paren ,pos ,char ,flash? ,fixup? ',smart-skip)
+         (send t get-text))))))
+(define-syntax (test-insert-close-paren stx)
+  (syntax-case stx ()
+    [(_ . args)
+     (with-syntax ([line (syntax-line stx)])
+       #'(test-insert-close-paren/proc line . args))]))
+
+(test-insert-close-paren 0 #\] #t #t 'adjacent "" "]")
+(test-insert-close-paren 0 #\] #t #t #f "" "]")
+(test-insert-close-paren 1 #\] #t #t #f "(" "()")
+(test-insert-close-paren 1 #\] #f #f #f "(" "(]")
+(test-insert-close-paren 0 #\] #t #t 'forward "" "]")
+
 ;; tests what happens when a given key/s is/are typed in an editor with initial
 ;;       text and cursor position, under different settings of the auto-parentheses and
 ;;       smart-skip-parentheses preferences   .nah.

doc/release-notes/drracket/HISTORY.txt

@@ -1,3 +1,10 @@
+------------------------------
+       Version 5.3.6
+------------------------------
+
+  . fixes various bugs surrounding square bracket (especially relevant
+    for windows users with non-US keyboards)
+
 ------------------------------
        Version 5.3.3
 ------------------------------