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

overwrite mode repairs

Browse Source 
also make keys.rkt test suite be less likely to corrupt the
preferences file (when run in standalone mode)
This commit is contained in:
Robby Findler 2013-08-14 17:45:18 -05:00
parent 0f4ff899e6
commit 593ab2d51f
2 changed files with 107 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
pkgs/gui-pkgs/gui-lib/framework/private/racket.rkt
View File

@ -1573,8 +1573,7 @@
(send text insert close-brace) (send text insert close-brace)
(when (and (char? open-brace) (char=? #\| open-brace) hash-before?) (when (and (char? open-brace) (char=? #\| open-brace) hash-before?)
(send text insert #\#)) (send text insert #\#))
(send text set-position (+ selection-start open-len (if space-between? 1 0))) (send text set-position (+ selection-start open-len (if space-between? 1 0))))
)
(send text end-edit-sequence)) (send text end-edit-sequence))
@ -1586,7 +1585,11 @@
(for/list ([x (racket-paren:get-paren-pairs)]) (string-ref (car x) 0))) (for/list ([x (racket-paren:get-paren-pairs)]) (string-ref (car x) 0)))
(cond (cond
[(not (preferences:get 'framework:automatic-parens)) [(not (preferences:get 'framework:automatic-parens))
(send text insert open-brace)] (define startpos (send text get-start-position))
(if (and (send text get-overwrite-mode)
(= startpos (send text get-end-position)))
(send text insert open-brace startpos (add1 startpos))
(send text insert open-brace))]
[else ; automatic-parens is enabled [else ; automatic-parens is enabled
(define c (immediately-following-cursor text)) (define c (immediately-following-cursor text))
@ -1775,7 +1778,9 @@
[end-pos (send text get-end-position)] [end-pos (send text get-end-position)]
[letrec-like-forms (preferences:get 'framework:square-bracket:letrec)]) [letrec-like-forms (preferences:get 'framework:square-bracket:letrec)])
(send text begin-edit-sequence #f #f) (send text begin-edit-sequence #f #f)
(send text insert "[" start-pos 'same #f) (if (and (send text get-overwrite-mode) (= start-pos end-pos))
(send text insert "[" start-pos (add1 start-pos) #f)
(send text insert "[" start-pos 'same #f))
(when (eq? (send text classify-position pos) 'parenthesis) (when (eq? (send text classify-position pos) 'parenthesis)
(let* ([before-whitespace-pos (send text skip-whitespace pos 'backward #t)] (let* ([before-whitespace-pos (send text skip-whitespace pos 'backward #t)]
[keyword/distance (find-keyword-and-distance before-whitespace-pos text)]) [keyword/distance (find-keyword-and-distance before-whitespace-pos text)])

155
pkgs/gui-pkgs/gui-test/framework/tests/keys.rkt
View File

@ -112,38 +112,43 @@
;; a buff-spec is (make-buff-spec string nat nat) ;; a buff-spec is (make-buff-spec string nat nat)
;; a buff-spec represents a buffer state; the content of the buffer, ;; a buff-spec represents a buffer state; the content of the buffer,
;; and the start and end of the highlighted region. ;; and the start and end of the highlighted region.
(define-struct buff-spec (string start end) #:prefab) ;; the overwrite? field specifies if the overwrite mode is enabled during the test
;; (its value is ignored for the result checking)
(define-struct buff-spec (string start end overwrite?) #:prefab)
(define (build-buff-spec string start end #:overwrite? [overwrite? #f])
(make-buff-spec string start end overwrite?))
;; the keybindings test cases applied to frame:text% editors ;; the keybindings test cases applied to frame:text% editors
(define global-specs (define global-specs
(list (list
(make-key-spec (make-buff-spec "abc" 1 1) (make-key-spec (build-buff-spec "abc" 1 1)
(make-buff-spec "abc" 2 2) (build-buff-spec "abc" 2 2)
(list '((#\f control)) '((right))) (list '((#\f control)) '((right)))
(list '((#\f control)) '((right))) (list '((#\f control)) '((right)))
(list '((#\f control)) '((right)))) (list '((#\f control)) '((right))))
;; TeX-compress tests ;; TeX-compress tests
(make-key-spec/allplatforms (make-key-spec/allplatforms
(make-buff-spec "\\ome" 4 4) (build-buff-spec "\\ome" 4 4)
(make-buff-spec "ω" 1 1) (build-buff-spec "ω" 1 1)
'(((#\\ control)))) '(((#\\ control))))
(make-key-spec/allplatforms (make-key-spec/allplatforms
(make-buff-spec "\\sub" 4 4) (build-buff-spec "\\sub" 4 4)
(make-buff-spec "\\subset" 7 7) (build-buff-spec "\\subset" 7 7)
'(((#\\ control)))) '(((#\\ control))))
(make-key-spec/allplatforms (make-key-spec/allplatforms
(make-buff-spec "\\subset" 7 7) (build-buff-spec "\\subset" 7 7)
(make-buff-spec "⊂" 1 1) (build-buff-spec "⊂" 1 1)
'(((#\\ control)))) '(((#\\ control))))
(make-key-spec/allplatforms (make-key-spec/allplatforms
(make-buff-spec "\\sub" 4 4) (build-buff-spec "\\sub" 4 4)
(make-buff-spec "⊆" 1 1) (build-buff-spec "⊆" 1 1)
'(((#\\ control) (#\e) (#\\ control)))))) '(((#\\ control) (#\e) (#\\ control))))))
(define (build-open-bracket-spec str pos char) (define (build-open-bracket-spec str pos char)
(make-key-spec (make-buff-spec str pos pos) (make-key-spec (build-buff-spec str pos pos)
(make-buff-spec (build-buff-spec
(string-append (substring str 0 pos) (string-append (substring str 0 pos)
(string char) (string char)
(substring str pos (string-length str))) (substring str pos (string-length str)))
@ -154,31 +159,31 @@
(list (list (list #\[))))) (list (list (list #\[)))))
(define (ascii-art-box-spec before after) (define (ascii-art-box-spec before after)
(make-key-spec/allplatforms (make-buff-spec before 0 0) (make-key-spec/allplatforms (build-buff-spec before 0 0)
(make-buff-spec after 0 0) (build-buff-spec after 0 0)
(list '((#\x control) (#\r) (#\a))))) (list '((#\x control) (#\r) (#\a)))))
;; the keybindings test cases applied to racket:text% editors ;; the keybindings test cases applied to racket:text% editors
(define scheme-specs (define scheme-specs
(list (list
(make-key-spec (make-buff-spec "(abc (def))" 4 4) (make-key-spec (build-buff-spec "(abc (def))" 4 4)
(make-buff-spec "(abc (def))" 10 10) (build-buff-spec "(abc (def))" 10 10)
(list '((right alt))) (list '((right alt)))
(list '((right alt))) (list '((right alt)))
(list '((right alt)))) (list '((right alt))))
(make-key-spec (make-buff-spec "'(abc (def))" 1 1) (make-key-spec (build-buff-spec "'(abc (def))" 1 1)
(make-buff-spec "'(abc (def))" 12 12) (build-buff-spec "'(abc (def))" 12 12)
(list '((right alt))) (list '((right alt)))
(list '((right alt))) (list '((right alt)))
(list '((right alt)))) (list '((right alt))))
#| #|
(make-key-spec (make-buff-spec "'(abc (def))" 0 0) (make-key-spec (build-buff-spec "'(abc (def))" 0 0)
(make-buff-spec "'(abc (def))" 12 12) (build-buff-spec "'(abc (def))" 12 12)
(list '(right alt)) (list '(right alt))
(list '(right alt)) (list '(right alt))
(list '(right alt))) (list '(right alt)))
(make-key-spec (make-buff-spec "'(abc (def))" 12 12) (make-key-spec (build-buff-spec "'(abc (def))" 12 12)
(make-buff-spec "'(abc (def))" 0 0) (build-buff-spec "'(abc (def))" 0 0)
(list '(left alt)) (list '(left alt))
(list '(left alt)) (list '(left alt))
(list '(left alt))) (list '(left alt)))
@ -217,69 +222,95 @@
(build-open-bracket-spec "(local []" 9 #\() (build-open-bracket-spec "(local []" 9 #\()
;; test to show that multi-keystrokes works: ;; test to show that multi-keystrokes works:
(make-key-spec/allplatforms (make-key-spec/allplatforms
(make-buff-spec "" 0 0) (build-buff-spec "" 0 0)
(make-buff-spec "zx" 2 2) (build-buff-spec "zx" 2 2)
(list '((#\z) (#\x)))) (list '((#\z) (#\x))))
;; remove-enclosing-parens : ;; remove-enclosing-parens :
(make-key-spec/allplatforms (make-key-spec/allplatforms
(make-buff-spec "(abc def)" 1 1) (build-buff-spec "(abc def)" 1 1)
(make-buff-spec "abc" 0 0) (build-buff-spec "abc" 0 0)
(list '((#\c control) (#\o control)))) (list '((#\c control) (#\o control))))
;; (is this the desired behavior?): ;; (is this the desired behavior?):
(make-key-spec/allplatforms (make-key-spec/allplatforms
(make-buff-spec "(abc def)" 2 3) (build-buff-spec "(abc def)" 2 3)
(make-buff-spec "bc" 0 0) (build-buff-spec "bc" 0 0)
(list '((#\c control) (#\o control)))) (list '((#\c control) (#\o control))))
;; insert-()-pair : ;; insert-()-pair :
(make-key-spec (make-key-spec
(make-buff-spec "abc" 0 0) (build-buff-spec "abc" 0 0)
(make-buff-spec "()abc" 1 1) (build-buff-spec "()abc" 1 1)
(list '((escape) (#\())) (list '((escape) (#\()))
(list '((#\( meta))) (list '((#\( meta)))
(list '((escape) (#\()))) (list '((escape) (#\())))
(make-key-spec (make-key-spec
(make-buff-spec "abc" 0 2) (build-buff-spec "abc" 0 2)
(make-buff-spec "(ab)c" 1 1) (build-buff-spec "(ab)c" 1 1)
(list '((escape) (#\())) (list '((escape) (#\()))
(list '((#\( meta))) (list '((#\( meta)))
(list '((escape) (#\()))) (list '((escape) (#\())))
;; toggle-square-round-parens : ;; toggle-square-round-parens :
; () -> [] ; () -> []
(make-key-spec/allplatforms (make-key-spec/allplatforms
(make-buff-spec "(a)" 0 0) (build-buff-spec "(a)" 0 0)
(make-buff-spec "[a]" 0 0) (build-buff-spec "[a]" 0 0)
(list '((#\c control) (#\[ control)))) (list '((#\c control) (#\[ control))))
; [] -> () ; [] -> ()
(make-key-spec/allplatforms (make-key-spec/allplatforms
(make-buff-spec "[a]" 0 0) (build-buff-spec "[a]" 0 0)
(make-buff-spec "(a)" 0 0) (build-buff-spec "(a)" 0 0)
(list '((#\c control) (#\[ control)))) (list '((#\c control) (#\[ control))))
; enclosed sexps ; enclosed sexps
(make-key-spec/allplatforms (make-key-spec/allplatforms
(make-buff-spec "[a (def )b]" 0 0) (build-buff-spec "[a (def )b]" 0 0)
(make-buff-spec "(a (def )b)" 0 0) (build-buff-spec "(a (def )b)" 0 0)
(list '((#\c control) (#\[ control)))) (list '((#\c control) (#\[ control))))
; extra preceding whitespace ; extra preceding whitespace
(make-key-spec/allplatforms (make-key-spec/allplatforms
(make-buff-spec " \n [a (def )b]" 0 0) (build-buff-spec " \n [a (def )b]" 0 0)
(make-buff-spec " \n (a (def )b)" 0 0) (build-buff-spec " \n (a (def )b)" 0 0)
(list '((#\c control) (#\[ control)))) (list '((#\c control) (#\[ control))))
; cursor not at beginning of buffer ; cursor not at beginning of buffer
(make-key-spec/allplatforms (make-key-spec/allplatforms
(make-buff-spec " \n [a (def )b]" 1 1) (build-buff-spec " \n [a (def )b]" 1 1)
(make-buff-spec " \n (a (def )b)" 1 1) (build-buff-spec " \n (a (def )b)" 1 1)
(list '((#\c control) (#\[ control)))) (list '((#\c control) (#\[ control))))
; intervening non-paren sexp ; intervening non-paren sexp
(make-key-spec/allplatforms (make-key-spec/allplatforms
(make-buff-spec " \nf [a (def )b]" 1 1) (build-buff-spec " \nf [a (def )b]" 1 1)
(make-buff-spec " \nf [a (def )b]" 1 1) (build-buff-spec " \nf [a (def )b]" 1 1)
(list '((#\c control) (#\[ control)))) (list '((#\c control) (#\[ control))))
;; at end of buffer (hence sexp-forward returns #f): ;; at end of buffer (hence sexp-forward returns #f):
(make-key-spec/allplatforms (make-key-spec/allplatforms
(make-buff-spec "[a]" 3 3) (build-buff-spec "[a]" 3 3)
(make-buff-spec "[a]" 3 3) (build-buff-spec "[a]" 3 3)
(list '((#\c control) (#\[ control)))) (list '((#\c control) (#\[ control))))
(make-key-spec/allplatforms
(build-buff-spec "a" 0 0 #:overwrite? #t)
(build-buff-spec "b" 1 1)
(list '((#\b))))
(make-key-spec/allplatforms
(build-buff-spec "a" 0 0 #:overwrite? #t)
(build-buff-spec "|" 1 1)
(list '((#\|))))
(make-key-spec/allplatforms
(build-buff-spec "a" 0 0 #:overwrite? #t)
(build-buff-spec "(" 1 1)
(list '((#\())))
(make-key-spec/allplatforms
(build-buff-spec "a" 0 0 #:overwrite? #t)
(build-buff-spec ")" 1 1)
(list '((#\)))))
;; needs to be in auto-adjut open paren mode
(make-key-spec/allplatforms
(build-buff-spec "a" 0 0 #:overwrite? #t)
(build-buff-spec "(" 1 1)
(list '((#\[))))
(ascii-art-box-spec "+" "═") (ascii-art-box-spec "+" "═")
(ascii-art-box-spec "x" "x") (ascii-art-box-spec "x" "x")
(ascii-art-box-spec "+-+" "═══") (ascii-art-box-spec "+-+" "═══")
@ -310,20 +341,20 @@
"╚═╩═╝\n")))) "╚═╩═╝\n"))))
(define automatic-scheme-specs (define automatic-scheme-specs
(list (make-key-spec/allplatforms (make-buff-spec "" 0 0) (list (make-key-spec/allplatforms (build-buff-spec "" 0 0)
(make-buff-spec "()" 1 1) (build-buff-spec "()" 1 1)
'(((#\()))) '(((#\())))
(make-key-spec/allplatforms (make-buff-spec "" 0 0) (make-key-spec/allplatforms (build-buff-spec "" 0 0)
(make-buff-spec "[]" 1 1) (build-buff-spec "[]" 1 1)
'(((#\[)))) '(((#\[))))
(make-key-spec/allplatforms (make-buff-spec "" 0 0) (make-key-spec/allplatforms (build-buff-spec "" 0 0)
(make-buff-spec "{}" 1 1) (build-buff-spec "{}" 1 1)
'(((#\{)))) '(((#\{))))
(make-key-spec/allplatforms (make-buff-spec "" 0 0) (make-key-spec/allplatforms (build-buff-spec "" 0 0)
(make-buff-spec "\"\"" 1 1) (build-buff-spec "\"\"" 1 1)
'(((#\")))) '(((#\"))))
(make-key-spec/allplatforms (make-buff-spec "" 0 0) (make-key-spec/allplatforms (build-buff-spec "" 0 0)
(make-buff-spec "||" 1 1) (build-buff-spec "||" 1 1)
'(((#\|)))))) '(((#\|))))))
(queue-sexp-to-mred `(send (make-object frame:basic% "dummy to trick frame group") show #t)) (queue-sexp-to-mred `(send (make-object frame:basic% "dummy to trick frame group") show #t))
@ -352,6 +383,7 @@
(channel-get c)))] (channel-get c)))]
[text (qc (λ () (send (get-top-level-focus-window) get-editor)))]) [text (qc (λ () (send (get-top-level-focus-window) get-editor)))])
(qc (λ () (qc (λ ()
(send text set-overwrite-mode ,(buff-spec-overwrite? before))
(send text erase) (send text erase)
(send text insert ,(buff-spec-string before)) (send text insert ,(buff-spec-string before))
(send text set-position ,(buff-spec-start before) ,(buff-spec-end before)))) (send text set-position ,(buff-spec-start before) ,(buff-spec-end before))))
@ -372,6 +404,11 @@
(test-key spec i)) (test-key spec i))
(queue-sexp-to-mred `(send (get-top-level-focus-window) close))) (queue-sexp-to-mred `(send (get-top-level-focus-window) close)))
(define old-paren-adjusting-prefs
(queue-sexp-to-mred `(list (preferences:get 'framework:fixup-open-parens)
(preferences:get 'framework:automatic-parens))))
(queue-sexp-to-mred `(preferences:set 'framework:fixup-open-parens #t)) (queue-sexp-to-mred `(preferences:set 'framework:fixup-open-parens #t))
(queue-sexp-to-mred `(preferences:set 'framework:automatic-parens #f)) (queue-sexp-to-mred `(preferences:set 'framework:automatic-parens #f))
(test-specs "global keybindings test" 'frame:text% global-specs) (test-specs "global keybindings test" 'frame:text% global-specs)
@ -387,3 +424,7 @@
(define/override (get-editor%) racket:text%) (define/override (get-editor%) racket:text%)
(super-new)) (super-new))
automatic-scheme-specs) automatic-scheme-specs)
(queue-sexp-to-mred
`(begin (preferences:set 'framework:fixup-open-parens ,(list-ref old-paren-adjusting-prefs 0))
(preferences:set 'framework:automatic-parens ,(list-ref old-paren-adjusting-prefs 1))))