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

[Iban Hatchondo]

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

Modified Files:
	cludg.lisp html.lisp 
Log Message:
title attribute added in the general symbol index href. The title attribute will show the fully qualified name of the symbol and its lambda list when this symbol is 'lambda-descriptor' symbol.
Date: Sun Jan  8 17:12:18 2006
Author: ihatchondo

Index: cldoc/src/cludg.lisp
diff -u cldoc/src/cludg.lisp:1.4 cldoc/src/cludg.lisp:1.5
--- cldoc/src/cludg.lisp:1.4	Thu Jan  5 15:47:11 2006
+++ cldoc/src/cludg.lisp	Sun Jan  8 17:12:17 2006
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CLUDG; -*-
-;;; $Id: cludg.lisp,v 1.4 2006/01/05 14:47:11 ihatchondo Exp $
+;;; $Id: cludg.lisp,v 1.5 2006/01/08 16:12:17 ihatchondo Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;     Title: Common Lisp Universal Documentation Generator
 ;;;   Created: 2005 10 23 12:30
@@ -347,6 +347,16 @@
      :reader allocation-type))
   (:documentation "This descripor is made for describe the slots of 
     class, conditon and structure."))
+
+(defgeneric fully-qualified-name (symbol-descriptor)
+  (:documentation "Returns the string that represent the fully qualified
+   name of the given symbol-descriptor.")
+  (:method ((symdesc symbol-descriptor))
+    (with-slots ((pname package) name) symdesc
+      (multiple-value-bind (sym status)
+	  (find-symbol (standard-io-name name) (find-package-caseless pname))
+	(declare (ignore sym))
+	(format nil "~(~a~):~:[~;:~]~a" pname (eq status :internal) name)))))
 
 ;;;
 ;;; Common Lisp common descripor classes.


Index: cldoc/src/html.lisp
diff -u cldoc/src/html.lisp:1.8 cldoc/src/html.lisp:1.9
--- cldoc/src/html.lisp:1.8	Thu Jan  5 16:08:06 2006
+++ cldoc/src/html.lisp	Sun Jan  8 17:12:18 2006
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CLUDG; -*-
-;;; $Id: html.lisp,v 1.8 2006/01/05 15:08:06 ihatchondo Exp $
+;;; $Id: html.lisp,v 1.9 2006/01/08 16:12:18 ihatchondo Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;     Title: Common Lisp Universal Documentation Generator: HTML driver
 ;;;   Created: 2005 10 23 2:30
@@ -403,6 +403,15 @@
 ;;; HTML index creation facilities 
 ;;;
 
+(defgeneric href-title (symbol-descriptor)
+  (:documentation "Returns a string for the title attribute of an href.")
+  (:method ((symdesc symbol-descriptor))
+    (purge-string-for-html (fully-qualified-name symdesc)))
+  (:method ((symdesc lambda-descriptor))
+    (let ((name (purge-string-for-html (fully-qualified-name symdesc)))
+	  (ll (format nil "(~{~s~^ ~})" (lambda-list symdesc))))
+      (concatenate 'string name " " (purge-string-for-html ll)))))
+
 (defmacro with-index-header
     ((index hdriver dest-dir title &key (head-title title)) &body body)
   (with-gensym (href ttitle iindex ddir)
@@ -448,7 +457,8 @@
             if (or (and entry (first-char-p (name desc) entry)) non-alphabetic)
             do (unless (and filter (funcall filter desc))
                  (with-tag (:div (:class "index-entry"))
-                   (with-tag (:a (:href (meta-descriptor-href mdesc)))
+                   (with-tag (:a (:href (meta-descriptor-href mdesc)
+				  :title (href-title desc)))
                      (html-write "~a," (purge-string-for-html (name desc))))
                    (with-tag (:em ())
                      (html-write "~a" (html-printable-type desc)))))