Added the beginnings of a master index. Search for it to try it.

svn: r7250

collects/help/private/standard-urls.ss

@@ -8,7 +8,7 @@
            "internal-hp.ss"
            "get-help-url.ss")
   
-  (provide home-page-url)
+  (provide home-page-url host+dirs)
   
   (define (search-type? x)
     (member x '("keyword" "keyword-index" "keyword-index-text")))

collects/help/servlets/home.ss

@@ -175,7 +175,11 @@
   ;; static subpages
   ;;  - In ALPHABETICAL order
   (define easy-pages
-    `(("acknowledge" "Acknowledgements"
+    `(("about-the-master-index" "About the Master Index"
+       ((p "The master index is a list of all keywords present in the html documentation.")
+        (p (a ([href ,url-helpdesk-master-index]) "The Master Index"))))
+      ;;
+      ("acknowledge" "Acknowledgements"
        ((p ,(get-general-acks))
         (p ,(get-translating-acks))))
       ;;
@@ -187,8 +191,7 @@
          "MzScheme, or MrEd.  MysterX is available from ")
         (pre
          nbsp nbsp
-         (a ((href "http://www.plt-scheme.org/software/mysterx/")
+         (a ([href "http://www.plt-scheme.org/software/mysterx/"])
-             (target "_top"))
             "http://www.plt-scheme.org/software/mysterx/"))
         (p ,(collection-doc-link "mysterx" "The MysterX collection"))))
       ;;

collects/help/servlets/master-index.ss

@@ -0,0 +1,101 @@
+(module master-index mzscheme
+  (require (lib "servlet.ss" "web-server")
+           (lib "xml.ss" "xml")
+           (lib "match.ss")
+           (lib "dirs.ss" "setup")
+           (lib "list.ss")
+           (lib "match.ss")
+           "../private/options.ss"
+           "private/url.ss"
+           "../private/standard-urls.ss"
+           "private/html.ss")
+  
+  (provide interface-version timeout start)
+  (define interface-version 'v1)
+  (define timeout +inf.0)
+  
+  (define (start request)
+    (with-errors-to-browser 
+        send/finish
+      (lambda ()
+        (html-page 
+         #:title "Master Index"
+         #:top (case (helpdesk-platform)
+                 [(internal-browser) '()]
+                 [(internal-browser-simple) '()]
+                 [else               (html-top request)])
+         #:body (html-master-index)))))
+  
+  
+  (define-struct entry (keyword host manual file label title) (make-inspector))
+  (define entries (make-hash-table 'equal))
+  
+  ;;;
+  ;;; HTML
+  ;;;
+  
+  (define (html-entry the-entry)
+    (match the-entry
+      [($ entry keyword host manual file label title)
+       `(div 'nbsp 'nbsp 'nbsp 'nbsp
+             (a ([href ,(file-path->url host manual file label)])
+                ,title))]))
+  
+  (define (html-keyword keyword)
+    `(div (b ,keyword)
+          ,@(map html-entry (hash-table-get entries keyword))))
+  
+  (define (html-master-index)
+    (let ([keywords (sort (hash-table-map entries (lambda (key val) key)) string<?)])
+      `(div (h1 "Master Index")
+            (p "This master index contains (for now) all keywords from the tex2page based manuals.")
+            ,@(map html-keyword keywords))))
+  
+  (define (file-path->url host manual file label)
+    (string-append (url-static host manual file)
+                   (if label (format "#~a" label) "")))
+  
+  ;;;
+  ;;; ENTRIES
+  ;;;
+  
+  (define (add-entry! entry)
+    (let* ([keyword (entry-keyword entry)]
+           [old     (hash-table-get entries keyword (lambda () '()))])
+      (hash-table-put! entries (entry-keyword entry) (cons entry old))))
+  
+  (define (keyword->entry host manual keyword-list)
+    (match keyword-list
+      [(keyword result-display html-file html-label title)
+       (make-entry keyword host manual html-file html-label title)]
+      [_
+       (error 'keyword->list 
+              "Expected a four element list: (<keyword> <result-to-display> <html-file> <html-label> <title>), got: "
+              keyword-list)]))
+  
+  ;;;
+  ;;; TRAVERSAL
+  ;;;
+  
+  (define (add-keywords-in-directory! host manual dir)
+    (when (directory-exists? dir)
+      (let ([keywords-path (build-path dir "keywords")]) 
+        (when (file-exists? keywords-path)
+          (with-input-from-file keywords-path
+            (lambda ()
+              (let ([keyword-entries (read)])
+                (for-each (lambda (k) (add-entry! (keyword->entry host manual k)))
+                          keyword-entries))))))))
+  
+  (define (add-keywords-in-sub-directories! host+dir)
+    (match host+dir
+      [(host . dir)
+       (when (directory-exists? dir)
+         (for-each (lambda (manual)
+                     (add-keywords-in-directory! host manual
+                                                 (build-path dir manual)))
+                   (directory-list dir)))]))
+  
+  (for-each add-keywords-in-sub-directories!
+            host+dirs)
+  )

collects/help/servlets/private/url.ss

@@ -6,8 +6,10 @@
   (define url-helpdesk-root
     (format "http://~a:~a/servlets/" internal-host (internal-port)))
 
-  (define url-helpdesk-home    (string-append url-helpdesk-root "home.ss"))
+  (define url-helpdesk-home         (string-append url-helpdesk-root "home.ss"))
-  (define url-helpdesk-results (string-append url-helpdesk-root "results.ss"))
+  (define url-helpdesk-results      (string-append url-helpdesk-root "results.ss"))
+  (define url-helpdesk-master-index (string-append url-helpdesk-root "master-index.ss"))
+
 
   (define (url-home-subpage subpage-str)
     (string-append url-helpdesk-home "?subpage=" subpage-str))