Commits

Paul Sexton  committed 81cb690

Added 'colophon' to end of output documentation -- contains brief information about CLOD.
Fixed lambda list documentation for functions/generics (whitespace was being misformatted).
New option to document-package: :internal-symbols?. Controls whether to document all symbols, or only external ones.

  • Participants
  • Parent commits cec10f0

Comments (0)

Files changed (3)

 
 (in-package :clod)
 
+(defparameter *clod-version-string* "1.0"
+  "String containing CLOD's version number.")
 (defvar *out* *standard-output*
   "Global variable that is bound to the output stream used by CLOD
 while writing documentation.")
 therefore described in a very brief format (bulleted list).
 
 If false, each method receives its own section, just like other functions.")
+(defvar *accessibilities* (list :external :internal)
+  "List of one or both of the keywords =:EXTERNAL= and =:INTERNAL=.
+Only symbols whose accessibility matches one of the keywords in the list
+will be documented.")
 (defvar *class-diagram* nil
   "If true, creates a section describing the package class hierarchy as a
 'dot' diagram, which can be fed to the GraphViz program (if installed) to
    tree))
 
 
+(defun find-pkg (pkg)
+  ;; find-package only seems to work if pkg is an UPPER CASE string
+  (find-package (string-upcase (string pkg))))
+
+
+(defun find-sym (sym &optional (pkg (package-name *package*)))
+  ;; find-symbol only seems to work if symbol and pkg are UPPER CASE strings
+  (find-symbol (string-upcase (string sym)) (string-upcase (string pkg))))
+
+
 (defun symbol-accessibility (sym &optional (pkg *package*))
   "* Arguments
 - SYM :: A symbol.
 the package =PKG=. If =SYM= is exported by =PKG= then the function
 returns =:external=, and so on."
   (unless (packagep pkg)
-    (setf pkg (find-package pkg)))
-  (multiple-value-bind (sym2 access) (find-symbol (string sym) pkg)
+    (setf pkg (find-pkg pkg)))
+  (multiple-value-bind (sym2 access) (find-sym (string sym) (package-name pkg))
     (declare (ignore sym2))
     access))
 
   "Parse the arglist-string of the function object FN."
   (let ((string (kernel:%function-arglist 
                  (kernel:%function-self fn)))
-        (package (find-package
+        (package (find-pkg
                   (c::compiled-debug-info-package
                    (kernel:%code-debug-info
                     (vm::find-code-object fn))))))
 Given a symbol =SYM=, return a list of entity values, describing the
 different meanings/bindings of =SYM= within its home package."
   (let ((uses nil))
-    (when (find-package sym)
+    (when (find-pkg sym)
       (push :package uses))
     (cond
       ((find-class sym nil)
       (setf docstr (subseq docstr 4)))
     ((string-starts-with? docstr (format nil "###~C~C" #\return #\newline))
       (setf docstr (subseq docstr 5)))
-    ((string-starts-with? docstr (format nil "###" #\return #\newline))
+    ((string-starts-with? docstr (format nil "###"))
       (setf docstr (subseq docstr 3))))
   (if (and (stringp docstr)
            (string-starts-with? docstr (format nil "~C " *heading-char*)))
   "Writes a section describing the lambda list of the function or macro SYM."
   (writing-section ("Syntax")
     (format *out* "~&#+BEGIN_SRC lisp~%")
-    (let* ((text (format
-                  nil "(~(~A~)~{ ~A~})~%"
-                  sym
-                  (mapcar (lambda (term)
-                            (if (ampersand-symbol? term)
-                                (string-downcase (string term))
-                                term))
-                          (function-lambda-list sym))))
-           (lines (word-wrap text :width *line-width*
-                             :respect-hyphens t)))
-      (dolist (line lines)
-        (write-out line)))
+    (let* ((text (format nil "~A" (cons sym (function-lambda-list sym)))))
+      (write-out "~(~A~)~%" text))
     (format *out* "#+END_SRC~%")))
 
 
 
+(defun write-colophon ()
+  (writing-section ("Colophon")
+    (write-out (str+ "This documentation was generated from "
+                     "Common Lisp source code using CLOD, version ~A.")
+               *clod-version-string*)
+    (write-out (str+ "The latest version of CLOD is available "
+                     "[[http://bitbucket.org/eeeickythump/clod/][here]]."))))
+
+
+
 ;;;; Document methods =========================================================
 
 
 
 
 
-(defun document-package-contents (pkg &optional (accessibilities
-                                                 (list :external :internal)))
+(defun document-package-contents (pkg &optional
+                                  (accessibilities *accessibilities*))
   "* Arguments
 - PKG :: A package name or package object.
 - ACCESSIBILITIES :: A list containing zero or more of the symbols
         (types nil)
         (classes nil))  ;; structures are actually classes too
     (unless (packagep pkg)
-      (setf pkg (find-package pkg)))
+      (setf pkg (find-pkg pkg)))
     (setf *ambiguities* (make-hash-table :test #'eql))
     (do-own-symbols (sym pkg)
       (setf access (symbol-accessibility sym pkg))
 
 (defun docpkg (&rest packages)
   (write-preamble)
-  (dolist (pkg (mapcar #'(lambda (p) (if (packagep p) p (find-package p)))
+  (dolist (pkg (mapcar #'(lambda (p) (if (packagep p) p (find-pkg p)))
                        packages))
     (writing-section-for-symbol (:package (read-from-string (package-name pkg)))
       (writing-bulleted-list
             (t
              (write-out "None.")))))
       (write-docstring-section "Description" (documentation pkg t))
-      (document-package-contents pkg))))
+      (document-package-contents pkg)))
+  (write-colophon))
+
 
 
 (defun document-packages (packages file/stream
                           &key (auto-links nil)
                           (lines-between-sections t)
                           (brief-methods t)
+                          (internal-symbols? t)
                           (class-diagram nil)
                           (style-sheet nil)
                           (title *document-title*)
   (let ((*auto-links* auto-links)
         (*lines-between-sections* lines-between-sections)
         (*brief-methods* brief-methods)
+        (*accessibilities* (if internal-symbols?
+                               (list :external :internal)
+                               (list :external)))
         (*class-diagram* class-diagram)
         (*document-style-sheet* style-sheet)
         (*document-title* title)
 (defun document-package (pkg file/stream &key (auto-links nil)
                           (lines-between-sections t)
                           (brief-methods t)
+                         (internal-symbols? t)
                          (class-diagram nil)
                          (style-sheet nil)
                          (title nil) (author *document-author*)
 - AUTO-LINKS :: Boolean.
 - LINES-BETWEEN-SECTIONS :: Boolean.
 - BRIEF-METHODS :: Boolean.
+- INTERNAL-SYMBOLS :: Boolean.
 - CLASS-DIAGRAM :: Boolean.
 - STYLE-SHEET :: A string.
 - TITLE :: A string.
   sections, just like functions and generic functions. Most people put
   'method' documentation in the docstrings of their generic functions, but
   if you set docstrings for individual methods then set this to nil.
+- If =INTERNAL-SYMBOLS?= is non-nil, document both internal and external
+  (exported) symbols. If nil, only document external symbols.
 - If =CLASS-DIAGRAM= is non-nil, create a section after the toplevel package
   description, containing a description of the package hierarchy
   in the form of a GraphViz 'dot' diagram (see http://www.graphviz.org/).
 * See also
 - [[document-packages]]"
   (unless (packagep pkg)
-    (setf pkg (find-package pkg)))
+    (setf pkg (find-pkg pkg)))
   (unless title
     (setf title (format nil "The ~A package"
                         (package-name pkg))))
                      :auto-links auto-links
                      :lines-between-sections lines-between-sections
                      :brief-methods brief-methods
+                     :internal-symbols? internal-symbols?
                      :class-diagram class-diagram
                      :style-sheet style-sheet
                      :title title :author author :email email))