ab55d43312
edit the buffer" attempt In other words, go back to (a rackety version of) the old implementation of the get-close-paren method
383 lines
18 KiB
Racket
383 lines
18 KiB
Racket
#lang racket/base
|
|
|
|
(require "test-suite-utils.rkt")
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;
|
|
;; testing highlight-range method
|
|
;;
|
|
|
|
|
|
(define (test-text-balanced? number str start end expected)
|
|
(test
|
|
(string->symbol (format "racket:text-balanced?-~a" number))
|
|
(lambda (x)
|
|
(equal? x expected))
|
|
(λ ()
|
|
(queue-sexp-to-mred
|
|
`(let ([t (new racket:text%)])
|
|
(send t insert ,str)
|
|
(racket:text-balanced? t ,start ,end))))))
|
|
|
|
(test-text-balanced? 0 "" 0 #f #f)
|
|
(test-text-balanced? 1 " \n " 0 #f #f)
|
|
(test-text-balanced? 2 "foo)" 0 #f #t)
|
|
(test-text-balanced? 3 "(foo" 0 #f #f)
|
|
(test-text-balanced? 4 "(foo)" 0 #f #t)
|
|
(test-text-balanced? 5 "(foo 'bar))" 0 #f #t)
|
|
(test-text-balanced? 6 "(foo) bar ([buz])" 0 #f #t)
|
|
(test-text-balanced? 7 "(foo]" 0 #f #t)
|
|
(test-text-balanced? 8 "{foo} ((bar) [5.9])" 0 #f #t)
|
|
(test-text-balanced? 9 "#(1 2 . 3)" 0 #f #t)
|
|
|
|
(define (test-indentation which before after)
|
|
(test
|
|
(string->symbol (format "racket:test-indentation-~a" which))
|
|
(λ (x) (equal? x after))
|
|
(λ ()
|
|
(queue-sexp-to-mred
|
|
`(let* ([t (new racket: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 tabify-all)
|
|
(send t get-text))))))
|
|
|
|
(test-indentation 1 "a" "a")
|
|
(test-indentation 2 "(a\n b)" "(a\n b)")
|
|
(test-indentation 3 "(a\nb)" "(a\n b)")
|
|
(test-indentation 3 "(a b\nc)" "(a b\n c)")
|
|
(test-indentation 3 "(a ...\nb)" "(a ...\n b)")
|
|
(test-indentation 4 "(lambda (x)\nb)" "(lambda (x)\n b)")
|
|
(test-indentation 5 "(lambdaa (x)\nb)" "(lambdaa (x)\n b)")
|
|
(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 "racket:test-magic-square-bracket-~a" which))
|
|
(λ (x) (equal? x after))
|
|
(λ ()
|
|
(queue-sexp-to-mred
|
|
`(let* ([t (new racket: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 (racket:get-keymap) call-function "maybe-insert-[]-pair-maybe-fixup-[]" t (new event%))
|
|
(send t get-text))))))
|
|
|
|
(queue-sexp-to-mred `(preferences:set 'framework:automatic-parens #f))
|
|
(queue-sexp-to-mred `(preferences:set 'framework:fixup-open-parens #t))
|
|
(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)] (")
|
|
|
|
|
|
;; 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.
|
|
|
|
;; test-auto-parens-behavior
|
|
;; : any string [or num (list num num)] [or char symbol 1string (list char) (list key-event%)] [or num (list num num)] string
|
|
(define (test-auto-parens-behavior which initial-text initial-pos keys final-text final-pos
|
|
[auto-parens? #f])
|
|
(test
|
|
(string->symbol (format "racket:test-auto-parens-behavior ~a" which))
|
|
(λ (x) (if (list? final-pos)
|
|
(equal? x (car final-pos) (cadr final-pos) final-text)
|
|
(equal? x (list final-pos final-pos final-text))))
|
|
(λ ()
|
|
(queue-sexp-to-mred
|
|
`(let* ([t (new racket:text%)]
|
|
[f (new frame% [label ""] [width 600] [height 600])]
|
|
[ec (new editor-canvas% [parent f] [editor t])])
|
|
(preferences:set 'framework:fixup-parens #t)
|
|
(preferences:set 'framework:automatic-parens ,auto-parens?)
|
|
(send f reflow-container)
|
|
(send t insert ,initial-text)
|
|
,(if (number? initial-pos)
|
|
`(send t set-position ,initial-pos)
|
|
`(send t set-position ,(car initial-pos) ,(cadr initial-pos)))
|
|
,@(map
|
|
(lambda (k)
|
|
(cond [(char? k)
|
|
`(send (racket:get-keymap)
|
|
handle-key-event t (new key-event% [key-code ,k]))]
|
|
[(string? k)
|
|
`(send (racket:get-keymap)
|
|
handle-key-event t (new key-event% [key-code ,(car (string->list k))]))]
|
|
[(symbol? k)
|
|
`(send (racket:get-keymap)
|
|
handle-key-event t (new key-event% [key-code (quote ,k)]))]
|
|
[else `(send (racket:get-keymap) handle-key-event t ,k)]))
|
|
(if (list? keys) keys (list keys)))
|
|
(list (send t get-start-position) (send t get-end-position) (send t get-text)))))))
|
|
|
|
|
|
;; this takes an initial editor state (specified by the text before the cursor,
|
|
;; some selected text (may be blank string), and text after the cursor), and
|
|
;; a key(s), and runs tests to check what happens when that key(s) is/are
|
|
;; typed - in both possible settings of the 'automatic-parens preference
|
|
;;
|
|
;; final-states is a list of 2 pairs of strings. each pair is the final text before
|
|
;; and after the cursor, for auto-parens disabled and enabled respectively
|
|
(define (test-parens-behavior/full which
|
|
init-text-before init-text-selected init-text-after
|
|
keys
|
|
final-states)
|
|
(define initial-text (string-append init-text-before init-text-selected init-text-after))
|
|
(define initial-start-pos (string-length init-text-before))
|
|
(define initial-end-pos (+ initial-start-pos (string-length init-text-selected)))
|
|
(for-each
|
|
(lambda (label auto? final-pair)
|
|
(test-auto-parens-behavior (format "~a-~a" which label)
|
|
initial-text (list initial-start-pos initial-end-pos) keys
|
|
(apply string-append final-pair) (string-length (car final-pair))
|
|
auto?))
|
|
'("no-auto-parens" "with-auto-parens")
|
|
'(#f #t)
|
|
final-states))
|
|
|
|
|
|
(define SPECIAL-CHARS '(#\( #\) #\[ #\] #\" #\| #\{ #\}))
|
|
|
|
(for ([k SPECIAL-CHARS])
|
|
;; test that character literals never result in a pair of characters typed...
|
|
(test-parens-behavior/full (format "literal-~a" k)
|
|
"(list 1 #\\" "" ")"
|
|
k
|
|
`([,(string-append "(list 1 #\\" (string k)) ")"]
|
|
[,(string-append "(list 1 #\\" (string k)) ")"]))
|
|
;; test that auto-parens has no effect in strings
|
|
(test-parens-behavior/full (format "~a-in-string" k)
|
|
"\" abc def " "" " \""
|
|
k
|
|
`([,(string-append "\" abc def " (string k)) " \""]
|
|
[,(string-append "\" abc def " (string k)) " \""]))
|
|
|
|
;; test that auto-parens has no effect in various comment situations
|
|
(define scenarios
|
|
; description before-cursor after-cursor
|
|
'(("in-line-comment" ";; abc def " " ghi ")
|
|
("end-of-line-comment" ";; abc def " "")
|
|
("end-of-line-comment-with-close-paren" ";; abc def " " ) \n )")
|
|
("in-block-comment" "#| abc def " " ghi |#")
|
|
))
|
|
(for ([s scenarios])
|
|
(let* ([before (cadr s)]
|
|
[after (caddr s)]
|
|
[before-final (string-append before (string k))]
|
|
[result (list before-final after)])
|
|
(test-parens-behavior/full (format "~a-~a" k (car s))
|
|
before "" after k `(,result ,result)))))
|
|
|
|
;;; assorted other scenarios...
|
|
(test-parens-behavior/full 'open-parens
|
|
"abcd" "" "efg" ; editor state: before, selected, after
|
|
#\( ; key(s) pressed
|
|
'(["abcd(" "efg"] ; result state sep by cursor, no auto-parens
|
|
["abcd(" ")efg"])) ; result state with auto-parens
|
|
|
|
(test-parens-behavior/full 'close-1
|
|
"abcd" "" "efg"
|
|
#\)
|
|
'(["abcd)" "efg"] ["abcd)" "efg"]))
|
|
(test-parens-behavior/full 'close-2
|
|
"(abcd" "" "efg"
|
|
#\)
|
|
'(["(abcd)" "efg"] ["(abcd)" "efg"]))
|
|
(test-parens-behavior/full 'close-3
|
|
"(abcd" "" ")efg"
|
|
#\)
|
|
'(["(abcd)" ")efg"] ["(abcd)" "efg"]))
|
|
(test-parens-behavior/full 'close-4
|
|
"(abcd efg " "" " ) efg"
|
|
#\)
|
|
'(["(abcd efg )" " ) efg"]
|
|
["(abcd efg )" " efg"]))
|
|
(test-parens-behavior/full 'close-5
|
|
"(define before+afters `([\"\" abc \"efg\" 12345 xyz]) [84])"
|
|
""
|
|
""
|
|
#\)
|
|
'(["(define before+afters `([\"\" abc \"efg\" 12345 xyz]) [84]))" ""]
|
|
["(define before+afters `([\"\" abc \"efg\" 12345 xyz]) [84]))" ""]))
|
|
(test-parens-behavior/full 'close-6
|
|
"(define before+afters `([\"\" abc \"efg\""
|
|
""
|
|
" 12345 xyz]) [84])"
|
|
#\)
|
|
'(["(define before+afters `([\"\" abc \"efg\"]" " 12345 xyz]) [84])"]
|
|
["(define before+afters `([\"\" abc \"efg\"]" " 12345 xyz]) [84])"]))
|
|
|
|
|
|
(test-parens-behavior/full 'close-skip-1
|
|
"(define before+afters `([\"\" abc \"efg\" 12345 xyz]"
|
|
""
|
|
" ) [84])"
|
|
#\)
|
|
'(["(define before+afters `([\"\" abc \"efg\" 12345 xyz])" " ) [84])"]
|
|
["(define before+afters `([\"\" abc \"efg\" 12345 xyz] )" " [84])"]))
|
|
(test-parens-behavior/full 'close-skip-fixup-1
|
|
"(define before+afters `{[abc 123]"
|
|
""
|
|
" ) [84])"
|
|
#\) ; here the next close after ) doesn't match the {, so no skip happens
|
|
'(["(define before+afters `{[abc 123]}" " ) [84])"]
|
|
["(define before+afters `{[abc 123]}" " ) [84])"]))
|
|
(test-parens-behavior/full 'close-skip-fixup-2
|
|
"(define before+afters `{[abc 123]"
|
|
""
|
|
" } [84])"
|
|
#\) ; here the next close does match the {, so skip
|
|
'(["(define before+afters `{[abc 123]}" " } [84])"]
|
|
["(define before+afters `{[abc 123] }" " [84])"]))
|
|
|
|
(test-parens-behavior/full 'surround-open-1
|
|
"abcd" "ef" "g"
|
|
#\(
|
|
'(["abcd(" "g"] ["abcd(" "ef)g"]))
|
|
|
|
(test-parens-behavior/full 'double-quote-1
|
|
"" "" ""
|
|
#\"
|
|
'(["\"" ""] ["\"" "\""]))
|
|
(test-parens-behavior/full 'double-quote-2
|
|
"abc " "" ""
|
|
#\"
|
|
'(["abc \"" ""] ["abc \"" "\""]))
|
|
(test-parens-behavior/full 'double-quote-selection-1
|
|
"(abc " "def 123" " xyz]"
|
|
#\"
|
|
'(["(abc \"" " xyz]"] ["(abc \"" "def 123\" xyz]"]))
|
|
(test-parens-behavior/full 'double-quote-skip-1
|
|
"\"abc def " "" "\" 123"
|
|
#\"
|
|
'(["\"abc def \"" "\" 123"] ["\"abc def \"" " 123"]))
|
|
(test-parens-behavior/full 'double-quote-escaped-1
|
|
"\"abcd \\" "" ""
|
|
#\"
|
|
'(["\"abcd \\\"" ""]
|
|
["\"abcd \\\"" "\""])) ; this one inserts a pair
|
|
; because the string wasn't closed anyway
|
|
; (it's a hard case to distinguish)
|
|
(test-parens-behavior/full 'double-quote-escaped-2
|
|
"\"abcd \\" "" "\""
|
|
#\"
|
|
'(["\"abcd \\\"" "\""]
|
|
["\"abcd \\\"" "\""]))
|
|
|
|
(test-parens-behavior/full 'bar
|
|
"abc " "" "123"
|
|
#\|
|
|
'(["abc |" "123"] ["abc |" "|123"]))
|
|
(test-parens-behavior/full 'bar-literal
|
|
"(list 1 #\\" "" ")"
|
|
#\|
|
|
'(["(list 1 #\\|" ")"] ["(list 1 #\\|" ")"]))
|
|
(test-parens-behavior/full 'bar-skip
|
|
"abc |def" "" "|123"
|
|
#\|
|
|
'(["abc |def|" "|123"] ["abc |def|" "123"]))
|
|
(test-parens-behavior/full 'bar-selection
|
|
"abc |def " "hij" "|123"
|
|
#\|
|
|
'(["abc |def |" "|123"] ["abc |def |" "hij||123"]))
|
|
|
|
|
|
(test-parens-behavior/full 'block-comment-1
|
|
" #" "" ""
|
|
#\|
|
|
'([" #|" ""]
|
|
[" #|" "|#"]))
|
|
(test-parens-behavior/full 'block-comment-2
|
|
"(123 abc#" "" " def 456)"
|
|
#\|
|
|
'(["(123 abc#|" " def 456)"]
|
|
["(123 abc#|" "|# def 456)"]))
|
|
(test-parens-behavior/full 'block-comment-skip-1
|
|
"#| (123 abc" "" "|# def 456)"
|
|
#\|
|
|
'(["#| (123 abc|" "|# def 456)"]
|
|
["#| (123 abc|#" " def 456)"]))
|
|
|
|
(test-parens-behavior/full 'close-adjusts-properly-when-space-follows-paren
|
|
"( x" "" ""
|
|
#\]
|
|
'(["( x)" "" ""]
|
|
["( x)" "" ""]))
|
|
(test-parens-behavior/full 'close-adjusts-properly-when-inside-a-comment
|
|
"[();" "" ""
|
|
#\)
|
|
'(["[();)" "" ""]
|
|
["[();)" "" ""]))
|
|
(test-parens-behavior/full 'close-adjusts-properly-when-inside-a-comment.2
|
|
"[;" "" "\n"
|
|
#\)
|
|
'(["[;)" "" "\n"]
|
|
["[;)" "" "\n"]))
|
|
(test-parens-behavior/full 'close-adjusts-properly-when-inside-an-unclosed-string
|
|
"[()\"" "" ""
|
|
#\)
|
|
'(["[()\")" "" ""]
|
|
["[()\")" "" ""]))
|
|
(test-parens-behavior/full 'close-adjusts-properly-when-inside-a-string
|
|
"[()\"" "" "\""
|
|
#\)
|
|
'(["[()\")" "" "\""]
|
|
["[()\")" "" "\""]))
|
|
|
|
(test-parens-behavior/full 'close-adjusts-properly-when-no-containing-sexp
|
|
")" "" ""
|
|
#\]
|
|
'([")]" "" ""]
|
|
[")]" "" ""]))
|
|
|
|
|
|
#| for these, the key-event with meta-down doesn't seem to work... maybe a Mac OS
|
|
issue; and may cause problems with these tests on another platform? .nah. |#
|
|
(when (equal? 'macosx (system-type))
|
|
(test-parens-behavior/full 'meta-open-1
|
|
"abcd" "" "efg"
|
|
'(escape #\() ; '((new key-event% [key-code #\(] [meta-down #t]))
|
|
'(["abcd(" ")efg"] ["abcd(" ")efg"]))
|
|
|
|
(test-parens-behavior/full 'meta-close-skip-1
|
|
"(define before (list 1 2" "" " 3 4)"
|
|
'(escape #\)) ; '((new key-event% [key-code #\)] [meta-down #t]))
|
|
'(["(define before (list 1 2 3 4)" ""]
|
|
["(define before (list 1 2 3 4)" ""]))
|
|
(test-parens-behavior/full 'meta-close-skip-2
|
|
"#lang racket\n(define before+afters `([\"\" abc \"efg\""
|
|
""
|
|
" 12345 xyz] [84])"
|
|
'(escape #\)) ;'((new key-event% [key-code #\)] [meta-down #t]))
|
|
'(["#lang racket\n(define before+afters `([\"\" abc \"efg\" 12345 xyz]" " [84])"]
|
|
["#lang racket\n(define before+afters `([\"\" abc \"efg\" 12345 xyz]" " [84])"]))
|
|
(test-parens-behavior/full 'meta-close-skip-3
|
|
"(define before" "" " (list 1 2 3 4)"
|
|
'(escape #\)) ; '((new key-event% [key-code #\)] [meta-down #t]))
|
|
'(["(define before (list 1 2 3 4)" ""]
|
|
["(define before (list 1 2 3 4)" ""]))
|
|
)
|