writer-common.lisp

   1 ;;; -*- lisp; show-trailing-whitespace: t; indent-tabs: nil -*-
   2
   3 ;;;; Part of this software was originally written as docstrings.lisp in
   4 ;;;; SBCL, but is now part of the texinfo-docstrings project.  The file
   5 ;;;; docstrings.lisp was written by Rudi Schlatte <rudi@constantly.at>,
   6 ;;;; mangled by Nikodemus Siivola, turned into a stand-alone project by
   7 ;;;; Luis Oliveira.  SBCL is in the public domain and is provided with
   8 ;;;; absolutely no warranty.
   9
  10 ;;;; texinfo-docstrings is:
  11 ;;;;
  12 ;;;; Copyright (c) 2008 David Lichteblau:
  13 ;;;;
  14 ;;;; Permission is hereby granted, free of charge, to any person
  15 ;;;; obtaining a copy of this software and associated documentation
  16 ;;;; files (the "Software"), to deal in the Software without
  17 ;;;; restriction, including without limitation the rights to use, copy,
  18 ;;;; modify, merge, publish, distribute, sublicense, and/or sell copies
  19 ;;;; of the Software, and to permit persons to whom the Software is
  20 ;;;; furnished to do so, subject to the following conditions:
  21 ;;;;
  22 ;;;; The above copyright notice and this permission notice shall be
  23 ;;;; included in all copies or substantial portions of the Software.
  24 ;;;;
  25 ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  26 ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  27 ;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  28 ;;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
  29 ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
  30 ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  31 ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  32 ;;;; DEALINGS IN THE SOFTWARE.
  33
  34 ;;;; TODO
  35 ;;;; * Method documentation untested
  36 ;;;; * Method sorting, somehow
  37 ;;;; * Index for macros & constants?
  38 ;;;; * This is getting complicated enough that tests would be good
  39
  40 (in-package #:texinfo-docstrings)
  41
  42 (defvar *document-output*)
  43
  44 ;;;; utilities
  45
  46 (defun flatten (list)
  47   (cond ((null list)
  48          nil)
  49         ((consp (car list))
  50          (nconc (flatten (car list)) (flatten (cdr list))))
  51         ((null (cdr list))
  52          (cons (car list) nil))
  53         (t
  54          (cons (car list) (flatten (cdr list))))))
  55
  56 (defun flatten-to-string (list)
  57   (format nil "~{~A~^~%~}" (flatten list)))
  58
  59 (defun ensure-class-precedence-list (class)
  60   (unless (class-finalized-p class)
  61     (finalize-inheritance class))
  62   (class-precedence-list class))
  63
  64
  65 ;;;; document formats
  66
  67 (defclass document-format ()
  68   ((name :initarg :name :reader document-format-name)
  69    (pathname-type :initarg :pathname-type :reader document-format-pathname-type)))
  70
  71 (defmethod document-format-pathname-type ((format symbol))
  72   (document-format-pathname-type (find-document-format format)))
  73
  74 (defparameter *document-formats* (make-hash-table))
  75
  76 (defmacro define-document-format (name type)
  77   `(setf (gethash ,name *document-formats*)
  78          (make-instance 'document-format
  79                         :name ,name
  80                         :pathname-type ,type)))
  81
  82 (defvar *default-document-format* :html)
  83
  84 (defun find-document-format (format)
  85   (if (typep format 'document-format)
  86       format
  87       (or (gethash format *document-formats*)
  88           (error "Unknown document format: ~S" format))))
  89
  90 (defgeneric format-doc (stream doc format))
  91
  92 (defun document-package-pathname (package &key format)
  93   (make-pathname :name (string-downcase (package-name package))
  94                  :type (document-format-pathname-type
  95                         (or format *default-document-format*))))
  96
  97 (defmacro with-document-file ((stream pathname format package) &body body)
  98   (sb-int:once-only ((format format) (package package))
  99     `(with-open-file (,stream ,pathname
 100                               :direction :output
 101                               :if-does-not-exist :create
 102                               :if-exists :supersede)
 103        (format-document-start ,stream ,package ,format)
 104        ,@body
 105        (format-document-end ,stream ,package ,format))))
 106
 107 (defun document-package (package &key output-file (format *default-document-format*))
 108   "Create a file containing all available documentation for the
 109 exported symbols of `package' in Texinfo format. If `filename' is not
 110 supplied, a file \"<packagename>.texinfo\" is generated.
 111
 112 The definitions can be referenced using Texinfo statements like
 113 @ref{<doc-type>_<packagename>_<symbol-name>.texinfo}. Texinfo
 114 syntax-significant characters are escaped in symbol names, but if a
 115 docstring contains invalid Texinfo markup, you lose."
 116   (let ((real-package (find-package package)))
 117     (unless real-package
 118       (error "Unknown package: ~S" package))
 119     (let* ((real-format (find-document-format format))
 120            (real-output-file
 121             (if output-file
 122                 (pathname output-file)
 123                 (document-package-pathname package :format real-format)))
 124            (docs (sort (parse-docstrings:collect-documentation real-package)
 125                        #'parse-docstrings:documentation<)))
 126       (with-document-file (f real-output-file format real-package)
 127         (dolist (doc docs)
 128           (format-doc f doc format)))
 129       real-output-file)))