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

   1 ;;; yas-doc-helper.el --- Help generate documentation for YASnippet
   2
   3 ;; Copyright (C) 2012, 2013  Free Software Foundation, Inc.
   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 (or (require 'org-publish nil t)
  31     (require 'ox-publish))
  32 (require 'yasnippet) ; docstrings must be loaded
  33
  34 (defun yas--org-raw-html (tag content)
  35   ;; in version 8.0 org-mode changed the export syntax, see
  36   ;; http://orgmode.org/worg/org-8.0.html#sec-8-1
  37   (format (if (version< org-version "8.0.0")
  38               "@<%s>%s@</%s>"                ; old: @<tag>
  39             "@@html:<%s>@@%s@@html:</%s>@@") ; new: @@html:<tag>@@
  40           tag content tag))
  41
  42 (defun yas--document-symbol (symbol level)
  43   (flet ((concat-lines (&rest lines)
  44                        (mapconcat #'identity lines "\n")))
  45     (let* ((stars (make-string level ?*))
  46            (args (and (fboundp symbol)
  47                       (mapcar #'symbol-name (help-function-arglist symbol t))))
  48            (heading (cond ((fboundp symbol)
  49                            (format
  50                             "%s =%s= (%s)" stars symbol
  51                             (mapconcat (lambda (a)
  52                                          (format (if (string-prefix-p "&" a)
  53                                                      "/%s/" "=%s=") a))
  54                                        args " ")))
  55                           (t
  56                            (format "%s =%s=\n" stars symbol))))
  57            (after-heading
  58             (concat-lines ":PROPERTIES:"
  59                           (format ":CUSTOM_ID: %s" symbol)
  60                           ":END:"))
  61            (body (or (cond ((fboundp symbol)
  62                             (let ((doc-synth (car-safe (get symbol 'function-documentation))))
  63                               (if (functionp doc-synth)
  64                                   (funcall doc-synth nil)
  65                                 (documentation symbol t))))
  66                            ((boundp symbol)
  67                             (documentation-property symbol 'variable-documentation t))
  68                            (t
  69                             (format "*WARNING*: no symbol named =%s=" symbol)))
  70                      (format "*WARNING*: no doc for symbol =%s=" symbol)))
  71            (case-fold-search nil))
  72       ;; do some transformations on the body:
  73       ;; ARGxxx becomes @<code>arg@</code>xxx
  74       ;; FOO becomes /foo/
  75       ;; `bar' becomes [[#bar][=bar=]]
  76       (setq body (replace-regexp-in-string
  77                   "\\<\\([A-Z][-A-Z0-9]+\\)\\(\\sw+\\)?\\>"
  78                   #'(lambda (match)
  79                       (let* ((match1 (match-string 1 match))
  80                              (prefix (downcase match1))
  81                              (suffix (match-string 2 match))
  82                              (fmt (cond
  83                                    ((member prefix args)
  84                                     (yas--org-raw-html "code" "%s"))
  85                                    ((null suffix) "/%s/"))))
  86                         (if fmt (format fmt prefix)
  87                           match1)))
  88                   body t t 1)
  89             body (replace-regexp-in-string
  90                   "`\\([a-z-]+\\)'"
  91                   #'(lambda (match)
  92                       (let* ((name (downcase (match-string 1 match)))
  93                              (sym (intern name)))
  94                         (if (memq sym yas--exported-syms)
  95                             (format "[[#%s][=%s=]]" name name)
  96                           (format "=%s=" name))))
  97                   body t))
  98       ;; output the paragraph
  99       ;;
 100       (concat-lines heading
 101                     after-heading
 102                     body))))
 103
 104 (defun yas--document-symbols (level &rest names-and-predicates)
 105   (let ((sym-lists (make-vector (length names-and-predicates) nil))
 106         (stars (make-string level ?*)))
 107     (loop for sym in yas--exported-syms
 108           do (loop for test in (mapcar #'cdr names-and-predicates)
 109                    for i from 0
 110                    do (when (funcall test sym)
 111                         (push sym (aref sym-lists i))
 112                         (return))))
 113     (loop for slist across sym-lists
 114           for name in (mapcar #'car names-and-predicates)
 115           concat (format "\n%s %s\n" stars name)
 116           concat (mapconcat (lambda (sym)
 117                               (yas--document-symbol sym (1+ level)))
 118                             slist "\n\n"))))
 119
 120 (defun yas--internal-link-snippet ()
 121   (interactive)
 122   (yas-expand-snippet "[[#$1][=${1:`yas/selected-text`}=]]"))
 123
 124 (define-key org-mode-map [M-f8] 'yas--internal-link-snippet)
 125
 126 ;; This lets all the org files be exported to HTML with
 127 ;; `org-publish-current-project' (C-c C-e P).
 128
 129 (let* ((dir (if load-file-name (file-name-directory load-file-name)
 130               default-directory))
 131        (rev (with-temp-file (expand-file-name "html-revision" dir)
 132               (or (when (eq (call-process "git" nil t nil
 133                                           "rev-parse" "--verify" "HEAD") 0)
 134                     (buffer-string))
 135                   (princ yas--version (current-buffer)))))
 136        (proj-plist
 137         `(,@(when (fboundp 'org-html-publish-to-html)
 138               '(:publishing-function org-html-publish-to-html))
 139           :base-directory ,dir :publishing-directory ,dir
 140           :html-preamble
 141           ,(with-temp-buffer
 142              (insert-file-contents (expand-file-name "nav-menu.html.inc" dir))
 143              (buffer-string))
 144           :html-postamble
 145           ,(concat "<hr><p class='creator'>Generated by %c on %d from "
 146                    rev "</p>\n"
 147                    "<p class='xhtml-validation'>%v</p>\n")))
 148        (project (assoc "yasnippet" org-publish-project-alist)))
 149   (if project
 150       (setcdr project proj-plist)
 151     (push `("yasnippet" . ,proj-plist)
 152           org-publish-project-alist)))
 153
 154 (defun yas--generate-html-batch ()
 155   (let ((org-publish-use-timestamps-flag nil)
 156         (org-export-copy-to-kill-ring nil)
 157         (org-confirm-babel-evaluate nil)
 158         (make-backup-files nil)
 159         (org-html-htmlize-output-type 'css))
 160     (org-publish "yasnippet" 'force)))
 161
 162
 163
 164 (provide 'yas-doc-helper)
 165 ;; Local Variables:
 166 ;; indent-tabs-mode: nil
 167 ;; coding: utf-8
 168 ;; End:
 169 ;;; yas-doc-helper.el ends here