
(lambda ()
  (let* ([quicksort
	  (invoke-unit/sig
	   (compound-unit/sig
	    (import)
	    (link [F : (quicksort) ((require-library "functior.ss"))]
		  [I : () ((unit/sig () (import (quicksort)) quicksort) F)])
	    (export)))]
	 [docpos (car (require-library "docpos.ss" "help"))]
	 [known-docs (cdr (require-library "docpos.ss" "help"))]
	 [doc-collection-path (with-handlers ([void (lambda (x) #f)])
	      (collection-path "doc"))]
	 [docs (let loop ([l (if doc-collection-path
				 (directory-list doc-collection-path)
				 null)])
		 (cond
		  [(null? l) null]
		  [(file-exists? (build-path doc-collection-path (car l) "index.htm"))
		   (cons (car l) (loop (cdr l)))]
		  [else (loop (cdr l))]))]
	 [docs (quicksort docs (lambda (a b)
				 (let ([ap (docpos a)]
				       [bp (docpos b)])
				   (cond
				    [(= ap bp) (string<? a b)]
				    [else (< ap bp)]))))]
	 [doc-paths (map (lambda (doc) (build-path doc-collection-path doc)) docs)]
	 [names
	  (map
	   (lambda (d)
	     (with-input-from-file (build-path d "index.htm")
	       (lambda ()
		 (let loop ()
		   (let ([r (read-line)])
		     (cond
		      [(eof-object? r) "(Unknown title)"]
		      [(regexp-match "<[tT][iI][tT][lL][eE]>(.*)</[tT][iI][tT][lL][eE]>" r) => cadr]
		      [else (loop)]))))))
	   doc-paths)])
    (let-values ([(collections-doc-files collection-names)
		  ((require-library "colldocs.ss" "help") quicksort)])

      (apply
       string-append
       "<TITLE>Installed Manuals</TITLE>"
       "<H1>Installed Manuals</H1>"
       "<UL>"
       (append
	(map
	 (lambda (doc name)
	   (format "<LI> <A HREF=\"file:~a\">~a</A>"
		   (build-path doc "index.htm")
		   name))
	 doc-paths
	 names)
	(list "</UL><P><UL>")
	(map
	 (lambda (collection-doc-file name)
	   (format "<LI> <A HREF=\"file:~a\">~a collection</A>"
		   (apply build-path collection-doc-file)
		   name))
	 collections-doc-files
	 collection-names)
	(list "</UL>")
	(let ([uninstalled (let loop ([l known-docs])
			     (cond
			      [(null? l) null]
			      [(member (caar l) docs) (loop (cdr l))]
			      [else (cons (car l) (loop (cdr l)))]))])
	  (cond
            [(null? uninstalled)
             (list "")]
            [(not doc-collection-path)
             (message-box "Help Desk" "Please create a doc collection. You will not be able to install any manuals until you do.")
             (list "")]
            [else
             (list*
              "<H3>Uninstalled Manuals</H3>"
              "<UL>"
              (append
               (map
                (lambda (doc-pair)
                  (format "<LI> <A HREF=\"file:~a\">~a</A>~a"
                          (build-path doc-collection-path (car doc-pair) "index.htm")
                          (cdr doc-pair)
                          (if (file-exists? (build-path doc-collection-path (car doc-pair) "hdindex"))
                              " (index installed)"
                              "")))
                uninstalled)
               (list "</UL>")))])))))))
