Update for use with -batch switch

- Require the `package' and `help-fns' libraries which aren't loaded
  when using the `-batch' switch with Emacs.

- Add options to specify which style sheet to use and whether to only
  print the body (so no `<doctype>' or `<html>' etc.)

- Reverse the list of symbols to show up in the same order as they
  appear in the buffer.

- Replace `case' with a `cond', I didn't realize `case' was part of the
  cl-lib.

- Add function to be used with the `-batch' switch.
This commit is contained in:
Tom Willemse 2013-12-09 00:06:34 +01:00
parent 473969a654
commit d88ad750c2

View file

@ -25,6 +25,15 @@
;;; Code: ;;; Code:
(require 'package)
(require 'help-fns)
(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.")
(defun edocs--list-symbols () (defun edocs--list-symbols ()
"Get a list of all symbols in the buffer. "Get a list of all symbols in the buffer.
@ -46,22 +55,22 @@ etc."
(match-beginning 1) (match-end 1)) (match-beginning 1) (match-end 1))
(buffer-substring-no-properties (buffer-substring-no-properties
(match-beginning 2) (match-end 2))) ls)))) (match-beginning 2) (match-end 2))) ls))))
ls)) (reverse ls)))
(defun edocs--get-docs (type name) (defun edocs--get-docs (type name)
"Get docs of TYPE for symbol NAME." "Get docs of TYPE for symbol NAME."
(let ((type (intern type)) (let ((type (intern type))
(obj (intern name))) (obj (intern name)))
(case type (cond
((defun define-minor-mode) ((memq type '(defun define-minor-mode))
(cons (format "%s" (or (help-function-arglist obj :preserve-names) (cons (format "%s" (or (help-function-arglist obj :preserve-names)
"()")) "()"))
(documentation obj))) (documentation obj)))
((defcustom defvar defconst defclass) ((memq type '(defcustom defvar defconst defclass))
(documentation-property obj 'variable-documentation)) (documentation-property obj 'variable-documentation))
(defgroup ((eql type 'defgroup)
(documentation-property obj 'group-documentation)) (documentation-property obj 'group-documentation))
(defgeneric ((eql type 'defgeneric)
(mapcar (lambda (itm) (mapcar (lambda (itm)
(cons (format "%s" (cons (list (car (nth 2 itm)) (cons (format "%s" (cons (list (car (nth 2 itm))
(car itm)) (car itm))
@ -87,9 +96,13 @@ etc."
(let ((buffer (get-buffer-create "*edocs*")) (let ((buffer (get-buffer-create "*edocs*"))
(binfo (package-buffer-info))) (binfo (package-buffer-info)))
(with-current-buffer buffer (with-current-buffer buffer
(unless edocs-generate-only-body
(insert "<!DOCTYPE html>\n" (insert "<!DOCTYPE html>\n"
"<html><body>" "<html><head>"
"<h1>" (aref binfo 0) " <small>" (aref binfo 2) "<link href=\"" edocs-stylesheet-location
"\" rel=\"stylesheet\"></head><body>"))
(insert "<div class=\"container\">"
"<h1>" (aref binfo 0) " <small>&mdash; " (aref binfo 2)
"</small></h1><p>" "</small></h1><p>"
(replace-regexp-in-string (replace-regexp-in-string
";; " "" (replace-regexp-in-string ";; " "" (replace-regexp-in-string
@ -99,7 +112,7 @@ etc."
(let ((docs (edocs--get-docs (car itm) (cdr itm)))) (let ((docs (edocs--get-docs (car itm) (cdr itm))))
(with-current-buffer buffer (with-current-buffer buffer
(mapc (lambda (doc) (mapc (lambda (doc)
(insert "<div>&mdash; " (insert "<div>&ndash; "
(edocs--get-type-display (car itm)) (edocs--get-type-display (car itm))
" <tt>" (cdr itm) "</tt> " " <tt>" (cdr itm) "</tt> "
(if (consp doc) (car doc) "") (if (consp doc) (car doc) "")
@ -116,8 +129,19 @@ etc."
docs))))) docs)))))
(edocs--list-symbols)) (edocs--list-symbols))
(with-current-buffer buffer (with-current-buffer buffer
(insert "</body></html>")) (insert "</div>")
(unless edocs-generate-only-body
(insert "</body></html>")))
(switch-to-buffer buffer))) (switch-to-buffer buffer)))
(defun edocs-generate-batch ()
"Generate module docs using batch operations."
(mapc (lambda (file)
(with-current-buffer (find-file file)
(eval-buffer)
(edocs-generate)
(write-file (concat (file-name-sans-extension file) ".html"))))
command-line-args-left))
(provide 'edocs) (provide 'edocs)
;;; edocs.el ends here ;;; edocs.el ends here