svn: r7775
This commit is contained in:
parent
22575dd28a
commit
b018afc440
93
collects/help/private/search.ss
Normal file
93
collects/help/private/search.ss
Normal file
|
@ -0,0 +1,93 @@
|
||||||
|
#lang scheme/base
|
||||||
|
|
||||||
|
(require setup/scribble-index
|
||||||
|
scribble/struct
|
||||||
|
scribble/manual-struct
|
||||||
|
scribble/decode
|
||||||
|
scribble/basic
|
||||||
|
scribble/manual
|
||||||
|
(prefix-in scheme: scribble/scheme)
|
||||||
|
browser/external)
|
||||||
|
|
||||||
|
(provide generate-search-results)
|
||||||
|
|
||||||
|
(define (make-extra-content desc)
|
||||||
|
;; Use `desc' to provide more details on the link:
|
||||||
|
(append
|
||||||
|
(cond
|
||||||
|
[(method-index-desc? desc)
|
||||||
|
(list " method of "
|
||||||
|
;; This is bad. We need a more abstract way to take a
|
||||||
|
;; binding name and tag/source to create a Scheme link.
|
||||||
|
(make-element
|
||||||
|
"schemesymbol"
|
||||||
|
(list (make-link-element
|
||||||
|
"schemevaluelink"
|
||||||
|
(list (symbol->string (exported-index-desc-name desc)))
|
||||||
|
(method-index-desc-class-tag desc)))))]
|
||||||
|
[else null])
|
||||||
|
(cond
|
||||||
|
[(and (exported-index-desc? desc)
|
||||||
|
(not (null? (exported-index-desc-from-libs desc))))
|
||||||
|
(cons ", provided from "
|
||||||
|
(cdr (apply append
|
||||||
|
(map (lambda (lib)
|
||||||
|
(list ", "
|
||||||
|
(scheme:to-element lib)))
|
||||||
|
(exported-index-desc-from-libs desc)))))]
|
||||||
|
[else null])))
|
||||||
|
|
||||||
|
(define search-results-files
|
||||||
|
(reverse
|
||||||
|
(let loop ([n 10])
|
||||||
|
(cond
|
||||||
|
[(zero? n) '()]
|
||||||
|
[else
|
||||||
|
(cons (build-path (find-system-path 'temp-dir)
|
||||||
|
(format "search-results-~a.html" n))
|
||||||
|
(loop (- n 1)))]))))
|
||||||
|
|
||||||
|
(define (next-search-results-file)
|
||||||
|
(begin0 (car search-results-files)
|
||||||
|
(set! search-results-files
|
||||||
|
(append (cdr search-results-files)
|
||||||
|
(list (car search-results-files))))))
|
||||||
|
|
||||||
|
(define (generate-search-results search-keys)
|
||||||
|
(let ([file (next-search-results-file)]
|
||||||
|
[search-regexps (map regexp-quote search-keys)]
|
||||||
|
[search-key-string
|
||||||
|
(cond
|
||||||
|
[(null? search-keys) ""]
|
||||||
|
[else
|
||||||
|
(apply
|
||||||
|
string-append
|
||||||
|
(car search-keys)
|
||||||
|
(map (λ (x) (format ", or ~a" x))
|
||||||
|
(cdr search-keys)))])])
|
||||||
|
(let ([x (load-xref)])
|
||||||
|
(xref-render
|
||||||
|
x
|
||||||
|
(decode `(,(title (format "Search results for ~a" search-key-string))
|
||||||
|
,(let* ([index (xref-index x)]
|
||||||
|
[len (length index)])
|
||||||
|
(apply itemize
|
||||||
|
(map
|
||||||
|
(λ (entry)
|
||||||
|
(apply item
|
||||||
|
(make-link-element
|
||||||
|
"indexlink"
|
||||||
|
(entry-content entry)
|
||||||
|
(entry-link-key entry))
|
||||||
|
(make-extra-content
|
||||||
|
(entry-desc entry))))
|
||||||
|
(filter
|
||||||
|
(λ (entry)
|
||||||
|
(ormap (λ (str)
|
||||||
|
(ormap
|
||||||
|
(λ (key) (regexp-match key str))
|
||||||
|
search-regexps))
|
||||||
|
(entry-words entry)))
|
||||||
|
index))))))
|
||||||
|
file)
|
||||||
|
(send-url (format "file://~a" (path->string file))))))
|
|
@ -1,14 +0,0 @@
|
||||||
When the doc/help subcollection is installed, the installer creates an
|
|
||||||
hdindex file. See plt/collects/help/doc.txt for information about the
|
|
||||||
structure of such files.
|
|
||||||
|
|
||||||
To create index entries for Help Desk servlets, put anchor entries of
|
|
||||||
the form
|
|
||||||
|
|
||||||
(a ([name "name"] [value "Index entry"]))
|
|
||||||
|
|
||||||
on a single line in the Scheme source. The `name' attribute can be
|
|
||||||
any string that is unique among such anchors in that file, though of
|
|
||||||
course it should be mnemonic. The `value' attribute is used as the
|
|
||||||
index entry that is matched against search strings in Help Desk, and
|
|
||||||
appears again as the link caption in the Help Desk search results.
|
|
Loading…
Reference in New Issue
Block a user