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