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

added new, fixed a bug in character constants for the new [ handling

Browse Source 
svn: r2663
This commit is contained in:
Robby Findler 2006-04-12 03:15:10 +00:00
parent 6638f46c75
commit 676df8bc8c
3 changed files with 84 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
collects/framework/private/scheme.ss
View File

@ -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.

53
collects/tests/framework/key-specs.ss
View File

@ -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 #\[)))

57
collects/tests/framework/keys.ss
View File

@ -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")