suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

..

Browse Source 
original commit: c2a8e543ea67f1a2e6671c01f187663ec65d23f0
This commit is contained in:
Robby Findler 2003-09-30 23:10:19 +00:00
parent 5b73d23f27
commit c66068df39
1 changed files with 37 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
collects/help/private/search.ss
View File

@ -3,6 +3,7 @@
"docpos.ss" "docpos.ss"
"colldocs.ss" "colldocs.ss"
"path.ss" "path.ss"
"manuals.ss"
(lib "list.ss") (lib "list.ss")
(lib "contract.ss")) (lib "contract.ss"))
@ -36,54 +37,51 @@
; get-std-doc-title : string -> string ; get-std-doc-title : string -> string
; gets the standard title of the documentation, from the ; gets the standard title of the documentation, from the
; known docs list. ; known docs list.
(define (get-std-doc-title path doc) (define (get-std-doc-title path/doc)
(cond (let-values ([(path doc _1) (split-path path/doc)])
[(string=? doc "help") (cond
"PLT Help Desk"] [(string=? doc "help")
[(assoc doc known-docs) "PLT Help Desk"]
=> (lambda (a) (cdr a))] [(assoc doc known-docs)
[else => (lambda (a) (cdr a))]
(let ([index-file (build-path path doc "index.htm")]) [else
(if (file-exists? index-file) (let ([index-file (build-path path doc "index.htm")])
(call-with-input-file index-file (if (file-exists? index-file)
(lambda (port) (call-with-input-file index-file
(let loop () (lambda (port)
(let ([l (read-line port)]) (let loop ()
(cond (let ([l (read-line port)])
[(eof-object? l) (cond
doc] [(eof-object? l)
[(regexp-match re:title l) doc]
=> [(regexp-match re:title l)
(lambda (m) =>
(apply (lambda (m)
string (apply
(map (lambda (x) (if (char-whitespace? x) #\space x)) string
(string->list (cadr m)))))] (map (lambda (x) (if (char-whitespace? x) #\space x))
[else (loop)]))))) (string->list (cadr m)))))]
doc))])) [else (loop)])))))
doc))])))
(define (reset-doc-lists) (define (reset-doc-lists)
; Locate standard HTML documentation ; Locate standard HTML documentation
(define-values (std-docs std-doc-names) (define-values (std-docs std-doc-names)
(let* ([path (with-handlers ([not-break-exn? (lambda (x) #f)]) (let* ([docs (find-doc-directories)]
(collection-path "doc"))]) [doc-names (map get-std-doc-title docs)])
(if path ; Order the standard docs:
(let* ([doc-collections (directory-list path)] (let ([ordered (quicksort
[docs (map (lambda (x) (build-path path x)) doc-collections)] (map list docs doc-names)
[doc-names (map (lambda (x) (get-std-doc-title path x)) doc-collections)]) (lambda (a b) ; html-doc-position expects collection name
; Order the standard docs: (< (html-doc-position (cadr a))
(let ([ordered (quicksort (html-doc-position (cadr b)))))])
(map list docs doc-collections doc-names) (values (map car ordered) (map cadr ordered))))) ; here we want the std title
(lambda (a b) ; html-doc-position expects collection name
(< (html-doc-position (cadr a))
(html-doc-position (cadr b)))))])
(values (map car ordered) (map caddr ordered)))) ; here we want the std title
(values null null))))
; Check collections for doc.txt files: ; Check collections for doc.txt files:
(define-values (txt-docs txt-doc-names) (colldocs)) (define-values (txt-docs txt-doc-names) (colldocs))
(set! docs (append std-docs txt-docs)) (set! docs (append std-docs txt-docs))
(set! doc-names (append (set! doc-names (append
std-doc-names std-doc-names
(map (lambda (s) (format "the ~a collection" s)) (map (lambda (s) (format "the ~a collection" s))