Download
(defvar auto-document-version "$Id: auto-document.el,v 1.16 2010/05/04 09:00:52 rubikitch Exp $")
(eval-when-compile (require 'cl))
(defgroup auto-document nil
"auto-document"
:group 'lisp)
(defcustom adoc-command-list-header-message "Below are complete command list"
"*The first line of `Commands' section."
:type 'string
:group 'auto-document)
(defcustom adoc-command-name-format ";; `%s'\n"
"*Format string of listing command name."
:type 'string
:group 'auto-document)
(defcustom adoc-command-doc-format ";; %s\n"
"*Format string of docstring (1st line only)."
:type 'string
:group 'auto-document)
(defcustom adoc-option-list-header-message "Below are customizable option list"
"*The first line of `Customizable Options' section."
:type 'string
:group 'auto-document)
(defcustom adoc-option-name-format ";; `%s'\n"
"*Format string of listing option name."
:type 'string
:group 'auto-document)
(defcustom adoc-option-doc-format ";; %s\n"
"*Format string of docstring (1st line only)."
:type 'string
:group 'auto-document)
(defcustom adoc-option-default-format ";; default = %s\n"
"*Format string of default value."
:type 'string
:group 'auto-document)
(defcustom adoc-document-insert-position "\n;;; Commentary"
"*Auto document is inserted after the occurrence of this string."
:type 'string
:group 'auto-document)
(defcustom adoc-print-length 5
"*Maximum length of list to print before abbreviating.
See also `print-length'."
:type 'integer
:group 'auto-document)
(defcustom adoc-print-level 3
"*Maximum depth of list nesting to print before abbreviating.
See also `print-level'."
:type 'integer
:group 'auto-document)
(defcustom adoc-define-command-functions
'( define-derived-mode define-compilation-mode
easy-mmode-define-minor-mode define-minor-mode easy-mmode-define-global-mode
define-global-minor-mode define-globalized-minor-mode define-generic-mode)
"*Define command functions."
:type 'list
:group 'auto-document)
(defcustom adoc-exclude-file-regexp nil
"*Regexp of files not to apply `auto-document'."
:type 'string
:group 'auto-document)
(defun adoc-construct (buf)
"Scan for command definitions in BUF and return data structure."
(save-excursion
(set-buffer buf)
(goto-char (point-min))
(adoc-construct-from-sexps
(loop with it
while (setq it (condition-case v (read (current-buffer)) (error nil)))
collect it))))
(defun adoc-construct-from-sexps (sexps)
(loop with doc
for sexp in sexps
for func = (car sexp)
for doc = (ignore-errors (nth (get func 'doc-string-elt) sexp))
when (and (stringp doc)
(or (and (memq func '(defun* defun))
(eq (car-safe (nth 4 sexp)) 'interactive))
(memq func adoc-define-command-functions)))
collect (cons (nth 1 sexp) doc) into commands
when (and (stringp doc)
(eq func 'defcustom))
collect (list (nth 1 sexp) doc (nth 2 sexp)) into options
finally (return (list commands options))))
(defun adoc-output (buf)
"Scan for command definitions in BUF and generate command list."
(destructuring-bind (commands options)
(adoc-construct buf)
(adoc-output-commands commands)
(adoc-output-separator)
(adoc-output-customizable-options options)))
(defun adoc-output-section (section pairs header-msg name-fmt doc-fmt)
(adoc-output-section-header section header-msg)
(loop for (name . doc) in pairs do
(princ (format name-fmt name))
(princ (format doc-fmt (substring doc 0 (string-match "$" doc))))))
(defun adoc-output-commands (pairs)
(adoc-output-section-header "Commands" adoc-command-list-header-message)
(loop for (name . doc) in pairs do
(princ (format adoc-command-name-format name))
(princ (format adoc-command-doc-format (adoc-first-line doc)))))
(defun adoc-output-customizable-options (pairs)
(adoc-output-section-header "Customizable Options" adoc-option-list-header-message)
(loop for (name doc default) in pairs do
(princ (format adoc-option-name-format name))
(princ (format adoc-option-doc-format (adoc-first-line doc)))
(princ (format adoc-option-default-format (adoc-prin1-to-string default)))))
(defun adoc-prin1-to-string (object)
(let ((print-escape-newlines t)
(print-escape-nonascii t)
(print-length adoc-print-length)
(print-level adoc-print-level))
(prin1-to-string object)))
(defun adoc-first-line (str)
"Get first line of STR."
(substring str 0 (string-match "$" str)))
(defun adoc-output-section-header (section header-msg)
(princ (concat ";;; " section ":\n"))
(princ ";;\n")
(princ (format ";; %s:\n" header-msg))
(princ ";;\n"))
(defun adoc-output-separator ()
(princ ";;\n"))
(defun adoc-prepare (buf)
"Prepare to insert command list."
(progn
(set-buffer buf)
(goto-char (point-min))
(if (not (search-forward adoc-document-insert-position nil t))
(error "Cannot find Commentary section")
(cond ((search-forward "\n;;; Commands:\n" nil t)
(let ((s (match-beginning 0)) e)
(when (search-forward "\n\n" nil t)
(setq e (1- (point)))
(delete-region s e))))
((and (search-forward ";" nil t) (search-forward "\n\n" nil t))
t)
(t
(error "Cannot prepare to insert command summary"))))))
(defun auto-document-maybe ()
"Insert or update command list of current buffer if the major-mode is `emacs-lisp-mode'."
(when (and (eq major-mode 'emacs-lisp-mode)
(not (and adoc-exclude-file-regexp
(string-match adoc-exclude-file-regexp
(or buffer-file-name "")))))
(ignore-errors (auto-document))))
(defun auto-document ()
"Insert or update command list of current buffer."
(interactive)
(save-excursion
(adoc-prepare (current-buffer))
(insert (with-output-to-string (adoc-output (current-buffer))) "\n")))
(defun auto-document-test (filename)
"Display generated document of FILENAME."
(interactive "fDocument for Elisp: ")
(with-output-to-temp-buffer "*Document Generator*"
(adoc-output (find-file-noselect filename))))
(defvar adoc-maintainer-mail-address
(concat "rubiki" "tch@ru" "by-lang.org"))
(defvar adoc-bug-report-salutation
"Describe bug below, using a precise recipe.
When I executed M-x ...
How to send a bug report:
1) Be sure to use the LATEST version of auto-document.el.
2) Enable debugger. M-x toggle-debug-on-error or (setq debug-on-error t)
3) Use Lisp version instead of compiled one: (load \"auto-document.el\")
4) If you got an error, please paste *Backtrace* buffer.
5) Type C-c C-c to send.
# If you are a Japanese, please write in Japanese:-)")
(defun adoc-send-bug-report ()
(interactive)
(reporter-submit-bug-report
adoc-maintainer-mail-address
"auto-document.el"
(apropos-internal "^adoc-" 'boundp)
nil nil
adoc-bug-report-salutation))
(dont-compile
(when (fboundp 'expectations)
(expectations
(desc "defun")
(expect '(((foo . "foodoc")) nil)
(adoc-construct-from-sexps
'((defun foo ()
"foodoc"
(interactive)))))
(expect '(((foo2 . "foo2doc")) nil)
(adoc-construct-from-sexps
'((defun* foo2 ()
"foo2doc"
(interactive)))))
(expect '(nil nil)
(adoc-construct-from-sexps
'((defun* foo3 ()
"foo3doc"))))
(expect '(nil nil)
(adoc-construct-from-sexps
'((defun* foo4 ()
(interactive)))))
(expect '(nil nil)
(adoc-construct-from-sexps
'((defun func (arg)
"doc"
"string"
))))
(desc "define-minor-mode")
(expect '(((foo-mode . "foo minor mode")) nil)
(adoc-construct-from-sexps
'((define-minor-mode foo-mode
"foo minor mode"))))
(desc "defcustom")
(expect '(nil ((custom-var "vardoc" 22)))
(adoc-construct-from-sexps
'((defcustom custom-var 22
"vardoc"))))
(desc "combination")
(expect '(((foo . "foodoc")) ((custom-var "vardoc" 22)))
(adoc-construct-from-sexps
'((defcustom custom-var 22
"vardoc")
(defun foo ()
"foodoc"
(interactive)))))
)))
(provide 'auto-document)