commit 94cda256e80edad55bf4f2e87deca11eff6e60d8
parent 85a7fb296d1c1d8c5aa72c52735d85d774684778
Author: Robby Findler <robby@racket-lang.org>
Date: Tue, 20 Nov 2007 04:52:45 +0000
made f1 work in drscheme, fixed a few other bugs
svn: r7781
original commit: 1f81a98987e353686d7500d7ce7f5ff813147617
Diffstat:
2 files changed, 95 insertions(+), 93 deletions(-)
diff --git a/collects/help/private/search.ss b/collects/help/private/search.ss
@@ -1,93 +0,0 @@
-#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))))))
diff --git a/collects/help/search.ss b/collects/help/search.ss
@@ -0,0 +1,95 @@
+#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
+ mzlib/contract)
+
+(provide/contract
+ [generate-search-results (-> (listof string?) void?)])
+
+(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))))))
