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

fix the auto-square-bracket thing for with-syntax

Browse Source 
closes PR 12096

original commit: 40c68df514e54212113db57cdd7855ec7bd51098
This commit is contained in:
Robby Findler 2011-08-08 19:29:22 -05:00
parent 48e71d341a
commit 19763add70
2 changed files with 41 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/framework/private/scheme.rkt
View File

@ -13,6 +13,7 @@
"../preferences.rkt"
scheme/match)
(import mred^
[prefix preferences: framework:preferences^]
[prefix icon: framework:icon^]
@ -34,7 +35,7 @@
(init-depend mred^ framework:keymap^ framework:color^ framework:mode^
framework:text^ framework:editor^)
(define-local-member-name stick-to-next-sexp?)
(define (scheme-paren:get-paren-pairs)
'(("(" . ")")
@ -879,7 +880,7 @@
(delete snip-pos (+ snip-pos 1)))
(set-position pos pos)))
(define/private (stick-to-next-sexp? start-pos)
(define/public (stick-to-next-sexp? start-pos)
(let ([end-pos (forward-match start-pos (last-position))])
(and end-pos
(member (get-text start-pos end-pos)
@ -1592,7 +1593,9 @@
[backward-match
(let ([before-whitespace-pos (send text skip-whitespace backward-match 'backward #t)])
(loop before-whitespace-pos
(+ n 1)))]
(if (send text stick-to-next-sexp? backward-match)
n
(+ n 1))))]
[else
(let* ([afterwards (send text get-forward-sexp pos)]
[keyword

35
collects/tests/framework/scheme.rkt
View File

@ -54,3 +54,38 @@
(test-indentation 6
"(define x\n (let/ec return\n (when 1\n (when 2\n\t\t 3))\n 2))"
"(define x\n (let/ec return\n (when 1\n (when 2\n 3))\n 2))")
(define (test-magic-square-bracket which before after)
(test
(string->symbol (format "scheme:test-magic-square-bracket-~a" which))
(λ (x) (equal? x after))
(λ ()
(queue-sexp-to-mred
`(let* ([t (new scheme:text%)]
[f (new frame% [label ""] [width 600] [height 600])]
[ec (new editor-canvas% [parent f] [editor t])])
(send f reflow-container)
(send t insert ,before)
(send t rewrite-square-paren)
(send t get-text))))))
(test-magic-square-bracket 'mt "" "(")
(test-magic-square-bracket 'mt2 "(() " "(() (")
(test-magic-square-bracket 'mt3 "([] " "([] [")
(test-magic-square-bracket 'mt4 "(\"" "(\"[")
(test-magic-square-bracket 'mt4 "(#\\" "(#\\[")
(test-magic-square-bracket 'let1 "(let " "(let (")
(test-magic-square-bracket 'let2 "(let (" "(let ([")
(test-magic-square-bracket 'let3 "(let loop " "(let loop (")
(test-magic-square-bracket 'let3 "(let loop (" "(let loop ([")
(test-magic-square-bracket 'cond1 "(cond " "(cond [")
(test-magic-square-bracket 'cond2 "(cond [" "(cond [(")
(test-magic-square-bracket 'with-syntax1 "(syntax-case x " "(syntax-case x (")
(test-magic-square-bracket 'with-syntax2 "(syntax-case x () " "(syntax-case x () [")
(test-magic-square-bracket 'with-syntax3 "(syntax-case 'x " "(syntax-case 'x (")
(test-magic-square-bracket 'with-syntax4 "(syntax-case 'x () " "(syntax-case 'x () [")
(test-magic-square-bracket 'with-syntax3 "(syntax-case #'x " "(syntax-case #'x (")
(test-magic-square-bracket 'with-syntax4 "(syntax-case #'x () " "(syntax-case #'x () [")
(test-magic-square-bracket 'local1 "(local " "(local [")
(test-magic-square-bracket 'local2 "(local [" "(local [(")
(test-magic-square-bracket 'local2 "(local [(define x 1)] " "(local [(define x 1)] (")