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

adjust the c:x;n and c:x;p keybindings to use the

Browse Source 
same information as the yellow green bubbles

Before, when you typed c:x;n, drracket would look at the identifier
you're on, find its binder, find all bound occurrences of that binder,
sort them by position in the buffer, and then jump to the one that
follows where you are.

This works great for things like the "x" in "(let ([x 1]) x x)"
but not so great for things like the "define" in:

  #lang racket
  (define x '(+ 1 2))
  (define y '(+ 3 4))

since that would jump to the quote, since there are bindign arrows
going from the "racket" to the define and to the quote.

Now, since it is using information ultimately derived directly
from (and only from) free-identifier=? (the arrows also come from
identifier-binding, which is how we get those arrows in the second
example above) you jump from the first define to the second define,
which seems better.
This commit is contained in:
Robby Findler 2013-02-19 13:49:08 -06:00
parent 164a5831b8
commit d3e1c16159
1 changed files with 42 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

84
collects/drracket/private/syncheck/gui.rkt
View File

@ -29,6 +29,7 @@ If the namespace does not, they are colored the unbound color.
racket/runtime-path racket/runtime-path
racket/place racket/place
data/interval-map data/interval-map
data/union-find
drracket/tool drracket/tool
syntax/toplevel syntax/toplevel
mrlib/switchable-button mrlib/switchable-button
@ -38,7 +39,6 @@ If the namespace does not, they are colored the unbound color.
framework framework
net/url net/url
browser/external browser/external
data/union-find
(for-syntax racket/base) (for-syntax racket/base)
(only-in ffi/unsafe register-finalizer) (only-in ffi/unsafe register-finalizer)
"../../syncheck-drracket-button.rkt" "../../syncheck-drracket-button.rkt"
@ -1178,7 +1178,7 @@ If the namespace does not, they are colored the unbound color.
(make-object menu-item% (make-object menu-item%
jump-to-next-bound-occurrence jump-to-next-bound-occurrence
menu menu
(λ (item evt) (jump-to-next-callback pos text arrows))) (λ (item evt) (jump-to-next-callback pos text)))
(make-object menu-item% (make-object menu-item%
jump-to-binding jump-to-binding
menu menu
@ -1239,17 +1239,8 @@ If the namespace does not, they are colored the unbound color.
(define current-matching-identifiers (set)) (define current-matching-identifiers (set))
(define/private (update-matching-identifiers refreshing?) (define/private (update-matching-identifiers refreshing?)
(define arrow-records (fetch-arrow-records cursor-text cursor-pos)) (printf "mouse over pos ~s\n" cursor-pos)
(define id-set (if arrow-records (define id-set (position->matching-identifier-set cursor-text cursor-pos))
(let ([an-identifier-location-set
(for/or ([x (in-list arrow-records)])
(and (identifier-location-set? x)
x))])
(if an-identifier-location-set
(uf-find (identifier-location-set-set
an-identifier-location-set))
(set)))
(set)))
(define clr "GreenYellow") (define clr "GreenYellow")
(define style 'ellipse) (define style 'ellipse)
(unless (equal? current-matching-identifiers id-set) (unless (equal? current-matching-identifiers id-set)
@ -1272,6 +1263,21 @@ If the namespace does not, they are colored the unbound color.
(for ([x (in-list in-edit-sequence)]) (for ([x (in-list in-edit-sequence)])
(send x end-edit-sequence)))) (send x end-edit-sequence))))
;; return the set of locations of identifiers that have the
;; same binding information as the identifier at cursor-pos (if any)
(define/private (position->matching-identifier-set cursor-text cursor-pos)
(define arrow-records (fetch-arrow-records cursor-text cursor-pos))
(if arrow-records
(let ([an-identifier-location-set
(for/or ([x (in-list arrow-records)])
(and (identifier-location-set? x)
x))])
(if an-identifier-location-set
(uf-find (identifier-location-set-set
an-identifier-location-set))
(set)))
(set)))
;; Sometimes when this is called, the calls to 'tooltip-info->ltrb' ;; Sometimes when this is called, the calls to 'tooltip-info->ltrb'
;; fail and we get no information back. When that happens, we return ;; fail and we get no information back. When that happens, we return
;; 'out-of-sync and try again in on-paint (which happens every time ;; 'out-of-sync and try again in on-paint (which happens every time
@ -1423,7 +1429,7 @@ If the namespace does not, they are colored the unbound color.
(jump-to-binding/bound-helper (jump-to-binding/bound-helper
text text
(λ (pos text vec-ents) (λ (pos text vec-ents)
(jump-to-next-callback pos text vec-ents backwards?)))) (jump-to-next-callback pos text backwards?))))
;; syncheck:jump-to-binding-occurrence : text -> void ;; syncheck:jump-to-binding-occurrence : text -> void
(define/public (syncheck:jump-to-binding-occurrence text) (define/public (syncheck:jump-to-binding-occurrence text)
@ -1443,34 +1449,28 @@ If the namespace does not, they are colored the unbound color.
;; jump-to-next-callback : num text (listof arrow) boolean? -> void ;; jump-to-next-callback : num text (listof arrow) boolean? -> void
;; callback for the jump popup menu item ;; callback for the jump popup menu item
(define/private (jump-to-next-callback pos txt input-arrows backwards?) (define/private (jump-to-next-callback pos txt backwards?)
(unless (null? input-arrows) (define orig-arrows
(define arrow-key (car input-arrows)) (sort (set->list (position->matching-identifier-set txt pos))
(define orig-arrows (λ (x y) (if backwards?
(sort (set->list (hash-ref bindings-table (not (syncheck:compare-bindings x y))
(list (var-arrow-start-text arrow-key) (syncheck:compare-bindings x y)))))
(var-arrow-start-pos-left arrow-key) (cond
(var-arrow-start-pos-right arrow-key)) [(null? orig-arrows) (void)]
(λ () '()))) [(null? (cdr orig-arrows)) (jump-to (car orig-arrows))]
(λ (x y) (if backwards? [else
(not (syncheck:compare-bindings x y)) (let loop ([arrows orig-arrows])
(syncheck:compare-bindings x y))))) (cond
(cond [(null? arrows) (jump-to (car orig-arrows))]
[(null? orig-arrows) (void)] [else
[(null? (cdr orig-arrows)) (jump-to (car orig-arrows))] (define arrow (car arrows))
[else (cond
(let loop ([arrows orig-arrows]) [(and (object=? txt (list-ref arrow 0))
(cond (<= (list-ref arrow 1) pos (list-ref arrow 2)))
[(null? arrows) (jump-to (car orig-arrows))] (jump-to (if (null? (cdr arrows))
[else (car orig-arrows)
(define arrow (car arrows)) (cadr arrows)))]
(cond [else (loop (cdr arrows))])]))]))
[(and (object=? txt (list-ref arrow 0))
(<= (list-ref arrow 1) pos (list-ref arrow 2)))
(jump-to (if (null? (cdr arrows))
(car orig-arrows)
(cadr arrows)))]
[else (loop (cdr arrows))])]))])))
;; jump-to : (list text number number) -> void ;; jump-to : (list text number number) -> void
(define/private (jump-to to-arrow) (define/private (jump-to to-arrow)