ld/yasnippet
1
0
Fork 0
mirror of https://github.com/joaotavora/yasnippet.git synced 2025-10-13 21:13:04 +00:00
Code Issues Packages Projects Releases Wiki Activity

Remove last use of flet

Browse Source 
It is obsolete as of 24.3, and this particular use of flet in this place
isn't much use anyway.

* doc/yas-doc-helper.el (yas--document-symbol): Stop using flet.

Fixes #752
This commit is contained in:
Noam Postavsky 2016-11-28 22:20:31 -05:00
parent 8412d71e44
commit c485d13995
1 changed files with 52 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

112
doc/yas-doc-helper.el
View File

@ -40,66 +40,58 @@
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 (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 ((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 @<code>arg@</code>xxx
;; FOO becomes /foo/
;; `bar' becomes [[#bar][=bar=]]
(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
"`\\([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
after-heading
body))))
(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 (lambda (a)
(format (if (string-prefix-p "&" a)
"/%s/" "=%s=") a))
args " ")))
(t
(format "%s =%s=\n" stars symbol))))
(after-heading (format ":PROPERTIES:\n:CUSTOM_ID: %s\n:END:" 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))
(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 @<code>arg@</code>xxx
;; FOO becomes /foo/
;; `bar' becomes [[#bar][=bar=]]
(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
"`\\([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 heading "\n" after-heading "\n" body)))
(defun yas--document-symbols (level &rest names-and-predicates)
(let ((sym-lists (make-vector (length names-and-predicates) nil))