commit 750e18115c1af51da9f6d65158d18b834573a4e0
parent 58fa3c4dfc4238998f7460b04af88e0ca0d6200e
Author: Eli Barzilay <eli@racket-lang.org>
Date: Mon, 4 Feb 2008 19:59:39 +0000
removed help/* leftovers that are not used in v4
svn: r8528
original commit: 5dd18dadcb4b7634c3035abf4f6f0d87fd65ae90
Diffstat:
1 file changed, 53 insertions(+), 75 deletions(-)
diff --git a/collects/help/search.ss b/collects/help/search.ss
@@ -13,9 +13,9 @@
setup/dirs)
(provide/contract
- [generate-search-results (-> (listof string?) void?)]
- [send-exact-results (-> string? void?)]
- [send-main-page (-> void?)])
+ [generate-search-results (-> (listof string?) void?)]
+ [send-exact-results (-> string? void?)]
+ [send-main-page (-> void?)])
(define (send-main-page)
(let* ([path (build-path (find-user-doc-dir) "index.html")]
@@ -32,28 +32,24 @@
[index (xref-index x)]
[len (length index)]
[exact-matches (filter (has-match (list exact-search-regexp)) index)])
- (cond
- [(or (null? exact-matches)
- (not (null? (cdr exact-matches))))
- (generate-search-results (list search-key))]
- [else
- (let ([match (car exact-matches)])
- (let-values ([(path tag) (xref-tag->path+anchor x (entry-tag match))])
- (send-url/file path #:fragment (uri-encode tag))))])))
+ (if (or (null? exact-matches)
+ (not (null? (cdr exact-matches))))
+ (generate-search-results (list search-key))
+ (let ([match (car exact-matches)])
+ (let-values ([(path tag) (xref-tag->path+anchor x (entry-tag match))])
+ (send-url/file path #:fragment (uri-encode tag)))))))
(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)]
+ [exact-search-regexps
+ (map (λ (x) (regexp (format "^~a$" (regexp-quote x #f)))) 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)))])])
+ (if (null? search-keys)
+ ""
+ (apply string-append
+ (car search-keys)
+ (map (λ (x) (format ", or ~a" x)) (cdr search-keys))))])
(let ([x (load-collections-xref)])
(xref-render
x
@@ -78,51 +74,34 @@
(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])))
+ (if (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)))))
+ null)
+ (if (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)))))
+ 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 next-search-results-file
+ (let ([n -1] [tmp (find-system-path 'temp-dir)])
+ (lambda ()
+ (set! n (modulo (add1 n) 10))
+ (build-path tmp (format "search-results-~a.html" n)))))
;; has-match : (listof regexp) -> entry -> boolean
(define ((has-match search-regexps) entry)
- (ormap (λ (str)
- (ormap
- (λ (key) (regexp-match key str))
- search-regexps))
+ (ormap (λ (str) (ormap (λ (key) (regexp-match key str)) search-regexps))
(entry-words entry)))
;; limit : exact-positive-integer
@@ -131,13 +110,12 @@
;; build-itemization : (listof entry) -> (listof <stuff>)
(define (build-itemization title entries)
- (cond
- [(null? entries) '()]
- [else
- (let ([entries
- (sort
- entries
- (λ (x y) (string-ci<=? (entry->sort-key x) (entry->sort-key y))))])
+ (if (null? entries)
+ '()
+ (let ([entries
+ (sort
+ entries
+ (λ (x y) (string-ci<=? (entry->sort-key x) (entry->sort-key y))))])
(list*
(bold title)
(apply itemize
@@ -155,17 +133,17 @@
entries)))
(if (<= (length entries) limit)
'()
- (list (make-element "schemeerror" (list (format "Search truncated after ~a hits." limit)))))))]))
+ (list (make-element "schemeerror"
+ (list (format "Search truncated after ~a hits."
+ limit)))))))))
(define (limit-length n l)
- (cond
- [(null? l) '()]
- [(zero? n) '()]
- [else (cons (car l) (limit-length (- n 1) (cdr l)))]))
+ (cond [(null? l) '()]
+ [(zero? n) '()]
+ [else (cons (car l) (limit-length (- n 1) (cdr l)))]))
(define (entry->sort-key e)
(let ([words (entry-words e)])
(apply string-append
(car words)
- (map (λ (x) (string-append ", " x))
- (cdr words)))))
+ (map (λ (x) (string-append ", " x)) (cdr words)))))
