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

improved forward sexp

Browse Source 
svn: r4720
This commit is contained in:
Robby Findler 2006-10-31 20:29:39 +00:00
parent 54dea82d8a
commit 58a0b99d35
2 changed files with 65 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -404,13 +404,13 @@
(inherit get-styles-fixed) (inherit get-styles-fixed)
(inherit has-focus? find-snip split-snip) (inherit has-focus? find-snip split-snip)
(public get-limit tabify-on-return? tabify (public tabify-on-return? tabify
tabify-all insert-return calc-last-para tabify-all insert-return calc-last-para
box-comment-out-selection comment-out-selection uncomment-selection box-comment-out-selection comment-out-selection uncomment-selection
get-forward-sexp remove-sexp forward-sexp flash-forward-sexp get-backward-sexp flash-forward-sexp
flash-backward-sexp backward-sexp find-up-sexp up-sexp find-down-sexp down-sexp flash-backward-sexp backward-sexp find-up-sexp up-sexp find-down-sexp down-sexp
remove-parens-forward) remove-parens-forward)
(define (get-limit pos) 0) (define/public (get-limit pos) 0)
(define/public (balance-parens key-event) (define/public (balance-parens key-event)
(insert-close-paren (get-start-position) (insert-close-paren (get-start-position)
@ -484,7 +484,7 @@
pos-start))))] pos-start))))]
[get-proc [get-proc
(λ () (λ ()
(let ([id-end (forward-match contains (last-position))]) (let ([id-end (get-forward-sexp contains)])
(if (and id-end (> id-end contains)) (if (and id-end (> id-end contains))
(let* ([text (get-text contains id-end)]) (let* ([text (get-text contains id-end)])
(or (get-keyword-type text) (or (get-keyword-type text)
@ -492,8 +492,7 @@
[procedure-indent [procedure-indent
(λ () (λ ()
(case (get-proc) (case (get-proc)
[(define) 1] [(begin define) 1]
[(begin) 1]
[(lambda) 3] [(lambda) 3]
[else 0]))] [else 0]))]
[special-check [special-check
@ -542,7 +541,7 @@
;; So far, the S-exp containing "pos" was all on ;; So far, the S-exp containing "pos" was all on
;; one line (possibly not counting the opening paren), ;; one line (possibly not counting the opening paren),
;; so indent to follow the first S-exp's end ;; so indent to follow the first S-exp's end
(let ([name-length (let ([id-end (forward-match contains (last-position))]) (let ([name-length (let ([id-end (get-forward-sexp contains)])
(if id-end (if id-end
(- id-end contains) (- id-end contains)
0))]) 0))])
@ -744,23 +743,33 @@
(delete snip-pos (+ snip-pos 1))) (delete snip-pos (+ snip-pos 1)))
(set-position pos pos))) (set-position pos pos)))
[define get-forward-sexp (define/public (get-forward-sexp start-pos)
(λ (start-pos) (let ([one-forward (forward-match start-pos (last-position))])
(forward-match start-pos (last-position)))] (cond
[define remove-sexp [(and one-forward (not (= 0 one-forward)))
(λ (start-pos) (let ([bw (backward-match one-forward 0)])
(cond
[(and bw
(= (- one-forward 1) bw)
(member (get-character bw) '(#\, #\` #\')))
(let ([two-forward (forward-match one-forward (last-position))])
(or two-forward
one-forward))]
[else
one-forward]))]
[else one-forward])))
(define/public (remove-sexp start-pos)
(let ([end-pos (get-forward-sexp start-pos)]) (let ([end-pos (get-forward-sexp start-pos)])
(if end-pos (if end-pos
(kill 0 start-pos end-pos) (kill 0 start-pos end-pos)
(bell))) (bell)))
#t)] #t)
[define forward-sexp (define/public (forward-sexp start-pos)
(λ (start-pos)
(let ([end-pos (get-forward-sexp start-pos)]) (let ([end-pos (get-forward-sexp start-pos)])
(if end-pos (if end-pos
(set-position end-pos) (set-position end-pos)
(bell)) (bell))
#t))] #t))
[define flash-forward-sexp [define flash-forward-sexp
(λ (start-pos) (λ (start-pos)
(let ([end-pos (get-forward-sexp start-pos)]) (let ([end-pos (get-forward-sexp start-pos)])
@ -768,20 +777,15 @@
(flash-on end-pos (add1 end-pos)) (flash-on end-pos (add1 end-pos))
(bell)) (bell))
#t))] #t))]
[define get-backward-sexp (define/public (get-backward-sexp start-pos)
(λ (start-pos)
(let* ([limit (get-limit start-pos)] (let* ([limit (get-limit start-pos)]
[end-pos [end-pos (backward-match start-pos limit)]
(backward-match start-pos limit)] [min-pos (backward-containing-sexp start-pos limit)])
[min-pos
(backward-containing-sexp start-pos limit)]
[ans
(if (and end-pos (if (and end-pos
(or (not min-pos) (or (not min-pos)
(>= end-pos min-pos))) (end-pos . >= . min-pos)))
end-pos end-pos
#f)]) #f)))
ans))]
[define flash-backward-sexp [define flash-backward-sexp
(λ (start-pos) (λ (start-pos)
(let ([end-pos (get-backward-sexp start-pos)]) (let ([end-pos (get-backward-sexp start-pos)])
@ -832,9 +836,8 @@
#t))] #t))]
[define find-down-sexp [define find-down-sexp
(λ (start-pos) (λ (start-pos)
(let ([last (last-position)])
(let loop ([pos start-pos]) (let loop ([pos start-pos])
(let ([next-pos (forward-match pos last)]) (let ([next-pos (get-forward-sexp pos)])
(if (and next-pos (> next-pos pos)) (if (and next-pos (> next-pos pos))
(let ([back-pos (let ([back-pos
(backward-containing-sexp (sub1 next-pos) pos)]) (backward-containing-sexp (sub1 next-pos) pos)])
@ -842,7 +845,7 @@
(> back-pos pos)) (> back-pos pos))
back-pos back-pos
(loop next-pos))) (loop next-pos)))
#f)))))] #f))))]
[define down-sexp [define down-sexp
(λ (start-pos) (λ (start-pos)
(let ([pos (find-down-sexp start-pos)]) (let ([pos (find-down-sexp start-pos)])
@ -857,7 +860,7 @@
[paren? (or (char=? first-char #\( ) [paren? (or (char=? first-char #\( )
(char=? first-char #\[ ))] (char=? first-char #\[ ))]
[closer (if paren? [closer (if paren?
(forward-match pos (last-position)))]) (get-forward-sexp pos))])
(if (and paren? closer) (if (and paren? closer)
(begin (begin-edit-sequence) (begin (begin-edit-sequence)
(delete pos (add1 pos)) (delete pos (add1 pos))
@ -1254,7 +1257,7 @@
(loop before-whitespace-pos (loop before-whitespace-pos
(+ n 1)))] (+ n 1)))]
[else [else
(let* ([afterwards (send text forward-match pos (send text last-position))] (let* ([afterwards (send text get-forward-sexp pos)]
[keyword [keyword
(and afterwards (and afterwards
(send text get-text pos afterwards))]) (send text get-text pos afterwards))])

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

@ -115,6 +115,16 @@
(list '(right alt)) (list '(right alt))
(list '(right alt)) (list '(right alt))
(list '(right alt))) (list '(right alt)))
(make-key-spec (make-buff-spec "'(abc (def))" 0 0)
(make-buff-spec "'(abc (def))" 12 12)
(list '(right alt))
(list '(right alt))
(list '(right alt)))
(make-key-spec (make-buff-spec "'(abc (def))" 12 12)
(make-buff-spec "'(abc (def))" 0 0)
(list '(left alt))
(list '(left alt))
(list '(left alt)))
(build-open-bracket-spec "" 0 #\() (build-open-bracket-spec "" 0 #\()
(build-open-bracket-spec "(f cond " 8 #\() (build-open-bracket-spec "(f cond " 8 #\()
(build-open-bracket-spec "(f let (" 8 #\() (build-open-bracket-spec "(f let (" 8 #\()