suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 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 (module search mzscheme
(require (lib "string-constant.ss" "string-constants") (require (lib "string-constant.ss" "string-constants")
(lib "unitsig.ss")
"sig.ss"
"../help-sig.ss"
"docpos.ss" "docpos.ss"
"colldocs.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@ ; hd-cookie string sym sym any -> void
(unit/sig search^ ; shows search result in default browser
(import help:doc-position^) (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) (define (html-doc-position x)
(or (user-defined-doc-position x) (or (user-defined-doc-position x)
@ -27,7 +38,7 @@
(define doc-names null) (define doc-names null)
; doc-kinds : (list-of symbol) ; doc-kinds : (list-of symbol)
(define doc-kinds null) (define doc-kinds null)
; doc-collection-date : ?? ; doc-collection-date : (union #f number 'none)
(define doc-collection-date #f) (define doc-collection-date #f)
(define re:title (regexp "<[tT][iI][tT][lL][eE]>(.*)</[tT][iI][tT][lL][eE]>")) (define re:title (regexp "<[tT][iI][tT][lL][eE]>(.*)</[tT][iI][tT][lL][eE]>"))
@ -58,7 +69,6 @@
[else (loop)]))))) [else (loop)])))))
doc))))) 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)
@ -70,11 +80,11 @@
[doc-names (map (lambda (x) (get-std-doc-title path x)) doc-collections)]) [doc-names (map (lambda (x) (get-std-doc-title path x)) doc-collections)])
; Order the standard docs: ; Order the standard docs:
(let ([ordered (quicksort (let ([ordered (quicksort
(map cons docs doc-names) (map list docs doc-collections doc-names)
(lambda (a b) (lambda (a b) ; html-doc-position expects collection name
(< (html-doc-position (cdr a)) (< (html-doc-position (cadr a))
(html-doc-position (cdr b)))))]) (html-doc-position (cadr b)))))])
(values (map car ordered) (map cdr ordered)))) (values (map car ordered) (map caddr ordered)))) ; here we want the std title
(values null null)))) (values null null))))
; Check collections for doc.txt files: ; Check collections for doc.txt files:
@ -155,7 +165,8 @@
ht ht
doc doc
(lambda () (lambda ()
(with-handlers ([not-break-exn? (lambda (x) null)]) (with-handlers
([not-break-exn? (lambda (x) null)])
(with-input-from-file doc (with-input-from-file doc
(lambda () (lambda ()
(let loop ([start 0]) (let loop ([start 0])
@ -254,7 +265,8 @@
(string->list s))))) (string->list s)))))
(define (doc-collections-changed) (define (doc-collections-changed)
(set! doc-collection-date #f)) (set! doc-collection-date #f)
(reset-doc-positions!))
(define re:url-dir (regexp "^([^/]*)/(.*)$")) (define re:url-dir (regexp "^([^/]*)/(.*)$"))
(define (combine-path/url-path path url-path) (define (combine-path/url-path path url-path)
@ -431,9 +443,8 @@
(format (string-constant nothing-found-for) (format (string-constant nothing-found-for)
(apply (apply
string-append string-append
(append
(cons (format "\"~a\"" (car string-finds)) (cons (format "\"~a\"" (car string-finds))
(map (lambda (i) (format " ~a \"~a\"" (string-constant and) i)) (map (lambda (i) (format " ~a \"~a\"" (string-constant and) i))
(cdr string-finds))) (cdr string-finds)))))])
(list "."))))]) #f))))
#f))))))