Skip to content

Commit

Permalink
Update for additional new struct, index-desc
Browse files Browse the repository at this point in the history 
Add "Language families" column to racket-describe-search-mode.
  • Loading branch information
@greghendershott
greghendershott committed Oct 2, 2024
1 parent e863812 commit 11b2279
Show file tree
Hide file tree
Showing 2 changed files with 84 additions and 42 deletions.
14 changes: 9 additions & 5 deletions racket-describe.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -594,7 +594,7 @@ point if any.
(pcase result
(`()
(message "No documentation found for %s" name))
(`((,_term ,_what ,_from ,path ,anchor))
(`((,_term ,_what ,_from ,_fams ,path ,anchor))
(racket-describe-search-visit name
(racket-file-name-back-to-front path)
anchor))
Expand All @@ -603,12 +603,14 @@ point if any.
(get-buffer-create buf-name)
(racket-describe-search-mode)
(let ((max-term 0)
(max-what 0))
(max-what 0)
(max-from 0))
(setq tabulated-list-entries
(mapcar
(pcase-lambda (`(,term ,what ,from ,path ,anchor))
(pcase-lambda (`(,term ,what ,from ,fams ,path ,anchor))
(setq max-term (max max-term (length term)))
(setq max-what (max max-what (length what)))
(setq max-from (max max-from (length from)))
(list nil
(vector
(list term
Expand All @@ -617,13 +619,15 @@ point if any.
'anchor anchor
'action #'racket-describe-search-button)
what
from)))
from
fams)))
vs))
(setq tabulated-list-sort-key nil)
(setq tabulated-list-format
(vector (list "Name" (max max-term (length "Name ")) nil)
(list "Kind" (max max-what (length "Kind ")) t)
(list "Provided from" 99 t)))
(list "Provided from" (max max-from (length "Provided from")) t)
(list "Language families" 99 t)))
(setq tabulated-list-padding 0)
(tabulated-list-init-header)
(tabulated-list-print)
Expand Down
112 changes: 75 additions & 37 deletions racket/scribble.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,8 @@
racket/set
racket/string
(only-in scribble/core
tag?)
tag?
content->string)
scribble/blueboxes
(only-in scribble/manual-struct
;; i.e. Not the newer exported-index-desc*
Expand Down Expand Up @@ -39,7 +40,8 @@
setup/xref
syntax/parse/define
version/utils
"elisp.rkt")
"elisp.rkt"
"util.rkt")

(provide binding->path+anchor
identifier->bluebox
Expand Down Expand Up @@ -130,26 +132,39 @@
;; making _another_ 30K+ list, by returning a thunk for elisp-write
;; to call, to do "streaming" writes.

;; When available use new index structs circa Racket 8.14.0.6.
(define-polyfill (exported-index-desc*? _)
#:module scribble/manual-struct
#f)
(define-polyfill (exported-index-desc*-extras _)
#:module scribble/manual-struct
#hasheq())
(define-polyfill (index-desc? _)
#:module scribble/manual-struct
#f)
(define-polyfill (index-desc-extras _)
#:module scribble/manual-struct
#hasheq())

(define (hide-desc? desc)
;; Don't show doc for constructors; class doc suffices.
(or (constructor-index-desc? desc)
(and (exported-index-desc*? desc)
(let ([ht (exported-index-desc*-extras desc)])
(or (hash-ref ht 'hidden? #f)
(hash-ref ht 'constructor? #f))))))

(define ((doc-index-names))
(with-less-memory-pressure
(with-parens
(define xref (force xref-promise))
(for* ([entry (in-list (xref-index xref))]
[desc (in-value (entry-desc entry))]
#:when (not (constructor-index-desc? desc))
#:unless (hide-desc? desc)
[term (in-value (car (entry-words entry)))])
(elisp-write term))
(newline))))

;; When available use new exported-index-desc* struct, introduced c.
;; Racket 8.14.0.5.
(define exported-index-desc*?
(dynamic-require 'scribble/manual-struct 'exported-index-desc*?
(λ () (λ (_) #f))))
(define exported-index-desc*-extras
(dynamic-require 'scribble/manual-struct 'exported-index-desc*-extras
(λ () (λ (_) (hasheq)))))

(define (doc-index-lookup str)
(with-less-memory-pressure
(define xref (force xref-promise))
Expand All @@ -159,12 +174,8 @@
#:when (string=? str term)
[desc (in-value (entry-desc entry))]
#:when desc
;;; [_ (in-value (println desc))] ;;; DEBUG
#:unless (or (constructor-index-desc? desc)
(and (exported-index-desc*? desc)
(let ([ht (exported-index-desc*-extras desc)])
(or (hash-ref ht 'hidden? #f)
(hash-ref ht 'constructor? #f))))))
[_ (in-value (println desc))] ;;; DEBUG
#:unless (hide-desc? desc))
(define tag (entry-tag entry))
(define (what/method tag)
(cond
Expand All @@ -173,16 +184,53 @@
(format "method of ~a" c/i)]
[else "method"]))
(define-values (path anchor) (xref-tag->path+anchor xref tag))
(define-values (what from)
(define (doc-in)
(match (reverse (explode-path path))
[(list* html-file dir _)
(format "in ~a ~a"
(path->string dir)
(path->string (path-replace-extension html-file
#"")))]
[_
(format "tag ~a") tag]))
(define-values (what from fams)
(cond
;; New structs
[(exported-index-desc*? desc)
(define ht (exported-index-desc*-extras desc))
(define kind (hash-ref ht 'kind))
(define what (if (string=? kind "method")
(what/method tag)
kind))
(define libs (exported-index-desc-from-libs desc))
(values what libs)]
(define from
(string-join (match (hash-ref ht 'display-from-libs #f)
[(? list? contents)
(map content->string contents)]
[#f
(map ~s (exported-index-desc-from-libs desc))])
", "))
(define fams (match (hash-ref ht 'language-family #f)
[(? list? fams) (string-join (map ~a fams) ", ")]
[#f "Racket"]))
(values what from fams)]
[(index-desc? desc)
(define ht (index-desc-extras desc))
(define what (match (hash-ref ht 'module-kind #f)
['lib "module"]
['lang "language"]
['reader "reader"]
[#f "documentation"]
[v (~a v)]))
(define from
(match (hash-ref ht 'display-from-libs #f)
[(? list? contents)
(string-join (map content->string contents) ", ")]
[#f (doc-in)]))
(define fams (match (hash-ref ht 'language-family #f)
[(? list? fams) (string-join (map ~a fams) ", ")]
[#f "Racket"]))
(values what from fams)]
;; Older structs
[(exported-index-desc? desc)
(define what
(match desc
Expand All @@ -197,29 +245,19 @@
[(? mixin-index-desc?) "mixin"]
[(? method-index-desc?) (what/method tag)]
[_ ""]))
(define libs (exported-index-desc-from-libs desc))
(values what libs)]
(define from (string-join (map ~s (exported-index-desc-from-libs desc)) ", "))
(values what from "")]
[(module-path-index-desc? desc)
(values "module" null)]
(values "module" "" "")]
[else
(define where
(match (reverse (explode-path path))
[(list* html-file dir _)
(format "in ~a ~a"
(path->string dir)
(path->string (path-replace-extension html-file
#"")))]
[_
(format "tag ~a") tag]))
(values where null)]))
(define from-str (string-join (map ~s from) ", "))
(list term what from-str path anchor)))
(values "documentation" (doc-in) "")]))
(list term what from fams path anchor)))
(sort (set->list results)
string<?
#:cache-keys? #t
#:key
(match-lambda
[(list* _term _what from _path _anchor)
[(list* _term _what from _fams _path _anchor)
(match from
;; sort things from some distinguished libs first
[(and (pregexp "^racket/") v)
Expand Down

0 comments on commit 11b2279

Please sign in to comment.