From a008d097c7cc746818c9e221b34dc10e9dd6fcb8 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Tue, 18 Dec 2007 18:57:33 +0000
Subject: [PATCH] added -x flag to plt-help, improved man pages

svn: r8048

original commit: 9dcef875fe1b088dd12b29f71f3cca6028e625fd
---
 collects/help/help.ss   | 19 +++++++---
 collects/help/search.ss | 82 ++++++++++++++++++++++++++---------------
 2 files changed, 66 insertions(+), 35 deletions(-)

diff --git a/collects/help/help.ss b/collects/help/help.ss
index 24a3c722..93003163 100644
--- 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
index f2a81734..2db94a3f 100644
--- 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)