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

improve magic opening square bracket for for/fold

Browse Source
This commit is contained in:
Robby Findler 2014-09-29 08:40:51 -05:00
parent 34d7c22740
commit 144fdb2a18
3 changed files with 77 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkgs/gui-pkgs/gui-lib/framework/private/main.rkt
View File

@ -169,7 +169,6 @@
(define deletions (list-ref marshed 1)) (define deletions (list-ref marshed 1))
(append additions (remove* deletions defaults))])))) (append additions (remove* deletions defaults))]))))
(set-square-bracket-nonum-pref 'framework:square-bracket:local (set-square-bracket-nonum-pref 'framework:square-bracket:local
'("local")) '("local"))
@ -189,9 +188,10 @@
untyped-fors))) untyped-fors)))
all-fors)) all-fors))
(define for/folds '("for/fold" "for/fold:" "for*/fold" "for*/fold:"))
(set-square-bracket-nonum-pref 'framework:square-bracket:letrec (set-square-bracket-nonum-pref 'framework:square-bracket:letrec
(append (map symbol->string all-fors) (append (map symbol->string all-fors)
'("for/fold" "for/fold:" "for*/fold" "for*/fold:") for/folds
'("let" '("let"
"let*" "let-values" "let*-values" "let*" "let-values" "let*-values"
"let-syntax" "let-struct" "let-syntaxes" "let-syntax" "let-struct" "let-syntaxes"
@ -201,6 +201,8 @@
"parameterize" "parameterize*" "parameterize" "parameterize*"
"with-syntax" "with-handlers"))) "with-syntax" "with-handlers")))
(set-square-bracket-nonum-pref 'framework:square-bracket:for/fold for/folds)
(preferences:set-default 'framework:white-on-black? #f boolean?) (preferences:set-default 'framework:white-on-black? #f boolean?)
(preferences:set-default 'framework:case-sensitive-search? (preferences:set-default 'framework:case-sensitive-search?

47
pkgs/gui-pkgs/gui-lib/framework/private/racket.rkt
View File

@ -1772,7 +1772,8 @@
(set! real-char c))] (set! real-char c))]
[start-pos (send text get-start-position)] [start-pos (send text get-start-position)]
[end-pos (send text get-end-position)] [end-pos (send text get-end-position)]
[letrec-like-forms (preferences:get 'framework:square-bracket:letrec)]) [letrec-like-forms (preferences:get 'framework:square-bracket:letrec)]
[for/fold-like-forms (preferences:get 'framework:square-bracket:for/fold)])
(send text begin-edit-sequence #f #f) (send text begin-edit-sequence #f #f)
(if (and (send text get-overwrite-mode) (= start-pos end-pos)) (if (and (send text get-overwrite-mode) (= start-pos end-pos))
(send text insert "[" start-pos (add1 start-pos) #f) (send text insert "[" start-pos (add1 start-pos) #f)
@ -1810,16 +1811,16 @@
[(not (zero? before-whitespace-pos)) [(not (zero? before-whitespace-pos))
;; this is the first thing in the sequence ;; this is the first thing in the sequence
;; pop out one layer and look for a keyword. ;; pop out one layer and look for a keyword.
(let ([b-w-p-char (send text get-character (- before-whitespace-pos 1))]) (define b-w-p-char (send text get-character (- before-whitespace-pos 1)))
(cond (cond
[(equal? b-w-p-char #\() [(equal? b-w-p-char #\()
(let* ([second-before-whitespace-pos (send text skip-whitespace (define second-before-whitespace-pos (send text skip-whitespace
(- before-whitespace-pos 1) (- before-whitespace-pos 1)
'backward 'backward
#t)] #t))
[second-backwards-match (send text backward-match (define second-backwards-match (send text backward-match
second-before-whitespace-pos second-before-whitespace-pos
0)]) 0))
(cond (cond
[(not second-backwards-match) [(not second-backwards-match)
(change-to 3 #\()] (change-to 3 #\()]
@ -1833,14 +1834,23 @@
(void)] (void)]
[else [else
;; go back one more sexp in the same row, looking for `let loop' pattern ;; go back one more sexp in the same row, looking for `let loop' pattern
(let* ([second-before-whitespace-pos2 (send text skip-whitespace (define second-before-whitespace-pos2 (send text skip-whitespace
second-backwards-match second-backwards-match
'backward 'backward
#t)] #t))
[second-backwards-match2 (send text backward-match (define second-backwards-match2 (send text backward-match
second-before-whitespace-pos2 second-before-whitespace-pos2
0)]) 0))
(cond (cond
[(and second-backwards-match2
(ormap (λ (x)
(text-between-equal? x
text
second-backwards-match2
second-before-whitespace-pos2))
for/fold-like-forms))
;; found a for/fold-like form, so we keep the [
(void)]
[(and second-backwards-match2 [(and second-backwards-match2
(member (send text classify-position second-backwards-match) (member (send text classify-position second-backwards-match)
;;; otherwise, this isn't a `let loop', ;;; otherwise, this isn't a `let loop',
@ -1855,9 +1865,9 @@
(void)] (void)]
[else [else
;; otherwise, round. ;; otherwise, round.
(change-to 4 #\()]))]))] (change-to 4 #\()])])]
[else [else
(change-to 5 #\()]))] (change-to 5 #\()])]
[else [else
(change-to 6 #\()]))]))) (change-to 6 #\()]))])))
(send text delete pos (+ pos 1) #f) (send text delete pos (+ pos 1) #f)
@ -2063,18 +2073,19 @@
(send f show #t) (send f show #t)
answers) answers)
(define stupid-internal-definition-syntax1 (mk-list-box 'framework:square-bracket:letrec "Letrec" values (get-new-simple-keyword "Letrec"))
(mk-list-box 'framework:square-bracket:letrec "Letrec" values (get-new-simple-keyword "Letrec")))
(define stupid-internal-definition-syntax3
(mk-list-box 'framework:square-bracket:local (mk-list-box 'framework:square-bracket:local
"Local" "Local"
values values
(get-new-simple-keyword "Local"))) (get-new-simple-keyword "Local"))
(define stupid-internal-definition-syntax2 (mk-list-box 'framework:square-bracket:for/fold
"For/fold"
values
(get-new-simple-keyword "For/fold"))
(mk-list-box 'framework:square-bracket:cond/offset (mk-list-box 'framework:square-bracket:cond/offset
"Cond" "Cond"
(λ (l) (format "~a (~a)" (car l) (cadr l))) (λ (l) (format "~a (~a)" (car l) (cadr l)))
get-new-cond-keyword)) get-new-cond-keyword)
(define check-box (new check-box% (define check-box (new check-box%
[parent main-panel] [parent main-panel]

2
pkgs/gui-pkgs/gui-test/framework/tests/racket.rkt
View File

@ -100,6 +100,8 @@
(test-magic-square-bracket 'local1 "(local " "(local [") (test-magic-square-bracket 'local1 "(local " "(local [")
(test-magic-square-bracket 'local2 "(local [" "(local [(") (test-magic-square-bracket 'local2 "(local [" "(local [(")
(test-magic-square-bracket 'local2 "(local [(define x 1)] " "(local [(define x 1)] (") (test-magic-square-bracket 'local2 "(local [(define x 1)] " "(local [(define x 1)] (")
(test-magic-square-bracket 'for/fold1 "(for/fold (" "(for/fold ([")
(test-magic-square-bracket 'for/fold2 "(for/fold ([x 1]) (" "(for/fold ([x 1]) ([")
(define (test-message-send/proc line before expected pos msg (define (test-message-send/proc line before expected pos msg