[cldoc-cvs] CVS update: cldoc/src/html.lisp

[Iban Hatchondo]

Update of /project/cldoc/cvsroot/cldoc/src
In directory common-lisp.net:/tmp/cvs-serv1460

Modified Files:
	html.lisp 
Log Message:
Fix defpackage issue: if no defpackage form have been parsed, for any reason, re-arrenge parsed descripor by packages anyway. Otherwise table of content might be empty.
Date: Fri Dec 16 11:30:10 2005
Author: ihatchondo

Index: cldoc/src/html.lisp
diff -u cldoc/src/html.lisp:1.3 cldoc/src/html.lisp:1.4
--- cldoc/src/html.lisp:1.3	Fri Dec 16 00:16:15 2005
+++ cldoc/src/html.lisp	Fri Dec 16 11:30:09 2005
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CLUDG; -*-
-;;; $Id: html.lisp,v 1.3 2005/12/15 23:16:15 ihatchondo Exp $
+;;; $Id: html.lisp,v 1.4 2005/12/16 10:30:09 ihatchondo Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;     Title: Common Lisp Universal Documentation Generator: HTML driver
 ;;;   Created: 2005 10 23 2:30
@@ -466,6 +466,10 @@
 (defun write-index (filename dest-dir title html-driver meta-descriptors)
   (let ((na-anchor (format nil "~a" (gensym)))
 	(index-file (namestring (merge-pathnames filename dest-dir))))
+    ;; Remove defpackage-descriptor of the meta-descriptors if any.
+    (let ((desc (meta-descriptor-desc (car meta-descriptors))))
+      (when (typep desc 'defpackage-descriptor)
+        (setf meta-descriptors (cdr meta-descriptors))))
     (with-index-header (index-file html-driver dest-dir title)
       ;; generate a b c d ... links
       (loop for i from (char-code #\a) to (char-code #\z)
@@ -524,10 +528,16 @@
 	for desc = (meta-descriptor-desc meta-desc)
 	for add-p = (not (or (not filter) (funcall filter desc)))
 	for pname = (dpackage desc)
+        ;; Search the meta-desc package-name entry
 	if (and add-p (gethash pname package-table))
 	do (push meta-desc (gethash pname package-table))
+        ;; Else search the meta-desc (string-upcase package-name) entry
 	else if (and add-p (gethash (string-upcase pname) package-table))
-	do (push meta-desc (gethash (string-upcase pname) package-table))))  
+	do (push meta-desc (gethash (string-upcase pname) package-table))
+        ;; Else meta-desc package entry is not in the table. Lets create the
+        ;; entry and add the meta-desc if desc is not a defpackage-descriptor.
+        else if (and add-p (not (typep desc 'defpackage-descriptor)))
+        do (push meta-desc (gethash pname package-table))))
 
 (defun make-indexes (dest-dir html-driver)
   "Creates package index files, global index and table of contents."
@@ -550,9 +560,8 @@
       (get-descriptors-by-package html-driver meta-descriptors package-table)
       ;; Write a descriptors index file for each package.
       (loop for key being each hash-key in package-table using (hash-value mds)
-	    for meta-descs = (cdr (reverse mds))
 	    for file = (format nil "~a-index.html" key)
-	    for href = (write-index file dest-dir key html-driver meta-descs)
+	    for href = (write-index file dest-dir key html-driver (reverse mds))
 	    for files = (mapcar #'meta-descriptor-file
 			   (stable-sort mds #'< :key #'meta-descriptor-index))
 	    do (push