split setup/scribble-index into setup/xref and scribble/xref
svn: r8020 original commit: c9aecb01f011513749adee4d311d545fcb760b7a
This commit is contained in:
parent
2dcde7a5e2
commit
7a53e8ef7e
|
@ -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))
|
||||
|
|
|
@ -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))))
|
||||
|
||||
;; ----------------------------------------
|
Loading…
Reference in New Issue
Block a user