From 08b531825afad043ce96bc664b9833340da41eb9 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 30 Jan 2006 01:30:27 +0000 Subject: [PATCH] fixed bugs in manual search order code svn: r2032 --- collects/help/private/docpos.ss | 47 ++++++++++---------------------- collects/help/private/manuals.ss | 14 ++++++++-- collects/help/private/search.ss | 21 +++----------- 3 files changed, 29 insertions(+), 53 deletions(-) diff --git a/collects/help/private/docpos.ss b/collects/help/private/docpos.ss index 4765caf296..08dd273ecf 100644 --- a/collects/help/private/docpos.ss +++ b/collects/help/private/docpos.ss @@ -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))) diff --git a/collects/help/private/manuals.ss b/collects/help/private/manuals.ss index ce61e5c664..853db55ae1 100644 --- a/collects/help/private/manuals.ss +++ b/collects/help/private/manuals.ss @@ -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)]) diff --git a/collects/help/private/search.ss b/collects/help/private/search.ss index 6e1a95d1e3..61b5f841a9 100644 --- a/collects/help/private/search.ss +++ b/collects/help/private/search.ss @@ -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)