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

added let loop recognition to [ thingy

Browse Source 
svn: r2671

original commit: ae20c75e1882280be0a2cead102e192195a9a142
This commit is contained in:
Robby Findler 2006-04-13 22:01:56 +00:00
parent 064180d763
commit b8816e691f
2 changed files with 23 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1268,8 +1268,6 @@
[(not (zero? before-whitespace-pos))
;; this is the first thing in the sequence
;; pop out one layer and look for a keyword.
;; if we find a let<mumble> keyword, we get a square bracket,
;; otherwise a round paren
(let ([b-w-p-char (send text get-character (- before-whitespace-pos 1))])
(cond
[(equal? b-w-p-char #\()
@ -1292,9 +1290,28 @@
"let*" "let-values" "let-syntax" "let-struct" "let-syntaxes"
"letrec"
"letrec-syntaxes" "letrec-syntaxes+values" "letrec-values")))
;; we found a let<mumble> keyword, so we get a square bracket
(void)]
[else
(change-to #\()]))]
;; go back one more sexp in the same row, looking for `let loop' pattern
(let* ([second-before-whitespace-pos2 (send text skip-whitespace
second-backwards-match
'backward
#t)]
[second-backwards-match2 (send text backward-match
second-before-whitespace-pos2
0)])
(cond
[(and second-backwards-match2
(text-between-equal? "let"
text
second-backwards-match2
second-before-whitespace-pos2))
;; found the `(let loop (' so we keep the [
(void)]
[else
;; otherwise, round.
(change-to #\()]))]))]
[else
(change-to #\()]))]
[else

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

@ -137,7 +137,9 @@
(build-open-bracket-spec "#\\a" 2 #\[)
(build-open-bracket-spec "(let ([let (" 12 #\()
(build-open-bracket-spec "ab" 1 #\()
(build-open-bracket-spec "|ab|" 2 #\[)))
(build-open-bracket-spec "|ab|" 2 #\[)
(build-open-bracket-spec "(let loop " 10 #\()
(build-open-bracket-spec "(let loop (" 11 #\[)))
(send-sexp-to-mred `(send (make-object frame:basic% "dummy to trick frame group") show #t))