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

fixed bugs in manual search order code

Browse Source 
svn: r2032
This commit is contained in:
Robby Findler 2006-01-30 01:30:27 +00:00
parent 223604169a
commit 08b531825a
3 changed files with 29 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
collects/help/private/docpos.ss
View File

@ -4,10 +4,7 @@
(provide/contract
[standard-html-doc-position (path? . -> . number?)]
[user-defined-doc-position (path? . -> . (union false/c number?))]
[known-docs (listof (cons/c path? string?))]
[set-doc-position! (path? number? . -> . void?)]
[reset-doc-positions! (-> void?)])
[known-docs (listof (cons/c path? string?))])
;; Define an order on the standard docs.
(define (standard-html-doc-position d)
@ -19,22 +16,6 @@
(caddr line)
100)))))
(define user-doc-positions '())
(define (set-doc-position! manual weight)
(unless (assoc manual known-docs)
(error 'set-doc-position! "unknown manual ~s" manual))
(set! user-doc-positions
(cons (list manual weight)
(filter (lambda (x) (not (equal? (car x) manual)))
user-doc-positions))))
(define (reset-doc-positions!)
(set! user-doc-positions '()))
(define (user-defined-doc-position manual)
(let ([result (assoc manual user-doc-positions)])
(and result (cadr result))))
;; (listof (list string string number))
;; the first string is the collection name
@ -45,18 +26,7 @@
("mzscheme" "PLT MzScheme: Language Manual" -49)
("mred" "PLT MrEd: Graphical Toolbox Manual" -48)
("beginning" "Beginning Student Language" -19)
("beginning-abbr" "Beginning Student with List Abbreviations Language" -18)
("intermediate" "Intermediate Student Language" -17)
("intermediate-lambda" "Intermediate Student with Lambda Language" -16)
("advanced" "Advanced Student Language" -15)
("teachpack" "Teachpacks for How to Design Programs" -16)
("profj-beginner" "ProfessorJ Beginner Language" -10)
("profj-intermediate" "ProfessorJ Intermediate Language" -9)
("profj-advanced" "ProfessorJ Advanced Language" -8)
("tour" ,(format "A Brief Tour of DrScheme version ~a" (version)) 0)
("tour" "A Brief Tour of DrScheme" 0)
("drscheme" "PLT DrScheme: Programming Environment Manual" 1)
("srfi" "SRFI documents inside PLT" 3)
@ -77,6 +47,17 @@
("plot" "PLoT Manual" 62)
("t-y-scheme" "Teach Yourself Scheme in Fixnum Days" 100)
("tex2page" "TeX2page" 101)))
("tex2page" "TeX2page" 101)
("beginning" "Beginning Student Language" 200)
("beginning-abbr" "Beginning Student with List Abbreviations Language" 201)
("intermediate" "Intermediate Student Language" 202)
("intermediate-lambda" "Intermediate Student with Lambda Language" 203)
("advanced" "Advanced Student Language" 204)
("teachpack" "Teachpacks for How to Design Programs" 205)
("profj-beginner" "ProfessorJ Beginner Language" 210)
("profj-intermediate" "ProfessorJ Intermediate Language" 211)
("profj-advanced" "ProfessorJ Advanced Language" 212)))
(define known-docs (map (lambda (x) (cons (string->path (car x)) (cadr x))) docs-and-positions)))

14
collects/help/private/manuals.ss
View File

@ -164,10 +164,18 @@
uninstalled)))
;; find-doc-directories : -> (listof path)
;; constructs a list of directories where documentation may reside.
;; constructs a sorted list of directories where documentation may reside.
(define (find-doc-directories)
(append (find-info.ss-doc-directories)
(find-doc-directories-in-doc-collection)))
(let ([unsorted
(append (find-info.ss-doc-directories)
(find-doc-directories-in-doc-collection))])
(quicksort
unsorted
(λ (a b)
(let-values ([(_1 a-short _2) (split-path a)]
[(_3 b-short _4) (split-path b)])
(< (standard-html-doc-position a-short)
(standard-html-doc-position b-short)))))))
(define (find-info.ss-doc-directories)
(let ([dirs (find-relevant-directories '(html-docs) 'all-available)])

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

@ -1,6 +1,5 @@
(module search mzscheme
(require (lib "string-constant.ss" "string-constants")
"docpos.ss"
"colldocs.ss"
"path.ss"
"manuals.ss"
@ -34,9 +33,6 @@
(non-regexp (string? . -> . string?)))
(define (html-doc-position x)
(or (user-defined-doc-position x)
(standard-html-doc-position x)))
; These are set by reset-doc-lists:
; docs, doc-names and doc-kinds are parallel lists. doc-kinds
@ -49,22 +45,14 @@
(define doc-kinds null)
; doc-collection-date : (union #f number 'none)
(define doc-collection-date #f)
(define (reset-doc-lists)
; Locate standard HTML documentation
(define-values (std-docs std-doc-names)
(let* ([docs (find-doc-directories)]
[doc-names (map get-doc-name docs)])
; Order the standard docs:
(let ([ordered (quicksort
(map list docs doc-names)
(lambda (a b) ; html-doc-position expects collection name
(let-values ([(_1 a-short _2) (split-path (car a))]
[(_3 b-short _4) (split-path (car b))])
(< (html-doc-position a-short)
(html-doc-position b-short)))))])
(values (map car ordered) (map cadr ordered))))) ; here we want the std title
(values docs doc-names)))
; Check collections for doc.txt files:
(define-values (txt-docs txt-doc-names) (colldocs))
@ -300,8 +288,7 @@
(set! html-keywords (make-hash-table 'equal))
(set! html-indices (make-hash-table 'equal))
(set! text-keywords (make-hash-table 'equal))
(set! text-indices (make-hash-table 'equal))
(reset-doc-positions!))
(set! text-indices (make-hash-table 'equal)))
(define max-reached #f)