commit a008d097c7cc746818c9e221b34dc10e9dd6fcb8
parent 69ee9cce11d18178e2e10ee85cbab23ac9c790fa
Author: Robby Findler <robby@racket-lang.org>
Date: Tue, 18 Dec 2007 18:57:33 +0000
added -x flag to plt-help, improved man pages
svn: r8048
original commit: 9dcef875fe1b088dd12b29f71f3cca6028e625fd
Diffstat:
2 files changed, 66 insertions(+), 35 deletions(-)
diff --git a/collects/help/help.ss b/collects/help/help.ss
@@ -5,11 +5,20 @@
setup/dirs
scheme/cmdline)
+(define exact-search? #f)
+
(command-line
+ #:once-any (["--exact" "-x"] "Go directly to the first exact hit for the search term" (set! exact-search? #t))
#:args search-term
(cond
- [(null? search-term)
- (let ([dest-path (build-path (find-doc-dir) "start" "index.html")])
- (send-url (format "file://~a" (path->string dest-path))))]
- [else
- (generate-search-results search-term)]))
+ [exact-search?
+ (when (null? search-term)
+ (error 'plt-help "expected a search term after -x or --exact"))
+ (unless (null? (cdr search-term))
+ (error 'plt-help "expected a single search term, got ~s" search-term))
+ (send-exact-results (car search-term))]
+ [(null? search-term)
+ (let ([dest-path (build-path (find-doc-dir) "start" "index.html")])
+ (send-url (format "file://~a" (path->string dest-path))))]
+ [else
+ (generate-search-results search-term)]))
diff --git a/collects/help/search.ss b/collects/help/search.ss
@@ -9,10 +9,61 @@
scribble/manual
(prefix-in scheme: scribble/scheme)
net/sendurl
+ net/uri-codec
mzlib/contract)
(provide/contract
- [generate-search-results (-> (listof string?) void?)])
+ [generate-search-results (-> (listof string?) void?)]
+ [send-exact-results (-> string? void?)])
+
+;; if there is exactly one exact match for this search key, go directly
+;; to that place. Otherwise, go to a page that lists all of the matches.
+(define (send-exact-results search-key)
+ (let* ([file (next-search-results-file)]
+ [exact-search-regexp (regexp (format "^~a$" (regexp-quote search-key #f)))]
+ [x (load-collections-xref)]
+ [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 (format "file://~a~a"
+ (path->string path)
+ (if tag (string-append "#" (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)]
+ [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-collections-xref)])
+ (xref-render
+ x
+ (decode `(,(title (format "Search results for ~a" search-key-string))
+ ,@(let* ([index (xref-index x)]
+ [len (length index)]
+ [matching-entries (filter (has-match search-regexps) index)]
+ [exact-matches (filter (has-match exact-search-regexps) matching-entries)]
+ [inexact-matches (filter (compose not (has-match exact-search-regexps)) matching-entries)])
+ (append
+ (build-itemization "Exact matches" exact-matches)
+ (build-itemization "Containing matches" inexact-matches)))))
+ file)
+ (send-url (format "file://~a" (path->string file)))
+ (void))))
(define (make-extra-content desc)
;; Use `desc' to provide more details on the link:
@@ -56,35 +107,6 @@
(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 (λ (x) (regexp (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)))])])
- (let ([x (load-collections-xref)])
- (xref-render
- x
- (decode `(,(title (format "Search results for ~a" search-key-string))
- ,@(let* ([index (xref-index x)]
- [len (length index)]
- [matching-entries (filter (has-match search-regexps) index)]
- [exact-matches (filter (has-match exact-search-regexps) matching-entries)]
- [inexact-matches (filter (compose not (has-match exact-search-regexps)) matching-entries)])
- (append
- (build-itemization "Exact matches" exact-matches)
- (build-itemization "Containing matches" inexact-matches)))))
- file)
- (send-url (format "file://~a" (path->string file)))
- (void))))
-
;; has-match : (listof regexp) -> entry -> boolean
(define ((has-match search-regexps) entry)
(ormap (λ (str)
