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

fix c:c;c:e for empty sequences

Browse Source 
closes PR 13905
This commit is contained in:
Robby Findler 2013-07-06 10:33:19 -05:00
parent 50fb71247d
commit c107ad1f77
2 changed files with 33 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -546,6 +546,7 @@
#f)]
[last-para (and last
(position-paragraph last))])
(define sizing-dc (or (get-dc) (make-object bitmap-dc% (make-bitmap 1 1))))
(letrec
([find-offset
(λ (start-pos)
@ -568,7 +569,7 @@
(position-location start-pos start-x #f #t #t)
(position-location end-pos end-x #f #t #t)
(define-values (w _1 _2 _3)
(send (get-dc) get-text-extent "x"
(send sizing-dc get-text-extent "x"
(send (send (get-style-list)
find-named-style "Standard")
get-font)))
@ -1141,17 +1142,17 @@
(define/public (kill-enclosing-parens begin-inner)
(begin-edit-sequence)
(let ([begin-outer (find-up-sexp begin-inner)])
(cond
[begin-outer
(let ([end-outer (get-forward-sexp begin-outer)])
(cond
[(and end-outer (> (- end-outer begin-outer) 2))
(delete (- end-outer 1) end-outer)
(delete begin-outer (+ begin-outer 1))
(tabify-selection begin-outer (- end-outer 2))]
[else (bell)]))]
[else (bell)]))
(define begin-outer (find-up-sexp begin-inner))
(cond
[begin-outer
(define end-outer (get-forward-sexp begin-outer))
(cond
[(and end-outer (>= (- end-outer begin-outer) 2))
(delete (- end-outer 1) end-outer)
(delete begin-outer (+ begin-outer 1))
(tabify-selection begin-outer (- end-outer 2))]
[else (bell)])]
[else (bell)])
(end-edit-sequence))
;; change the parens following the cursor from () to [] or vice versa

34
pkgs/gui-pkgs/gui-test/framework/tests/racket.rkt
View File

@ -94,14 +94,15 @@
(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)
(define (test-message-send/proc line before after pos msg . args)
(define (maybe-quote x)
(cond
[(or (number? x) (boolean? x) (string? x)) x]
[else `',x]))
(test
(string->symbol (format "line ~a: ~s"
line
`(test-insert-close-paren ,pos ,char ,flash? ,fixup? ',smart-skip
,before ,after)))
`(,msg ,@(map maybe-quote args))))
(λ (x) (equal? x after))
(λ ()
(queue-sexp-to-mred
@ -111,19 +112,24 @@
(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 ,msg ,@(map maybe-quote args))
(send t get-text))))))
(define-syntax (test-insert-close-paren stx)
(define-syntax (test-message-send stx)
(syntax-case stx ()
[(_ . args)
[(_ before after pos mth . args)
(with-syntax ([line (syntax-line stx)])
#'(test-insert-close-paren/proc line . args))]))
#'(test-message-send/proc line before after pos 'mth . 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 "" "]")
(test-message-send "" "]" 0 insert-close-paren 0 #\] #t #t 'adjacent)
(test-message-send "" "]" 0 insert-close-paren 0 #\] #t #t #f)
(test-message-send "(" "()" 1 insert-close-paren 1 #\] #t #t #f)
(test-message-send "(" "(]" 1 insert-close-paren 1 #\] #f #f #f)
(test-message-send "" "]" 0 insert-close-paren 0 #\] #t #t 'forward)
(test-message-send "(1)" "1" 1 kill-enclosing-parens 1)
(test-message-send "(1 2 3)" "1 2 3" 3 kill-enclosing-parens 3)
(test-message-send "()" "" 1 kill-enclosing-parens 1)
(test-message-send "(1\n 2\n 3)" "1\n2\n3" 1 kill-enclosing-parens 1) ;; test tabify call
;; 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