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

Replace yas--with-temp-redefs with cl-letf

Browse Source 
* yasnippet-tests.el (yas--call-with-temporary-redefinitions):
yas--with-temporary-redefinitions): Remove.
* yasnippet-tests.el (yas-with-overriden-buffer-list):
(basic-jit-loading-with-compiled-snippets):
(visiting-compiled-snippets): Use cl-letf.
This commit is contained in:
Noam Postavsky 2016-10-07 20:01:58 -04:00
parent 00be21c717
commit ff6f31ee2c
1 changed files with 12 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
yasnippet-tests.el
View File

@ -526,48 +526,16 @@ TODO: correct this bug!"
;;; Loading ;;; Loading
;;; ;;;
(defun yas--call-with-temporary-redefinitions (function
&rest function-names-and-overriding-functions)
(let* ((overrides (cl-remove-if-not (lambda (fdef)
(fboundp (car fdef)))
function-names-and-overriding-functions))
(definition-names (mapcar #'car overrides))
(overriding-functions (mapcar #'cl-second overrides))
(saved-functions (mapcar #'symbol-function definition-names)))
;; saving all definitions before overriding anything ensures FDEFINITION
;; errors don't cause accidental permanent redefinitions.
;;
(cl-labels ((set-fdefinitions (names functions)
(cl-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)
;; ...)"
;; FIXME: This is hideous! Better use defadvice (or at least letf).
`(yas--call-with-temporary-redefinitions
(lambda () ,@body)
,@(mapcar #'(lambda (thingy)
`(list ',(car thingy)
(lambda ,@(cdr thingy))))
fdefinitions)))
(defmacro yas-with-overriden-buffer-list (&rest body) (defmacro yas-with-overriden-buffer-list (&rest body)
(let ((saved-sym (make-symbol "yas--buffer-list"))) (let ((saved-sym (make-symbol "yas--buffer-list")))
`(let ((,saved-sym (symbol-function 'buffer-list))) `(let ((,saved-sym (symbol-function 'buffer-list)))
(yas--with-temporary-redefinitions (cl-letf (((symbol-function 'buffer-list)
((buffer-list () (lambda ()
(cl-remove-if (lambda (buf) (cl-remove-if (lambda (buf)
(with-current-buffer buf (with-current-buffer buf
(eq major-mode 'lisp-interaction-mode))) (eq major-mode 'lisp-interaction-mode)))
(funcall ,saved-sym)))) (funcall ,saved-sym)))))
,@body)))) ,@body))))
@ -610,9 +578,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)
(yas--with-temporary-redefinitions ((yas--load-directory-2 (cl-letf (((symbol-function 'yas--load-directory-2)
(&rest _dummies) (lambda (&rest _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))))
@ -672,9 +640,9 @@ TODO: correct this bug!"
(yas-with-some-interesting-snippet-dirs (yas-with-some-interesting-snippet-dirs
(yas-recompile-all) (yas-recompile-all)
(yas-reload-all 'no-jit) ; must be loaded for `yas-lookup-snippet' to work. (yas-reload-all 'no-jit) ; must be loaded for `yas-lookup-snippet' to work.
(yas--with-temporary-redefinitions ((find-file-noselect (cl-letf (((symbol-function 'find-file-noselect)
(filename &rest _) (lambda (filename &rest _)
(throw 'yas-snippet-file filename))) (throw 'yas-snippet-file filename))))
(should (string-suffix-p (should (string-suffix-p
"cc-mode/def" "cc-mode/def"
(catch 'yas-snippet-file (catch 'yas-snippet-file
@ -1088,13 +1056,6 @@ attention to case differences."
(put 'yas-with-overriden-buffer-list 'edebug-form-spec t) (put 'yas-with-overriden-buffer-list 'edebug-form-spec t)
(put 'yas-with-some-interesting-snippet-dirs 'edebug-form-spec t) (put 'yas-with-some-interesting-snippet-dirs 'edebug-form-spec t)
(put 'yas--with-temporary-redefinitions 'lisp-indent-function 1)
(put 'yas--with-temporary-redefinitions 'edebug-form-spec '((&rest (defun*)) cl-declarations body))
(provide 'yasnippet-tests) (provide 'yasnippet-tests)
;; Local Variables: ;; Local Variables:
;; indent-tabs-mode: nil ;; indent-tabs-mode: nil