code.delx.au - gnu-emacs-elpa/blob - doc/yas-doc-helper.el

   1 ;;; yas-doc-helper.el --- Help generate documentation for YASnippet
   2
   3 ;; Copyright (C) 2012  João Távora
   4
   5 ;; Author: João Távora <joaotavora@gmail.com>
   6 ;; Keywords: convenience
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;; Some functions to help generate YASnippet docs
  24
  25 ;;; Code:
  26
  27 (eval-when-compile
  28   (require 'cl))
  29 (require 'org)
  30 (require 'org-publish)
  31 (require 'yasnippet) ; docstrings must be loaded
  32
  33 (defun yas--document-symbol (symbol level)
  34   (flet ((concat-lines (&rest lines)
  35                        (mapconcat #'identity lines "\n")))
  36     (let* ((stars (make-string level ?*))
  37            (args (and (fboundp symbol)
  38                       (mapcar #'symbol-name (help-function-arglist symbol t))))
  39            (heading (cond ((fboundp symbol)
  40                            (format
  41                             "%s =%s= (%s)" stars symbol
  42                             (mapconcat (lambda (a)
  43                                          (format (if (string-prefix-p "&" a)
  44                                                      "/%s/" "=%s=") a))
  45                                        args " ")))
  46                           (t
  47                            (format "%s =%s=\n" stars symbol))))
  48            (after-heading
  49             (concat-lines ":PROPERTIES:"
  50                           (format ":CUSTOM_ID: %s" symbol)
  51                           ":END:"))
  52            (body (or (cond ((fboundp symbol)
  53                             (let ((doc-synth (car-safe (get symbol 'function-documentation))))
  54                               (if (functionp doc-synth)
  55                                   (funcall doc-synth nil)
  56                                 (documentation symbol t))))
  57                            ((boundp symbol)
  58                             (documentation-property symbol 'variable-documentation t))
  59                            (t
  60                             (format "*WARNING*: no symbol named =%s=" symbol)))
  61                      (format "*WARNING*: no doc for symbol =%s=" symbol)))
  62            (case-fold-search nil))
  63       ;; do some transformations on the body:
  64       ;; ARG becomes =arg=
  65       ;; FOO becomes /foo/
  66       ;; `bar' becomes [[#bar][=bar=]]
  67       (setq body (replace-regexp-in-string
  68                   "[A-Z][A-Z-]+" #'(lambda (match)
  69                                      (setq match (downcase match))
  70                                      (format (if (member match args)
  71                                                  "=%s=" "/%s/")
  72                                              match))
  73                   body t)
  74             body (replace-regexp-in-string "`\\([a-z-]+\\)'" #'(lambda (match)
  75                                                                  (let* ((name (downcase (match-string 1 match)))
  76                                                                         (sym (intern name)))
  77                                                                    (if (and (or (boundp sym)
  78                                                                                 (fboundp sym))
  79                                                                             (save-match-data
  80                                                                               (string-match "^yas-" name)))
  81                                                                        (format "[[#%s][=%s=]]"
  82                                                                                name name)
  83                                                                      (format "=%s=" name))))
  84                                            body))
  85       ;; output the paragraph
  86       ;;
  87       (concat-lines heading
  88                     after-heading
  89                     body))))
  90
  91 (defun yas--document-symbols (level &rest names-and-predicates)
  92   (let ((sym-lists (make-vector (length names-and-predicates) nil)))
  93     (loop for sym in yas--exported-syms
  94           do (loop for test in (mapcar #'cdr names-and-predicates)
  95                    for i from 0
  96                    do (when (funcall test sym)
  97                         (push sym (aref sym-lists i))
  98                         (return))))
  99     (loop for slist across sym-lists
 100           for name in (mapcar #'car names-and-predicates)
 101           concat (format "\n** %s\n" name)
 102           concat (mapconcat (lambda (sym)
 103                               (yas--document-symbol sym (1+ level)))
 104                             slist "\n\n"))))
 105
 106 (defun yas--internal-link-snippet ()
 107   (interactive)
 108   (yas-expand-snippet "[[#$1][=${1:`yas/selected-text`}=]]"))
 109
 110 (define-key org-mode-map [M-f8] 'yas--internal-link-snippet)
 111
 112 ;; This lets all the org files be exported to HTML with
 113 ;; `org-publish-current-project' (C-c C-e P).
 114
 115 (let* ((rev (or (with-temp-buffer
 116                   (when (eq (call-process "git" nil t nil
 117                                           "rev-parse" "--verify" "HEAD") 0)
 118                     (buffer-string)))
 119                 yas--version))
 120        (dir (if load-file-name (file-name-directory load-file-name)
 121               default-directory))
 122        (proj-plist
 123         (list
 124          :base-directory dir :publishing-directory dir
 125          :html-postamble
 126          (concat "<hr><p class='creator'>Generated by %c on %d from "
 127                  rev "</p>\n"
 128                  "<p class='xhtml-validation'>%v</p>\n")))
 129        (project (assoc "yasnippet" org-publish-project-alist)))
 130   (if project
 131       (setcdr project proj-plist)
 132     (push `("yasnippet" . ,proj-plist)
 133           org-publish-project-alist)))
 134
 135 (defun yas--generate-html-batch ()
 136   (let ((org-publish-use-timestamps-flag nil)
 137         (org-export-copy-to-kill-ring nil)
 138         (org-confirm-babel-evaluate nil)
 139         (make-backup-files nil))
 140     (org-publish "yasnippet" 'force)))
 141
 142
 143
 144 (provide 'yas-doc-helper)
 145 ;;; yas-doc-helper.el ends here
 146 ;; Local Variables:
 147 ;; coding: utf-8
 148 ;; End: