suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

split setup/scribble-index into setup/xref and scribble/xref

Browse Source 
svn: r8020

original commit: c9aecb01f011513749adee4d311d545fcb760b7a
This commit is contained in:
Matthew Flatt 2007-12-15 22:10:29 +00:00
parent 2dcde7a5e2
commit 7a53e8ef7e
2 changed files with 9 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/help/search.ss
View File

@ -1,6 +1,7 @@
#lang scheme/base #lang scheme/base
(require setup/scribble-index (require setup/xref
scribble/xref
scribble/struct scribble/struct
scribble/manual-struct scribble/manual-struct
scribble/decode scribble/decode
@ -10,11 +11,8 @@
net/sendurl net/sendurl
mzlib/contract) mzlib/contract)
;; Restore the contract when keywords are supported:
(provide generate-search-results)
#;
(provide/contract (provide/contract
[generate-search-results (-> (listof string?) #:xref xref? void?)]) [generate-search-results (-> (listof string?) void?)])
(define (make-extra-content desc) (define (make-extra-content desc)
;; Use `desc' to provide more details on the link: ;; Use `desc' to provide more details on the link:
@ -58,7 +56,7 @@
(append (cdr search-results-files) (append (cdr search-results-files)
(list (car 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)] (let ([file (next-search-results-file)]
[search-regexps (map (λ (x) (regexp (regexp-quote x #f))) search-keys)] [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)] [exact-search-regexps (map (λ (x) (regexp (format "^~a$" (regexp-quote x #f)))) search-keys)]
@ -71,7 +69,7 @@
(car search-keys) (car search-keys)
(map (λ (x) (format ", or ~a" x)) (map (λ (x) (format ", or ~a" x))
(cdr search-keys)))])]) (cdr search-keys)))])])
(let ([x (or xref (load-xref))]) (let ([x (load-collections-xref)])
(xref-render (xref-render
x x
(decode `(,(title (format "Search results for ~a" search-key-string)) (decode `(,(title (format "Search results for ~a" search-key-string))

40
collects/setup/scribble-index.ss → collects/scribble/xref.ss
View File

@ -6,8 +6,6 @@
scribble/base-render scribble/base-render
(prefix-in html: scribble/html-render) (prefix-in html: scribble/html-render)
scheme/class scheme/class
setup/getinfo
setup/dirs
mzlib/serialize mzlib/serialize
scheme/path scheme/path
setup/main-collects) setup/main-collects)
@ -33,47 +31,17 @@
;; ---------------------------------------- ;; ----------------------------------------
;; Xref loading ;; Xref loading
(define-struct doc (source dest))
(define-namespace-anchor here) (define-namespace-anchor here)
(define (load-xref) (define (load-xref sources)
(let* ([renderer (new (html:render-mixin render%) (let* ([renderer (new (html:render-mixin render%)
[dest-dir (find-system-path 'temp-dir)])] [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)]) [ci (send renderer collect null null)])
(for-each (lambda (doc) (for-each (lambda (src)
(parameterize ([current-namespace (namespace-anchor->empty-namespace here)]) (parameterize ([current-namespace (namespace-anchor->empty-namespace here)])
(let ([r (with-input-from-file (build-path (doc-dest doc) "out.sxref") (let ([r (with-input-from-file src read)])
read)])
(send renderer deserialize-info (cadr r) ci)))) (send renderer deserialize-info (cadr r) ci))))
docs) sources)
(make-xrefs renderer (send renderer resolve null null ci)))) (make-xrefs renderer (send renderer resolve null null ci))))
;; ---------------------------------------- ;; ----------------------------------------