fixed bugs in manual search order code

svn: r2032

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?))])
-   [known-docs (listof (cons/c path? string?))]
-   [set-doc-position! (path? number? . -> . void?)]
-   [reset-doc-positions! (-> void?)])
   
   ;; 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)
+      ("tour" "A Brief Tour of DrScheme" 0)
-      ("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)
       ("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)))

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)
+    (let ([unsorted
-            (find-doc-directories-in-doc-collection)))
+           (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)])

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
@@ -55,15 +51,7 @@
     (define-values (std-docs std-doc-names)
       (let* ([docs (find-doc-directories)]
              [doc-names (map get-doc-name docs)])
-        ; Order the standard docs:
+        (values docs doc-names)))
-        (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
   
     ; 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))
+    (set! text-indices (make-hash-table 'equal)))
-    (reset-doc-positions!))
 
   (define max-reached #f)