writer-common.lisp

   1 ;;; -*- lisp -*-
   2
   3 ;;;; A docstring extractor for the sbcl manual.  Creates
   4 ;;;; @include-ready documentation from the docstrings of exported
   5 ;;;; symbols of specified packages.
   6
   7 ;;;; This software was originally part of the SBCL software system.
   8 ;;;; SBCL is in the public domain and is provided with absolutely no warranty.
   9 ;;;; See the COPYING file for more information.
  10 ;;;;
  11 ;;;; Written by Rudi Schlatte <rudi@constantly.at>, mangled
  12 ;;;; by Nikodemus Siivola, Luis Oliveira, David Lichteblau, and others.
  13
  14 ;;;; TODO
  15 ;;;; * Method documentation untested
  16 ;;;; * Method sorting, somehow
  17 ;;;; * Index for macros & constants?
  18 ;;;; * This is getting complicated enough that tests would be good
  19
  20 (in-package #:texinfo-docstrings)
  21
  22 (defvar *document-output*)
  23
  24 ;;;; utilities
  25
  26 (defun flatten (list)
  27   (cond ((null list)
  28          nil)
  29         ((consp (car list))
  30          (nconc (flatten (car list)) (flatten (cdr list))))
  31         ((null (cdr list))
  32          (cons (car list) nil))
  33         (t
  34          (cons (car list) (flatten (cdr list))))))
  35
  36 (defun flatten-to-string (list)
  37   (format nil "~{~A~^~%~}" (flatten list)))
  38
  39 (defun ensure-class-precedence-list (class)
  40   (unless (class-finalized-p class)
  41     (finalize-inheritance class))
  42   (class-precedence-list class))
  43
  44
  45 ;;;; document formats
  46
  47 (defclass document-format ()
  48   ((name :initarg :name :reader document-format-name)
  49    (pathname-type :initarg :pathname-type :reader document-format-pathname-type)))
  50
  51 (defmethod document-format-pathname-type ((format symbol))
  52   (document-format-pathname-type (find-document-format format)))
  53
  54 (defparameter *document-formats* (make-hash-table))
  55
  56 (defmacro define-document-format (name type)
  57   `(setf (gethash ,name *document-formats*)
  58          (make-instance 'document-format
  59                         :name ,name
  60                         :pathname-type ,type)))
  61
  62 (defvar *default-document-format* :html)
  63
  64 (defun find-document-format (format)
  65   (if (typep format 'document-format)
  66       format
  67       (or (gethash format *document-formats*)
  68           (error "Unknown document format: ~S" format))))
  69
  70 (defgeneric format-doc (stream doc format))
  71
  72 (defun document-package-pathname (package &key format)
  73   (make-pathname :name (string-downcase (package-name package))
  74                  :type (document-format-pathname-type
  75                         (or format *default-document-format*))))
  76
  77 (defmacro with-document-file ((stream pathname format package) &body body)
  78   (sb-int:once-only ((format format) (package package))
  79     `(with-open-file (,stream ,pathname
  80                               :direction :output
  81                               :if-does-not-exist :create
  82                               :if-exists :supersede)
  83        (format-document-start ,stream ,package ,format)
  84        ,@body
  85        (format-document-end ,stream ,package ,format))))
  86
  87 (defun document-package (package &key output-file (format *default-document-format*))
  88   "Create a file containing all available documentation for the
  89 exported symbols of `package' in Texinfo format. If `filename' is not
  90 supplied, a file \"<packagename>.texinfo\" is generated.
  91
  92 The definitions can be referenced using Texinfo statements like
  93 @ref{<doc-type>_<packagename>_<symbol-name>.texinfo}. Texinfo
  94 syntax-significant characters are escaped in symbol names, but if a
  95 docstring contains invalid Texinfo markup, you lose."
  96   (let ((real-package (find-package package)))
  97     (unless real-package
  98       (error "Unknown package: ~S" package))
  99     (let* ((real-format (find-document-format format))
 100            (real-output-file
 101             (if output-file
 102                 (pathname output-file)
 103                 (document-package-pathname package :format real-format)))
 104            (docs (sort (parse-docstrings:collect-documentation real-package)
 105                        #'parse-docstrings:documentation<)))
 106       (with-document-file (f real-output-file format real-package)
 107         (dolist (doc docs)
 108           (format-doc f doc format)))
 109       real-output-file)))