X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/730d2fe311363fadfe3af1b3f1cfbbbec5cf5790..4c77f20e144dc409e3c59abdb7105fb0db41ee54:/packages/yasnippet/doc/yas-doc-helper.el diff --git a/packages/yasnippet/doc/yas-doc-helper.el b/packages/yasnippet/doc/yas-doc-helper.el index c575c0a40..f4cd49bfd 100755 --- a/packages/yasnippet/doc/yas-doc-helper.el +++ b/packages/yasnippet/doc/yas-doc-helper.el @@ -24,47 +24,77 @@ ;;; 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) + ;; 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:@@ + tag content tag)) + (defun yas--document-symbol (symbol level) (flet ((concat-lines (&rest lines) (mapconcat #'identity lines "\n"))) (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)" - stars - symbol - (mapconcat #'symbol-name - (help-function-arglist symbol t) " "))) + (format + "%s =%s= (%s)" stars symbol + (mapconcat (lambda (a) + (format (if (string-prefix-p "&" a) + "/%s/" "=%s=") a)) + args " "))) (t (format "%s =%s=\n" stars symbol)))) (after-heading (concat-lines ":PROPERTIES:" (format ":CUSTOM_ID: %s" symbol) ":END:")) - (body (or (cond ((boundp symbol) + (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)) - ((fboundp symbol) - (documentation-property symbol 'function-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: FOO becomes /foo/ and + ;; do some transformations on the body: + ;; ARGxxx becomes @arg@xxx + ;; FOO becomes /foo/ ;; `bar' becomes [[#bar][=bar=]] (setq body (replace-regexp-in-string - "[A-Z][A-Z-]+" #'(lambda (match) - (format "/%s/" (downcase match))) - body) - body (replace-regexp-in-string "`\\([a-z-]+\\)'" #'(lambda (match) - (let* ((name (downcase (match-string 1 match))) - (sym (intern name))) - (if (and (or (boundp sym) - (fboundp sym)) - (save-match-data - (string-match "^yas-" name))) - (format "[[#%s][=%s=]]" - name name) - (format "=%s=" name)))) - body)) + "\\<\\([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 + "`\\([a-z-]+\\)'" + #'(lambda (match) + (let* ((name (downcase (match-string 1 match))) + (sym (intern name))) + (if (memq sym yas--exported-syms) + (format "[[#%s][=%s=]]" name name) + (format "=%s=" name)))) + body t)) ;; output the paragraph ;; (concat-lines heading @@ -72,8 +102,8 @@ body)))) (defun yas--document-symbols (level &rest names-and-predicates) - (let ((sym-lists (make-vector (length names-and-predicates) (list))) - (retval "")) + (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 @@ -82,12 +112,10 @@ (return)))) (loop for slist across sym-lists for name in (mapcar #'car names-and-predicates) - do (progn - (setq retval - (concat retval - (format "\n** %s\n" name) - (mapconcat #'yas--document-symbol slist "\n\n"))))) - retval)) + 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) @@ -95,8 +123,46 @@ (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). + +(let* ((dir (if load-file-name (file-name-directory load-file-name) + default-directory)) + (rev (with-temp-file (expand-file-name "html-revision" dir) + (or (when (eq (call-process "git" nil t nil + "rev-parse" "--verify" "HEAD") 0) + (buffer-string)) + (princ yas--version (current-buffer))))) + (proj-plist + `(,@(when (fboundp 'org-html-publish-to-html) + '(:publishing-function org-html-publish-to-html)) + :base-directory ,dir :publishing-directory ,dir + :html-preamble + ,(with-temp-buffer + (insert-file-contents (expand-file-name "nav-menu.html.inc" dir)) + (buffer-string)) + :html-postamble + ,(concat "

Generated by %c on %d from " + rev "

\n" + "

%v

\n"))) + (project (assoc "yasnippet" org-publish-project-alist))) + (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-publish "yasnippet" 'force))) + + + (provide 'yas-doc-helper) -;;; yas-doc-helper.el ends here ;; Local Variables: +;; indent-tabs-mode: nil ;; coding: utf-8 ;; End: +;;; yas-doc-helper.el ends here