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

v201 changes

Browse Source 
original commit: 4928ab22adbeffbca64d394176af6da4e3002212
This commit is contained in:
Paul Steckler 2002-06-25 20:32:52 +00:00
parent eced374756
commit d54711c88b
1 changed files with 281 additions and 270 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,18 +1,29 @@
(module search mzscheme
(require (lib "string-constant.ss" "string-constants")
(lib "unitsig.ss")
"sig.ss"
"../help-sig.ss"
"docpos.ss"
"colldocs.ss"
(lib "list.ss"))
(lib "list.ss")
(lib "util.ss" "doc" "help" "servlets" "private")
"../server.ss"
"../browser.ss")
(provide search@)
(provide do-search
doc-collections-changed
search-for-docs)
(define search@
(unit/sig search^
(import help:doc-position^)
; hd-cookie string sym sym any -> void
; shows search result in default browser
(define (search-for-docs cookie search-string search-type match-type lucky?)
(let* ([port (hd-cookie->port cookie)]
[url (format
(string-append "http://127.0.0.1:~a/servlets/index.ss?"
"search-string=~a&"
"search-type=~a&"
"match-type=~a&"
"lucky=~a")
port (hexify-string search-string) search-type match-type
(if lucky? "true" "false"))])
(help-desk-navigate url)))
(define (html-doc-position x)
(or (user-defined-doc-position x)
@ -27,7 +38,7 @@
(define doc-names null)
; doc-kinds : (list-of symbol)
(define doc-kinds null)
; doc-collection-date : ??
; doc-collection-date : (union #f number 'none)
(define doc-collection-date #f)
(define re:title (regexp "<[tT][iI][tT][lL][eE]>(.*)</[tT][iI][tT][lL][eE]>"))
@ -58,7 +69,6 @@
[else (loop)])))))
doc)))))
(define (reset-doc-lists)
; Locate standard HTML documentation
(define-values (std-docs std-doc-names)
@ -70,11 +80,11 @@
[doc-names (map (lambda (x) (get-std-doc-title path x)) doc-collections)])
; Order the standard docs:
(let ([ordered (quicksort
(map cons docs doc-names)
(lambda (a b)
(< (html-doc-position (cdr a))
(html-doc-position (cdr b)))))])
(values (map car ordered) (map cdr ordered))))
(map list docs doc-collections doc-names)
(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:
@ -155,7 +165,8 @@
ht
doc
(lambda ()
(with-handlers ([not-break-exn? (lambda (x) null)])
(with-handlers
([not-break-exn? (lambda (x) null)])
(with-input-from-file doc
(lambda ()
(let loop ([start 0])
@ -254,7 +265,8 @@
(string->list s)))))
(define (doc-collections-changed)
(set! doc-collection-date #f))
(set! doc-collection-date #f)
(reset-doc-positions!))
(define re:url-dir (regexp "^([^/]*)/(.*)$"))
(define (combine-path/url-path path url-path)
@ -431,9 +443,8 @@
(format (string-constant nothing-found-for)
(apply
string-append
(append
(cons (format "\"~a\"" (car string-finds))
(map (lambda (i) (format " ~a \"~a\"" (string-constant and) i))
(cdr string-finds)))
(list "."))))])
#f))))))
(cdr string-finds)))))])
#f))))