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

107
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,44 +743,49 @@
(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)])
(let ([end-pos (get-forward-sexp start-pos)]) (cond
(if end-pos [(and bw
(kill 0 start-pos end-pos) (= (- one-forward 1) bw)
(bell))) (member (get-character bw) '(#\, #\` #\')))
#t)] (let ([two-forward (forward-match one-forward (last-position))])
[define forward-sexp (or two-forward
(λ (start-pos) one-forward))]
(let ([end-pos (get-forward-sexp start-pos)]) [else
(if end-pos one-forward]))]
(set-position end-pos) [else one-forward])))
(bell)) (define/public (remove-sexp start-pos)
#t))] (let ([end-pos (get-forward-sexp start-pos)])
(if end-pos
(kill 0 start-pos end-pos)
(bell)))
#t)
(define/public (forward-sexp start-pos)
(let ([end-pos (get-forward-sexp start-pos)])
(if end-pos
(set-position end-pos)
(bell))
#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)])
(if end-pos (if end-pos
(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 (backward-match start-pos limit)]
[end-pos [min-pos (backward-containing-sexp start-pos limit)])
(backward-match start-pos limit)] (if (and end-pos
[min-pos (or (not min-pos)
(backward-containing-sexp start-pos limit)] (end-pos . >= . min-pos)))
[ans end-pos
(if (and end-pos #f)))
(or (not min-pos)
(>= end-pos min-pos)))
end-pos
#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,17 +836,16 @@
#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 (get-forward-sexp pos)])
(let ([next-pos (forward-match pos last)]) (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)]) (if (and back-pos
(if (and back-pos (> 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 #\()