code.delx.au - gnu-emacs-elpa/blob - lispdoc.el

   1 (require 'pp)
   2
   3 (defun update-lispdoc-tags ()
   4   (interactive)
   5   (save-excursion
   6     (goto-char (point-min))
   7     (while (re-search-forward "^@c lispfun \\(.+\\)" nil t)
   8       (let ((name (match-string 1)) begin end)
   9         (message "Update lispdoc for function '%s'" name)
  10         (if (re-search-forward (concat "^@defun " name) nil t)
  11             (setq begin (match-beginning 0)))
  12         (if (re-search-forward "^@end defun" nil t)
  13             (setq end (match-end 0)))
  14         (if (and begin end)
  15             (delete-region begin end))
  16         (let* ((sym (or (intern-soft name)
  17                         (signal 'wrong-type-argument
  18                                 (list 'functionp name))))
  19                (data (let ((func (symbol-function sym)))
  20                        (while (symbolp func)
  21                          (setq func (symbol-function func)))
  22                        func))
  23                (args (pp-to-string (if (listp data)
  24                                        (cadr data)
  25                                      (aref data 0))))
  26                (doc (documentation sym)))
  27           (if (or (null doc) (= (length doc) 0))
  28               (message "warning: no documentation available for '%s'" name)
  29             (unless (and begin end)
  30               (insert ?\n ?\n))
  31             (insert (format "@defun %s %s\n" name
  32                             (substring args 1 (- (length args) 2))))
  33             (setq begin (point))
  34             (insert doc ?\n)
  35             (save-restriction
  36               (narrow-to-region begin (point))
  37               (goto-char (point-min))
  38               (let ((case-fold-search nil))
  39                 (while (re-search-forward "[A-Z][A-Z-]+" nil t)
  40                   (replace-match (format "@var{%s}"
  41                                          (downcase (match-string 0))) t t)))
  42               (goto-char (point-max)))
  43             (insert "@end defun")))))))
  44
  45 (defun chess-undocd-functions ()
  46   (interactive)
  47   (save-excursion
  48     (dolist (func (apropos-internal "^chess-" 'functionp))
  49       (goto-char (point-min))
  50       (unless (search-forward (concat "@c lispfun " (symbol-name func)) nil t)
  51         (message "Missing documentation for '%s'" (symbol-name func))))))
  52
  53 (provide 'lispdoc)