split setup/scribble-index into setup/xref and scribble/xref
svn: r8020
This commit is contained in:
Matthew Flatt
parent
27c99d2c7f
commit
c9aecb01f0
|
|
@ -29,7 +29,8 @@ If the namespace does not, they are colored the unbound color.
|
|||
(prefix-in drscheme:arrow: drscheme/arrow)
|
||||
(prefix-in fw: framework/framework)
|
||||
mred/mred
|
||||
setup/scribble-index
|
||||
setup/xref
|
||||
scribble/xref
|
||||
net/url
|
||||
net/uri-codec
|
||||
browser/external
|
||||
|
|
@ -99,7 +100,7 @@ If the namespace does not, they are colored the unbound color.
|
|||
(define (force-xref th)
|
||||
(when (symbol? xref)
|
||||
(th)
|
||||
(set! xref (load-xref))))
|
||||
(set! xref (load-collections-xref))))
|
||||
|
||||
|
||||
;;; ;;; ;;; ;;;;;
|
||||
|
|
|
|||
|
|
@ -20,7 +20,8 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
(lib "dirs.ss" "setup")
|
||||
(lib "string.ss")
|
||||
(prefix-in srfi1: (lib "1.ss" "srfi")))
|
||||
(require setup/scribble-index
|
||||
(require setup/xref
|
||||
scribble/xref
|
||||
scribble/struct
|
||||
scribble/manual-struct
|
||||
scribble/decode
|
||||
|
|
@ -2812,7 +2813,7 @@ designates the character that triggers autocompletion
|
|||
[manual-mpis (and manuals (map sym->mpi manuals))])
|
||||
|
||||
(unless xref
|
||||
(set! xref (load-xref)))
|
||||
(set! xref (load-collections-xref)))
|
||||
|
||||
(let ([ht (make-hash-table 'equal)])
|
||||
(for-each
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
#lang scheme/base
|
||||
|
||||
(require setup/scribble-index
|
||||
(require setup/xref
|
||||
scribble/xref
|
||||
scribble/struct
|
||||
scribble/manual-struct
|
||||
scribble/decode
|
||||
|
|
@ -10,11 +11,8 @@
|
|||
net/sendurl
|
||||
mzlib/contract)
|
||||
|
||||
;; Restore the contract when keywords are supported:
|
||||
(provide generate-search-results)
|
||||
#;
|
||||
(provide/contract
|
||||
[generate-search-results (-> (listof string?) #:xref xref? void?)])
|
||||
[generate-search-results (-> (listof string?) void?)])
|
||||
|
||||
(define (make-extra-content desc)
|
||||
;; Use `desc' to provide more details on the link:
|
||||
|
|
@ -58,7 +56,7 @@
|
|||
(append (cdr search-results-files)
|
||||
(list (car search-results-files))))))
|
||||
|
||||
(define (generate-search-results search-keys #:xref [xref #f])
|
||||
(define (generate-search-results search-keys)
|
||||
(let ([file (next-search-results-file)]
|
||||
[search-regexps (map (λ (x) (regexp (regexp-quote x #f))) search-keys)]
|
||||
[exact-search-regexps (map (λ (x) (regexp (format "^~a$" (regexp-quote x #f)))) search-keys)]
|
||||
|
|
@ -71,7 +69,7 @@
|
|||
(car search-keys)
|
||||
(map (λ (x) (format ", or ~a" x))
|
||||
(cdr search-keys)))])])
|
||||
(let ([x (or xref (load-xref))])
|
||||
(let ([x (load-collections-xref)])
|
||||
(xref-render
|
||||
x
|
||||
(decode `(,(title (format "Search results for ~a" search-key-string))
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
#lang scheme/base
|
||||
|
||||
(require setup/scribble-index
|
||||
(require setup/xref
|
||||
scribble/xref
|
||||
scribble/manual-struct
|
||||
net/url
|
||||
net/sendurl
|
||||
|
|
@ -49,13 +50,6 @@
|
|||
(define (open-help-start)
|
||||
(find-help #'help))
|
||||
|
||||
(define xref #f)
|
||||
|
||||
(define (refresh-xref!)
|
||||
(unless xref
|
||||
(printf "Loading help index...\n")
|
||||
(set! xref (load-xref))))
|
||||
|
||||
(define-namespace-anchor anchor)
|
||||
|
||||
(define (find-help/lib sym lib)
|
||||
|
|
@ -71,12 +65,11 @@
|
|||
lib))))
|
||||
|
||||
(define (find-help id)
|
||||
(refresh-xref!)
|
||||
(let ([b (or (identifier-label-binding id)
|
||||
(identifier-binding id))])
|
||||
(if b
|
||||
(let ([tag (xref-binding->definition-tag
|
||||
xref
|
||||
(load-collections-xref)
|
||||
(car b)
|
||||
(cadr b))])
|
||||
(if tag
|
||||
|
|
@ -88,7 +81,7 @@
|
|||
(search-for-exports (syntax-e id)))))
|
||||
|
||||
(define (search-for-exports sym)
|
||||
(let ([idx (xref-index xref)]
|
||||
(let ([idx (xref-index (load-collections-xref))]
|
||||
[libs null])
|
||||
(for-each (lambda (entry)
|
||||
(when (exported-index-desc? (entry-desc entry))
|
||||
|
|
@ -106,7 +99,7 @@
|
|||
(loop (cdr libs))))))))
|
||||
|
||||
(define (go-to-tag t)
|
||||
(let-values ([(file anchor) (xref-tag->path+anchor xref t)])
|
||||
(let-values ([(file anchor) (xref-tag->path+anchor (load-collections-xref) t)])
|
||||
(printf "Sending to web browser...\n file: ~a\n anchor: ~a\n"
|
||||
file
|
||||
anchor)
|
||||
|
|
@ -126,11 +119,11 @@
|
|||
(define generate-search-results #f)
|
||||
|
||||
(define (search-for strs)
|
||||
(refresh-xref!)
|
||||
(printf "Generating and opening search page...\n")
|
||||
(unless generate-search-results
|
||||
(parameterize ([current-namespace (namespace-anchor->empty-namespace
|
||||
anchor)])
|
||||
(set! generate-search-results
|
||||
(dynamic-require 'help/search 'generate-search-results))))
|
||||
(generate-search-results strs #:xref xref))
|
||||
(generate-search-results strs))
|
||||
|
||||
|
|
|
|||
|
|
@ -6,8 +6,6 @@
|
|||
scribble/base-render
|
||||
(prefix-in html: scribble/html-render)
|
||||
scheme/class
|
||||
setup/getinfo
|
||||
setup/dirs
|
||||
mzlib/serialize
|
||||
scheme/path
|
||||
setup/main-collects)
|
||||
|
|
@ -33,47 +31,17 @@
|
|||
;; ----------------------------------------
|
||||
;; Xref loading
|
||||
|
||||
(define-struct doc (source dest))
|
||||
|
||||
(define-namespace-anchor here)
|
||||
|
||||
(define (load-xref)
|
||||
(define (load-xref sources)
|
||||
(let* ([renderer (new (html:render-mixin render%)
|
||||
[dest-dir (find-system-path 'temp-dir)])]
|
||||
[dirs (find-relevant-directories '(scribblings))]
|
||||
[infos (map get-info/full dirs)]
|
||||
[docs (filter
|
||||
values
|
||||
(apply append
|
||||
(map (lambda (i dir)
|
||||
(let ([s (i 'scribblings)])
|
||||
(map (lambda (d)
|
||||
(if (pair? d)
|
||||
(let ([flags (if (pair? (cdr d))
|
||||
(cadr d)
|
||||
null)])
|
||||
(let ([name (if (and (pair? (cdr d))
|
||||
(pair? (cddr d))
|
||||
(caddr d))
|
||||
(cadr d)
|
||||
(let-values ([(base name dir?) (split-path (car d))])
|
||||
(path-replace-suffix name #"")))])
|
||||
(make-doc
|
||||
(build-path dir (car d))
|
||||
(if (memq 'main-doc flags)
|
||||
(build-path (find-doc-dir) name)
|
||||
(build-path dir "compiled" "doc" name)))))
|
||||
#f))
|
||||
s)))
|
||||
infos
|
||||
dirs)))]
|
||||
[ci (send renderer collect null null)])
|
||||
(for-each (lambda (doc)
|
||||
(for-each (lambda (src)
|
||||
(parameterize ([current-namespace (namespace-anchor->empty-namespace here)])
|
||||
(let ([r (with-input-from-file (build-path (doc-dest doc) "out.sxref")
|
||||
read)])
|
||||
(let ([r (with-input-from-file src read)])
|
||||
(send renderer deserialize-info (cadr r) ci))))
|
||||
docs)
|
||||
sources)
|
||||
(make-xrefs renderer (send renderer resolve null null ci))))
|
||||
|
||||
;; ----------------------------------------
|
||||
41
collects/setup/xref.ss
Normal file
41
collects/setup/xref.ss
Normal file
|
|
@ -0,0 +1,41 @@
|
|||
#lang scheme/base
|
||||
|
||||
(require scribble/xref
|
||||
setup/getinfo
|
||||
setup/dirs)
|
||||
|
||||
(provide load-collections-xref)
|
||||
|
||||
(define cached-xref #f)
|
||||
|
||||
(define (load-collections-xref)
|
||||
(or cached-xref
|
||||
(let* ([dirs (find-relevant-directories '(scribblings))]
|
||||
[infos (map get-info/full dirs)]
|
||||
[dests (filter
|
||||
values
|
||||
(apply append
|
||||
(map (lambda (i dir)
|
||||
(let ([s (i 'scribblings)])
|
||||
(map (lambda (d)
|
||||
(if (pair? d)
|
||||
(let ([flags (if (pair? (cdr d))
|
||||
(cadr d)
|
||||
null)])
|
||||
(let ([name (if (and (pair? (cdr d))
|
||||
(pair? (cddr d))
|
||||
(caddr d))
|
||||
(cadr d)
|
||||
(let-values ([(base name dir?) (split-path (car d))])
|
||||
(path-replace-suffix name #"")))])
|
||||
(build-path
|
||||
(if (memq 'main-doc flags)
|
||||
(build-path (find-doc-dir) name)
|
||||
(build-path dir "compiled" "doc" name))
|
||||
"out.sxref")))
|
||||
#f))
|
||||
s)))
|
||||
infos
|
||||
dirs)))])
|
||||
(set! cached-xref (load-xref dests))
|
||||
cached-xref)))
|
||||
Loading…
Reference in New Issue
Block a user