diff --git a/drracket-test/tests/drracket/syncheck-test.rkt b/drracket-test/tests/drracket/syncheck-test.rkt index 74f12b9f2..7aae92d6d 100644 --- a/drracket-test/tests/drracket/syncheck-test.rkt +++ b/drracket-test/tests/drracket/syncheck-test.rkt @@ -1548,24 +1548,6 @@ " y`1\n" " `2)\n")) - (build-rename-test - (string-append - "#lang racket\n" - "(require racket/list)\n") - 14 - "require" - #f - #f) - - (build-rename-test - (string-append - "#lang racket\n" - "(require racket/list)\n") - 20 - "require" - #f - #f) - (build-test #:extra-files (hash "define-suffix.rkt" diff --git a/drracket-tool-doc/scribblings/drracket-tools/drracket-tools.scrbl b/drracket-tool-doc/scribblings/drracket-tools/drracket-tools.scrbl index e9ebdef3b..f424d6f39 100644 --- a/drracket-tool-doc/scribblings/drracket-tools/drracket-tools.scrbl +++ b/drracket-tool-doc/scribblings/drracket-tools/drracket-tools.scrbl @@ -41,8 +41,7 @@ that are exposed via Racket APIs to be used with other editors. the vector are the arguments passed to the method. (Note that this procedure does not account for the callback procedures present in - @method[syncheck-annotations<%> syncheck:add-arrow/name-dup/pxpy] - and @method[syncheck-annotations<%> syncheck:add-id-set].) + @method[syncheck-annotations<%> syncheck:add-arrow/name-dup/pxpy/renamable].) The @racket[file-or-stx] argument gives the input program and @racket[fully-expanded?] indicates if the @@ -207,7 +206,7 @@ in order to make the results be platform independent. void?]{This method is no longer called by Check Syntax. It is here for backwards compatibility only. The information it provided must now be synthesized from the information supplied to - @method[syncheck-annotations<%> syncheck:add-arrow/name-dup/pxpy].} + @method[syncheck-annotations<%> syncheck:add-arrow/name-dup/pxpy/renamable].} @defmethod[(syncheck:add-arrow [start-source-obj (not/c #f)] [start-left exact-nonnegative-integer?] @@ -219,7 +218,7 @@ in order to make the results be platform independent. [phase-level (or/c exact-nonnegative-integer? #f)]) void?]{ This function is not called directly anymore by Check Syntax. Instead - @method[syncheck-annotations<%> syncheck:add-arrow/name-dup/pxpy] is. + @method[syncheck-annotations<%> syncheck:add-arrow/name-dup/pxpy/renamable] is. This method is invoked by the default implementation of @racket[_syncheck:add-arrow/name-dup] in @@ -237,11 +236,11 @@ in order to make the results be platform independent. [name-dup? (-> string? boolean?)]) void?]{ This function is not called directly anymore by Check Syntax. Instead - @method[syncheck-annotations<%> syncheck:add-arrow/name-dup/pxpy] is. + @method[syncheck-annotations<%> syncheck:add-arrow/name-dup/pxpy/renamable] is. - The default implementation of @method[syncheck-annotations<%> syncheck:add-arrow/name-dup/pxpy] - discards the @racket[_start-px] @racket[_start-py] @racket[_end-px] @racket[_end-py] - arguments and calls this method. + This method is invoked by the default implementation of + @racket[_syncheck:add-arrow/name-dup/pxpy] in + @racket[annotations-mixin]. } @defmethod[(syncheck:add-arrow/name-dup/pxpy [start-source-obj (not/c #f)] [start-left exact-nonnegative-integer?] @@ -258,6 +257,29 @@ in order to make the results be platform independent. [require-arrow (or/c boolean? 'module-lang-require)] [name-dup? (-> string? boolean?)]) void?]{ + This function is not called directly anymore by Check Syntax. Instead + @method[syncheck-annotations<%> syncheck:add-arrow/name-dup/pxpy/renamable] is. + + This method is invoked by the default implementation of + @racket[_syncheck:add-arrow/name-dup/pxpy/renamable] in + @racket[annotations-mixin]. + } + @defmethod[(syncheck:add-arrow/name-dup/pxpy/renamable + [start-source-obj (not/c #f)] + [start-left exact-nonnegative-integer?] + [start-right exact-nonnegative-integer?] + [start-px (real-in 0 1)] + [start-py (real-in 0 1)] + [end-source-obj (not/c #f)] + [end-left exact-nonnegative-integer?] + [end-right exact-nonnegative-integer?] + [end-px (real-in 0 1)] + [end-py (real-in 0 1)] + [actual? boolean?] + [phase-level (or/c exact-nonnegative-integer? #f)] + [require-arrow (or/c boolean? 'module-lang)] + [name-dup? (-> string? boolean?)]) + void?]{ Called to indicate that there should be an arrow between the locations described by the first ten arguments. The @racket[start-px] and @racket[start-py] indicate how far along the diagonal between the upper-left coordinate of the editor position @racket[start-left] and the bottom-right @@ -392,7 +414,10 @@ in order to make the results be platform independent. @item{the @method[syncheck-annotations<%> syncheck:add-arrow/name-dup/pxpy] method drops the @racket[_from-px], @racket[_from-py], @racket[_to-px], and @racket[_to-py] arguments and calls - @method[syncheck-annotations<%> syncheck:add-arrow/name-dup]; and} + @method[syncheck-annotations<%> syncheck:add-arrow/name-dup]} + @item{the @method[syncheck-annotations<%> syncheck:add-arrow/name-dup/pxpy/renamable] + method drops the @racket[_renamable?] argument and calls + @method[syncheck-annotations<%> syncheck:add-arrow/name-dup/pxpy]; and} @item{all of the other methods ignore their arguments and return @racket[(void)].}] Here is an example showing how use this library to extract all @@ -409,10 +434,10 @@ in order to make the results be platform independent. (super-new) (define/override (syncheck:find-source-object stx) stx) - (define/override (syncheck:add-arrow/name-dup/pxpy + (define/override (syncheck:add-arrow/name-dup/pxpy/renamable start-source-obj start-left start-right start-px start-py end-source-obj end-left end-right end-px end-py - actual? phase-level require-arrow? name-dup?) + actual? phase-level require-arrow? name-dup? renamable?) (set! arrows (cons (list start-source-obj end-source-obj) arrows))) @@ -456,6 +481,7 @@ in order to make the results be platform independent. syncheck:add-arrow syncheck:add-arrow/name-dup syncheck:add-arrow/name-dup/pxpy + syncheck:add-arrow/name-dup/pxpy/renamable syncheck:add-tail-arrow syncheck:add-mouse-over-status syncheck:add-jump-to-definition diff --git a/drracket-tool-lib/drracket/check-syntax.rkt b/drracket-tool-lib/drracket/check-syntax.rkt index 59cc6b040..1bb775b2e 100644 --- a/drracket-tool-lib/drracket/check-syntax.rkt +++ b/drracket-tool-lib/drracket/check-syntax.rkt @@ -46,6 +46,7 @@ syncheck:add-arrow syncheck:add-arrow/name-dup syncheck:add-arrow/name-dup/pxpy + syncheck:add-arrow/name-dup/pxpy/renamable syncheck:add-tail-arrow syncheck:add-mouse-over-status syncheck:add-jump-to-definition diff --git a/drracket-tool-lib/drracket/private/syncheck/syncheck-intf.rkt b/drracket-tool-lib/drracket/private/syncheck/syncheck-intf.rkt index e2982bfc7..192bc6472 100644 --- a/drracket-tool-lib/drracket/private/syncheck/syncheck-intf.rkt +++ b/drracket-tool-lib/drracket/private/syncheck/syncheck-intf.rkt @@ -13,6 +13,7 @@ syncheck:add-arrow syncheck:add-arrow/name-dup syncheck:add-arrow/name-dup/pxpy + syncheck:add-arrow/name-dup/pxpy/renamable syncheck:add-tail-arrow syncheck:add-mouse-over-status syncheck:add-jump-to-definition @@ -63,6 +64,20 @@ (syncheck:add-arrow/name-dup start-text start-pos-left start-pos-right end-text end-pos-left end-pos-right actual? level require-arrow? name-dup?)) + (define/public (syncheck:add-arrow/name-dup/pxpy/renamable + start-text + start-pos-left start-pos-right + start-px start-py + end-text + end-pos-left end-pos-right + end-px end-py + actual? level require-arrow? name-dup? renamable?) + (syncheck:add-arrow/name-dup/pxpy + start-text start-pos-left start-pos-right + start-px start-py + end-text end-pos-left end-pos-right + end-px end-py + actual? level require-arrow? name-dup?)) (define/public (syncheck:add-tail-arrow from-text from-pos to-text to-pos) (void)) (define/public (syncheck:add-mouse-over-status text pos-left pos-right str) (void)) diff --git a/drracket-tool-lib/drracket/private/syncheck/syncheck-local-member-names.rkt b/drracket-tool-lib/drracket/private/syncheck/syncheck-local-member-names.rkt index 4b0e7bec5..51aa97d69 100644 --- a/drracket-tool-lib/drracket/private/syncheck/syncheck-local-member-names.rkt +++ b/drracket-tool-lib/drracket/private/syncheck/syncheck-local-member-names.rkt @@ -13,6 +13,7 @@ syncheck:add-arrow syncheck:add-arrow/name-dup syncheck:add-arrow/name-dup/pxpy + syncheck:add-arrow/name-dup/pxpy/renamable syncheck:add-rename-menu syncheck:add-tail-arrow syncheck:add-mouse-over-status diff --git a/drracket-tool-lib/drracket/private/syncheck/traversals.rkt b/drracket-tool-lib/drracket/private/syncheck/traversals.rkt index 4ca80d03f..d1a7de530 100644 --- a/drracket-tool-lib/drracket/private/syncheck/traversals.rkt +++ b/drracket-tool-lib/drracket/private/syncheck/traversals.rkt @@ -1144,10 +1144,14 @@ ans) (when (and (<= from-pos-left from-pos-right) (<= to-pos-left to-pos-right)) - (send defs-text syncheck:add-arrow/name-dup/pxpy + (define renamable? + (not (or require-arrow? + (syntax-property to 'inhibit-renaming?) + (syntax-property from 'inhibit-renaming?)))) + (send defs-text syncheck:add-arrow/name-dup/pxpy/renamable from-source from-pos-left from-pos-right from-dx from-dy to-source to-pos-left to-pos-right to-dx to-dy - actual? level require-arrow? name-dup?))] + actual? level require-arrow? name-dup? renamable?))] [else (unless (hash-ref connections connections-key #f) (hash-set! connections connections-key #t) diff --git a/drracket/drracket/private/syncheck/gui.rkt b/drracket/drracket/private/syncheck/gui.rkt index cbbb27359..d78f695cd 100644 --- a/drracket/drracket/private/syncheck/gui.rkt +++ b/drracket/drracket/private/syncheck/gui.rkt @@ -251,7 +251,7 @@ If the namespace does not, they are colored the unbound color. (define-struct (var-arrow arrow) (start-text start-pos-left start-pos-right start-px start-py end-text end-pos-left end-pos-right end-px end-py - actual? level require-arrow? name-dup?) + actual? level require-arrow? name-dup? renamable?) ;; level is one of 'lexical, 'top-level, 'import #:transparent) (define-struct (tail-arrow arrow) (from-text from-pos to-text to-pos) #:transparent) @@ -751,6 +751,7 @@ If the namespace does not, they are colored the unbound color. (position->matching-identifiers-hash text (send text get-start-position) (send text get-end-position) + #t #t)) (unless (null? binding-identifiers) (define name-to-offer (find-name-to-offer binding-identifiers @@ -804,7 +805,7 @@ If the namespace does not, they are colored the unbound color. (end-edit-sequence)) (define/public (add-prefix-for-require txt pos) - (define binding-identifiers (position->binding-arrows txt pos pos #t)) + (define binding-identifiers (position->binding-arrows txt pos pos #t #f)) (define candidate-binders/possibly-prefixed (for/list ([binding-identifier (in-list binding-identifiers)] #:when (equal? (var-arrow-require-arrow? binding-identifier) @@ -857,7 +858,7 @@ If the namespace does not, they are colored the unbound color. (when prefix (define binder (car candidate-binders)) (define make-identifiers-hash - (binding-arrows->identifiers-hash #t (list binder))) + (binding-arrows->identifiers-hash #t #f (list binder))) (define req-txt (var-arrow-start-text binder)) (define req-start (var-arrow-start-pos-left binder)) (define req-end (var-arrow-start-pos-right binder)) @@ -1057,15 +1058,24 @@ If the namespace does not, they are colored the unbound color. end-pos-left end-pos-right actual? level require-arrow? name-dup?) (void)) + (define/public (syncheck:add-arrow/name-dup/pxpy + start-text + start-pos-left start-pos-right + end-text + end-pos-left end-pos-right + actual? level require-arrow? name-dup?) + (void)) ;; pre: start-editor, end-editor are embedded in `this' (or are `this') - (define/public (syncheck:add-arrow/name-dup/pxpy start-text - start-pos-left start-pos-right - start-px start-py - end-text - end-pos-left end-pos-right - end-px end-py - actual? level require-arrow? name-dup?) + (define/public (syncheck:add-arrow/name-dup/pxpy/renamable + start-text + start-pos-left start-pos-right + start-px start-py + end-text + end-pos-left end-pos-right + end-px end-py + actual? level require-arrow? name-dup? + renamable?) (when (and arrow-records (preferences:get 'drracket:syncheck:show-arrows?)) (when (add-to-bindings-table @@ -1075,7 +1085,7 @@ If the namespace does not, they are colored the unbound color. start-px start-py end-text end-pos-left end-pos-right end-px end-py - actual? level require-arrow? name-dup?)]) + actual? level require-arrow? name-dup? renamable?)]) (add-to-range/key start-text start-pos-left start-pos-right arrow #f #f) (add-to-range/key end-text end-pos-left end-pos-right arrow #f #f))))) @@ -1517,7 +1527,7 @@ If the namespace does not, they are colored the unbound color. (f menu)) (define-values (binding-identifiers make-identifiers-hash) - (position->matching-identifiers-hash text pos pos #t)) + (position->matching-identifiers-hash text pos pos #t #t)) (unless (null? binding-identifiers) (define name-to-offer (find-name-to-offer binding-identifiers pos pos)) (new menu-item% @@ -1581,7 +1591,7 @@ If the namespace does not, they are colored the unbound color. [(and cursor-text cursor-pos) (define-values (_binders make-identifiers-hash) (position->matching-identifiers-hash cursor-text cursor-pos cursor-pos - #f)) + #f #f)) (make-identifiers-hash)] [else (make-hash)])) @@ -1594,24 +1604,33 @@ If the namespace does not, they are colored the unbound color. ;; position->matching-identifiers-hash ;; : txt pos pos -> (values (listof var-arrow?) hash[(list txt pos pos) -o> #t]) (define/private (position->matching-identifiers-hash the-text the-start-pos the-end-pos - include-require-arrows?) + include-require-arrows? + only-renamable?) (define binding-arrows (position->binding-arrows the-text the-start-pos the-end-pos - include-require-arrows?)) + include-require-arrows? + only-renamable?)) (values binding-arrows - (binding-arrows->identifiers-hash include-require-arrows? binding-arrows))) + (binding-arrows->identifiers-hash include-require-arrows? + only-renamable? + binding-arrows))) (define/private (position->binding-arrows the-text the-start-pos the-end-pos - include-require-arrows?) + include-require-arrows? + only-renamable?) (define binding-arrows '()) (define (add-binding-arrow arr) - (when (or include-require-arrows? - (not (var-arrow-require-arrow? arr))) + (when (and (or include-require-arrows? + (not (var-arrow-require-arrow? arr))) + (or (not only-renamable?) + (var-arrow-renamable? arr))) (set! binding-arrows (cons arr binding-arrows)))) (for ([the-pos (in-range the-start-pos (+ the-end-pos 1))]) (define arrs (fetch-arrow-records the-text the-pos)) (when arrs (for ([arrow (in-list arrs)]) - (when (var-arrow? arrow) + (when (and (var-arrow? arrow) + (or (not only-renamable?) + (var-arrow-renamable? arrow))) (cond [(and (equal? (var-arrow-start-text arrow) the-text) (<= (var-arrow-start-pos-left arrow) @@ -1634,7 +1653,9 @@ If the namespace does not, they are colored the unbound color. (add-binding-arrow candidate-binder))))]))))) binding-arrows) - (define (binding-arrows->identifiers-hash include-require-arrows? binding-arrows) + (define (binding-arrows->identifiers-hash include-require-arrows? + only-renamable? + binding-arrows) (define identifiers-hash #f) (define (add-one txt start end) (hash-set! identifiers-hash (list txt start end) #t)) @@ -1656,8 +1677,10 @@ If the namespace does not, they are colored the unbound color. (var-arrow-start-text binding-arrow) pos))]) (when (var-arrow? arrow) - (when (or include-require-arrows? - (not (var-arrow-require-arrow? arrow))) + (when (and (or include-require-arrows? + (not (var-arrow-require-arrow? arrow))) + (or (not only-renamable?) + (var-arrow-renamable? arrow))) (when (and (equal? (var-arrow-start-text arrow) (var-arrow-start-text binding-arrow)) (equal? (var-arrow-start-pos-left arrow) @@ -1850,7 +1873,7 @@ If the namespace does not, they are colored the unbound color. ;; callback for the jump popup menu item (define/private (jump-to-next-callback start-pos end-pos txt backwards?) (define-values (_binders make-identifiers-hash) - (position->matching-identifiers-hash txt start-pos end-pos #f)) + (position->matching-identifiers-hash txt start-pos end-pos #f #f)) (define orig-arrows (sort (hash-map (make-identifiers-hash) (λ (x y) x)) @@ -2198,15 +2221,15 @@ If the namespace does not, they are colored the unbound color. ;; using 'defs-text' all the time is wrong in the case of embedded editors, ;; but they already don't work and we've arranged for them to not appear here .... (match x - [`#(syncheck:add-arrow/name-dup/pxpy + [`#(syncheck:add-arrow/name-dup/pxpy/renamable ,start-pos-left ,start-pos-right ,start-px ,start-py ,end-pos-left ,end-pos-right ,end-px ,end-py - ,actual? ,level ,require-arrow? ,name-dup-pc ,name-dup-id) + ,actual? ,level ,require-arrow? ,name-dup-pc ,name-dup-id ,renamable?) (define name-dup? (build-name-dup? name-dup-pc name-dup-id known-dead-place-channels)) - (send defs-text syncheck:add-arrow/name-dup/pxpy + (send defs-text syncheck:add-arrow/name-dup/pxpy/renamable defs-text start-pos-left start-pos-right start-px start-py defs-text end-pos-left end-pos-right end-px end-py - actual? level require-arrow? name-dup?)] + actual? level require-arrow? name-dup? renamable?)] [`#(syncheck:add-tail-arrow ,from-pos ,to-pos) (send defs-text syncheck:add-tail-arrow defs-text from-pos defs-text to-pos)] [`#(syncheck:add-mouse-over-status ,pos-left ,pos-right ,str) diff --git a/drracket/drracket/private/syncheck/online-comp.rkt b/drracket/drracket/private/syncheck/online-comp.rkt index d92906c28..fca525cc2 100644 --- a/drracket/drracket/private/syncheck/online-comp.rkt +++ b/drracket/drracket/private/syncheck/online-comp.rkt @@ -61,19 +61,21 @@ (define-values (remote-chan local-chan) (place-channel)) (define table (make-hash)) (create-rename-answerer-thread orig-cust local-chan table) - (define/override (syncheck:add-arrow/name-dup/pxpy _start-text - start-pos-left start-pos-right - start-px start-py - _end-text - end-pos-left end-pos-right - end-px end-py - actual? level require-arrow? name-dup?) + (define/override (syncheck:add-arrow/name-dup/pxpy/renamable + _start-text + start-pos-left start-pos-right + start-px start-py + _end-text + end-pos-left end-pos-right + end-px end-py + actual? level require-arrow? name-dup? + renamable?) (define id (hash-count table)) (hash-set! table id name-dup?) - (add-to-trace (vector 'syncheck:add-arrow/name-dup/pxpy + (add-to-trace (vector 'syncheck:add-arrow/name-dup/pxpy/renamable start-pos-left start-pos-right start-px start-py end-pos-left end-pos-right end-px end-py - actual? level require-arrow? remote-chan id))) + actual? level require-arrow? remote-chan id renamable?))) (define/override (syncheck:add-id-set to-be-renamed/poss dup-name?) (define id (hash-count table))