;;; yas-doc-helper.el --- Help generate documentation for YASnippet ;; Copyright (C) 2012, 2013 Free Software Foundation, Inc. ;; Author: João Távora ;; Keywords: convenience ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; Some functions to help generate YASnippet docs ;;; Code: (eval-when-compile (require 'cl)) (require 'org) (or (require 'org-publish nil t) (require 'ox-publish)) (require 'yasnippet) ; docstrings must be loaded (defun yas--org-raw-html (tag content &optional attrs) ;; in version 8.0 org-mode changed the export syntax, see ;; http://orgmode.org/worg/org-8.0.html#sec-8-1 (format (if (version< org-version "8.0.0") "@<%s>%s@" ; old: @ "@@html:<%s>@@%s@@html:@@") ; new: @@html:@@ (concat tag (if attrs " ") attrs) content tag)) (defun yas--document-symbol (symbol level) (let* ((stars (make-string level ?*)) (args (and (fboundp symbol) (mapcar #'symbol-name (help-function-arglist symbol t)))) (heading (cond ((fboundp symbol) (format "%s %s (%s)\n" stars (yas--org-raw-html "code" symbol "class='function'") (mapconcat (lambda (a) (format (if (string-prefix-p "&" a) "/%s/" "=%s=") a)) args " "))) (t (format "%s %s\n" stars (yas--org-raw-html "code" symbol "class='variable'"))))) (after-heading (format ":PROPERTIES:\n:CUSTOM_ID: %s\n:END:" symbol)) (text-quoting-style 'grave) (body (or (cond ((fboundp symbol) (let ((doc-synth (car-safe (get symbol 'function-documentation)))) (if (functionp doc-synth) (funcall doc-synth nil) (documentation symbol t)))) ((boundp symbol) (documentation-property symbol 'variable-documentation t)) (t (format "*WARNING*: no symbol named =%s=" symbol))) (format "*WARNING*: no doc for symbol =%s=" symbol))) (case-fold-search nil)) ;; Do some transformations on the body: ;; ARGxxx becomes @arg@xxx ;; FOO becomes /foo/ ;; `bar' becomes [[#bar][=bar=]] ;; (...) becomes #+BEGIN_SRC elisp (...) #+END_SRC ;; Info node `(some-manual) Node Name' becomes ;; [[https://www.gnu.org/software/emacs/manual/html_node/some-manual/Node-Name.html] ;; [(some-manual) Node Name]] ;; ;; This is fairly fragile, though it seems to be working for ;; now... (setq body (replace-regexp-in-string "\\<\\([A-Z][-A-Z0-9]+\\)\\(\\sw+\\)?\\>" #'(lambda (match) (let* ((match1 (match-string 1 match)) (prefix (downcase match1)) (suffix (match-string 2 match)) (fmt (cond ((member prefix args) (yas--org-raw-html "code" "%s")) ((null suffix) "/%s/")))) (if fmt (format fmt prefix) match1))) body t t 1) body (replace-regexp-in-string "\\\\{[^}]+}" (lambda (match) (concat "#+BEGIN_EXAMPLE\n" (substitute-command-keys match) "#+END_EXAMPLE\n")) body t t) body (substitute-command-keys body) body (replace-regexp-in-string "Info node `(\\([-a-z]+\\)) \\([A-Za-z0-9 ]+\\)'" (lambda (match) (let* ((manual (match-string 1 match)) (node (match-string 2 match)) (html-node (replace-regexp-in-string " " "-" node t t))) (format "Info node\ [[https://www.gnu.org/software/emacs/manual/html_node/%s/%s.html][(%s) %s]]" manual html-node manual node))) body t t) body (replace-regexp-in-string "`\\([-a-z]+\\)'" #'(lambda (match) (let* ((name (downcase (match-string 1 match))) (sym (intern-soft name))) (if (memq sym yas--exported-syms) (format "[[#%s][=%s=]]" name name) (format "=%s=" name)))) body t t) body (replace-regexp-in-string "\n\n +(.+\\(?:\n +.+\\)*" (lambda (match) (concat "\n#+BEGIN_SRC elisp\n" match "\n#+END_SRC\n")) body t t)) ;; output the paragraph (concat heading after-heading "\n" body))) (defun yas--document-symbols (level &rest names-and-predicates) (let ((sym-lists (make-vector (length names-and-predicates) nil)) (stars (make-string level ?*))) (loop for sym in yas--exported-syms do (loop for test in (mapcar #'cdr names-and-predicates) for i from 0 do (when (funcall test sym) (push sym (aref sym-lists i)) (return)))) (loop for slist across sym-lists for name in (mapcar #'car names-and-predicates) concat (format "\n%s %s\n" stars name) concat (mapconcat (lambda (sym) (yas--document-symbol sym (1+ level))) slist "\n\n")))) (defun yas--internal-link-snippet () (interactive) (yas-expand-snippet "[[#$1][=${1:`yas/selected-text`}=]]")) (define-key org-mode-map [M-f8] 'yas--internal-link-snippet) ;; This lets all the org files be exported to HTML with ;; `org-publish-current-project' (C-c C-e P). (defun yas--make-preamble (props) "Return contents of nav-menu-html.inc. But replace link to \"current\" page with a span element." (with-temp-buffer (let ((dir (file-name-directory (plist-get props :input-file)))) (insert-file-contents (expand-file-name "nav-menu.html.inc" dir)) (goto-char (point-min)) (search-forward (concat "")) (replace-match "") (search-forward "") (replace-match "") (buffer-string)))) (let* ((dir (if load-file-name (file-name-directory load-file-name) default-directory)) (src-epoch (getenv "SOURCE_DATE_EPOCH")) ;; Presence of SOURCE_DATE_EPOCH indicates a reproducible ;; build, don't depend on git. (rev (unless src-epoch (ignore-errors (car (process-lines "git" "describe" "--dirty"))))) (date (format-time-string "(%Y-%m-%d %H:%M:%S)" (seconds-to-time (string-to-number (or (if rev (car (process-lines "git" "show" "--format=%ct")) src-epoch) "0"))) t)) (proj-plist `(,@(when (fboundp 'org-html-publish-to-html) '(:publishing-function org-html-publish-to-html)) :base-directory ,dir :publishing-directory ,dir :html-preamble yas--make-preamble ;;:with-broken-links mark :html-postamble ,(concat "

Generated by %c from " (or rev yas--version) " " date "

\n" "

%v

\n"))) (project (assoc "yasnippet" org-publish-project-alist))) (when rev ;; Rakefile :doc:upload uses "html-revision". (with-temp-file (expand-file-name "html-revision" dir) (princ rev (current-buffer)))) (if project (setcdr project proj-plist) (push `("yasnippet" . ,proj-plist) org-publish-project-alist))) (defun yas--generate-html-batch () (let ((org-publish-use-timestamps-flag nil) (org-export-copy-to-kill-ring nil) (org-confirm-babel-evaluate nil) (make-backup-files nil) (org-html-htmlize-output-type 'css)) (org-publish "yasnippet" 'force))) (provide 'yas-doc-helper) ;; Local Variables: ;; indent-tabs-mode: nil ;; coding: utf-8 ;; End: ;;; yas-doc-helper.el ends here