doc.lisp 5.4 KB
Newer Older
David O'Toole's avatar
David O'Toole committed
1
;;; doc.lisp --- extract Lisp docstrings into org-mode publishing
David O'Toole's avatar
David O'Toole committed
2

David O'Toole's avatar
David O'Toole committed
3
;; Copyright (C) 2009-2017 by David O'Toole
David O'Toole's avatar
David O'Toole committed
4

David O'Toole's avatar
David O'Toole committed
5
;; Author: David O'Toole dto@xelf.me
David O'Toole's avatar
David O'Toole committed
6 7
;; Keywords: lisp, tools

David O'Toole's avatar
David O'Toole committed
8 9 10 11 12 13 14
;; Permission is hereby granted, free of charge, to any person obtaining
;; a copy of this software and associated documentation
;; files (the "Software"), to deal in the Software without restriction,
;; including without limitation the rights to use, copy, modify, merge,
;; publish, distribute, sublicense, and/or sell copies of the Software,
;; and to permit persons to whom the Software is furnished to do so,
;; subject to the following conditions:
David O'Toole's avatar
David O'Toole committed
15

David O'Toole's avatar
David O'Toole committed
16 17
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
David O'Toole's avatar
David O'Toole committed
18

David O'Toole's avatar
David O'Toole committed
19 20 21 22 23 24 25
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
David O'Toole's avatar
David O'Toole committed
26

David O'Toole's avatar
David O'Toole committed
27
;;; Known issues:
David O'Toole's avatar
David O'Toole committed
28

David O'Toole's avatar
David O'Toole committed
29 30
;; Needs to be refactored a bit.
;; Only works on SBCL for now.
David O'Toole's avatar
David O'Toole committed
31

David O'Toole's avatar
David O'Toole committed
32 33 34
;; (defpackage #:dox
;;   (:use #:cl #:xelf)
;;   (:export dox))
David O'Toole's avatar
David O'Toole committed
35

David O'Toole's avatar
David O'Toole committed
36 37
;; (in-package :dox)
(in-package :xelf)
David O'Toole's avatar
David O'Toole committed
38 39

(defun get-symbols (package)
David O'Toole's avatar
David O'Toole committed
40
  (let (symbols)
David O'Toole's avatar
David O'Toole committed
41
    (do-external-symbols (symbol (find-package package))
David O'Toole's avatar
David O'Toole committed
42
      (push symbol symbols))
David O'Toole's avatar
David O'Toole committed
43
    (sort symbols #'string<)))
David O'Toole's avatar
David O'Toole committed
44

David O'Toole's avatar
David O'Toole committed
45 46
(defvar *symbol-count* 0)

David O'Toole's avatar
David O'Toole committed
47 48 49 50 51 52 53 54 55 56
(defun methodp (symbol)
  (fboundp symbol))

(defun heading (level text stream)
  (fresh-line stream) 
  (format stream "~A ~A" 
   (make-string level :initial-element (character "*"))
   text)
  (fresh-line stream))

David O'Toole's avatar
David O'Toole committed
57 58 59
(defun arguments-prefix (stream) 
  (format stream " "))

David O'Toole's avatar
David O'Toole committed
60
(defun document-function (symbol stream)
David O'Toole's avatar
David O'Toole committed
61 62 63
  (let ((doc (documentation symbol 'function))
	(args (sb-introspect:function-lambda-list (or (macro-function symbol)
						      (fdefinition symbol)))))
David O'Toole's avatar
David O'Toole committed
64 65 66
    (heading 2 (format nil "~A (~A)" symbol (if (macro-function symbol) "macro"
						(if (find-class symbol nil)
						    "class"
David O'Toole's avatar
David O'Toole committed
67 68 69
						    (if (typep (fdefinition symbol) 'standard-generic-function)
							"generic function"
							"function"))))
David O'Toole's avatar
David O'Toole committed
70
	     stream)
David O'Toole's avatar
David O'Toole committed
71 72 73 74 75
    (when (not (null (first args)))
      (arguments-prefix stream)
      (fresh-line stream)
      (fresh-line stream)
      (format stream ": ~S" args))
David O'Toole's avatar
David O'Toole committed
76
    (when doc
David O'Toole's avatar
David O'Toole committed
77
      (incf *symbol-count*)
David O'Toole's avatar
David O'Toole committed
78
      (fresh-line stream)
David O'Toole's avatar
David O'Toole committed
79 80
      (format stream "~A" doc)
      (fresh-line stream))))
David O'Toole's avatar
David O'Toole committed
81 82

(defun document-variable (symbol stream)
David O'Toole's avatar
David O'Toole committed
83 84
  (heading 2 (format nil "~A (variable)" symbol)
	   stream)
David O'Toole's avatar
David O'Toole committed
85
  (when (documentation symbol 'variable)
David O'Toole's avatar
David O'Toole committed
86 87 88
    (incf *symbol-count*)
    (format stream "~A" (documentation symbol 'variable)))
  (fresh-line stream))
David O'Toole's avatar
David O'Toole committed
89

David O'Toole's avatar
David O'Toole committed
90
(defun document-all-symbols (package stream)
David O'Toole's avatar
David O'Toole committed
91
  (fresh-line stream)
David O'Toole's avatar
David O'Toole committed
92 93
  (dolist (sym (get-symbols package))
    (fresh-line)
David O'Toole's avatar
David O'Toole committed
94 95 96 97
    (if (fboundp sym)
	(document-function sym stream)
	(document-variable sym stream))))

David O'Toole's avatar
David O'Toole committed
98 99 100 101 102 103 104 105 106
(defun preamble-file-lines (preamble-file)
  (with-open-file (file preamble-file
			:direction :input
			:if-does-not-exist nil)
    (let* ((len (file-length file))
           (string (make-string len)))
      (read-sequence string file)
      (split-string-on-lines string))))

David O'Toole's avatar
David O'Toole committed
107 108 109 110
(defun clean-name (name)
  (substitute #\_ #\+ 
	      (substitute #\_ #\* name))) 

David O'Toole's avatar
David O'Toole committed
111
(defun make-symbol-pathname (name directory)
David O'Toole's avatar
David O'Toole committed
112
  (make-pathname :name (concatenate 'string (clean-name name) ".org")
David O'Toole's avatar
David O'Toole committed
113
		 :defaults (cl-fad:pathname-as-directory directory)))
David O'Toole's avatar
David O'Toole committed
114

David O'Toole's avatar
David O'Toole committed
115
(defun make-dictionary (package-name directory &optional buffer)
David O'Toole's avatar
David O'Toole committed
116 117 118 119 120 121
  (let ((package (find-package package-name))
	(symbols nil)
	(*symbol-count* 0))
    (do-external-symbols (symbol package)
      (push symbol symbols))
    (dolist (sym symbols)
David O'Toole's avatar
David O'Toole committed
122
      (let ((output-file (make-symbol-pathname (symbol-name sym) directory)))
David O'Toole's avatar
David O'Toole committed
123
	(with-open-file (stream output-file :direction :output :if-exists :supersede)
David O'Toole's avatar
David O'Toole committed
124 125
	  (format stream "#+OPTIONS: *:nil")
	  (fresh-line stream)
David O'Toole's avatar
David O'Toole committed
126 127 128 129
	  (if (fboundp sym)
	      (document-function sym stream)
	      (document-variable sym stream)))))))
    
David O'Toole's avatar
David O'Toole committed
130
(defun make-reference-* (package-name &key (stream t) preamble-file title)
David O'Toole's avatar
David O'Toole committed
131
  (let ((package (find-package package-name))
David O'Toole's avatar
David O'Toole committed
132 133
	symbols functions variables
	(*symbol-count* 0))
David O'Toole's avatar
David O'Toole committed
134 135 136 137 138 139
    ;; header
    (when title 
      (format stream "#+TITLE: ~A" title)
      (fresh-line stream))
    (format stream "#+OPTIONS: toc:2 *:nil")
    (fresh-line stream)
David O'Toole's avatar
David O'Toole committed
140
    ;;(format stream "#+INFOJS_OPT: view:info toc:t tdepth:1")
David O'Toole's avatar
David O'Toole committed
141
    (fresh-line stream)
David O'Toole's avatar
David O'Toole committed
142 143 144 145 146 147 148 149 150 151 152
    (fresh-line stream)
    (do-external-symbols (symbol package)
      (push symbol symbols))
    ;; print preamble
    (let ((preamble-lines 
	    (when preamble-file
	      (preamble-file-lines preamble-file))))
      (when preamble-file 
	(dolist (line preamble-lines)
	  (format stream "~A " line)
	  (fresh-line stream))))
David O'Toole's avatar
David O'Toole committed
153
    (document-all-symbols package-name stream)
David O'Toole's avatar
David O'Toole committed
154
    (message "Documented ~S of ~S symbols." *symbol-count* (length symbols))))
David O'Toole's avatar
David O'Toole committed
155

David O'Toole's avatar
David O'Toole committed
156
(defun make-reference (package-name output-file &key preamble-file title)
David O'Toole's avatar
David O'Toole committed
157
  (with-open-file (stream output-file :direction :output :if-exists :supersede)
David O'Toole's avatar
David O'Toole committed
158
    (make-reference-* package-name :title title :stream stream :preamble-file preamble-file)))
David O'Toole's avatar
David O'Toole committed
159

David O'Toole's avatar
David O'Toole committed
160
;; (make-dictionary :xelf #P"~/xelf/doc/dictionary/")
David O'Toole's avatar
David O'Toole committed
161
;; (make-reference :xelf #P"~/xelf/doc/reference.org" :preamble-file #P"~/xelf/doc/preamble.org" )
David O'Toole's avatar
David O'Toole committed
162 163

;;; doc.lisp ends here