summaryrefslogtreecommitdiffstats
path: root/edocs.el
blob: 0fabdd4eddf8016c019c3e121f53135c8f886bf5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
;;; edocs.el --- Extract and format documentation from file(s)

;; Copyright (C) 2013  Tom Willemse

;; Author: Tom Willemse <tom@ryuslash.org>
;; Keywords: docs
;; Version: 0.1.0

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Generate formatted description of a module.  Currently it makes a
;; simple HTML export of the Commentary and all the docstrings in a
;; file.  It is meant to be used as a batch operation, like so:

;; : emacs -batch -l edocs.el -f edocs-generate-batch file.el

;;; Code:

(require 'help-fns)
(require 'lisp-mnt)
(require 'ox-html)
(require 'package)

(defvar edocs-stylesheet-location "style.css"
  "Where to find the Cascading Style Sheet for the exported docs.")

(defvar edocs-generate-only-body nil
  "Whether to genereate only the body and no header/footer info.")

(defconst edocs--symbol-type-map
  #s(hash-table size 8 test equal
                data ("defclass" "Class"
                      "defconst" "Constant"
                      "defcustom" "Customization option"
                      "defgeneric" "Method"
                      "defgroup" "Customization group"
                      "define-minor-mode" "Minor mode"
                      "defun" "Function"
                      "defvar" "Variable"))
  "Type -> name map for symbol types.")

(defun edocs--list-symbols ()
  "Get a list of all symbols in the buffer.

The results also contain a specification of what was found for
each symbol, for example a `defun', `defvar' or `defcustom',
etc."
  (let (ls)
    (save-excursion
      (goto-char (point-min))
      (while (re-search-forward
              (rx (and bol ?\(
                       (group (or "defun" "defgroup" "defcustom" "defvar"
                                  "defclass" "defgeneric" "defconst"
                                  "define-minor-mode"))
                       " "
                       (group (1+ (not (any space ?\n ?\)))))))
              nil :noerror)
        (setq ls (cons (cons (buffer-substring-no-properties
                              (match-beginning 1) (match-end 1))
                             (buffer-substring-no-properties
                              (match-beginning 2) (match-end 2))) ls))))
    (reverse ls)))

(defun edocs--get-docs (type name)
  "Get docs of TYPE for symbol NAME."
  (let ((type (intern type))
        (obj (intern name)))
    (cond
     ((memq type '(defun define-minor-mode))
      (cons (format "%s" (or (help-function-arglist obj :preserve-names)
                             "()"))
            (documentation obj)))
     ((memq type '(defcustom defvar defconst defclass))
      (documentation-property obj 'variable-documentation))
     ((eql type 'defgroup)
       (documentation-property obj 'group-documentation))
     ((eql type 'defgeneric)
       (mapcar (lambda (itm)
                 (cons (format "%s" (cons (list (car (nth 2 itm))
                                                (car itm))
                                          (cdr (nth 2 itm))))
                       (nth 3 itm)))
               (aref (plist-get (symbol-plist obj)
                                'eieio-method-tree) 2))))))

(defun edocs--get-type-display (type-name)
  "Get the display text for TYPE-NAME."
  (gethash type-name edocs--symbol-type-map type-name))

(defun edocs--insert-header ()
  "Insert necessary header information into the current buffer."
  (insert "<!DOCTYPE html>\n"
          "<html><head>"
          "<link href=\"" edocs-stylesheet-location
          "\" rel=\"stylesheet\"></head><body>"))

(defun edocs--insert-footer ()
  "Insert necessary footer information into the current buffer."
  (insert "</body></html>"))

(defun edocs--insert-title (title sub)
  "Insert a formatted TITLE and SUB into the current buffer."
  (insert "<h1>" title " <small>&mdash; " sub "</small></h1>"))

(defmacro edocs--with-tag (tag attrs &rest contents)
  "Put insertion of TAG (possibly with ATTRS) around CONTENTS."
  (declare (indent 2))
  `(progn
     (insert "<" ,tag)
     (insert (mapconcat
              (lambda (itm) (format " %s=%S" (car itm) (cdr itm))) ,attrs ""))
     (insert ">")
     ,@contents
     (insert "</" ,tag ">")))

(defun edocs--format-text (txt)
  "Perform formatting operations on TXT."
  (let ((org-export-with-toc nil)
        (org-export-with-section-numbers nil))
    (org-export-string-as
     (replace-regexp-in-string "`\\([^']+\\)'" "~\\1~" txt)
     'html t)))

(defun edocs--format-commentary (cmt)
  "Perform special commentary formatting operations on CMT."
  (edocs--format-text
   (replace-regexp-in-string
    ";; " "" (replace-regexp-in-string
              ";;; Commentary:\n+" "" cmt))))

(defun edocs--format-doc (doc)
  "Perform formatting operations on DOC or on DOC's `cdr'."
  (edocs--format-text (if (consp doc) (cdr doc) doc)))

(defun edocs--package-desc-p (package-info)
  "Check to see if PACKAGE-INFO is a package-desc struct."
  (and (fboundp 'package-desc-p)
       (package-desc-p package-info)))

(defun edocs--module-name (package-info)
  "Extract the module name from PACKAGE-INFO.

The location of this information seems to have changed since
Emacs 24.3. If the function `package-desc-p' is bound and returns
t for PACKAGE-INFO, it is the new style and we should get it
accordingly.  Otherwise we assume we're dealing with an old-style
package description and return the first element."
  (if (edocs--package-desc-p package-info)
      (symbol-name (package-desc-name package-info))
    (aref package-info 0)))

(defun edocs--module-summary (package-info)
  "Extract a short description from PACKAGE-INFO.

See the docstring for `edocs--module-name' for more information."
  (if (edocs--package-desc-p package-info)
      (package-desc-summary package-info)
    (aref package-info 2)))

(defun edocs--normalize (docs)
  "Make sure DOCS is a properly formatted list."
  (if (or (not (listp docs))
          (not (listp (cdr docs))))
      (list docs)
    docs))

(defun edocs--format-symbol (symbol)
  "Format the information in SYMBOL."
  (let ((docs (edocs--get-docs (car symbol) (cdr symbol))))
    (mapc (lambda (doc)
            (edocs--with-tag "div" nil
              (insert "&ndash; ")
              (edocs--with-tag "strong" nil
                (insert (edocs--get-type-display (car symbol))))
              (insert ": ")
              (edocs--with-tag "tt" nil
                (insert (cdr symbol)))
              (insert " " (if (consp doc) (car doc) ""))
              (edocs--with-tag "div" '(("class" . "docstring"))
                (edocs--with-tag "p" nil
                  (insert (or (edocs--format-doc doc)
                              "Not documented."))))))
          (edocs--normalize docs))))

(defun edocs-generate ()
  "Generate nice-looking documentation for a module or file."
  (interactive)
  (let ((buffer (get-buffer-create "*edocs*"))
        (binfo (package-buffer-info))
        (commentary (lm-commentary))
        (symbols (edocs--list-symbols)))
    (with-current-buffer buffer
      (unless edocs-generate-only-body (edocs--insert-header))
      (edocs--with-tag "div" '(("class" . "container"))
        (edocs--insert-title (edocs--module-name binfo)
                             (edocs--module-summary binfo))
        (edocs--with-tag "p" nil
          (insert (edocs--format-commentary commentary)))
        (insert "<h2>API</h2>")
        (mapc #'edocs--format-symbol symbols))
      (unless edocs-generate-only-body
        (edocs--insert-footer)))
    (switch-to-buffer buffer)))

(defun edocs--generate-batch-1 (file)
  "Generate docs for FILE."
  (with-current-buffer (find-file file)
    (eval-buffer)
    (edocs-generate)
    (write-file (concat (file-name-sans-extension file) ".html"))))

(defun edocs-generate-batch ()
  "Generate module docs using batch operations."
  (mapc #'edocs--generate-batch-1 command-line-args-left))

(provide 'edocs)
;;; edocs.el ends here