suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

redo square-bracket related bug fixes from master

Browse Source
This commit is contained in:
Robby Findler 2013-06-29 21:38:21 -05:00 committed by Ryan Culpepper
parent 760affdbe9
commit 8b32934d68
9 changed files with 118 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/browser/private/hyper.rkt
View File

@ -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")

6
collects/drracket/private/frame.rkt
View File

@ -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))

6
collects/drracket/private/rep.rkt
View File

@ -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)

2
collects/framework/private/color.rkt
View File

@ -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)])]

123
collects/framework/private/keymap.rkt
View File

@ -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)

4
collects/scribblings/drracket/incremental-keybindings.rkt
View File

@ -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)

2
collects/scribblings/drracket/keybindings.scrbl
View File

@ -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))))

34
collects/tests/framework/racket.rkt
View File

@ -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.

7
doc/release-notes/drracket/HISTORY.txt
View File

@ -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
------------------------------