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

Fix: Closes #330

Browse Source
This commit is contained in:
Joao Tavora 2012-11-16 15:15:24 +00:00
parent b29e4b9259
commit 0778a1b61b
2 changed files with 89 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
yasnippet-tests.el
View File

@ -297,8 +297,9 @@ TODO: correct this bug!"
(yas-with-some-interesting-snippet-dirs (yas-with-some-interesting-snippet-dirs
(yas-reload-all) (yas-reload-all)
(yas-recompile-all) (yas-recompile-all)
(flet ((yas--load-directory-2 (yas--with-temporary-redefinitions ((yas--load-directory-2
(&rest dummies) (&rest dummies)
(declare (ignore dummies))
(ert-fail "yas--load-directory-2 shouldn't be called when snippets have been compiled"))) (ert-fail "yas--load-directory-2 shouldn't be called when snippets have been compiled")))
(yas-reload-all) (yas-reload-all)
(yas--basic-jit-loading-1)))) (yas--basic-jit-loading-1))))

50
yasnippet.el
View File

@ -147,13 +147,6 @@
(defvar yas-selected-text) (defvar yas-selected-text)
(defvar yas-verbosity)) (defvar yas-verbosity))
;; Future-proof against obsoleting flet, see github #324
;;
(eval-and-compile
(unless (fboundp 'cl-flet)
(defalias 'cl-flet 'flet)
(put 'cl-flet 'lisp-indent-function 1)
(put 'cl-flet 'edebug-form-spec '((&rest (defun*)) cl-declarations body))))
;;; User customizable variables ;;; User customizable variables
@ -1312,6 +1305,7 @@ them all in `yas--menu-table'"
:visible (yas--show-menu-p ',mode))) :visible (yas--show-menu-p ',mode)))
menu-keymap)) menu-keymap))
(defmacro yas--called-interactively-p (&optional kind) (defmacro yas--called-interactively-p (&optional kind)
"A backward-compatible version of `called-interactively-p'. "A backward-compatible version of `called-interactively-p'.
@ -1321,6 +1315,43 @@ in GNU Emacs 24.1 or higher."
'(called-interactively-p) '(called-interactively-p)
`(called-interactively-p ,kind))) `(called-interactively-p ,kind)))
(defun yas--call-with-temporary-redefinitions (function
&rest function-names-and-overriding-functions)
(let* ((overrides (remove-if-not #'(lambda (fdef)
(fboundp (first fdef)))
function-names-and-overriding-functions))
(definition-names (mapcar #'first overrides))
(overriding-functions (mapcar #'second overrides))
(saved-functions (mapcar #'symbol-function definition-names)))
;; saving all definitions before overriding anything ensures FDEFINITION
;; errors don't cause accidental permanent redefinitions.
;;
(labels ((set-fdefinitions (names functions)
(loop for name in names
for fn in functions
do (fset name fn))))
(set-fdefinitions definition-names overriding-functions)
(unwind-protect (funcall function)
(set-fdefinitions definition-names saved-functions)))))
(defmacro yas--with-temporary-redefinitions (fdefinitions &rest body)
;; "Temporarily (but globally) redefine each function in FDEFINITIONS.
;; E.g.: (yas--with-temporary-redefinitions ((foo (x) ...)
;; (bar (x) ...))
;; ;; code that eventually calls foo, bar of (setf foo)
;; ...)"
`(yas--call-with-temporary-redefinitions
(lambda () ,@body)
,@(mapcar #'(lambda (thingy)
`(list ',(first thingy)
(lambda ,@(rest thingy))))
fdefinitions)))
(put 'yas--with-temporary-redefinitions 'lisp-indent-function 1)
(put 'yas--with-temporary-redefinitions 'edebug-form-spec '((&rest (defun*)) cl-declarations body))
;;; Template-related and snippet loading functions ;;; Template-related and snippet loading functions
@ -1882,7 +1913,8 @@ foo\"bar\\! -> \"foo\\\"bar\\\\!\""
This works by stubbing a few functions, then calling This works by stubbing a few functions, then calling
`yas-load-directory'." `yas-load-directory'."
(interactive "DTop level snippet directory?") (interactive "DTop level snippet directory?")
(cl-flet ((yas--load-yas-setup-file (yas--with-temporary-redefinitions
((yas--load-yas-setup-file
(file) (file)
(let ((elfile (concat file ".el"))) (let ((elfile (concat file ".el")))
(when (file-exists-p elfile) (when (file-exists-p elfile)
@ -3662,7 +3694,7 @@ Returns the newly created snippet."
This is according to their relative positions in the buffer, and This is according to their relative positions in the buffer, and
has to be called before the $-constructs are deleted." has to be called before the $-constructs are deleted."
(cl-flet ((yas--fom-set-next-fom (fom nextfom) (labels ((yas--fom-set-next-fom (fom nextfom)
(cond ((yas--field-p fom) (cond ((yas--field-p fom)
(setf (yas--field-next fom) nextfom)) (setf (yas--field-next fom) nextfom))
((yas--mirror-p fom) ((yas--mirror-p fom)