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

no message

Browse Source 
original commit: fdd4883bef661bfd92969bc7a825ba9f31f6625c
This commit is contained in:
Robby Findler 2001-04-09 20:34:51 +00:00
parent 85317e5400
commit 9fd3522c22
1 changed files with 440 additions and 431 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,6 +1,15 @@
(unit/sig help:search^
(import help:doc-position^ (module search mzscheme
mzlib:function^) (require (lib "unitsig.ss")
"sig.ss"
"../help-sig.ss"
(lib "list.ss"))
(provide search@)
(define search@
(unit/sig search^
(import help:doc-position^)
; Define an order for the documentation: ; Define an order for the documentation:
; and the names of the standard documentation ; and the names of the standard documentation
@ -13,24 +22,24 @@
(standard-html-doc-position x))) (standard-html-doc-position x)))
; These are set by reset-doc-lists: ; These are set by reset-doc-lists:
;; docs, doc-names and doc-kinds are parallel lists. doc-kinds ; docs, doc-names and doc-kinds are parallel lists. doc-kinds
;; distinguishes between the two variants of docs. ; distinguishes between the two variants of docs.
;; docs : (list-of (union string (list string string))) ; docs : (list-of (union string (list string string)))
(define docs null) (define docs null)
;; doc-names : (list-of string) ; doc-names : (list-of string)
(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 : ??
(define doc-collection-date #f) (define doc-collection-date #f)
(define colldocs (require-library "colldocs.ss" "help")) (define colldocs (require-library "colldocs.ss" "help"))
(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]>"))
;; 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)
(let ([a (assoc doc known-manuals)]) (let ([a (assoc doc known-manuals)])
(if a (if a
@ -64,7 +73,7 @@
(let* ([doc-collections (directory-list path)] (let* ([doc-collections (directory-list path)]
[docs (map (lambda (x) (build-path path x)) doc-collections)] [docs (map (lambda (x) (build-path path x)) doc-collections)]
[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 cons docs doc-names)
(lambda (a b) (lambda (a b)
@ -275,17 +284,17 @@
rest)))] rest)))]
[else (build-path path url-path)]))) [else (build-path path url-path)])))
;; do-search : ((? -> ?) ; do-search : ((? -> ?)
;; ?? ; ??
;; boolean ; boolean
;; boolean ; boolean
;; ?? ; ??
;; (-> A) ;; doesn't return ; (-> A) ; doesn't return
;; (?? -> ??) ; (?? -> ??)
;; (?? -> ??) ; (?? -> ??)
;; (?? ?? ?? ?? ?? ?? -> ??) ; (?? ?? ?? ?? ?? ?? -> ??)
;; -> ; ->
;; (union string #f)) ; (union string #f))
(define (do-search given-find search-level regexp? exact? ckey maxxed-out (define (do-search given-find search-level regexp? exact? ckey maxxed-out
add-doc-section add-kind-section add-choice) add-doc-section add-kind-section add-choice)
; When new docs are installed, the directory's modification date changes: ; When new docs are installed, the directory's modification date changes:
@ -315,7 +324,7 @@
(unless (< hit-count MAX-HIT-COUNT) (unless (< hit-count MAX-HIT-COUNT)
(maxxed-out))) (maxxed-out)))
;; Keyword search ; Keyword search
(let ([keys (case doc-kind (let ([keys (case doc-kind
[(html) (load-html-keywords doc)] [(html) (load-html-keywords doc)]
[(text) (load-txt-keywords doc)] [(text) (load-txt-keywords doc)]
@ -345,7 +354,7 @@
(unless (and (not regexp?) (string=? given-find (car v))) (unless (and (not regexp?) (string=? given-find (car v)))
(add-key-choice v)))) (add-key-choice v))))
keys))) keys)))
;; Index search ; Index search
(unless (< search-level 1) (unless (< search-level 1)
(let ([index (case doc-kind (let ([index (case doc-kind
[(html) (load-html-index doc)] [(html) (load-html-index doc)]
@ -381,7 +390,7 @@
(unless (and (not regexp?) (string=? given-find (car v))) (unless (and (not regexp?) (string=? given-find (car v)))
(add-index-choice (car v) (cdr v))))) (add-index-choice (car v) (cdr v)))))
index))))) index)))))
;; Content Search ; Content Search
(unless (or (< search-level 2) exact? (null? finds)) (unless (or (< search-level 2) exact? (null? finds))
(let ([files (case doc-kind (let ([files (case doc-kind
[(html) (with-handlers ([not-break? (lambda (x) null)]) [(html) (with-handlers ([not-break? (lambda (x) null)])
@ -430,4 +439,4 @@
(map (lambda (i) (format " and \"~a\"" i)) (map (lambda (i) (format " and \"~a\"" i))
(cdr string-finds))) (cdr string-finds)))
(list "."))])) (list "."))]))
#f)))) #f))))))