diff --git a/collects/framework/private/scheme.ss b/collects/framework/private/scheme.ss index ee5034f3c1..a2bd4b9496 100644 --- a/collects/framework/private/scheme.ss +++ b/collects/framework/private/scheme.ss @@ -975,13 +975,15 @@ (inherit is-frozen? is-stopped?) (define/public (rewrite-square-paren) (insert (cond - [(or (is-frozen?) (is-stopped?)) + [(or (not (preferences:get 'framework:fixup-parens)) + (is-frozen?) + (is-stopped?)) #\[] [else (choose-paren this (get-start-position))]) (get-start-position) (get-end-position))) - (super-instantiate ()))) + (super-new))) (define -text-mode<%> (interface () @@ -1214,22 +1216,36 @@ ;; returns the character to replace a #\[ with, based ;; on the context where it is typed in. (define (choose-paren text pos) - (if (memq (send text classify-position pos) '(string error comment symbol)) + (if (memq (send text classify-position pos) '(string error comment symbol constant)) #\[ (let* ([before-whitespace-pos (send text skip-whitespace pos 'backward #t)] [backward-match (send text backward-match before-whitespace-pos 0)]) (let ([b-m-char (and (number? backward-match) (send text get-character backward-match))]) (cond - [(member b-m-char '(#\( #\[ #\{)) - ;; found a "sibling" parenthesized sequence. use the parens it uses. - b-m-char] [backward-match - ;; there is a sexp before this, but it isn't parenthesized. - ;; if it is the `cond' keyword, we get a square bracket. otherwise not. - (if (and (beginning-of-sequence? text backward-match) - (text-between-equal? "cond" text backward-match before-whitespace-pos)) - #\[ - #\()] + ;; there is an expression before this, at this layer + (let* ([before-whitespace-pos2 (send text skip-whitespace backward-match 'backward #t)] + [backward-match2 (send text backward-match before-whitespace-pos2 0)]) + + (cond + ;; we found a new expression, two steps back, so we don't use the sibling + ;; check here -- we just go with square brackets. + [(and backward-match2 + (text-between-equal? "new" + text + backward-match2 + before-whitespace-pos2)) + #\[] + [(member b-m-char '(#\( #\[ #\{)) + ;; found a "sibling" parenthesized sequence. use the parens it uses. + b-m-char] + [else + ;; there is a sexp before this, but it isn't parenthesized. + ;; if it is the `cond' keyword, we get a square bracket. otherwise not. + (if (and (beginning-of-sequence? text backward-match) + (text-between-equal? "cond" text backward-match before-whitespace-pos)) + #\[ + #\()]))] [(not (zero? before-whitespace-pos)) ;; this is the first thing in the sequence ;; pop out one layer and look for a keyword. diff --git a/collects/tests/framework/key-specs.ss b/collects/tests/framework/key-specs.ss deleted file mode 100644 index c0146c10ca..0000000000 --- a/collects/tests/framework/key-specs.ss +++ /dev/null @@ -1,53 +0,0 @@ -(define-struct key-spec (before after macos unix windows)) -(define-struct buff-spec (string start end)) - -(define global-specs - (list - (make-key-spec (make-buff-spec "abc" 1 1) - (make-buff-spec "abc" 2 2) - (list '(#\f control) '(right)) - (list '(#\f control) '(right)) - (list '(#\f control) '(right))))) - -(define (build-open-bracket-spec str pos char) - (make-key-spec (make-buff-spec str pos pos) - (make-buff-spec - (string-append (substring str 0 pos) - (string char) - (substring str pos (string-length str))) - (+ pos 1) - (+ pos 1)) - (list (list char)) - (list (list char)) - (list (list char)))) - -(define scheme-specs - (list - (make-key-spec (make-buff-spec "(abc (def))" 4 4) - (make-buff-spec "(abc (def))" 10 10) - (list '(right alt)) - (list '(right alt)) - (list '(right alt))) - (make-key-spec (make-buff-spec "'(abc (def))" 1 1) - (make-buff-spec "'(abc (def))" 12 12) - (list '(right alt)) - (list '(right alt)) - (list '(right alt))) - (build-open-bracket-spec "(f cond " 8 #\() - (build-open-bracket-spec "(f let (" 8 #\() - (build-open-bracket-spec "(let (" 6 #\[) - (build-open-bracket-spec "(let (" 5 #\() - (build-open-bracket-spec "(kond " 5 #\() - (build-open-bracket-spec "(cond " 5 #\[) - (build-open-bracket-spec "(let ([]" 8 #\[) - (build-open-bracket-spec "(let ({}" 8 #\{) - (build-open-bracket-spec "()" 2 #\() - (build-open-bracket-spec "(let (;;" 8 #\[) - (build-open-bracket-spec ";" 1 #\[) - (build-open-bracket-spec "\"" 1 #\[) - (build-open-bracket-spec "\"\"" 1 #\[) - (build-open-bracket-spec "||" 1 #\[) - (build-open-bracket-spec "ab" 1 #\[) - (build-open-bracket-spec "" 0 #\() - (build-open-bracket-spec "(let (" 6 #\[))) - diff --git a/collects/tests/framework/keys.ss b/collects/tests/framework/keys.ss index 4caa31d337..fca16a7aa3 100644 --- a/collects/tests/framework/keys.ss +++ b/collects/tests/framework/keys.ss @@ -80,7 +80,62 @@ (test-canonicalize 11 "esc;s:a" "esc;s:a") (test-canonicalize 12 "s:a;esc" "s:a;esc") - (include "key-specs.ss") + (define-struct key-spec (before after macos unix windows)) + (define-struct buff-spec (string start end)) + + (define global-specs + (list + (make-key-spec (make-buff-spec "abc" 1 1) + (make-buff-spec "abc" 2 2) + (list '(#\f control) '(right)) + (list '(#\f control) '(right)) + (list '(#\f control) '(right))))) + + (define (build-open-bracket-spec str pos char) + (make-key-spec (make-buff-spec str pos pos) + (make-buff-spec + (string-append (substring str 0 pos) + (string char) + (substring str pos (string-length str))) + (+ pos 1) + (+ pos 1)) + (list (list char)) + (list (list char)) + (list (list char)))) + + (define scheme-specs + (list + (make-key-spec (make-buff-spec "(abc (def))" 4 4) + (make-buff-spec "(abc (def))" 10 10) + (list '(right alt)) + (list '(right alt)) + (list '(right alt))) + (make-key-spec (make-buff-spec "'(abc (def))" 1 1) + (make-buff-spec "'(abc (def))" 12 12) + (list '(right alt)) + (list '(right alt)) + (list '(right alt))) + (build-open-bracket-spec "(f cond " 8 #\() + (build-open-bracket-spec "(f let (" 8 #\() + (build-open-bracket-spec "(let (" 6 #\[) + (build-open-bracket-spec "(let (" 5 #\() + (build-open-bracket-spec "(kond " 5 #\() + (build-open-bracket-spec "(cond " 5 #\[) + (build-open-bracket-spec "(let ([]" 8 #\[) + (build-open-bracket-spec "(let ({}" 8 #\{) + (build-open-bracket-spec "()" 2 #\() + (build-open-bracket-spec "(let (;;" 8 #\[) + (build-open-bracket-spec ";" 1 #\[) + (build-open-bracket-spec "\"" 1 #\[) + (build-open-bracket-spec "\"\"" 1 #\[) + (build-open-bracket-spec "||" 1 #\[) + (build-open-bracket-spec "ab" 1 #\[) + (build-open-bracket-spec "" 0 #\() + (build-open-bracket-spec "(let (" 6 #\[) + (build-open-bracket-spec "(new x% " 8 #\[) + (build-open-bracket-spec "#\\" 1 #\[) + (build-open-bracket-spec "#\\a" 1 #\[))) + (send-sexp-to-mred `(send (make-object frame:basic% "dummy to trick frame group") show #t)) (wait-for-frame "dummy to trick frame group")