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/place
data/interval-map
data/union-find
drracket/tool
syntax/toplevel
mrlib/switchable-button
@ -38,7 +39,6 @@ If the namespace does not, they are colored the unbound color.
framework
net/url
browser/external
data/union-find
(for-syntax racket/base)
(only-in ffi/unsafe register-finalizer)
"../../syncheck-drracket-button.rkt"
@ -1178,7 +1178,7 @@ If the namespace does not, they are colored the unbound color.
(make-object menu-item%
jump-to-next-bound-occurrence
menu
(λ (item evt) (jump-to-next-callback pos text arrows)))
(λ (item evt) (jump-to-next-callback pos text)))
(make-object menu-item%
jump-to-binding
menu
@ -1239,17 +1239,8 @@ If the namespace does not, they are colored the unbound color.
(define current-matching-identifiers (set))
(define/private (update-matching-identifiers refreshing?)
(define arrow-records (fetch-arrow-records cursor-text cursor-pos))
(define id-set (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)))
(printf "mouse over pos ~s\n" cursor-pos)
(define id-set (position->matching-identifier-set cursor-text cursor-pos))
(define clr "GreenYellow")
(define style 'ellipse)
(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)])
(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'
;; 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
@ -1423,7 +1429,7 @@ If the namespace does not, they are colored the unbound color.
(jump-to-binding/bound-helper
text
(λ (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
(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
;; callback for the jump popup menu item
(define/private (jump-to-next-callback pos txt input-arrows backwards?)
(unless (null? input-arrows)
(define arrow-key (car input-arrows))
(define orig-arrows
(sort (set->list (hash-ref bindings-table
(list (var-arrow-start-text arrow-key)
(var-arrow-start-pos-left arrow-key)
(var-arrow-start-pos-right arrow-key))
(λ () '())))
(λ (x y) (if backwards?
(not (syncheck:compare-bindings x y))
(syncheck:compare-bindings x y)))))
(cond
[(null? orig-arrows) (void)]
[(null? (cdr orig-arrows)) (jump-to (car orig-arrows))]
[else
(let loop ([arrows orig-arrows])
(cond
[(null? arrows) (jump-to (car orig-arrows))]
[else
(define arrow (car arrows))
(cond
[(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))])]))])))
(define/private (jump-to-next-callback pos txt backwards?)
(define orig-arrows
(sort (set->list (position->matching-identifier-set txt pos))
(λ (x y) (if backwards?
(not (syncheck:compare-bindings x y))
(syncheck:compare-bindings x y)))))
(cond
[(null? orig-arrows) (void)]
[(null? (cdr orig-arrows)) (jump-to (car orig-arrows))]
[else
(let loop ([arrows orig-arrows])
(cond
[(null? arrows) (jump-to (car orig-arrows))]
[else
(define arrow (car arrows))
(cond
[(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
(define/private (jump-to to-arrow)