suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

added -x flag to plt-help, improved man pages

Browse Source 
svn: r8048

original commit: 9dcef875fe1b088dd12b29f71f3cca6028e625fd
This commit is contained in:
Robby Findler 2007-12-18 18:57:33 +00:00
parent 69ee9cce11
commit a008d097c7
2 changed files with 66 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/help/help.ss
View File

@ -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)]))

82
collects/help/search.ss
View File

@ -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)