;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE: lispdoc.lisp
;;;;LANGUAGE: Common-Lisp
;;;;SYSTEM: Common-Lisp
;;;;USER-INTERFACE: NONE
;;;;DESCRIPTION
;;;;
;;;; Generate HTML documentation of a set of CL packages.
;;;;
;;;; Originally:
;;;; Id: lispdoc.lisp,v 1.8 2004/01/13 14:03:41 sven Exp
;;;;AUTHORS
;;;; Sven Van Caekenberghe.
;;;; <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;; 2012-04-29 <PJB>
;;;;BUGS/TODO
;;;;
;;;; - improve class documentation (slots, accessors).
;;;;
;;;; - improve navigation menu (symbol lists, tree).
;;;;
;;;; - make it run on clisp, sbcl, etc.
;;;;
;;;; - deal with re-exported symbol, whose home is not one of the
;;;; documented packages.
;;;;
;;;; - make it merge documentations (tree, navigation), since some
;;;; packages can only be loaded in a specific implementation.
;;;;
;;;; - make links from symbols and packages to source files (eg. gitorious).
;;;;
;;;; - It would be nice to have a reST parser for the docstrings.
;;;; Check cl-docutils for its reST parser?
;;;; http://www.jarw.org.uk/lisp/cl-docutils.html
;;;;
;;;;LEGAL
;;;; LLGPL
;;;;
;;;; Copyright Pascal J. Bourguignon 2012 - 2016
;;;; Copyright (C) 2003 Sven Van Caekenberghe.
;;;;
;;;; This library is licenced under the Lisp Lesser General Public
;;;; License.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 2 of the License, or (at your option) any later
;;;; version.
;;;;
;;;; This library is distributed in the hope that it will be
;;;; useful, but WITHOUT ANY WARRANTY; without even the implied
;;;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;;; PURPOSE. See the GNU Lesser General Public License for more
;;;; details.
;;;;
;;;; You should have received a copy of the GNU Lesser General
;;;; Public License along with this library; if not, write to the
;;;; Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;; Boston, MA 02111-1307 USA
;;;;**************************************************************************
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf *readtable* (copy-readtable nil)))
(in-package "COM.INFORMATIMAGO.LISPDOC")
;;;----------------------------------------------------------------------
;;;
;;; documentation portability layer
;;;
(defun function-lambda-list (funame)
"
FUNAME: A function name.
RETURN: The function lambda list.
"
(let ((le (function-lambda-expression (if (consp funame)
(fdefinition funame)
(or (macro-function funame)
(symbol-function funame))))))
(if le
(second le)
(or
#+openmcl (ccl:arglist funame)
#+lispworks (lw:function-lambda-list funame)
'()))))
(defun class-precedence-list (class-name)
"
CLASS-NAME: A class name.
RETURN: The class precedence list.
"
(closer-mop:class-precedence-list (find-class class-name)))
(defun class-slot-initargs (class-name)
"
CLASS-NAME: A class name.
RETURN: The initargs of the class slots.
"
(let ((class (find-class class-name)))
(mapcan (lambda (slot) (copy-seq (closer-mop:slot-definition-initargs slot)))
(closer-mop:class-slots class))))
(defun has-meaning (symbol)
(or (boundp symbol)
(fboundp symbol)
(ignore-errors (fdefinition `(setf ,symbol)))
(ignore-errors (find-class symbol))))
;;;----------------------------------------------------------------------
;;;
;;; lispdoc
;;;
(defun lispdoc-symbol (symbol)
"
RETURN: A list of doc structures for the SYMBOL.
"
(let ((doc '()))
(when (documentation symbol 'variable)
(push (make-vardoc :kind (if (constantp symbol)
:constant
:variable)
:symbol symbol
:string (documentation symbol 'variable)
:initial-value (if (boundp symbol)
(symbol-value symbol)
:unbound))
doc))
(let ((spec `(setf ,symbol)))
(when (and (documentation spec 'function)
(fboundp spec))
(push (make-fundoc :kind (cond
((typep (fdefinition spec) 'standard-generic-function)
:generic-function)
(t
:function))
:symbol `(setf ,symbol)
:string (documentation spec 'function)
:lambda-list (function-lambda-list spec))
doc)))
(when (and (documentation symbol 'function)
(fboundp symbol))
(push (make-fundoc :kind (cond
((macro-function symbol)
:macro)
((typep (fdefinition symbol) 'standard-generic-function)
:generic-function)
(t
:function))
:symbol symbol
:string (documentation symbol 'function)
:lambda-list (function-lambda-list symbol))
doc))
(when (documentation symbol 'type)
(cond
((not (ignore-errors (find-class symbol)))
(push (make-doc :kind :type
:symbol symbol
:string (documentation symbol 'type))
doc))
((subtypep (find-class symbol) (find-class 'structure-object))
(push (make-classdoc :kind :structure
:symbol symbol
:string (documentation symbol 'type))
doc))
(t
(block :ignore
(push (make-classdoc :kind (cond
((subtypep (find-class symbol) (find-class 'condition))
:condition)
((subtypep (find-class symbol) (find-class 'standard-object))
:class)
(t (return-from :ignore)))
:symbol symbol
:string (documentation symbol 'type)
:precedence-list (mapcar (function class-name) (class-precedence-list symbol))
:initargs (class-slot-initargs symbol))
doc)))))
(unless doc
(push (make-doc :kind (if (has-meaning symbol)
:undocumented
:skip)
:symbol symbol)
doc))
doc))
(defun lispdoc-package (package)
"
RETURN: packdoc structure for the package.
"
(make-packdoc :kind :package
:symbol package
:string (or (documentation package t) :undocumented)
:nicknames (package-nicknames package)
:external-symbol-docs
(mapcan (function lispdoc-symbol)
(let ((symbols '()))
(do-external-symbols (x package) (push x symbols))
(sort symbols (function string-lessp))))))
(defun lispdoc (packages)
"Generate a lispdoc sexp documenting the exported symbols of each package"
(mapcar (lambda (package)
(lispdoc-package (if (packagep package)
package
(find-package package))))
packages))
;;;; THE END ;;;;