Skip to content

Commit 9867f7f

Browse files
6cdh6cdh
authored
Add same-file hover source detail (#219)
Add same-file hover source detail - Show declaration forms and leading comments from the live buffer for local bindings, and shift stored ranges through a position journal so edits do not rebuild every Hover-Detail. - Add `srfi-lib` to info.rkt dependency - Migrate to new resyntax API
1 parent ab61d6b commit 9867f7f

15 files changed

Lines changed: 1508 additions & 110 deletions

‎doclib/doc-trace.rkt‎

Lines changed: 10 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
(require racket/class
44
drracket/check-syntax
55
"service/completion.rkt"
6-
"service/hover.rkt"
6+
"service/hover/service.rkt"
77
"service/docs.rkt"
88
"service/require.rkt"
99
"service/definition.rkt"
@@ -15,7 +15,6 @@
1515
(define build-trace%
1616
(class (annotations-mixin object%)
1717
(init-field src doc-text lexer-state)
18-
(define hovers (new hover%))
1918
(define docs (new docs%))
2019
(define completions (new completion%))
2120
(define requires (new require%))
@@ -25,6 +24,11 @@
2524
[doc-text doc-text]
2625
[lexer-state lexer-state]))
2726
(define decls (new declaration%))
27+
(define hovers
28+
(new hover%
29+
[src src]
30+
[doc-text doc-text]
31+
[lexer-state lexer-state]))
2832
(define workspace-references (new workspace-references% [src src] [doc-text doc-text]))
2933
(define semantic-tokens (new highlight% [src src] [doc-text doc-text]))
3034

@@ -59,9 +63,12 @@
5963
(for ([s services])
6064
(send s walk-log text)))
6165

66+
;; Named reads for services. Do not add getters that expose interval-maps.
67+
(define/public (get-hover) hovers)
68+
(define/public (get-declaration) decls)
69+
6270
;; Getters
6371
(define/public (get-warn-diags) (car (send diag get)))
64-
(define/public (get-hovers) (send hovers get))
6572
(define/public (get-docs) (send docs get))
6673
(define/public (get-completions) (send completions get))
6774
(define/public (get-online-completions str-before-cursor)

‎doclib/doc.rkt‎

Lines changed: 179 additions & 46 deletions
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,8 @@
3434
racket/string
3535
data/interval-map
3636
"check-syntax.rkt"
37+
"hover.rkt"
38+
"service/hover/types.rkt"
3739
"external/resyntax.rkt"
3840
"docs-helpers.rkt"
3941
"documentation-parser.rkt"
@@ -516,57 +518,203 @@
516518
(define (abs-range->range doc start end)
517519
(Range (doc-abs-pos->pos doc start) (doc-abs-pos->pos doc end)))
518520

519-
(define (hover-tag->signature-block tag)
520-
;; We want signatures from `scribble/blueboxes` as they have better indentation,
521-
;; but in some super rare cases blueboxes aren't accessible, thus we try to use the
522-
;; parsed signature instead.
521+
;; Build hover cards: read from the hover service and docs map, build a
522+
;; `Hover-Card`, then render. Lookup stays here so `hover.rkt` stays testable
523+
;; without expansion.
524+
;;
525+
;; Hot path: interval-map lookup plus limited reads from the live buffer.
526+
;; No re-lex, expand, or cross-file load. Source detail uses shifted ranges
527+
;; while a trace is old. The result can be wrong or incomplete. Do not wait for
528+
;; `doc-trace-latest?`. Limits match features.md.
529+
530+
(define (hover-tag->signature tag)
531+
;; Prefer bluebox signatures over HTML for the summary fence. They indent
532+
;; better. When this returns #f, `hover-documentation-text` may still take a
533+
;; signature from HTML docs via #:include-signature? #t.
523534
(match-define (list signatures args-description)
524535
(if tag
525536
(get-docs-for-tag tag)
526537
(list #f #f)))
527-
(and signatures
528-
(~a "```\n"
529-
(string-join signatures "\n")
538+
(and (pair? signatures)
539+
(~a (string-join signatures "\n")
530540
(if args-description
531541
(~a "\n" args-description)
532-
"")
533-
"\n```\n---\n")))
542+
""))))
534543

535-
(define (hover-documentation-text link signature-block)
544+
(define (hover-documentation-text link signature)
545+
;; Skip the HTML signature when a bluebox signature already fills the summary.
546+
;; Otherwise `extract-documentation` puts the same signature in the docs body
547+
;; (see #:include-signature? in documentation-parser.rkt).
536548
(if link
537-
(~a (or signature-block "")
538-
(or (extract-documentation-for-selected-element
539-
link #:include-signature? (not signature-block))
540-
""))
549+
(or (extract-documentation-for-selected-element
550+
link #:include-signature? (not signature))
551+
"")
541552
""))
542553

543-
(define (build-hover-contents hover-text link documentation-text)
544-
(if link
545-
(~a hover-text
546-
" - [online docs]("
547-
(make-proper-url-for-online-documentation link)
548-
")\n"
549-
(if (non-empty-string? documentation-text)
550-
(~a "\n---\n" documentation-text)
551-
""))
552-
hover-text))
554+
(define max-hover-source-lines 10)
555+
(define max-hover-source-characters 1000)
556+
557+
;; Apply `max-hover-source-lines` and `max-hover-source-characters`.
558+
;; `truncated-after?` is true when detail ranges end before `source-end`, even
559+
;; if the buffer read itself is shorter.
560+
(define (source-text->hover-excerpt text #:truncated-after? [truncated-after? #f])
561+
(define newline-positions
562+
(regexp-match-positions* #px"\n" text))
563+
(define source-line-end
564+
(if (>= (length newline-positions) max-hover-source-lines)
565+
(car (list-ref newline-positions (sub1 max-hover-source-lines)))
566+
(string-length text)))
567+
(define source-character-end
568+
(min source-line-end max-hover-source-characters))
569+
(define retained-text
570+
(substring text 0 source-character-end))
571+
(define truncated?
572+
(or truncated-after?
573+
(< source-character-end (string-length text))))
574+
;; Append indented `...` only at the end. Do not add a leading marker or fake
575+
;; closing delimiters for a truncated form.
576+
(and (not (string=? retained-text ""))
577+
(if truncated?
578+
(string-append retained-text "\n ...")
579+
retained-text)))
580+
581+
(define (hover-comment-line-in-bounds? line doc-end)
582+
(define line-start (Hover-Comment-Line-start line))
583+
(define line-end (Hover-Comment-Line-end line))
584+
(and (< line-start line-end)
585+
(<= line-end doc-end)))
586+
587+
(define (hover-comment-lines-in-bounds? comment-lines doc-end)
588+
(for/and ([line (in-list comment-lines)])
589+
(hover-comment-line-in-bounds? line doc-end)))
590+
591+
(define (hover-comment-line->text doc line)
592+
(define line-start (Hover-Comment-Line-start line))
593+
(define line-end (Hover-Comment-Line-end line))
594+
(define line-text (send (Doc-text doc) get-text line-start line-end))
595+
(if (Hover-Comment-Line-truncated? line)
596+
(string-append line-text "...")
597+
line-text))
598+
599+
;; Read leading-comment lines from the live buffer. Return #f when any stored
600+
;; range is past the end of the document.
601+
(define (hover-detail->comment-excerpt doc detail)
602+
(define comment-lines (Hover-Detail-comment-lines detail))
603+
(define doc-end (doc-end-abs-pos doc))
604+
(and (pair? comment-lines)
605+
(hover-comment-lines-in-bounds? comment-lines doc-end)
606+
(string-join
607+
(append (for/list ([line (in-list comment-lines)])
608+
(hover-comment-line->text doc line))
609+
(if (Hover-Detail-comments-truncated? detail)
610+
(list "...")
611+
'()))
612+
"\n")))
613+
614+
(define (hover-detail-ranges-valid? detail doc-end)
615+
(define source-start (Hover-Detail-source-start detail))
616+
(define display-start (Hover-Detail-display-start detail))
617+
(define display-end (Hover-Detail-display-end detail))
618+
(define source-end (Hover-Detail-source-end detail))
619+
(and (<= source-start display-start)
620+
(< display-start display-end)
621+
(<= display-end source-end)
622+
(<= source-end doc-end)))
623+
624+
(define (hover-detail-truncated-after? detail read-end)
625+
(define display-end (Hover-Detail-display-end detail))
626+
(define source-end (Hover-Detail-source-end detail))
627+
(or (< read-end display-end)
628+
(< display-end source-end)))
629+
630+
(define (hover-detail->code-excerpt doc detail)
631+
(define display-start (Hover-Detail-display-start detail))
632+
(define display-end (Hover-Detail-display-end detail))
633+
(define read-end (min display-end
634+
(+ display-start max-hover-source-characters)))
635+
(define source-text (send (Doc-text doc) get-text display-start read-end))
636+
(source-text->hover-excerpt
637+
source-text
638+
#:truncated-after? (hover-detail-truncated-after? detail read-end)))
639+
640+
(define (hover-detail->summary doc detail)
641+
(define doc-end (doc-end-abs-pos doc))
642+
(and (hover-detail-ranges-valid? detail doc-end)
643+
(let ([code-excerpt (hover-detail->code-excerpt doc detail)])
644+
(and code-excerpt
645+
(Hover-Code-Summary
646+
(string-join
647+
(filter values
648+
(list (hover-detail->comment-excerpt doc detail)
649+
code-excerpt))
650+
"\n")
651+
(Hover-Detail-fence-language detail))))))
652+
653+
(define (build-hover-card hover-text link signature source-summary documentation-text)
654+
;; Same-file source form wins over a docs signature. Keep check-syntax text
655+
;; unchanged in a labeled fact. Do not rewrite it in the renderer.
656+
(Hover-Card (or source-summary
657+
(and signature
658+
(Hover-Code-Summary signature "racket")))
659+
'()
660+
(if hover-text
661+
(list (Hover-Fact "Check syntax" hover-text))
662+
'())
663+
(and link
664+
(Hover-Documentation documentation-text
665+
(make-proper-url-for-online-documentation link)))))
666+
667+
;; Find same-file detail through use-to-declaration lookup. Skip imports and
668+
;; cross-file `Decl-filepath` values. Keep the use span even when no stored
669+
;; detail exists yet, so mouse-over range fallback still works.
670+
(define (hover-detail-via-declaration hover-service declaration-service pos)
671+
(define-values (use-start use-end decl)
672+
(send declaration-service declaration-at pos))
673+
(match decl
674+
[(struct* Decl ([filepath #f] [left left]))
675+
(define-values (_ds _de detail)
676+
(send hover-service source-detail-at left))
677+
(values use-start use-end detail)]
678+
[_ (values #f #f #f)]))
553679

554680
(define/contract (doc-hover doc pos)
555681
(-> Doc? Pos? (or/c Hover? #f))
556682
(define doc-trace (Doc-trace doc))
683+
(define hover-service (send doc-trace get-hover))
684+
(define declaration-service (send doc-trace get-declaration))
557685
(define pos* (doc-pos->abs-pos doc pos))
558686
(define-values (start end hover-text)
559-
(interval-map-ref/bounds (send doc-trace get-hovers) pos* #f))
687+
(send hover-service mouse-over-at pos*))
688+
;; While a trace refreshes, show current buffer text from shifted ranges.
689+
;; The binding link may be old or wrong.
690+
(define-values (detail-start detail-end detail)
691+
(send hover-service source-detail-at pos*))
692+
(define-values (use-start use-end resolved-detail)
693+
(if detail
694+
(values detail-start detail-end detail)
695+
(hover-detail-via-declaration hover-service declaration-service pos*)))
696+
(define source-summary
697+
(and resolved-detail (hover-detail->summary doc resolved-detail)))
560698
(cond
561-
[(not hover-text) #f]
699+
;; Docs alone do not open a card. Stored source detail may still supply
700+
;; summary and range when check-syntax produced no hover text.
701+
[(and (not hover-text) (not source-summary)) #f]
562702
[else
563703
(match-define (list link tag)
564704
(interval-map-ref (send doc-trace get-docs) pos* (list #f #f)))
565-
(define signature-block (hover-tag->signature-block tag))
705+
(define signature (hover-tag->signature tag))
566706
(define documentation-text
567-
(hover-documentation-text link signature-block))
568-
(Hover #:contents (build-hover-contents hover-text link documentation-text)
569-
#:range (abs-range->range doc start end))]))
707+
(hover-documentation-text link signature))
708+
(define hover-card
709+
(build-hover-card hover-text
710+
link
711+
signature
712+
source-summary
713+
documentation-text))
714+
(Hover #:contents (render-hover-card hover-card)
715+
#:range (abs-range->range doc
716+
(or start use-start)
717+
(or end use-end)))]))
570718

571719
(define/contract (doc-code-action doc range)
572720
(-> Doc? Range? (listof CodeAction?))
@@ -631,22 +779,8 @@
631779
(values (or/c exact-nonnegative-integer? #f)
632780
(or/c exact-nonnegative-integer? #f)
633781
(or/c Decl? #f)))
634-
(define doc-trace (Doc-trace doc))
635782
(define pos* (doc-pos->abs-pos doc pos))
636-
(define doc-decls (send doc-trace get-sym-decls))
637-
(define doc-bindings (send doc-trace get-sym-bindings))
638-
(define-values (start end maybe-decl)
639-
(interval-map-ref/bounds doc-bindings pos* #f))
640-
(define-values (bind-start bind-end maybe-bindings)
641-
(interval-map-ref/bounds doc-decls pos* #f))
642-
(if maybe-decl
643-
(values start end maybe-decl)
644-
(if maybe-bindings
645-
(let ([decl (interval-map-ref doc-bindings (car (set-first maybe-bindings)) #f)])
646-
(if decl
647-
(values bind-start bind-end decl)
648-
(values #f #f #f)))
649-
(values #f #f #f))))
783+
(send (send (Doc-trace doc) get-declaration) declaration-at pos*))
650784

651785
;; Get binding ranges for a declaration.
652786
;; Returns a list of Range values.
@@ -1045,4 +1179,3 @@
10451179
doc-prepare-rename
10461180
doc-symbols
10471181
doc-symbols-hierarchical)
1048-

‎doclib/external/resyntax.rkt‎

Lines changed: 5 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -14,26 +14,18 @@
1414
(define (disable-resyntax!)
1515
(set! has-resyntax? #f))
1616

17-
(dynamic-imports ('resyntax/private/source
17+
(dynamic-imports ('resyntax/grimoire/source
1818
string-source
1919
source->string)
20-
('rebellion/base/range
21-
unbounded-range)
22-
('rebellion/base/comparator
23-
natural<=>)
24-
('rebellion/collection/range-set
25-
range-set)
26-
('resyntax/private/string-replacement
20+
('resyntax/grimoire/string-replacement
2721
string-replacement-start
2822
string-replacement-original-end
29-
string-replacement-render)
23+
string-replacement-new-text)
3024
('resyntax/private/refactoring-result
3125
refactoring-result-string-replacement
3226
refactoring-result-message
3327
refactoring-result-rule-name
3428
refactoring-result-set-results)
35-
('resyntax/default-recommendations
36-
default-recommendations)
3729
('resyntax
3830
resyntax-analyze)
3931
disable-resyntax!)
@@ -45,18 +37,13 @@
4537

4638
(define (run-resyntax-impl text)
4739
(define text-source (string-source text))
48-
(define all-lines (range-set (unbounded-range #:comparator natural<=>)))
49-
(define result-set
50-
(resyntax-analyze
51-
text-source
52-
#:suite default-recommendations
53-
#:lines all-lines))
40+
(define result-set (resyntax-analyze text-source))
5441

5542
(for/list ([result (in-list (refactoring-result-set-results result-set))])
5643
(define sr (refactoring-result-string-replacement result))
5744
(define char-start (string-replacement-start sr))
5845
(define char-end (string-replacement-original-end sr))
5946
(define message (refactoring-result-message result))
60-
(define new-text (string-replacement-render sr (source->string text-source)))
47+
(define new-text (string-replacement-new-text sr (source->string text-source)))
6148
(define rule-name (refactoring-result-rule-name result))
6249
(Resyntax-Result char-start char-end message rule-name new-text)))

0 commit comments

Comments
 (0)