3 ;;;; A docstring extractor for the sbcl manual. Creates
4 ;;;; @include-ready documentation from the docstrings of exported
5 ;;;; symbols of specified packages.
7 ;;;; This software is part of the SBCL software system. SBCL is in the
8 ;;;; public domain and is provided with absolutely no warranty. See
9 ;;;; the COPYING file for more information.
11 ;;;; Written by Rudi Schlatte <rudi@constantly.at>, mangled
12 ;;;; by Nikodemus Siivola.
17 ;;;; * Method documentation untested
18 ;;;; * Method sorting, somehow
19 ;;;; * Index for macros & constants?
20 ;;;; * This is getting complicated enough that tests would be good
21 ;;;; * Nesting (currently only nested itemizations work)
22 ;;;; * doc -> internal form -> texinfo (so that non-texinfo format are also
23 ;;;; easily generated)
25 ;;;; FIXME: The description below is no longer complete. This
26 ;;;; should possibly be turned into a contrib with proper documentation.
28 ;;;; Formatting heuristics (tweaked to format SAVE-LISP-AND-DIE sanely):
30 ;;;; Formats SYMBOL as @code{symbol}, or @var{symbol} if symbol is in
31 ;;;; the argument list of the defun / defmacro.
33 ;;;; Lines starting with * or - that are followed by intented lines
34 ;;;; are marked up with @itemize.
36 ;;;; Lines containing only a SYMBOL that are followed by indented
37 ;;;; lines are marked up as @table @code, with the SYMBOL as the item.
39 (eval-when (:compile-toplevel :load-toplevel :execute)
40 (require 'sb-introspect))
42 (defpackage :sb-texinfo
44 (:shadow #:documentation)
45 (:export #:generate-includes #:document-package)
47 "Tools to generate TexInfo documentation from docstrings."))
49 (in-package :sb-texinfo)
51 ;;;; various specials and parameters
53 (defvar *texinfo-output*)
54 (defvar *texinfo-variables*)
55 (defvar *documentation-package*)
57 (defparameter *undocumented-packages* '(sb-pcl sb-int sb-kernel sb-sys sb-c))
59 (defparameter *documentation-types*
64 ;;structure ; also handled by `type'
67 "A list of symbols accepted as second argument of `documentation'")
69 (defparameter *character-replacements*
70 '((#\* . "star") (#\/ . "slash") (#\+ . "plus"))
71 "Characters and their replacement names that `alphanumize' uses. If
72 the replacements contain any of the chars they're supposed to replace,
73 you deserve to lose.")
75 (defparameter *characters-to-drop* '(#\\ #\` #\')
76 "Characters that should be removed by `alphanumize'.")
78 (defparameter *texinfo-escaped-chars* "@{}"
79 "Characters that must be escaped with #\@ for Texinfo.")
81 (defparameter *itemize-start-characters* '(#\* #\-)
82 "Characters that might start an itemization in docstrings when
83 at the start of a line.")
85 (defparameter *symbol-characters* "ABCDEFGHIJKLMNOPQRSTUVWXYZ*:-+"
86 "List of characters that make up symbols in a docstring.")
88 (defparameter *symbol-delimiters* " ,.!?;")
90 (defparameter *ordered-documentation-kinds*
91 '(package type structure condition class macro))
99 (nconc (flatten (car list)) (flatten (cdr list))))
101 (cons (car list) nil))
103 (cons (car list) (flatten (cdr list))))))
105 (defun setf-name-p (name)
107 (and (listp name) (= 2 (length name)) (eq (car name) 'setf))))
109 (defgeneric specializer-name (specializer))
111 (defmethod specializer-name ((specializer eql-specializer))
112 (list 'eql (eql-specializer-object specializer)))
114 (defmethod specializer-name ((specializer class))
115 (class-name specializer))
117 (defun specialized-lambda-list (method)
118 ;; courtecy of AMOP p. 61
119 (let* ((specializers (method-specializers method))
120 (lambda-list (method-lambda-list method))
121 (n-required (length specializers)))
122 (append (mapcar (lambda (arg specializer)
123 (if (eq specializer (find-class 't))
125 `(,arg ,(specializer-name specializer))))
126 (subseq lambda-list 0 n-required)
128 (subseq lambda-list n-required))))
130 (defun string-lines (string)
131 "Lines in STRING as a vector."
132 (coerce (with-input-from-string (s string)
133 (loop for line = (read-line s nil nil)
134 while line collect line))
137 (defun indentation (line)
138 "Position of first non-SPACE character in LINE."
139 (position-if-not (lambda (c) (char= c #\Space)) line))
141 (defun docstring (x doc-type)
142 (cl:documentation x doc-type))
144 (defun flatten-to-string (list)
145 (format nil "~{~A~^-~}" (flatten list)))
147 (defun alphanumize (original)
148 "Construct a string without characters like *`' that will f-star-ck
149 up filename handling. See `*character-replacements*' and
150 `*characters-to-drop*' for customization."
151 (let ((name (remove-if (lambda (x) (member x *characters-to-drop*))
153 (flatten-to-string original)
155 (chars-to-replace (mapcar #'car *character-replacements*)))
156 (flet ((replacement-delimiter (index)
157 (cond ((or (< index 0) (>= index (length name))) "")
158 ((alphanumericp (char name index)) "-")
160 (loop for index = (position-if #'(lambda (x) (member x chars-to-replace))
163 do (setf name (concatenate 'string (subseq name 0 index)
164 (replacement-delimiter (1- index))
165 (cdr (assoc (aref name index)
166 *character-replacements*))
167 (replacement-delimiter (1+ index))
168 (subseq name (1+ index))))))
171 ;;;; generating various names
173 (defgeneric name (thing)
174 (:documentation "Name for a documented thing. Names are either
175 symbols or lists of symbols."))
177 (defmethod name ((symbol symbol))
180 (defmethod name ((cons cons))
183 (defmethod name ((package package))
184 (package-name package))
186 (defmethod name ((method method))
188 (generic-function-name (method-generic-function method))
189 (method-qualifiers method)
190 (specialized-lambda-list method)))
192 ;;; Node names for DOCUMENTATION instances
194 (defgeneric name-using-kind/name (kind name doc))
196 (defmethod name-using-kind/name (kind (name string) doc)
197 (declare (ignore kind doc))
200 (defmethod name-using-kind/name (kind (name symbol) doc)
201 (declare (ignore kind))
202 (format nil "~A:~A" (package-name (get-package doc)) name))
204 (defmethod name-using-kind/name (kind (name list) doc)
205 (declare (ignore kind))
206 (assert (setf-name-p name))
207 (format nil "(setf ~A:~A)" (package-name (get-package doc)) (second name)))
209 (defmethod name-using-kind/name ((kind (eql 'method)) name doc)
210 (format nil "~A~{ ~A~} ~A"
211 (name-using-kind/name nil (first name) doc)
215 (defun node-name (doc)
216 "Returns TexInfo node name as a string for a DOCUMENTATION instance."
217 (let ((kind (get-kind doc)))
218 (format nil "~:(~A~) ~(~A~)" kind (name-using-kind/name kind (get-name doc) doc))))
220 ;;; Definition titles for DOCUMENTATION instances
222 (defgeneric title-using-kind/name (kind name doc))
224 (defmethod title-using-kind/name (kind (name string) doc)
225 (declare (ignore kind doc))
228 (defmethod title-using-kind/name (kind (name symbol) doc)
229 (declare (ignore kind))
230 (format nil "~A:~A" (package-name (get-package doc)) name))
232 (defmethod title-using-kind/name (kind (name list) doc)
233 (declare (ignore kind))
234 (assert (setf-name-p name))
235 (format nil "(setf ~A:~A)" (package-name (get-package doc)) (second name)))
237 (defmethod title-using-kind/name ((kind (eql 'method)) name doc)
238 (format nil "~{~A ~}~A"
240 (title-using-kind/name nil (first name) doc)))
242 (defun title-name (doc)
243 "Returns a string to be used as name of the definition."
244 (string-downcase (title-using-kind/name (get-kind doc) (get-name doc) doc)))
246 (defun include-pathname (doc)
247 (let* ((kind (get-kind doc))
248 (name (nstring-downcase
249 (if (eq 'package kind)
250 (format nil "package-~A" (alphanumize (get-name doc)))
251 (format nil "~A-~A-~A"
253 ((function generic-function) "fun")
256 (otherwise (symbol-name (get-kind doc))))
257 (alphanumize (package-name (get-package doc)))
258 (alphanumize (get-name doc)))))))
259 (make-pathname :name name :type "texinfo")))
261 ;;;; documentation class and related methods
263 (defclass documentation ()
264 ((name :initarg :name :reader get-name)
265 (kind :initarg :kind :reader get-kind)
266 (string :initarg :string :reader get-string)
267 (children :initarg :children :initform nil :reader get-children)
268 (package :initform *documentation-package* :reader get-package)))
270 (defgeneric make-documentation (x doc-type string))
272 (defmethod make-documentation ((x package) doc-type string)
273 (declare (ignore doc-type))
274 (make-instance 'documentation
279 (defmethod make-documentation (x (doc-type (eql 'function)) string)
280 (declare (ignore doc-type))
281 (let* ((fdef (and (fboundp x) (fdefinition x)))
283 (kind (cond ((and (symbolp x) (special-operator-p x))
285 ((and (symbolp x) (macro-function x))
287 ((typep fdef 'generic-function)
288 (assert (or (symbolp name) (setf-name-p name)))
291 (assert (or (symbolp name) (setf-name-p name)))
293 (children (when (eq kind 'generic-function)
294 (collect-gf-documentation fdef))))
295 (make-instance 'documentation
299 :children children)))
301 (defmethod make-documentation ((x method) doc-type string)
302 (declare (ignore doc-type))
303 (make-instance 'documentation
308 (defmethod make-documentation (x (doc-type (eql 'type)) string)
309 (make-instance 'documentation
312 :kind (etypecase (find-class x nil)
313 (structure-class 'structure)
314 (standard-class 'class)
315 (sb-pcl::condition-class 'condition)
316 ((or built-in-class null) 'type))))
318 (defmethod make-documentation (x (doc-type (eql 'variable)) string)
319 (make-instance 'documentation
322 :kind (if (constantp x)
326 (defmethod make-documentation (x (doc-type (eql 'setf)) string)
327 (declare (ignore doc-type))
328 (make-instance 'documentation
333 (defmethod make-documentation (x doc-type string)
334 (make-instance 'documentation
339 (defun maybe-documentation (x doc-type)
340 "Returns a DOCUMENTATION instance for X and DOC-TYPE, or NIL if
341 there is no corresponding docstring."
342 (let ((docstring (docstring x doc-type)))
344 (make-documentation x doc-type docstring))))
346 (defun lambda-list (doc)
348 ((package constant variable type structure class condition)
351 (third (get-name doc)))
354 (when (symbolp (get-name doc))
355 (mapcar (lambda (arg)
357 (if (consp x) (clean (car x)) x)))
359 (sb-introspect:function-arglist (get-name doc)))))))
361 (defun documentation< (x y)
362 (let ((p1 (position (get-kind x) *ordered-documentation-kinds*))
363 (p2 (position (get-kind y) *ordered-documentation-kinds*)))
364 (if (or (not (and p1 p2)) (= p1 p2))
365 (string< (string (get-name x)) (string (get-name y)))
368 ;;;; turning text into texinfo
370 (defun escape-for-texinfo (string &optional downcasep)
371 "Return STRING with characters in *TEXINFO-ESCAPED-CHARS* escaped
372 with #\@. Optionally downcase the result."
373 (let ((result (with-output-to-string (s)
374 (loop for char across string
375 when (find char *texinfo-escaped-chars*)
376 do (write-char #\@ s)
377 do (write-char char s)))))
378 (if downcasep (nstring-downcase result) result)))
380 (defun empty-p (line-number lines)
381 (and (< -1 line-number (length lines))
382 (not (indentation (svref lines line-number)))))
386 (defun locate-symbols (line)
387 "Return a list of index pairs of symbol-like parts of LINE."
388 ;; This would be a good application for a regex ...
394 ;; symbol at end of line
395 (when (and begin (or (> i (1+ begin))
396 (not (member (char line begin) '(#\A #\I)))))
397 (push (list begin i) result))
400 ((and begin (find (char line i) *symbol-delimiters*))
401 ;; symbol end; remember it if it's not "A" or "I"
402 (when (or (> i (1+ begin)) (not (member (char line begin) '(#\A #\I))))
403 (push (list begin i) result))
406 ((and begin (not (find (char line i) *symbol-characters*)))
407 ;; Not a symbol: abort
409 ((and maybe-begin (not begin) (find (char line i) *symbol-characters*))
410 ;; potential symbol begin at this position
413 ((find (char line i) *symbol-delimiters*)
414 ;; potential symbol begin after this position
415 (setf maybe-begin t))
417 ;; Not reading a symbol, not at potential start of symbol
418 (setf maybe-begin nil)))))
420 (defun texinfo-line (line)
421 "Format symbols in LINE texinfo-style: either as code or as
422 variables if the symbol in question is contained in symbols
423 *TEXINFO-VARIABLES*."
424 (with-output-to-string (result)
426 (dolist (symbol/index (locate-symbols line))
427 (write-string (subseq line last (first symbol/index)) result)
428 (let ((symbol-name (apply #'subseq line symbol/index)))
429 (format result (if (member symbol-name *texinfo-variables*
433 (string-downcase symbol-name)))
434 (setf last (second symbol/index)))
435 (write-string (subseq line last) result))))
439 (defun lisp-section-p (line line-number lines)
440 "Returns T if the given LINE looks like start of lisp code -- ie. if
441 it starts with whitespace followed by a paren, and the previous line
443 (let ((offset (indentation line)))
446 (eql #\( (find-if-not (lambda (c) (eql #\Space c)) line))
447 (empty-p (1- line-number) lines))))
449 (defun collect-lisp-section (lines line-number)
450 (let ((lisp (loop for index = line-number then (1+ index)
451 for line = (and (< index (length lines)) (svref lines index))
452 while (indentation line)
454 (values (length lisp) `("@lisp" ,@lisp "@end lisp"))))
456 ;;; itemized sections
458 (defun maybe-itemize-offset (line)
459 "Return NIL or the indentation offset if LINE looks like it starts
460 an item in an itemization."
461 (let* ((offset (indentation line))
462 (char (when offset (char line offset))))
464 (member char *itemize-start-characters* :test #'char=)
465 (char= #\Space (find-if-not (lambda (c) (char= c char))
469 (defun collect-maybe-itemized-section (lines starting-line)
470 ;; Return index of next line to be processed outside
471 (let ((this-offset (maybe-itemize-offset (svref lines starting-line)))
474 (loop for line-number from starting-line below (length lines)
475 for line = (svref lines line-number)
476 for indentation = (indentation line)
477 for offset = (maybe-itemize-offset line)
480 ;; empty line -- inserts paragraph.
482 (incf lines-consumed))
483 ((and offset (> indentation this-offset))
484 ;; nested itemization -- handle recursively
485 ;; FIXME: tables in itemizations go wrong
486 (multiple-value-bind (sub-lines-consumed sub-itemization)
487 (collect-maybe-itemized-section lines line-number)
488 (when sub-lines-consumed
489 (incf line-number (1- sub-lines-consumed)) ; +1 on next loop
490 (incf lines-consumed sub-lines-consumed)
491 (setf result (nconc (nreverse sub-itemization) result)))))
492 ((and offset (= indentation this-offset))
494 (push (format nil "@item ~A"
495 (texinfo-line (subseq line (1+ offset))))
497 (incf lines-consumed))
498 ((and (not offset) (> indentation this-offset))
499 ;; continued item from previous line
500 (push (texinfo-line line) result)
501 (incf lines-consumed))
503 ;; end of itemization
505 ;; a single-line itemization isn't.
506 (if (> (count-if (lambda (line) (> (length line) 0)) result) 1)
507 (values lines-consumed `("@itemize" ,@(reverse result) "@end itemize"))
512 (defun tabulation-body-p (offset line-number lines)
513 (when (< line-number (length lines))
514 (let ((offset2 (indentation (svref lines line-number))))
515 (and offset2 (< offset offset2)))))
517 (defun tabulation-p (offset line-number lines direction)
518 (let ((step (ecase direction
519 (:backwards (1- line-number))
520 (:forwards (1+ line-number)))))
521 (when (and (plusp line-number) (< line-number (length lines)))
522 (and (eql offset (indentation (svref lines line-number)))
523 (or (when (eq direction :backwards)
524 (empty-p step lines))
525 (tabulation-p offset step lines direction)
526 (tabulation-body-p offset step lines))))))
528 (defun maybe-table-offset (line-number lines)
529 "Return NIL or the indentation offset if LINE looks like it starts
530 an item in a tabulation. Ie, if it is (1) indented, (2) preceded by an
531 empty line, another tabulation label, or a tabulation body, (3) and
532 followed another tabulation label or a tabulation body."
533 (let* ((line (svref lines line-number))
534 (offset (indentation line))
535 (prev (1- line-number))
536 (next (1+ line-number)))
537 (when (and offset (plusp offset))
538 (and (or (empty-p prev lines)
539 (tabulation-body-p offset prev lines)
540 (tabulation-p offset prev lines :backwards))
541 (or (tabulation-body-p offset next lines)
542 (tabulation-p offset next lines :forwards))
545 ;;; FIXME: This and itemization are very similar: could they share
546 ;;; some code, mayhap?
548 (defun collect-maybe-table-section (lines starting-line)
549 ;; Return index of next line to be processed outside
550 (let ((this-offset (maybe-table-offset starting-line lines))
553 (loop for line-number from starting-line below (length lines)
554 for line = (svref lines line-number)
555 for indentation = (indentation line)
556 for offset = (maybe-table-offset line-number lines)
559 ;; empty line -- inserts paragraph.
561 (incf lines-consumed))
562 ((and offset (= indentation this-offset))
563 ;; start of new item, or continuation of previous item
564 (if (and result (search "@item" (car result) :test #'char=))
565 (push (format nil "@itemx ~A" (texinfo-line line))
569 (push (format nil "@item ~A" (texinfo-line line))
571 (incf lines-consumed))
572 ((> indentation this-offset)
573 ;; continued item from previous line
574 (push (texinfo-line line) result)
575 (incf lines-consumed))
577 ;; end of itemization
579 ;; a single-line table isn't.
580 (if (> (count-if (lambda (line) (> (length line) 0)) result) 1)
581 (values lines-consumed
582 `("" "@table @emph" ,@(reverse result) "@end table" ""))
587 (defmacro with-maybe-section (index &rest forms)
588 `(multiple-value-bind (count collected) (progn ,@forms)
590 (dolist (line collected)
591 (write-line line *texinfo-output*))
592 (incf ,index (1- count)))))
594 (defun write-texinfo-string (string &optional lambda-list)
595 "Try to guess as much formatting for a raw docstring as possible."
596 (let ((*texinfo-variables* (flatten lambda-list))
597 (lines (string-lines (escape-for-texinfo string nil))))
598 (loop for line-number from 0 below (length lines)
599 for line = (svref lines line-number)
601 ((with-maybe-section line-number
602 (and (lisp-section-p line line-number lines)
603 (collect-lisp-section lines line-number))))
604 ((with-maybe-section line-number
605 (and (maybe-itemize-offset line)
606 (collect-maybe-itemized-section lines line-number))))
607 ((with-maybe-section line-number
608 (and (maybe-table-offset line-number lines)
609 (collect-maybe-table-section lines line-number))))
611 (write-line (texinfo-line line) *texinfo-output*))))))
613 ;;;; texinfo formatting tools
615 (defun hide-superclass-p (class-name super-name)
616 (let ((super-package (symbol-package super-name)))
618 ;; KLUDGE: We assume that we don't want to advertise internal
619 ;; classes in CP-lists, unless the symbol we're documenting is
621 (and (member super-package #.'(mapcar #'find-package *undocumented-packages*))
622 (not (eq super-package (symbol-package class-name))))
623 ;; KLUDGE: We don't generally want to advertise SIMPLE-ERROR or
624 ;; SIMPLE-CONDITION in the CPLs of conditions that inherit them
625 ;; simply as a matter of convenience. The assumption here is that
626 ;; the inheritance is incidental unless the name of the condition
627 ;; begins with SIMPLE-.
628 (and (member super-name '(simple-error simple-condition))
629 (let ((prefix "SIMPLE-"))
630 (mismatch prefix (string class-name) :end2 (length prefix)))
631 t ; don't return number from MISMATCH
634 (defun hide-slot-p (symbol slot)
635 ;; FIXME: There is no pricipal reason to avoid the slot docs fo
636 ;; structures and conditions, but their DOCUMENTATION T doesn't
637 ;; currently work with them the way we'd like.
638 (not (and (typep (find-class symbol nil) 'standard-class)
639 (docstring slot t))))
641 (defun texinfo-anchor (doc)
642 (format *texinfo-output* "@anchor{~A}~%" (node-name doc)))
644 (defun texinfo-begin (doc)
645 (let ((kind (get-kind doc)))
646 (format *texinfo-output* "@~A {~:(~A~)} ~(~A~@[ ~{~A~^ ~}~]~)~%"
648 ((package constant variable)
650 ((structure class condition type)
654 (map 'string (lambda (char) (if (eql char #\-) #\Space char)) (string kind))
658 (defun texinfo-index (doc)
659 (let ((title (title-name doc)))
661 ((structure type class condition)
662 (format *texinfo-output* "@tindex ~A~%" title))
664 (format *texinfo-output* "@vindex ~A~%" title))
665 ((compiler-macro function method-combination macro generic-function)
666 (format *texinfo-output* "@findex ~A~%" title)))))
668 (defun texinfo-inferred-body (doc)
669 (when (member (get-kind doc) '(class structure condition))
670 (let ((name (get-name doc)))
671 ;; class precedence list
672 (format *texinfo-output* "Class precedence list: @code{~(~{@w{~A}~^, ~}~)}~%~%"
673 (remove-if (lambda (class) (hide-superclass-p name class))
674 (mapcar #'class-name (class-precedence-list (find-class name)))))
676 (let ((slots (remove-if (lambda (slot) (hide-slot-p name slot))
677 (class-direct-slots (find-class name)))))
679 (format *texinfo-output* "Slots:~%@itemize~%")
681 (format *texinfo-output* "@item ~(@code{~A} ~
682 ~@[--- initargs: @code{~{@w{~S}~^, ~}}~]~)~%~%"
683 (slot-definition-name slot)
684 (slot-definition-initargs slot))
685 ;; FIXME: Would be neater to handler as children
686 (write-texinfo-string (docstring slot t)))
687 (format *texinfo-output* "@end itemize~%~%"))))))
689 (defun texinfo-body (doc)
690 (write-texinfo-string (get-string doc)))
692 (defun texinfo-end (doc)
693 (write-line (case (get-kind doc)
694 ((package variable constant) "@end defvr")
695 ((structure type class condition) "@end deftp")
699 (defun write-texinfo (doc)
700 "Writes TexInfo for a DOCUMENTATION instance to *TEXINFO-OUTPUT*."
704 (texinfo-inferred-body doc)
707 ;; FIXME: Children should be sorted one way or another
708 (mapc #'write-texinfo (get-children doc)))
712 (defun collect-gf-documentation (gf)
713 "Collects method documentation for the generic function GF"
714 (loop for method in (generic-function-methods gf)
715 for doc = (maybe-documentation method t)
719 (defun collect-name-documentation (name)
720 (loop for type in *documentation-types*
721 for doc = (maybe-documentation name type)
725 (defun collect-symbol-documentation (symbol)
726 "Collects all docs for a SYMBOL and (SETF SYMBOL), returns a list of
727 the form DOC instances. See `*documentation-types*' for the possible
729 (nconc (collect-name-documentation symbol)
730 (collect-name-documentation (list 'setf symbol))))
732 (defun collect-documentation (package)
733 "Collects all documentation for all external symbols of the given
734 package, as well as for the package itself."
735 (let* ((*documentation-package* (find-package package))
737 (check-type package package)
738 (do-external-symbols (symbol package)
739 (setf docs (nconc (collect-symbol-documentation symbol) docs)))
740 (let ((doc (maybe-documentation *documentation-package* t)))
745 (defmacro with-texinfo-file (pathname &body forms)
746 `(with-open-file (*texinfo-output* ,pathname
748 :if-does-not-exist :create
749 :if-exists :supersede)
752 (defun generate-includes (directory &rest packages)
753 "Create files in `directory' containing Texinfo markup of all
754 docstrings of each exported symbol in `packages'. `directory' is
755 created if necessary. If you supply a namestring that doesn't end in a
756 slash, you lose. The generated files are of the form
757 \"<doc-type>_<packagename>_<symbol-name>.texinfo\" and can be included
758 via @include statements. Texinfo syntax-significant characters are
759 escaped in symbol names, but if a docstring contains invalid Texinfo
761 (handler-bind ((warning #'muffle-warning))
762 (let ((directory (merge-pathnames (pathname directory))))
763 (ensure-directories-exist directory)
764 (dolist (package packages)
765 (dolist (doc (collect-documentation (find-package package)))
766 (with-texinfo-file (merge-pathnames (include-pathname doc) directory)
767 (write-texinfo doc))))
770 (defun document-package (package &optional filename)
771 "Create a file containing all available documentation for the
772 exported symbols of `package' in Texinfo format. If `filename' is not
773 supplied, a file \"<packagename>.texinfo\" is generated.
775 The definitions can be referenced using Texinfo statements like
776 @ref{<doc-type>_<packagename>_<symbol-name>.texinfo}. Texinfo
777 syntax-significant characters are escaped in symbol names, but if a
778 docstring contains invalid Texinfo markup, you lose."
779 (handler-bind ((warning #'muffle-warning))
780 (let* ((package (find-package package))
781 (filename (or filename (make-pathname
782 :name (string-downcase (package-name package))
784 (docs (sort (collect-documentation package) #'documentation<)))
785 (with-texinfo-file filename
787 (write-texinfo doc)))