cldoc-cvs

cldoc-cvs@common-lisp.net

31 discussions

[cldoc-cvs] CVS update: public_html/documentation.html
by ihatchondo＠common-lisp.net 08 Jan '06

08 Jan '06

Update of /project/cldoc/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv24765 Modified Files: documentation.html Log Message: Link are supported. Date: Sun Jan 8 18:16:28 2006 Author: ihatchondo Index: public_html/documentation.html diff -u public_html/documentation.html:1.2 public_html/documentation.html:1.3 --- public_html/documentation.html:1.2 Sat Nov 19 20:04:11 2005 +++ public_html/documentation.html Sun Jan 8 18:16:26 2006 @@ -155,9 +155,11 @@ Recognizes code segments: by default each lines are prefixed with ';;; '. </li> + <li> + Recognizes links: for standard URL's and symbol referencing. + (see the :link-delimiters option of the <a href="HTMLdoc/string-parser.html">doctree class</a>). + </li> </ul> - should be added to the DWIM: - <ul><li>links. how ?</li></ul> Install

1 0

[cldoc-cvs] CVS update: cldoc/src/html.lisp cldoc/src/package.lisp
by ihatchondo＠common-lisp.net 08 Jan '06

08 Jan '06

Update of /project/cldoc/cvsroot/cldoc/src In directory common-lisp.net:/tmp/cvs-serv22814 Modified Files: html.lisp package.lisp Log Message: doc updated. Date: Sun Jan 8 17:49:17 2006 Author: ihatchondo Index: cldoc/src/html.lisp diff -u cldoc/src/html.lisp:1.9 cldoc/src/html.lisp:1.10 --- cldoc/src/html.lisp:1.9 Sun Jan 8 17:12:18 2006 +++ cldoc/src/html.lisp Sun Jan 8 17:49:16 2006 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CLUDG; -*- -;;; $Id: html.lisp,v 1.9 2006/01/08 16:12:18 ihatchondo Exp $ +;;; $Id: html.lisp,v 1.10 2006/01/08 16:49:16 ihatchondo Exp $ ;;; --------------------------------------------------------------------------- ;;; Title: Common Lisp Universal Documentation Generator: HTML driver ;;; Created: 2005 10 23 2:30 @@ -681,7 +681,7 @@ (values T (format nil "~{~a~^ ~}" strings)) (multiple-value-bind (name package) (split-name (second strings)) (let ((href (lookup-meta-descriptor-href - name (first strings) package file))) + (or name "") (first strings) package file))) (values (if href T NIL) href name)))))) (defun format-doc (symdesc html-driver strings) Index: cldoc/src/package.lisp diff -u cldoc/src/package.lisp:1.2 cldoc/src/package.lisp:1.3 --- cldoc/src/package.lisp:1.2 Thu Jan 5 15:47:11 2006 +++ cldoc/src/package.lisp Sun Jan 8 17:49:16 2006 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CLUDG; -*- -;;; $Id: package.lisp,v 1.2 2006/01/05 14:47:11 ihatchondo Exp $ +;;; $Id: package.lisp,v 1.3 2006/01/08 16:49:16 ihatchondo Exp $ ;;; --------------------------------------------------------------------------- ;;; Title: Common Lisp Universal Documentation Generator package definition ;;; Created: 2005 10 23 12:30 @@ -78,9 +78,21 @@ - Recognize both indent and empty-line paragraph breaks. - Recognizes bulleted lists (the list grammar can be specified). - Recognizes code segments: by default each lines are prefixed with ';;; '. - - should be added to the DWIM: - - links. how ? + - Recognizes links: two kinds of hyper link are possible both using the + same grammar: + [opening-char(defun|defclass|defgeneric|...) symbol-name closing-char] | + [opening-char(http://|ftp://)address closing-char]. + opening-char and closing char can be customized, see the :link-delimiters + option of {defclass cldoc:doctree} . + + ;;; (defun foo () + ;;; \"-- URL's: {http://common-lisp.net/cldoc} + ;;; -- Common Lisp symbols: {defgeneric cldoc:extract-documentation}\" + ;;; (values)) + + will produce: + -- URL's: {http://common-lisp.net/cldoc} + -- Common Lisp symbols: {defgeneric cldoc:extract-documentation} Unlike Albert, {http://albert.sourceforge.net} , it does not allow programmers to insert comments at the source code level which are

1 0

[cldoc-cvs] CVS update: cldoc/src/cludg.lisp cldoc/src/html.lisp
by ihatchondo＠common-lisp.net 08 Jan '06

08 Jan '06

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)))))

1 0

[cldoc-cvs] CVS update: cldoc/src/html.lisp
by ihatchondo＠common-lisp.net 05 Jan '06

05 Jan '06

Update of /project/cldoc/cvsroot/cldoc/src In directory common-lisp.net:/tmp/cvs-serv32466 Modified Files: html.lisp Log Message: Fix invalid (when) expression in resolve-link. Date: Thu Jan 5 16:08:06 2006 Author: ihatchondo Index: cldoc/src/html.lisp diff -u cldoc/src/html.lisp:1.7 cldoc/src/html.lisp:1.8 --- cldoc/src/html.lisp:1.7 Thu Jan 5 15:54:11 2006 +++ cldoc/src/html.lisp Thu Jan 5 16:08:06 2006 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CLUDG; -*- -;;; $Id: html.lisp,v 1.7 2006/01/05 14:54:11 ihatchondo Exp $ +;;; $Id: html.lisp,v 1.8 2006/01/05 15:08:06 ihatchondo Exp $ ;;; --------------------------------------------------------------------------- ;;; Title: Common Lisp Universal Documentation Generator: HTML driver ;;; Created: 2005 10 23 2:30 @@ -672,7 +672,7 @@ (multiple-value-bind (name package) (split-name (second strings)) (let ((href (lookup-meta-descriptor-href name (first strings) package file))) - (when (values T href name))))))) + (values (if href T NIL) href name)))))) (defun format-doc (symdesc html-driver strings) "Default documentation string formater. The Do What I Mean capabilities

1 0

[cldoc-cvs] CVS update: cldoc/src/html.lisp
by ihatchondo＠common-lisp.net 05 Jan '06

05 Jan '06

Update of /project/cldoc/cvsroot/cldoc/src In directory common-lisp.net:/tmp/cvs-serv31320 Modified Files: html.lisp Log Message: Typo fix Date: Thu Jan 5 15:54:11 2006 Author: ihatchondo Index: cldoc/src/html.lisp diff -u cldoc/src/html.lisp:1.6 cldoc/src/html.lisp:1.7 --- cldoc/src/html.lisp:1.6 Thu Jan 5 15:47:11 2006 +++ cldoc/src/html.lisp Thu Jan 5 15:54:11 2006 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CLUDG; -*- -;;; $Id: html.lisp,v 1.6 2006/01/05 14:47:11 ihatchondo Exp $ +;;; $Id: html.lisp,v 1.7 2006/01/05 14:54:11 ihatchondo Exp $ ;;; --------------------------------------------------------------------------- ;;; Title: Common Lisp Universal Documentation Generator: HTML driver ;;; Created: 2005 10 23 2:30 @@ -706,7 +706,7 @@ ;; it was initially found. (html-write "~a~{~a~^ ~}~a" left-link-delim - (reverse link)1 + (reverse link) right-link-delim))))) (t (with-tag ((tree-tag element) ()) (map-over-tree element))))))))

1 0

[cldoc-cvs] CVS update: cldoc/src/cludg.lisp cldoc/src/html.lisp cldoc/src/package.lisp
by ihatchondo＠common-lisp.net 05 Jan '06

05 Jan '06

Update of /project/cldoc/cvsroot/cldoc/src In directory common-lisp.net:/tmp/cvs-serv31239 Modified Files: cludg.lisp html.lisp package.lisp Log Message: Fix Cody Koeninger bug: NIL is an acceptable value for dest-dir arg in extract-documentation (html.lisp); and clean up. Date: Thu Jan 5 15:47:12 2006 Author: ihatchondo Index: cldoc/src/cludg.lisp diff -u cldoc/src/cludg.lisp:1.3 cldoc/src/cludg.lisp:1.4 --- cldoc/src/cludg.lisp:1.3 Thu Dec 15 01:55:27 2005 +++ cldoc/src/cludg.lisp Thu Jan 5 15:47:11 2006 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CLUDG; -*- -;;; $Id: cludg.lisp,v 1.3 2005/12/15 00:55:27 ihatchondo Exp $ +;;; $Id: cludg.lisp,v 1.4 2006/01/05 14:47:11 ihatchondo Exp $ ;;; --------------------------------------------------------------------------- ;;; Title: Common Lisp Universal Documentation Generator ;;; Created: 2005 10 23 12:30 @@ -867,12 +867,16 @@ (defmethod extract-documentation ((text (eql 'text)) dest-dir (system asdf:system) &rest rest) (let ((files (get-asdf-system-files system))) + (unless (getf rest :path-prefix) + (setf (getf rest :path-prefix) + (namestring (asdf:component-relative-pathname system)))) (apply #'extract-documentation text dest-dir files rest))) (defmethod extract-documentation ((text (eql 'text)) dest-dir files &rest rest) (declare (ignorable text)) - (unless (char= (char dest-dir (1- (length dest-dir))) #\/) - (setf dest-dir (concatenate 'string dest-dir "/"))) + (cond ((not (stringp dest-dir)) (setf dest-dir "./")) + ((char/= (char dest-dir (1- (length dest-dir))) #\/) + (setf dest-dir (concatenate 'string dest-dir "/")))) (ensure-directories-exist dest-dir) (let ((path-prefix (or (getf rest :path-prefix) Index: cldoc/src/html.lisp diff -u cldoc/src/html.lisp:1.5 cldoc/src/html.lisp:1.6 --- cldoc/src/html.lisp:1.5 Fri Dec 16 19:21:58 2005 +++ cldoc/src/html.lisp Thu Jan 5 15:47:11 2006 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CLUDG; -*- -;;; $Id: html.lisp,v 1.5 2005/12/16 18:21:58 ihatchondo Exp $ +;;; $Id: html.lisp,v 1.6 2006/01/05 14:47:11 ihatchondo Exp $ ;;; --------------------------------------------------------------------------- ;;; Title: Common Lisp Universal Documentation Generator: HTML driver ;;; Created: 2005 10 23 2:30 @@ -135,16 +135,11 @@ (defmethod extract-documentation ((driver (eql 'html)) dest-dir (system asdf:system) &rest initargs &key &allow-other-keys) - (declare (ignorable driver)) - (let ((pp (getf initargs :path-prefix))) - (remf initargs :path-prefix) - (let ((args (get-initargs initargs))) - (make-html-doc - (apply #'make-instance 'html :string-parser-initargs initargs args) - (get-asdf-system-files system) - :dest-dir dest-dir - :path-prefix (or pp (namestring - (asdf:component-relative-pathname system))))))) + (unless (getf initargs :path-prefix) + (setf (getf initargs :path-prefix) + (namestring (asdf:component-relative-pathname system)))) + (let ((files (get-asdf-system-files system))) + (apply #'extract-documentation driver dest-dir files initargs))) (defmethod extract-documentation ((driver (eql 'html)) dest-dir filenames &rest initargs &key &allow-other-keys) @@ -156,7 +151,7 @@ (apply #'make-instance 'html :string-parser-initargs initargs args) filenames :path-prefix (or pp (directory-namestring (or *load-truename* "."))) - :dest-dir dest-dir)))) + :dest-dir (or dest-dir "."))))) ;;; @@ -342,26 +337,25 @@ ((&key (divclass "defun") name arg-list type anchor) &body body) "Presents lisp forms according to our html documentation template." (with-gensym (hanchor args) - `(progn - (with-tag (:div ,(when divclass `(:class ,divclass))) - (with-tag (:div ,(when divclass `(:class "defunsignatures"))) - (let ((,hanchor ,anchor)) - (when ,hanchor (with-tag (:a (:id ,hanchor)) ""))) - (with-tag (:table (:cellpadding 0 :cellspacing 0 :width "100%")) - (with-tag (:colgroup (:span 3)) - (with-tag (:col (:width "0*"))) - (with-tag (:col (:width "1*"))) - (with-tag (:col (:width "0*")))) - (with-tag (:tbody ()) - (with-tag (:tr ()) - (with-tag (:td (:class "symbol-name")) - (html-write "~a  " ,name)) - (with-tag (:td (:class "lambda-list")) - (let ((,args ,arg-list)) - (when ,args (html-write "~a" ,args)))) - (with-tag (:td (:class "symbol-type")) - (html-write " [~@(~a~)]" ,type)))))) - ,@body)))) + `(with-tag (:div ,(when divclass `(:class ,divclass))) + (with-tag (:div ,(when divclass `(:class "defunsignatures"))) + (let ((,hanchor ,anchor)) + (when ,hanchor (with-tag (:a (:id ,hanchor)) ""))) + (with-tag (:table (:cellpadding 0 :cellspacing 0 :width "100%")) + (with-tag (:colgroup (:span 3)) + (with-tag (:col (:width "0*"))) + (with-tag (:col (:width "1*"))) + (with-tag (:col (:width "0*")))) + (with-tag (:tbody ()) + (with-tag (:tr ()) + (with-tag (:td (:class "symbol-name")) + (html-write "~a  " ,name)) + (with-tag (:td (:class "lambda-list")) + (let ((,args ,arg-list)) + (when ,args (html-write "~a" ,args)))) + (with-tag (:td (:class "symbol-type")) + (html-write " [~@(~a~)]" ,type)))))) + ,@body))) (defun make-footer () "Appends CLDOC link and generation date." @@ -411,26 +405,25 @@ (defmacro with-index-header ((index hdriver dest-dir title &key (head-title title)) &body body) - (with-gensym (ctype href f ttitle) + (with-gensym (href ttitle iindex ddir) `(with-slots (filter css-pathname charset) ,hdriver - (with-open-file (os ,index :direction :output :if-exists :supersede) - (let ((*print-case* :downcase) - (,ttitle ,title) - (,f (enough-namestring (truename ,index) (truename ,dest-dir))) - (,ctype (format nil "text/html; charset=~a" charset)) - (,href (namestring (make-pathname-relative - :from (truename ,dest-dir) - :to (truename css-pathname))))) + (let* ((*print-case* :downcase) + (,iindex ,index) + (,ddir ,dest-dir) + (,ttitle ,title) + (,href (make-pathname-relative + :from (truename ,ddir) :to (truename css-pathname)))) + (with-open-file (os ,iindex :direction :output :if-exists :supersede) (with-html-page - (os :csshref ,href - :content-type ,ctype + (os :csshref (namestring ,href) + :content-type (format nil "text/html; charset=~a" charset) :head-title ,head-title :nav-name ,ttitle - :index (toc-path-from (pathname os) ,dest-dir)) + :index (toc-path-from (pathname os) ,ddir)) (with-tag (:div (:class "cludg-index-body")) (when ,ttitle (with-tag (:h2 ()) (html-write "~a~%" ,ttitle))) - (with-tag (:div ()) ,@body))) - (format nil "~a" ,f)))))) + (with-tag (:div ()) ,@body)))) + (enough-namestring (truename ,iindex) (truename ,ddir)))))) (defun make-abc-index-entry (filename &key char-code non-alphabetic) (let* ((name (file-namestring filename)) @@ -672,49 +665,53 @@ This control string has no parameter.") (defun resolve-link (symdesc strings) - (let ((protocols '("http://" "ftp://")) + (let ((schemes '("http://" "ftp://")) (file (meta-descriptor-file (lookup-meta-descriptor symdesc)))) - (if (loop for p in protocols when (starts-with (car strings) p) - do (return T)) + (if (some #'(lambda (scheme) (starts-with (first strings) scheme)) schemes) (values T (format nil "~{~a~^ ~}" strings)) (multiple-value-bind (name package) (split-name (second strings)) (let ((href (lookup-meta-descriptor-href name (first strings) package file))) - (values T href name)))))) + (when (values T href name))))))) (defun format-doc (symdesc html-driver strings) "Default documentation string formater. The Do What I Mean capabilities are delegated to the create-doctree-from-string method of the doctree protocol in coordination with with-tree-loop iterator to produced the final output." - (labels ((map-over-tree (tree) - (with-tree-loop (element tree) - (if (stringp element) - (html-write "~a " element) - (case (tree-tag element) - (:keyword - (with-tag (:span (:class "keyword")) - (map-over-tree element))) - (:hyper-link - (let ((link '())) - (with-tree-loop (e element) (push e link)) - (multiple-value-bind (found-p href name) - (resolve-link symdesc (reverse link)) - (if (and found-p href) - (with-tag (:a (:href href)) - (html-write (or name href))) - ;; [FIXME] RETRIEVE THE LINK MARKERS !!! - ;; No link can be created from the given - ;; information. Maybe the author was not - ;; thinking to a an hyper link, for this - ;; reason the text will be outputed as - ;; as it was initially found. - (html-write "{~{~a~^ ~}}" (reverse link)))))) - (t (with-tag ((tree-tag element) ()) - (map-over-tree element)))))))) - (with-slots (string-parser-initargs) html-driver - (map-over-tree (apply #'create-doctree-from-string - 'doctree strings string-parser-initargs))))) + (with-slots ((spi string-parser-initargs)) html-driver + (let* ((link-delims (getf spi :link-delimiters +default-link-delimiters+)) + (left-link-delim (first link-delims)) + (right-link-delim (second link-delims))) + (labels ((map-over-tree (tree) + (with-tree-loop (element tree) + (if (stringp element) + (html-write "~a " element) + (case (tree-tag element) + (:keyword + (with-tag (:span (:class "keyword")) + (map-over-tree element))) + (:hyper-link + (let ((link '())) + (with-tree-loop (e element) (push e link)) + (multiple-value-bind (found-p href name) + (resolve-link symdesc (reverse link)) + (if (and found-p href) + (with-tag (:a (:href href)) + (html-write (or name href))) + ;; No link can be created from the given + ;; information. Maybe the author was not + ;; thinking to an hyper link, for this + ;; reason the text will be outputed as + ;; it was initially found. + (html-write "~a~{~a~^ ~}~a" + left-link-delim + (reverse link)1 + right-link-delim))))) + (t (with-tag ((tree-tag element) ()) + (map-over-tree element)))))))) + (map-over-tree + (apply #'create-doctree-from-string 'doctree strings spi)))))) (defun make-html-doc (hdriver filenames &key (dest-dir ".") path-prefix) "Reads all files specified in filenames and extract their documentation Index: cldoc/src/package.lisp diff -u cldoc/src/package.lisp:1.1.1.1 cldoc/src/package.lisp:1.2 --- cldoc/src/package.lisp:1.1.1.1 Fri Nov 18 15:52:18 2005 +++ cldoc/src/package.lisp Thu Jan 5 15:47:11 2006 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CLUDG; -*- -;;; $Id: package.lisp,v 1.1.1.1 2005/11/18 14:52:18 ihatchondo Exp $ +;;; $Id: package.lisp,v 1.2 2006/01/05 14:47:11 ihatchondo Exp $ ;;; --------------------------------------------------------------------------- ;;; Title: Common Lisp Universal Documentation Generator package definition ;;; Created: 2005 10 23 12:30 @@ -82,9 +82,9 @@ should be added to the DWIM: - links. how ? - Unlike Albert (http://albert.sourceforge.net/) it does not allow programmers - to insert comments at the source code level which are incorporated into the - generated documentation. + Unlike Albert, {http://albert.sourceforge.net} , it does not allow + programmers to insert comments at the source code level which are + incorporated into the generated documentation. Its goal was not to produce a LispDoc ala JavaDoc but to create a simple and easy way to take advantage of the Lisp documentation string. So instead of copying and pasting it in some commentary section with extra special

1 0

[cldoc-cvs] CVS update: cldoc/src/html.lisp
by ihatchondo＠common-lisp.net 16 Dec '05

16 Dec '05

Update of /project/cldoc/cvsroot/cldoc/src In directory common-lisp.net:/tmp/cvs-serv6723 Modified Files: html.lisp Log Message: Clean up Date: Fri Dec 16 19:21:58 2005 Author: ihatchondo Index: cldoc/src/html.lisp diff -u cldoc/src/html.lisp:1.4 cldoc/src/html.lisp:1.5 --- cldoc/src/html.lisp:1.4 Fri Dec 16 11:30:09 2005 +++ cldoc/src/html.lisp Fri Dec 16 19:21:58 2005 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CLUDG; -*- -;;; $Id: html.lisp,v 1.4 2005/12/16 10:30:09 ihatchondo Exp $ +;;; $Id: html.lisp,v 1.5 2005/12/16 18:21:58 ihatchondo Exp $ ;;; --------------------------------------------------------------------------- ;;; Title: Common Lisp Universal Documentation Generator: HTML driver ;;; Created: 2005 10 23 2:30 @@ -260,12 +260,17 @@ :to (mkout (car (elt list (1- index)))))))) (defun alphabetical-order (desc1 desc2) - "Returns true if the name of the first descriptor is inferior, in the - string-lessp sens." + "Returns true if the name of the first descriptor is lexicographicaly + inferior to the name of the second descriptor." (flet ((get-name (desc) (let ((name (name desc))) (if (starts-with name "(") (subseq name 1) name)))) - (string-lessp (get-name desc1) (get-name desc2)))) + (let ((name1 (get-name desc1)) + (name2 (get-name desc2))) + (if (alpha-char-p (char name1 0)) + (if (alpha-char-p (char name2 0)) (string-lessp name1 name2) T) + (unless (alpha-char-p (char name2 0)) + (string-lessp name1 name2)))))) ;;; ;;; Macros for HTML writing. @@ -295,8 +300,9 @@ `(let ((,os ,stream)) (format ,os "<~a~{~^ ~a=\"~a\"~}~:[~;/~]>~%" ,tagname (list ,@attributes) ,(zerop (length body))) - ,@body - ,@(unless (zerop (length body)) `((format ,os "</~a>~%" ,tagname)))))) + (prog1 (progn ,@body) + ,@(unless (zerop (length body)) + `((format ,os "</~a>~%" ,tagname))))))) (defmacro with-html-page ((os &key csshref content-type head-title nav-name index prev next) @@ -436,32 +442,26 @@ (defun make-index-entry (meta-descriptors &key char-code non-alphabetic filter) (flet ((char-code-string () (format nil "~:@(~c~)..." (code-char char-code))) - (get-first-char (name) + (first-char-p (name char) (let ((c (char name 0))) - (if (char= c #\() (char name 1) c))) - (make-entry (name desc href) - (unless (and filter (funcall filter desc)) - (with-tag (:div (:class "index-entry")) - (with-tag (:a (:href href)) - (html-write "~a," (purge-string-for-html name))) - (with-tag (:em ()) - (html-write "~a" (html-printable-type desc))))))) + (char-equal char (if (char= c #\() (char name 1) c))))) (with-tag (:a (:id (format nil "_~a" (or char-code non-alphabetic)))) "") (with-tag (:div (:class "abc-entry")) (with-tag (:h3 ()) (html-write (if char-code (char-code-string) "non-alphabetic"))) - (loop for mdesc in meta-descriptors + (loop with entry = (and char-code (code-char char-code)) + for mdesc in meta-descriptors for desc = (meta-descriptor-desc mdesc) - for name = (name desc) - for char1 = (get-first-char name) - if char-code - do (cond ((char-equal (code-char char-code) char1) - (make-entry name desc (meta-descriptor-href mdesc))) - ((char-greaterp char1 (code-char char-code)) - (loop-finish))) - else if non-alphabetic - do (when (or (char-lessp char1 #\A) (char-greaterp char1 #\z)) - (make-entry name desc (meta-descriptor-href mdesc))))))) + 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))) + (html-write "~a," (purge-string-for-html (name desc)))) + (with-tag (:em ()) + (html-write "~a" (html-printable-type desc))))) + (pop meta-descriptors) + else do (loop-finish) + finally (return meta-descriptors))))) (defun write-index (filename dest-dir title html-driver meta-descriptors) (let ((na-anchor (format nil "~a" (gensym))) @@ -478,7 +478,9 @@ (make-abc-index-entry index-file :non-alphabetic na-anchor) ;; the index itself (loop for i from (char-code #\a) to (char-code #\z) - do (make-index-entry meta-descriptors :char-code i :filter filter)) + do (setf meta-descriptors + (make-index-entry + meta-descriptors :char-code i :filter filter))) ;; add non-alphabetic (make-index-entry meta-descriptors @@ -759,7 +761,7 @@ do (with-slots (name type) desc (unless (and filter (funcall filter desc)) (dformat desc hdriver os)))))))))) - *unhandled-forms*)) + (remove-duplicates *unhandled-forms*))) ;;; ;;; Purger.

1 0

[cldoc-cvs] CVS update: cldoc/src/html.lisp
by ihatchondo＠common-lisp.net 16 Dec '05

16 Dec '05

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

1 0

[cldoc-cvs] CVS update: cldoc/src/html.lisp
by ihatchondo＠common-lisp.net 15 Dec '05

15 Dec '05

Update of /project/cldoc/cvsroot/cldoc/src In directory common-lisp.net:/tmp/cvs-serv15404 Modified Files: html.lisp Log Message: Fix invalid call to some lookup functions whan nothing to lookup for because NIL is not a desc. And fix argument lambda list format glitches due to format directive that can be present. Date: Fri Dec 16 00:16:17 2005 Author: ihatchondo Index: cldoc/src/html.lisp diff -u cldoc/src/html.lisp:1.2 cldoc/src/html.lisp:1.3 --- cldoc/src/html.lisp:1.2 Thu Dec 15 01:55:27 2005 +++ cldoc/src/html.lisp Fri Dec 16 00:16:15 2005 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CLUDG; -*- -;;; $Id: html.lisp,v 1.2 2005/12/15 00:55:27 ihatchondo Exp $ +;;; $Id: html.lisp,v 1.3 2005/12/15 23:16:15 ihatchondo Exp $ ;;; --------------------------------------------------------------------------- ;;; Title: Common Lisp Universal Documentation Generator: HTML driver ;;; Created: 2005 10 23 2:30 @@ -591,13 +591,14 @@ (html-write summary-title ))) (loop for desc in (desc-sort descs #'alphabetical-order) for mdesc = (lookup-meta-descriptor desc) + when mdesc do (with-tag (:tr (:class "table-row-color")) (with-tag (:td (:class "summary-name")) (with-tag (:a (:href (meta-descriptor-href mdesc :local))) (html-write (purge-string-for-html (name desc))))) (with-tag (:td (:class "summary")) (let ((string (funcall key desc))) - (when string (html-write string))))))))) + (when string (html-write "~a" string))))))))) (defun make-constant-summary (descs filter) "Creates a summary table for defconstant descriptors if any."

1 0

[cldoc-cvs] CVS update: public_html/index.html
by ihatchondo＠common-lisp.net 15 Dec '05

15 Dec '05

Update of /project/cldoc/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv9502 Modified Files: index.html Log Message: news Date: Thu Dec 15 02:07:59 2005 Author: ihatchondo Index: public_html/index.html diff -u public_html/index.html:1.2 public_html/index.html:1.3 --- public_html/index.html:1.2 Sat Nov 19 20:04:11 2005 +++ public_html/index.html Thu Dec 15 02:07:59 2005 @@ -78,6 +78,16 @@ <div id="contentLeft"> + NEWS: 2005-12-15 + + <ul> + <li>Hyper link support.</li> + <li>Sections support (like in the Hyperspec).</li> + <li>HTML Documentation updated.</li> + </ul> + + + Quick links @@ -93,13 +103,6 @@ class="menuItem">Lisp Lesser GPL</a> -  <div class="bottomCorner">

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

cldoc-cvs