summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp/eieio-doc.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp/eieio-doc.el')
-rw-r--r--lisp/emacs-lisp/eieio-doc.el368
1 files changed, 368 insertions, 0 deletions
diff --git a/lisp/emacs-lisp/eieio-doc.el b/lisp/emacs-lisp/eieio-doc.el
new file mode 100644
index 00000000000..35de848c51c
--- /dev/null
+++ b/lisp/emacs-lisp/eieio-doc.el
@@ -0,0 +1,368 @@
+;;; eieio-doc.el --- create texinfo documentation for an eieio class
+
+;;; Copyright (C) 1996, 1998, 1999, 2000, 2001, 2004, 2005
+;;; Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+;; Version: 0.2
+;; Keywords: OO, lisp, docs
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Outputs into the current buffer documentation in texinfo format
+
+(require 'eieio-opt)
+
+;; for a class, all it's children, and all it's slots.
+
+;;; Code:
+(defvar eieiodoc-currently-in-node nil
+ "String representing the node we go BACK to.")
+
+(defvar eieiodoc-current-section-level nil
+ "String represending what type of section header to use.")
+
+(defvar eieiodoc-prev-class nil
+ "Non-nil when while `eieiodoc-recurse' is running.
+Can be referenced from the recursed function.")
+
+(defvar eieiodoc-next-class nil
+ "Non-nil when `eieiodoc-recurse' is running.
+Can be referenced from the recursed function.")
+
+(defun eieiodoc-class-nuke (root-class indexstring &optional skiplist)
+ "Call `eieiodoc-class' after nuking everything from POINT on.
+ROOT-CLASS, INDEXSTRING, and SKIPLIST are the same as `eieiodoc-class'."
+ (delete-region (point) (point-max))
+ (sit-for 0)
+ (eieiodoc-class root-class indexstring skiplist))
+
+(defvar eieiodoc--class-indexstring)
+(defvar eieiodoc--class-root)
+
+(defun eieiodoc-class (root-class indexstring &optional skiplist)
+ "Create documentation starting with ROOT-CLASS.
+The first job is to create an indented menu of all the classes
+starting with `root-class' and including all it's children. Once this
+is done, @nodes are created for all the subclasses. Each node is then
+documented with a description of the class, a brief inheritance tree
+\(with xrefs) and a list of all slots in a big table. Where each slot
+is inherited from is also documented. In addition, each class is
+documented in the index referenced by INDEXSTRING, a two letter code
+described in the texinfo manual.
+
+The optional third argument SKIPLIST is a list of object not to put
+into any menus, nodes or lists."
+ (interactive
+ (list (intern-soft
+ (completing-read "Class: " (eieio-build-class-alist) nil t))
+ (read-string "Index name (2 chars): ")))
+ (if (looking-at "[ \t\n]+@end ignore")
+ (goto-char (match-end 0)))
+ (save-excursion
+ (setq eieiodoc-currently-in-node
+ (if (re-search-backward "@node \\([^,]+\\)" nil t)
+ (buffer-substring (match-beginning 1) (match-end 1))
+ "Top")
+ eieiodoc-current-section-level
+ (if (re-search-forward "@\\(chapter\\|\\(sub\\)*section\\)"
+ (+ (point) 500) t)
+ (progn
+ (goto-char (match-beginning 0))
+ (cond ((looking-at "@chapter") "section")
+ ((looking-at "@section") "subsection")
+ ((looking-at "@\\(sub\\)+section") "subsubsection")
+ (t "subsubsection")))
+ "subsubsection")))
+ (save-excursion
+ (eieiodoc-main-menu root-class skiplist)
+ (insert "\n")
+ (let ((eieiodoc--class-indexstring indexstring)
+ (eieiodoc--class-root root-class))
+ (eieiodoc-recurse root-class 'eieiodoc-one-node nil skiplist))))
+
+(defun eieiodoc-main-menu (class skiplist)
+ "Create a menu of all classes under CLASS indented the correct amount.
+SKIPLIST is a list of objects to skip"
+ (end-of-line)
+ (insert "\n@menu\n")
+ (eieiodoc-recurse class (lambda (class level)
+ (insert "* " (make-string level ? )
+ (symbol-name class) " ::\n"))
+ nil skiplist)
+ (insert "@end menu\n"))
+
+(defun eieiodoc-one-node (class level)
+ "Create a node for CLASS, and for all subclasses of CLASS in order.
+This function should only be called by `eieiodoc-class'
+Argument LEVEL is the current level of recursion we have hit."
+ (message "Building node for %s" class)
+ (insert "\n@node " (symbol-name class) ", "
+ (if eieiodoc-next-class (symbol-name eieiodoc-next-class) " ") ", "
+ (if eieiodoc-prev-class (symbol-name eieiodoc-prev-class) " ") ", "
+ eieiodoc-currently-in-node "\n"
+ "@comment node-name, next, previous, up\n"
+ "@" eieiodoc-current-section-level " " (symbol-name class) "\n"
+ "@" eieiodoc--class-indexstring
+ "index " (symbol-name class) "\n\n")
+ ;; Now lets create a nifty little inheritance tree
+ (let ((cl class)
+ (revlist nil)
+ (depth 0))
+ (while cl
+ (setq revlist (cons cl revlist)
+ cl (class-parent cl)))
+ (insert "@table @asis\n@item Inheritance Tree:\n")
+ (while revlist
+ (insert "@table @code\n@item "
+ (if (and (child-of-class-p (car revlist) eieiodoc--class-root)
+ (not (eq class (car revlist))))
+ (concat "@w{@xref{" (symbol-name (car revlist)) "}.}")
+ (symbol-name (car revlist)))
+ "\n")
+ (setq revlist (cdr revlist)
+ depth (1+ depth)))
+ (let ((clist (reverse (aref (class-v class) class-children))))
+ (if (not clist)
+ (insert "No children")
+ (insert "@table @asis\n@item Children:\n")
+ (while clist
+ (insert "@w{@xref{" (symbol-name (car clist)) "}")
+ (if (cdr clist) (insert ",") (insert "."))
+ (insert "} ")
+ (setq clist (cdr clist)))
+ (insert "\n@end table\n")
+ ))
+ (while (> depth 0)
+ (insert "\n@end table\n")
+ (setq depth (1- depth)))
+ (insert "@end table\n\n "))
+ ;; Now lets build some documentation by extracting information from
+ ;; the class description vector
+ (let* ((cv (class-v class))
+ (docs (aref cv class-public-doc))
+ (names (aref cv class-public-a))
+ (deflt (aref cv class-public-d))
+ (prot (aref cv class-protection))
+ (typev (aref cv class-public-type))
+ (i 0)
+ (set-one nil)
+ (anchor nil)
+ )
+ ;; doc of the class itself
+ (insert (eieiodoc-texify-docstring (documentation class) class)
+ "\n\n@table @asis\n")
+ (if names
+ (progn
+ (setq anchor (point))
+ (insert "@item Slots:\n\n@table @code\n")
+ (while names
+ (if (eieiodoc-one-attribute class (car names) (car docs)
+ (car prot) (car deflt) (aref typev i))
+ (setq set-one t))
+ (setq names (cdr names)
+ docs (cdr docs)
+ prot (cdr prot)
+ deflt (cdr deflt)
+ i (1+ i)))
+ (insert "@end table\n\n")
+ (if (not set-one) (delete-region (point) anchor))
+ ))
+ (insert "@end table\n")
+ ;; Finally, document all the methods associated with this class.
+ (let ((methods (eieio-all-generic-functions class))
+ (doc nil))
+ (if (not methods) nil
+ (if (string= eieiodoc-current-section-level "subsubsection")
+ (insert "@" eieiodoc-current-section-level)
+ (insert "@sub" eieiodoc-current-section-level))
+ (insert " Specialized Methods\n\n")
+ (while methods
+ (setq doc (eieio-method-documentation (car methods) class))
+ (insert "@deffn Method " (symbol-name (car methods)))
+ (if (not doc)
+ (insert "\n Undocumented")
+ (if (car doc)
+ (progn
+ (insert " :BEFORE ")
+ (eieiodoc-output-deffn-args (car (car doc)))
+ (insert "\n")
+ (eieiodoc-insert-and-massage-docstring-with-args
+ (cdr (car doc)) (car (car doc)) class)))
+ (setq doc (cdr doc))
+ (if (car doc)
+ (progn
+ (insert " :PRIMARY ")
+ (eieiodoc-output-deffn-args (car (car doc)))
+ (insert "\n")
+ (eieiodoc-insert-and-massage-docstring-with-args
+ (cdr (car doc)) (car (car doc)) class)))
+ (setq doc (cdr doc))
+ (if (car doc)
+ (progn
+ (insert " :AFTER ")
+ (eieiodoc-output-deffn-args (car (car doc)))
+ (insert "\n")
+ (eieiodoc-insert-and-massage-docstring-with-args
+ (cdr (car doc)) (car (car doc)) class)))
+ (insert "\n@end deffn\n\n"))
+ (setq methods (cdr methods)))))
+ ))
+
+(defun eieiodoc-insert-and-massage-docstring-with-args (doc arglst class)
+ "Update DOC with texinfo strings using ARGLST with @var.
+Argument CLASS is the class passed to `eieiodoc-texify-docstring'."
+ (let ((start (point))
+ (end nil)
+ (case-fold-search nil))
+ ;; Insert the text
+ (insert (eieiodoc-texify-docstring doc class))
+ (setq end (point))
+ (save-restriction
+ (narrow-to-region start end)
+ (save-excursion
+ ;; Now find arguments
+ (while arglst
+ (goto-char (point-min))
+ (while (re-search-forward (upcase (symbol-name (car arglst))) nil t)
+ (replace-match "@var{\\&}" t))
+ (setq arglst (cdr arglst)))))))
+
+(defun eieiodoc-output-deffn-args (arglst)
+ "Output ARGLST for a deffn."
+ (while arglst
+ (insert (symbol-name (car arglst)) " ")
+ (setq arglst (cdr arglst))))
+
+(defun eieiodoc-one-attribute (class attribute doc priv deflt type)
+ "Create documentation of CLASS for a single ATTRIBUTE.
+Assume this attribute is inside a table, so it is initiated with the
+@item indicator. If this attribute is not inserted (because it is
+contained in the parent) then return nil, else return t.
+DOC is the documentation to use, PRIV is non-nil if it is a private slot,
+and DEFLT is the default value. TYPE is the symbol describing what type
+validation is done on that slot."
+ (let ((pv (eieiodoc-parent-diff class attribute))
+ (ia (eieio-attribute-to-initarg class attribute))
+ (set-me nil))
+ (if (or (eq pv t) (not ia))
+ nil ;; same in parent or no init arg
+ (setq set-me t)
+ (insert "@item " (if priv "Private: " "")
+ (symbol-name ia))
+ (if (and type (not (eq type t)))
+ (insert "\nType: @code{" (format "%S" type) "}"))
+ (if (not (eq deflt eieio-unbound))
+ (insert " @*\nDefault Value: @code{"(format "%S" deflt) "}"))
+ (insert "\n\n")
+ (if (eq pv 'default)
+ ;; default differs only, xref the parent
+ ;; This should be upgraded to actually search for the last
+ ;; differing default (or the original.)
+ (insert "@xref{" (symbol-name (class-parent class)) "}.\n")
+ (insert (if doc (eieiodoc-texify-docstring doc class) "Not Documented")
+ "\n@refill\n\n")))
+ set-me))
+;;;
+;; Utilities
+;;
+(defun eieiodoc-recurse (rclass func &optional level skiplist)
+ "Recurse down all children of RCLASS, calling FUNC on each one.
+LEVEL indicates the current depth below the first call we are. The
+function FUNC will be called with RCLASS and LEVEL. This will then
+recursivly call itself once for each child class of RCLASS. The
+optional fourth argument SKIPLIST is a list of objects to ignore while
+recursing."
+
+ (if (not level) (setq level 0))
+
+ ;; we reverse the children so they appear in the same order as it
+ ;; does in the code that creates them.
+ (let* ((children (reverse (aref (class-v rclass) class-children)))
+ (ocnc eieiodoc-next-class)
+ (eieiodoc-next-class (or (car children) ocnc))
+ (eieiodoc-prev-class eieiodoc-prev-class))
+
+ (if (not (member rclass skiplist))
+ (progn
+ (apply func (list rclass level))
+
+ (setq eieiodoc-prev-class rclass)))
+
+ (while children
+ (setq eieiodoc-next-class (or (car (cdr children)) ocnc))
+ (setq eieiodoc-prev-class (eieiodoc-recurse (car children) func (1+ level)))
+ (setq children (cdr children)))
+ ;; return the previous class so that the prev/next node gets it right
+ eieiodoc-prev-class))
+
+(defun eieiodoc-parent-diff (class slot)
+ "Return nil if the parent of CLASS does not have slot SLOT.
+Return t if it does, and return 'default if the default has changed."
+ (let ((df nil) (err t)
+ (scoped-class (class-parent class))
+ (eieio-skip-typecheck))
+ (condition-case nil
+ (setq df (eieio-oref-default (class-parent class) slot)
+ err nil)
+ (invalid-slot-name (setq df nil))
+ (error (setq df nil)))
+ (if err
+ nil
+ (if (equal df (eieio-oref-default class slot))
+ t
+ 'default))))
+
+(defun eieiodoc-texify-docstring (string class)
+ "Take STRING, (a normal doc string), and convert it into a texinfo string.
+For instances where CLASS is the class being referenced, do not Xref
+that class.
+
+ `function' => @dfn{function}
+ `variable' => @code{variable}
+ `class' => @code{class} @xref{class}
+ `unknown' => @code{unknonwn}
+ 'quoteme => @code{quoteme}
+ non-nil => non-@code{nil}
+ t => @code{t}
+ :tag => @code{:tag}
+ [ stuff ] => @code{[ stuff ]}
+ Key => @kbd{Key}"
+ (while (string-match "`\\([-a-zA-Z0-9]+\\)'" string)
+ (let* ((vs (substring string (match-beginning 1) (match-end 1)))
+ (v (intern-soft vs)))
+ (setq string
+ (concat
+ (replace-match (concat
+ (if (and (not (class-p v))(fboundp v))
+ "@dfn{" "@code{")
+ vs "}"
+ (if (and (class-p v) (not (eq v class)))
+ (concat " @xref{" vs "}.")))
+ nil t string)))))
+ (while (string-match "\\( \\|^\\|-\\)\\(nil\\|t\\|'[-a-zA-Z0-9]+\\|:[-a-zA-Z0-9]+\\)\\([ ,]\\|$\\)" string)
+ (setq string (replace-match "@code{\\2}" t nil string 2)))
+ (while (string-match "\\( \\|^\\)\\(\\[[^]]+\\]\\)\\( \\|$\\)" string)
+ (setq string (replace-match "@code{\\2}" t nil string 2)))
+ (while (string-match "\\( \\|^\\)\\(\\(\\(C-\\|M-\\|S-\\)+\\([^ \t\n]\\|RET\\|SPC\\|TAB\\)\\)\\|\\(RET\\|SPC\\|TAB\\)\\)\\( \\|$\\)" string)
+ (setq string (replace-match "@kbd{\\2}" t nil string 2)))
+ string)
+
+(provide 'eieio-doc)
+
+;;; eieio-doc.el ends here
generated by cgit v1.2.3 (git 2.39.1) at 2025-06-10 21:39:06 +0000