developer-tools/autodoc.el

   1 ;;; autodoc.el --- Inline auto documentation of lisp sources files.
   2
   3 ;; Author: Thierry Volpiatto <thierry.volpiatto@gmail.com>
   4
   5 ;; Copyright (C) 2010 ~ 2012, Thierry Volpiatto, all rights reserved.
   6
   7 ;; Compatibility: GNU Emacs 23/24+
   8
   9 ;; This file is not part of GNU Emacs.
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 3, or
  14 ;; (at your option) any later version.
  15 ;;
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20 ;;
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
  24 ;; Floor, Boston, MA 02110-1301, USA.
  25
  26 ;;; Autodoc documentation:
  27 ;;  ---------------------
  28
  29 ;;  * Commands defined here are:
  30 ;; [EVAL] (autodoc-document-lisp-buffer :type 'command :prefix "autodoc" :docstring t)
  31 ;; `autodoc-insert-header'
  32 ;; Insert an auto documentation line of commented code to eval.
  33
  34 ;;  * Macros defined here are:
  35 ;; [EVAL] (autodoc-document-lisp-buffer :type 'macro :prefix "autodoc" :docstring t)
  36 ;; `autodoc-document-lisp-buffer'
  37 ;; Auto document tool for lisp code.
  38
  39 ;;  * Functions defined here are:
  40 ;; [EVAL] (autodoc-document-lisp-buffer :type 'function :prefix "autodoc" :docstring t)
  41 ;; `autodoc-find-readlines'
  42 ;; Return an alist of all the (num-line line) of a file or buffer BFILE matching REGEXP.
  43 ;; `autodoc-update-all'
  44 ;; Not documented.
  45 ;; `autodoc-document-default-prefix'
  46 ;; Return file name without extension as default prefix.
  47 ;; `autodoc-get-first-line-documentation'
  48 ;; Return first line documentation of symbol SYM.
  49
  50 ;;  * User variables defined here
  51 ;; [EVAL] (autodoc-document-lisp-buffer :type 'internal-variable :prefix "autodoc" :var-value t)
  52 ;; `autodoc-truncate-long-lines'
  53 ;; Default Value: 80
  54
  55 ;;  *** END auto-documentation
  56
  57 ;;; Code:
  58
  59 (eval-when-compile (require 'cl))
  60
  61
  62 (defsubst* autodoc-find-readlines (bfile regexp &key (insert-fn 'buffer))
  63   "Return an alist of all the (numline line)  matching REGEXP."
  64   (let ((fn (case insert-fn
  65               ('file 'insert-file-contents)
  66               ('buffer 'insert-buffer-substring))))
  67     (with-temp-buffer
  68       (funcall fn bfile) ; call insert function
  69       (goto-char (point-min))
  70       (loop
  71          with lines-list = (split-string (buffer-string) "\n")
  72          for i in lines-list for count from 0 when (string-match regexp i)
  73          collect (list count i) into lis
  74          finally return lis))))
  75
  76 (defvar autodoc-truncate-long-lines 80
  77   "* When set to nil don't truncate lines.")
  78 (defmacro* autodoc-document-lisp-buffer (&key type prefix docstring any-sname var-value)
  79   "Auto document tool for lisp code.
  80
  81 TYPE can be one of:
  82     - command
  83     - nested-command
  84     - function
  85     - nested-function
  86     - macro
  87     - internal-variable
  88     - nested-variable
  89     - user-variable
  90     - faces
  91     - anything-source
  92
  93 PREFIX let you define a special name by regexp,
  94 \(e.g match only function with PREFIX \"^autodoc-\")
  95
  96 Example: (autodoc-document-lisp-buffer :type 'function :prefix \"autodoc\").
  97
  98 It's better and more convenient to use `autodoc-insert-header'
  99 to setup your headers. However if you write your headers manually,
 100 don't forget to add this line at the end of your autodoc-documentation:
 101
 102     ;;  *** END auto-documentation
 103
 104 DOCSTRING, if set to non--nil, will display first line of docstring.
 105
 106 Example: (autodoc-document-lisp-buffer :type 'function :prefix \"^autodoc-\" :docstring t).
 107
 108 See headers of traverselisp.el for example."
 109   `(let* ((boundary-regexp "^;; +\\*+ .*")
 110           (regexp          (case ,type
 111                              ('command           "^\(def\\(un\\|subst\\)")
 112                              ('nested-command    "^ +\(def\\(un\\|subst\\)")
 113                              ('function          "^\(def\\(un\\|subst\\|advice\\)")
 114                              ('nested-function   "^ +\(def\\(un\\|subst\\|advice\\)")
 115                              ('macro             "^\(defmacro")
 116                              ('internal-variable "^\(defvar")
 117                              ('nested-variable   "^ +\(defvar")
 118                              ('user-variable     "\(defcustom")
 119                              ('faces             "\(defface")
 120                              ('anything-source   "^\(defvar anything-c-source")
 121                              (t (error           "Unknow type"))))
 122           (fn-list         (autodoc-find-readlines
 123                             (current-buffer)
 124                             regexp
 125                             :insert-fn 'buffer))
 126           beg end)
 127
 128      (flet ((maybe-insert-with-prefix (name)
 129               (let ((doc (or (autodoc-get-first-line-documentation (intern name))
 130                              "Not documented."))
 131                     (any-source-name (or (when (and ,any-sname (eq ,type 'anything-source))
 132                                            (concat
 133                                             " ("
 134                                             (assoc-default
 135                                              'name (symbol-value (intern name))) ")"))
 136                                          ""))
 137                     (var-def-value (or (when (and ,var-value (or (eq ,type 'internal-variable)
 138                                                                  (eq ,type 'nested-variable)
 139                                                                  (eq ,type 'user-variable)))
 140                                                   (concat "\n;; Default Value: "
 141                                                           (let ((it (replace-regexp-in-string
 142                                                                      "\n" " "
 143                                                                      (pp-to-string (symbol-value (intern name))))))
 144                                                             (if autodoc-truncate-long-lines
 145                                                                 (truncate-string-to-width
 146                                                                  it
 147                                                                  autodoc-truncate-long-lines nil nil " [...]")
 148                                                               it))))
 149                                        "")))
 150                 (cond ((and ,docstring ,prefix)
 151                        (when (string-match ,prefix name)
 152                          (insert (concat ";; \`" name "\'"
 153                                          var-def-value any-source-name "\n;; " doc "\n"))))
 154                       (,docstring
 155                        (insert (concat ";; \`" name "\'"
 156                                        var-def-value any-source-name "\n;; " doc "\n")))
 157                       (,prefix
 158                         (when (string-match ,prefix name)
 159                           (insert (concat ";; \`" name "\'"
 160                                           var-def-value any-source-name "\n"))))
 161                       (t (insert (concat ";; \`" name "\'"
 162                                          var-def-value any-source-name "\n")))))))
 163        (insert "\n") (setq beg (point))
 164        (save-excursion (when (re-search-forward boundary-regexp)
 165                          (forward-line -1) (setq end (point))))
 166        (delete-region beg end)
 167        (when (eq ,type 'anything-source) (setq regexp "\(defvar"))
 168        (dolist (i fn-list)
 169          (let* ((elm     (cadr i))
 170                 (elm1    (replace-regexp-in-string "\*" "" elm))
 171                 (elm-mod (replace-regexp-in-string regexp "" elm1))
 172                 (elm-fin (replace-regexp-in-string "\(\\|\)" ""(car (split-string elm-mod)))))
 173            (case ,type
 174              ('command
 175               (when (commandp (intern elm-fin))
 176                 (maybe-insert-with-prefix elm-fin)))
 177              ('nested-command
 178               (when (commandp (intern elm-fin))
 179                 (maybe-insert-with-prefix elm-fin)))
 180              ('function
 181               (when (not (commandp (intern elm-fin)))
 182                 (maybe-insert-with-prefix elm-fin)))
 183              ('nested-function
 184               (when (not (commandp (intern elm-fin)))
 185                 (maybe-insert-with-prefix elm-fin)))
 186              ('internal-variable
 187               (unless (string-match "anything-c-source" elm-fin)
 188                 (maybe-insert-with-prefix elm-fin)))
 189              (t
 190               (maybe-insert-with-prefix elm-fin)))))
 191        (setq end (point))
 192        (align-regexp beg end "\\(\\s-*\\)(" 1 1 nil))))
 193
 194 ;;;###autoload
 195 (defun autodoc-update-all ()
 196   "Eval all autodoc headers found."
 197   (interactive)
 198   (goto-char (point-min))
 199   (while (re-search-forward "^;; +\\[EVAL\\]" nil t)
 200     (end-of-line)
 201     ;; Avoid infinite loop if one write an eval followed by autodoc-update-all.
 202     (unless (save-excursion (search-backward "autodoc-update-all" (point-at-bol) t))
 203       (eval-last-sexp t)
 204       (while (not (bolp)) (delete-char -1)))))
 205
 206
 207 (defun autodoc-document-default-prefix ()
 208   "Return file name without extension as default prefix."
 209   (file-name-sans-extension (buffer-name (current-buffer))))
 210
 211
 212 (defun autodoc-get-first-line-documentation (sym)
 213   "Return first line documentation of symbol SYM."
 214   (let ((doc (cond ((fboundp sym)
 215                     (documentation sym t))
 216                    ((boundp sym)
 217                     (documentation-property sym 'variable-documentation t))
 218                    ((facep sym)
 219                     (face-documentation sym))
 220                    (t nil))))
 221     (when doc
 222       (car (split-string doc "\n")))))
 223
 224 ;;;###autoload
 225 (defun autodoc-insert-header (title &optional docstring)
 226   "Insert an auto documentation line of commented code to eval.
 227 With prefix arg insert also the docstring argument.
 228 See headers of `autodoc.el' for example."
 229   (interactive "sTitle: \nP")
 230   (let* ((ttype      (anything-comp-read "Type: " '("command" "nested-command"
 231                                                     "function" "nested-function"
 232                                                     "macro" "internal-variable"
 233                                                     "user-variable" "nested-variable"
 234                                                     "faces" "anything-source")))
 235          (prefix     (read-string "Prefix: " (autodoc-document-default-prefix)))
 236          (prefix-arg (concat " :prefix " "\"" prefix "\"")))
 237     (insert (concat ";;  * " title "\n"
 238                     ";; [EVAL] (autodoc-document-lisp-buffer :type \'"
 239                     ttype
 240                     (unless (string= prefix "") prefix-arg)
 241                     (when (and (string= ttype "anything-source")
 242                                (y-or-n-p "Insert Anything Source Name?"))
 243                       " :any-sname t")
 244                     (when (and (or (string= ttype "user-variable")
 245                                    (string= ttype "nested-variable")
 246                                    (string= ttype "internal-variable"))
 247                                (y-or-n-p "Insert variable Default value?"))
 248                       " :var-value t")
 249                     (when docstring " :docstring t") ")")
 250             (if (save-excursion (search-forward "*** END auto-documentation" nil t))
 251                 "" "\n\n\n;;  *** END auto-documentation"))))
 252
 253
 254 ;;; Provide
 255 (provide 'autodoc)
 256
 257 ;;; autodoc.el ends here.