Mercurial > emacs
comparison lisp/eieio/eieio-doc.el @ 104401:2efe3dc24373
Add files for the EIEIO library.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sat, 22 Aug 2009 04:12:52 +0000 |
parents | |
children | 7602fd69cd93 |
comparison
equal
deleted
inserted
replaced
104400:ed5d844496e7 | 104401:2efe3dc24373 |
---|---|
1 ;;; eieio-doc.el --- create texinfo documentation for an eieio class | |
2 | |
3 ;;; Copyright (C) 1996, 1998, 1999, 2000, 2001, 2004, 2005 | |
4 ;;; Free Software Foundation, Inc. | |
5 | |
6 ;; Author: Eric M. Ludlam <zappo@gnu.org> | |
7 ;; Version: 0.2 | |
8 ;; Keywords: OO, lisp, docs | |
9 | |
10 ;; This file is part of GNU Emacs. | |
11 | |
12 ;; GNU Emacs is free software: you can redistribute it and/or modify | |
13 ;; it under the terms of the GNU General Public License as published by | |
14 ;; the Free Software Foundation, either version 3 of the License, or | |
15 ;; (at your option) any later version. | |
16 | |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
24 | |
25 ;;; Commentary: | |
26 ;; | |
27 ;; Outputs into the current buffer documentation in texinfo format | |
28 | |
29 (require 'eieio-opt) | |
30 | |
31 ;; for a class, all it's children, and all it's slots. | |
32 | |
33 ;;; Code: | |
34 (defvar eieiodoc-currently-in-node nil | |
35 "String representing the node we go BACK to.") | |
36 | |
37 (defvar eieiodoc-current-section-level nil | |
38 "String represending what type of section header to use.") | |
39 | |
40 (defvar eieiodoc-prev-class nil | |
41 "Non-nil when while `eieiodoc-recurse' is running. | |
42 Can be referenced from the recursed function.") | |
43 | |
44 (defvar eieiodoc-next-class nil | |
45 "Non-nil when `eieiodoc-recurse' is running. | |
46 Can be referenced from the recursed function.") | |
47 | |
48 (defun eieiodoc-class-nuke (root-class indexstring &optional skiplist) | |
49 "Call `eieiodoc-class' after nuking everything from POINT on. | |
50 ROOT-CLASS, INDEXSTRING, and SKIPLIST are the same as `eieiodoc-class'." | |
51 (delete-region (point) (point-max)) | |
52 (sit-for 0) | |
53 (eieiodoc-class root-class indexstring skiplist)) | |
54 | |
55 (defun eieiodoc-class (root-class indexstring &optional skiplist) | |
56 "Create documentation starting with ROOT-CLASS. | |
57 The first job is to create an indented menu of all the classes | |
58 starting with `root-class' and including all it's children. Once this | |
59 is done, @nodes are created for all the subclasses. Each node is then | |
60 documented with a description of the class, a brief inheritance tree | |
61 \(with xrefs) and a list of all slots in a big table. Where each slot | |
62 is inherited from is also documented. In addition, each class is | |
63 documented in the index referenced by INDEXSTRING, a two letter code | |
64 described in the texinfo manual. | |
65 | |
66 The optional third argument SKIPLIST is a list of object not to put | |
67 into any menus, nodes or lists." | |
68 (interactive | |
69 (list (intern-soft | |
70 (completing-read "Class: " (eieio-build-class-alist) nil t)) | |
71 (read-string "Index name (2 chars): "))) | |
72 (if (looking-at "[ \t\n]+@end ignore") | |
73 (goto-char (match-end 0))) | |
74 (save-excursion | |
75 (setq eieiodoc-currently-in-node | |
76 (if (re-search-backward "@node \\([^,]+\\)" nil t) | |
77 (buffer-substring (match-beginning 1) (match-end 1)) | |
78 "Top") | |
79 eieiodoc-current-section-level | |
80 (if (re-search-forward "@\\(chapter\\|\\(sub\\)*section\\)" | |
81 (+ (point) 500) t) | |
82 (progn | |
83 (goto-char (match-beginning 0)) | |
84 (cond ((looking-at "@chapter") "section") | |
85 ((looking-at "@section") "subsection") | |
86 ((looking-at "@\\(sub\\)+section") "subsubsection") | |
87 (t "subsubsection"))) | |
88 "subsubsection"))) | |
89 (save-excursion | |
90 (eieiodoc-main-menu root-class skiplist) | |
91 (insert "\n") | |
92 (eieiodoc-recurse root-class 'eieiodoc-one-node nil skiplist))) | |
93 | |
94 (defun eieiodoc-main-menu (class skiplist) | |
95 "Create a menu of all classes under CLASS indented the correct amount. | |
96 SKIPLIST is a list of objects to skip" | |
97 (end-of-line) | |
98 (insert "\n@menu\n") | |
99 (eieiodoc-recurse class (lambda (class level) | |
100 (insert "* " (make-string level ? ) | |
101 (symbol-name class) " ::\n")) | |
102 nil skiplist) | |
103 (insert "@end menu\n")) | |
104 | |
105 (defun eieiodoc-one-node (class level) | |
106 "Create a node for CLASS, and for all subclasses of CLASS in order. | |
107 This function should only be called by `eieiodoc-class' | |
108 Argument LEVEL is the current level of recursion we have hit." | |
109 (message "Building node for %s" class) | |
110 (insert "\n@node " (symbol-name class) ", " | |
111 (if eieiodoc-next-class (symbol-name eieiodoc-next-class) " ") ", " | |
112 (if eieiodoc-prev-class (symbol-name eieiodoc-prev-class) " ") ", " | |
113 eieiodoc-currently-in-node "\n" | |
114 "@comment node-name, next, previous, up\n" | |
115 "@" eieiodoc-current-section-level " " (symbol-name class) "\n" | |
116 ;; indexstring is grabbed from parent calling function | |
117 "@" indexstring "index " (symbol-name class) "\n\n") | |
118 ;; Now lets create a nifty little inheritance tree | |
119 (let ((cl class) | |
120 (revlist nil) | |
121 (depth 0)) | |
122 (while cl | |
123 (setq revlist (cons cl revlist) | |
124 cl (class-parent cl))) | |
125 (insert "@table @asis\n@item Inheritance Tree:\n") | |
126 (while revlist | |
127 ;; root-class is dragged in from the top-level function | |
128 (insert "@table @code\n@item " | |
129 (if (and (child-of-class-p (car revlist) root-class) | |
130 (not (eq class (car revlist)))) | |
131 (concat "@w{@xref{" (symbol-name (car revlist)) "}.}") | |
132 (symbol-name (car revlist))) | |
133 "\n") | |
134 (setq revlist (cdr revlist) | |
135 depth (1+ depth))) | |
136 ;; the value of rclass is brought in from caller | |
137 (let ((clist (reverse (aref (class-v rclass) class-children)))) | |
138 (if (not clist) | |
139 (insert "No children") | |
140 (insert "@table @asis\n@item Children:\n") | |
141 (while clist | |
142 (insert "@w{@xref{" (symbol-name (car clist)) "}") | |
143 (if (cdr clist) (insert ",") (insert ".")) | |
144 (insert "} ") | |
145 (setq clist (cdr clist))) | |
146 (insert "\n@end table\n") | |
147 )) | |
148 (while (> depth 0) | |
149 (insert "\n@end table\n") | |
150 (setq depth (1- depth))) | |
151 (insert "@end table\n\n ")) | |
152 ;; Now lets build some documentation by extracting information from | |
153 ;; the class description vector | |
154 (let* ((cv (class-v class)) | |
155 (docs (aref cv class-public-doc)) | |
156 (names (aref cv class-public-a)) | |
157 (deflt (aref cv class-public-d)) | |
158 (prot (aref cv class-protection)) | |
159 (typev (aref cv class-public-type)) | |
160 (i 0) | |
161 (set-one nil) | |
162 (anchor nil) | |
163 ) | |
164 ;; doc of the class itself | |
165 (insert (eieiodoc-texify-docstring (documentation class) class) | |
166 "\n\n@table @asis\n") | |
167 (if names | |
168 (progn | |
169 (setq anchor (point)) | |
170 (insert "@item Slots:\n\n@table @code\n") | |
171 (while names | |
172 (if (eieiodoc-one-attribute class (car names) (car docs) | |
173 (car prot) (car deflt) (aref typev i)) | |
174 (setq set-one t)) | |
175 (setq names (cdr names) | |
176 docs (cdr docs) | |
177 prot (cdr prot) | |
178 deflt (cdr deflt) | |
179 i (1+ i))) | |
180 (insert "@end table\n\n") | |
181 (if (not set-one) (delete-region (point) anchor)) | |
182 )) | |
183 (insert "@end table\n") | |
184 ;; Finally, document all the methods associated with this class. | |
185 (let ((methods (eieio-all-generic-functions class)) | |
186 (doc nil)) | |
187 (if (not methods) nil | |
188 (if (string= eieiodoc-current-section-level "subsubsection") | |
189 (insert "@" eieiodoc-current-section-level) | |
190 (insert "@sub" eieiodoc-current-section-level)) | |
191 (insert " Specialized Methods\n\n") | |
192 (while methods | |
193 (setq doc (eieio-method-documentation (car methods) class)) | |
194 (insert "@deffn Method " (symbol-name (car methods))) | |
195 (if (not doc) | |
196 (insert "\n Undocumented") | |
197 (if (car doc) | |
198 (progn | |
199 (insert " :BEFORE ") | |
200 (eieiodoc-output-deffn-args (car (car doc))) | |
201 (insert "\n") | |
202 (eieiodoc-insert-and-massage-docstring-with-args | |
203 (cdr (car doc)) (car (car doc)) class))) | |
204 (setq doc (cdr doc)) | |
205 (if (car doc) | |
206 (progn | |
207 (insert " :PRIMARY ") | |
208 (eieiodoc-output-deffn-args (car (car doc))) | |
209 (insert "\n") | |
210 (eieiodoc-insert-and-massage-docstring-with-args | |
211 (cdr (car doc)) (car (car doc)) class))) | |
212 (setq doc (cdr doc)) | |
213 (if (car doc) | |
214 (progn | |
215 (insert " :AFTER ") | |
216 (eieiodoc-output-deffn-args (car (car doc))) | |
217 (insert "\n") | |
218 (eieiodoc-insert-and-massage-docstring-with-args | |
219 (cdr (car doc)) (car (car doc)) class))) | |
220 (insert "\n@end deffn\n\n")) | |
221 (setq methods (cdr methods))))) | |
222 )) | |
223 | |
224 (defun eieiodoc-insert-and-massage-docstring-with-args (doc arglst class) | |
225 "Update DOC with texinfo strings using ARGLST with @var. | |
226 Argument CLASS is the class passed to `eieiodoc-texify-docstring'." | |
227 (let ((start (point)) | |
228 (end nil) | |
229 (case-fold-search nil)) | |
230 ;; Insert the text | |
231 (insert (eieiodoc-texify-docstring doc class)) | |
232 (setq end (point)) | |
233 (save-restriction | |
234 (narrow-to-region start end) | |
235 (save-excursion | |
236 ;; Now find arguments | |
237 (while arglst | |
238 (goto-char (point-min)) | |
239 (while (re-search-forward (upcase (symbol-name (car arglst))) nil t) | |
240 (replace-match "@var{\\&}" t)) | |
241 (setq arglst (cdr arglst))))))) | |
242 | |
243 (defun eieiodoc-output-deffn-args (arglst) | |
244 "Output ARGLST for a deffn." | |
245 (while arglst | |
246 (insert (symbol-name (car arglst)) " ") | |
247 (setq arglst (cdr arglst)))) | |
248 | |
249 (defun eieiodoc-one-attribute (class attribute doc priv deflt type) | |
250 "Create documentation of CLASS for a single ATTRIBUTE. | |
251 Assume this attribute is inside a table, so it is initiated with the | |
252 @item indicator. If this attribute is not inserted (because it is | |
253 contained in the parent) then return nil, else return t. | |
254 DOC is the documentation to use, PRIV is non-nil if it is a private slot, | |
255 and DEFLT is the default value. TYPE is the symbol describing what type | |
256 validation is done on that slot." | |
257 (let ((pv (eieiodoc-parent-diff class attribute)) | |
258 (ia (eieio-attribute-to-initarg class attribute)) | |
259 (set-me nil)) | |
260 (if (or (eq pv t) (not ia)) | |
261 nil ;; same in parent or no init arg | |
262 (setq set-me t) | |
263 (insert "@item " (if priv "Private: " "") | |
264 (symbol-name ia)) | |
265 (if (and type (not (eq type t))) | |
266 (insert "\nType: @code{" (format "%S" type) "}")) | |
267 (if (not (eq deflt eieio-unbound)) | |
268 (insert " @*\nDefault Value: @code{"(format "%S" deflt) "}")) | |
269 (insert "\n\n") | |
270 (if (eq pv 'default) | |
271 ;; default differs only, xref the parent | |
272 ;; This should be upgraded to actually search for the last | |
273 ;; differing default (or the original.) | |
274 (insert "@xref{" (symbol-name (class-parent class)) "}.\n") | |
275 (insert (if doc (eieiodoc-texify-docstring doc class) "Not Documented") | |
276 "\n@refill\n\n"))) | |
277 set-me)) | |
278 ;;; | |
279 ;; Utilities | |
280 ;; | |
281 (defun eieiodoc-recurse (rclass func &optional level skiplist) | |
282 "Recurse down all children of RCLASS, calling FUNC on each one. | |
283 LEVEL indicates the current depth below the first call we are. The | |
284 function FUNC will be called with RCLASS and LEVEL. This will then | |
285 recursivly call itself once for each child class of RCLASS. The | |
286 optional fourth argument SKIPLIST is a list of objects to ignore while | |
287 recursing." | |
288 | |
289 (if (not level) (setq level 0)) | |
290 | |
291 ;; we reverse the children so they appear in the same order as it | |
292 ;; does in the code that creates them. | |
293 (let* ((children (reverse (aref (class-v rclass) class-children))) | |
294 (ocnc eieiodoc-next-class) | |
295 (eieiodoc-next-class (or (car children) ocnc)) | |
296 (eieiodoc-prev-class eieiodoc-prev-class)) | |
297 | |
298 (if (not (member rclass skiplist)) | |
299 (progn | |
300 (apply func (list rclass level)) | |
301 | |
302 (setq eieiodoc-prev-class rclass))) | |
303 | |
304 (while children | |
305 (setq eieiodoc-next-class (or (car (cdr children)) ocnc)) | |
306 (setq eieiodoc-prev-class (eieiodoc-recurse (car children) func (1+ level))) | |
307 (setq children (cdr children))) | |
308 ;; return the previous class so that the prev/next node gets it right | |
309 eieiodoc-prev-class)) | |
310 | |
311 (defun eieiodoc-parent-diff (class slot) | |
312 "Return nil if the parent of CLASS does not have slot SLOT. | |
313 Return t if it does, and return 'default if the default has changed." | |
314 (let ((df nil) (err t) | |
315 (scoped-class (class-parent class)) | |
316 (eieio-skip-typecheck)) | |
317 (condition-case nil | |
318 (setq df (eieio-oref-default (class-parent class) slot) | |
319 err nil) | |
320 (invalid-slot-name (setq df nil)) | |
321 (error (setq df nil))) | |
322 (if err | |
323 nil | |
324 (if (equal df (eieio-oref-default class slot)) | |
325 t | |
326 'default)))) | |
327 | |
328 (defun eieiodoc-texify-docstring (string class) | |
329 "Take STRING, (a normal doc string), and convert it into a texinfo string. | |
330 For instances where CLASS is the class being referenced, do not Xref | |
331 that class. | |
332 | |
333 `function' => @dfn{function} | |
334 `variable' => @code{variable} | |
335 `class' => @code{class} @xref{class} | |
336 `unknown' => @code{unknonwn} | |
337 'quoteme => @code{quoteme} | |
338 non-nil => non-@code{nil} | |
339 t => @code{t} | |
340 :tag => @code{:tag} | |
341 [ stuff ] => @code{[ stuff ]} | |
342 Key => @kbd{Key}" | |
343 (while (string-match "`\\([-a-zA-Z0-9]+\\)'" string) | |
344 (let* ((vs (substring string (match-beginning 1) (match-end 1))) | |
345 (v (intern-soft vs))) | |
346 (setq string | |
347 (concat | |
348 (replace-match (concat | |
349 (if (and (not (class-p v))(fboundp v)) | |
350 "@dfn{" "@code{") | |
351 vs "}" | |
352 (if (and (class-p v) (not (eq v class))) | |
353 (concat " @xref{" vs "}."))) | |
354 nil t string))))) | |
355 (while (string-match "\\( \\|^\\|-\\)\\(nil\\|t\\|'[-a-zA-Z0-9]+\\|:[-a-zA-Z0-9]+\\)\\([ ,]\\|$\\)" string) | |
356 (setq string (replace-match "@code{\\2}" t nil string 2))) | |
357 (while (string-match "\\( \\|^\\)\\(\\[[^]]+\\]\\)\\( \\|$\\)" string) | |
358 (setq string (replace-match "@code{\\2}" t nil string 2))) | |
359 (while (string-match "\\( \\|^\\)\\(\\(\\(C-\\|M-\\|S-\\)+\\([^ \t\n]\\|RET\\|SPC\\|TAB\\)\\)\\|\\(RET\\|SPC\\|TAB\\)\\)\\( \\|$\\)" string) | |
360 (setq string (replace-match "@kbd{\\2}" t nil string 2))) | |
361 string) | |
362 | |
363 (provide 'eieio-doc) | |
364 | |
365 ;;; eieio-doc.el ends here |