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

exact matches now come first and help-desk with no arguments goes to some kind of generic page

Browse Source 
svn: r7970

original commit: 046abd204ea6cadb36e9a127e3a71c2b025adbd2
This commit is contained in:
Robby Findler 2007-12-12 17:24:57 +00:00
parent 2991306101
commit 45c8f79865
2 changed files with 72 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
collects/help/help.ss
View File

@ -1,7 +1,18 @@
#lang scheme/base #lang scheme/base
(require "search.ss") (require "search.ss"
(define argv (current-command-line-arguments)) browser/external
(when (equal? argv #()) setup/dirs
(error 'help-desk "expected a search term on the command line")) mzlib/cmdline)
(generate-search-results (vector->list argv))
(define search-terms '())
(command-line "Help Desk"
(current-command-line-arguments)
(args search-term (set! search-terms search-term)))
(cond
[(null? search-terms)
(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-terms)])

77
collects/help/search.ss
View File

@ -57,7 +57,8 @@
(define (generate-search-results search-keys) (define (generate-search-results search-keys)
(let ([file (next-search-results-file)] (let ([file (next-search-results-file)]
[search-regexps (map (λ (x) (regexp-quote x #f)) search-keys)] [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 [search-key-string
(cond (cond
[(null? search-keys) ""] [(null? search-keys) ""]
@ -71,26 +72,60 @@
(xref-render (xref-render
x x
(decode `(,(title (format "Search results for ~a" search-key-string)) (decode `(,(title (format "Search results for ~a" search-key-string))
,(let* ([index (xref-index x)] ,@(let* ([index (xref-index x)]
[len (length index)]) [len (length index)]
(apply itemize [matching-entries (filter (has-match search-regexps) index)]
(map [exact-matches (filter (has-match exact-search-regexps) matching-entries)]
(λ (entry) [inexact-matches (filter (compose not (has-match exact-search-regexps)) matching-entries)])
(apply item (append
(make-link-element (build-itemization "Exact matches" exact-matches)
"indexlink" (build-itemization "Containing matches" inexact-matches)))))
(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) file)
(send-url (format "file://~a" (path->string file))) (send-url (format "file://~a" (path->string file)))
(void)))) (void))))
(define ((compose f g) x) (f (g x)))
;; has-match : (listof regexp) -> entry -> boolean
(define ((has-match search-regexps) entry)
(ormap (λ (str)
(ormap
(λ (key) (regexp-match key str))
search-regexps))
(entry-words entry)))
;; build-itemization : (listof entry) -> (listof <stuff>)
(define (build-itemization title entries)
(cond
[(null? entries) '()]
[else
(list
(bold title)
(apply itemize
(map
(λ (entry)
(apply item
(make-link-element
"indexlink"
(entry-content entry)
(entry-link-key entry))
(make-extra-content
(entry-desc entry))))
(limit-length
500
(sort
entries
(λ (x y) (string-ci<=? (entry->sort-key x) (entry->sort-key y))))))))]))
(define (limit-length n l)
(cond
[(zero? n) '()]
[(null? l) '()]
[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)))))