From 8b32934d68fa32763e23f7538a671c96aa7917c9 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sat, 29 Jun 2013 21:38:21 -0500 Subject: [PATCH] redo square-bracket related bug fixes from master --- collects/browser/private/hyper.rkt | 4 +- collects/drracket/private/frame.rkt | 6 +- collects/drracket/private/rep.rkt | 6 +- collects/framework/private/color.rkt | 2 +- collects/framework/private/keymap.rkt | 123 ++++++++++-------- .../drracket/incremental-keybindings.rkt | 4 +- .../scribblings/drracket/keybindings.scrbl | 2 +- collects/tests/framework/racket.rkt | 34 ++++- doc/release-notes/drracket/HISTORY.txt | 7 + 9 files changed, 118 insertions(+), 70 deletions(-) diff --git a/collects/browser/private/hyper.rkt b/collects/browser/private/hyper.rkt index 5471ba317e..8792977279 100644 --- a/collects/browser/private/hyper.rkt +++ b/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") diff --git a/collects/drracket/private/frame.rkt b/collects/drracket/private/frame.rkt index 23a5d20388..1400adda6a 100644 --- a/collects/drracket/private/frame.rkt +++ b/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] - [(update) update])) + [(install) pkg:install] + [(update) pkg:update])) (apply action (cdr res)))))))]) (super file-menu:between-open-and-revert file-menu)) diff --git a/collects/drracket/private/rep.rkt b/collects/drracket/private/rep.rkt index 9f4d804aad..42e570d34f 100644 --- a/collects/drracket/private/rep.rkt +++ b/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 "m:n" "jump-to-next-error-loc") + (send drs-bindings-keymap map-function "~c:m:p" "jump-to-previous-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) diff --git a/collects/framework/private/color.rkt b/collects/framework/private/color.rkt index bf48797cf7..ec00fcbdec 100644 --- a/collects/framework/private/color.rkt +++ b/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)])] diff --git a/collects/framework/private/keymap.rkt b/collects/framework/private/keymap.rkt index e5601705c1..cf45f6d553 100644 --- a/collects/framework/private/keymap.rkt +++ b/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)))] - [has-key? (λ (k) (ormap (λ (x) (member (list k) x)) splits))]) - (cond - [(eq? (system-type) 'windows) - (cond - [(or (regexp-match #rx"a:c" cs) - (regexp-match #rx"c:m" cs)) - #f] - [(or (has-key? #\a) (has-key? #\d)) - #f] - [else #t])] - [(eq? (system-type) 'macosx) - (cond - [(has-key? #\m) - #f] - [else #t])] - [(eq? (system-type) 'unix) - (cond - [(or (has-key? #\a) (has-key? #\d)) - #f] - [else #t])] - [else - ;; just in case new platforms come along .... - #t]))) + (define splits + (for/list ([x (in-list (split-out #\; (string->list cs)))]) + (all-but-last (split-out #\: x)))) + (define (has-key? k) (ormap (λ (x) (member (list k) x)) splits)) + (cond + [(eq? (system-type) 'windows) + (cond + [(or (regexp-match #rx"a:c" cs) + (regexp-match #rx"c:m" cs)) + #f] + [(or (has-key? #\a) (has-key? #\d)) + #f] + [else #t])] + [(eq? (system-type) 'macosx) + (cond + [(has-key? #\m) + #f] + [else #t])] + [(eq? (system-type) 'unix) + (cond + [(or (has-key? #\a) (has-key? #\d)) + #f] + [else #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) - (list (string-append "m:" key) + (define (make-meta-prefix-list key [mask-control? #f]) + (list (if mask-control? + (string-append "m:" key) + (string-append "~c:m:" key)) (string-append "ESC;" key))) - (define send-map-function-meta - (λ (keymap key func) - (for-each (λ (key) (send keymap map-function key func)) - (make-meta-prefix-list key)))) + (define (send-map-function-meta keymap key func [mask-control? #f]) + (for ([key (in-list (make-meta-prefix-list key mask-control?))]) + (send keymap map-function key func))) + + (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)]) - (when (= pos (send text get-end-position)) - (let ([slash (send text find-string "\\" 'backward pos (max 0 (- pos biggest 1)))]) - (when slash - (define entered (send text get-text slash pos)) - (define completions - (filter (λ (shortcut) (string-prefix? entered (first shortcut))) - tex-shortcut-table)) - (unless (empty? completions) - (define-values (replacement partial?) - (let ([complete-match - (findf (λ (shortcut) (equal? entered (first shortcut))) - completions)]) - (if complete-match - (values (second complete-match) #f) - (if (= 1 (length completions)) - (values (second (first completions)) #f) - (let ([tex-names (map first completions)]) - (values (foldl meet (first tex-names) (rest tex-names)) #t)))))) - (send text begin-edit-sequence) - (send text delete (if partial? slash (- slash 1)) pos) - (send text insert replacement) - (send text end-edit-sequence))))))))] + (define pos (send text get-start-position)) + (when (= pos (send text get-end-position)) + (define slash (send text find-string "\\" 'backward pos (max 0 (- pos biggest 1)))) + (when slash + (define entered (send text get-text slash pos)) + (define completions + (filter (λ (shortcut) (string-prefix? entered (first shortcut))) + tex-shortcut-table)) + (unless (empty? completions) + (define-values (replacement partial?) + (let ([complete-match + (findf (λ (shortcut) (equal? entered (first shortcut))) + completions)]) + (if complete-match + (values (second complete-match) #f) + (if (= 1 (length completions)) + (values (second (first completions)) #f) + (let ([tex-names (map first completions)]) + (values (foldl meet (first tex-names) (rest tex-names)) + #t)))))) + (send text begin-edit-sequence) + (send text delete (if partial? slash (- slash 1)) pos) + (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) diff --git a/collects/scribblings/drracket/incremental-keybindings.rkt b/collects/scribblings/drracket/incremental-keybindings.rkt index db0636d064..529f76110a 100644 --- a/collects/scribblings/drracket/incremental-keybindings.rkt +++ b/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;m:r" (lambda (ed evt) (send-selection ed #t))) +(keybinding "c:c;~c:m:e" (lambda (ed evt) (send-toplevel-form 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) diff --git a/collects/scribblings/drracket/keybindings.scrbl b/collects/scribblings/drracket/keybindings.scrbl index e7a969da39..5a1ce2706c 100644 --- a/collects/scribblings/drracket/keybindings.scrbl +++ b/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)))) diff --git a/collects/tests/framework/racket.rkt b/collects/tests/framework/racket.rkt index 75c1132660..c2fd371f9d 100644 --- a/collects/tests/framework/racket.rkt +++ b/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. diff --git a/doc/release-notes/drracket/HISTORY.txt b/doc/release-notes/drracket/HISTORY.txt index 82ea841920..fe53a882a4 100644 --- a/doc/release-notes/drracket/HISTORY.txt +++ b/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 ------------------------------