From c9aecb01f011513749adee4d311d545fcb760b7a Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 15 Dec 2007 22:10:29 +0000 Subject: [PATCH] split setup/scribble-index into setup/xref and scribble/xref svn: r8020 --- collects/drscheme/syncheck.ss | 5 ++- collects/framework/private/text.ss | 5 ++- collects/help/search.ss | 12 +++--- collects/scheme/help.ss | 21 ++++------ .../scribble-index.ss => scribble/xref.ss} | 40 ++---------------- collects/setup/xref.ss | 41 +++++++++++++++++++ 6 files changed, 63 insertions(+), 61 deletions(-) rename collects/{setup/scribble-index.ss => scribble/xref.ss} (68%) create mode 100644 collects/setup/xref.ss diff --git a/collects/drscheme/syncheck.ss b/collects/drscheme/syncheck.ss index 9a11ed83c8..c29dd3e186 100644 --- a/collects/drscheme/syncheck.ss +++ b/collects/drscheme/syncheck.ss @@ -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)))) ;;; ;;; ;;; ;;;;; diff --git a/collects/framework/private/text.ss b/collects/framework/private/text.ss index dd59ce1b2f..df78474184 100644 --- a/collects/framework/private/text.ss +++ b/collects/framework/private/text.ss @@ -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 diff --git a/collects/help/search.ss b/collects/help/search.ss index 52fb9aa603..a8ebce65e2 100644 --- a/collects/help/search.ss +++ b/collects/help/search.ss @@ -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)) diff --git a/collects/scheme/help.ss b/collects/scheme/help.ss index 1614bd21ca..004da3d950 100644 --- a/collects/scheme/help.ss +++ b/collects/scheme/help.ss @@ -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)) + diff --git a/collects/setup/scribble-index.ss b/collects/scribble/xref.ss similarity index 68% rename from collects/setup/scribble-index.ss rename to collects/scribble/xref.ss index 3b98a0a123..de1989cf97 100644 --- a/collects/setup/scribble-index.ss +++ b/collects/scribble/xref.ss @@ -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)))) ;; ---------------------------------------- diff --git a/collects/setup/xref.ss b/collects/setup/xref.ss new file mode 100644 index 0000000000..1bcde1877f --- /dev/null +++ b/collects/setup/xref.ss @@ -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)))