diff --git a/yasnippet-tests.el b/yasnippet-tests.el index 388b7ea..194c0fd 100644 --- a/yasnippet-tests.el +++ b/yasnippet-tests.el @@ -297,9 +297,10 @@ TODO: correct this bug!" (yas-with-some-interesting-snippet-dirs (yas-reload-all) (yas-recompile-all) - (flet ((yas--load-directory-2 - (&rest dummies) - (ert-fail "yas--load-directory-2 shouldn't be called when snippets have been compiled"))) + (yas--with-temporary-redefinitions ((yas--load-directory-2 + (&rest dummies) + (declare (ignore dummies)) + (ert-fail "yas--load-directory-2 shouldn't be called when snippets have been compiled"))) (yas-reload-all) (yas--basic-jit-loading-1)))) diff --git a/yasnippet.el b/yasnippet.el index bc238ae..d5b6973 100644 --- a/yasnippet.el +++ b/yasnippet.el @@ -147,13 +147,6 @@ (defvar yas-selected-text) (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 @@ -1312,6 +1305,7 @@ them all in `yas--menu-table'" :visible (yas--show-menu-p ',mode))) menu-keymap)) + (defmacro yas--called-interactively-p (&optional kind) "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 ,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 @@ -1882,49 +1913,50 @@ foo\"bar\\! -> \"foo\\\"bar\\\\!\"" This works by stubbing a few functions, then calling `yas-load-directory'." (interactive "DTop level snippet directory?") - (cl-flet ((yas--load-yas-setup-file - (file) - (let ((elfile (concat file ".el"))) - (when (file-exists-p elfile) - (insert ";;; .yas-setup.el support file if any:\n;;;\n") - (insert-file-contents elfile) - (goto-char (point-max)) - ))) - (yas-define-snippets - (mode snippets) - (insert ";;; Snippet definitions:\n;;;\n") - (let ((literal-snippets (list)) - (print-length nil)) - (dolist (snippet snippets) - (let ((key (first snippet)) - (template-content (second snippet)) - (name (third snippet)) - (condition (fourth snippet)) - (group (fifth snippet)) - (expand-env (sixth snippet)) - (file nil) ;; (seventh snippet)) ;; omit on purpose - (binding (eighth snippet)) - (uuid (ninth snippet))) - (push `(,key - ,template-content - ,name - ,condition - ,group - ,expand-env - ,file - ,binding - ,uuid) - literal-snippets))) - (insert (pp-to-string `(yas-define-snippets ',mode ',literal-snippets))) - (insert "\n\n"))) - (yas--load-directory-1 - (dir mode parents &rest ignore) - (let ((output-file (concat (file-name-as-directory dir) ".yas-compiled-snippets.el"))) - (with-temp-file output-file - (insert (format ";;; Compiled snippets and support files for `%s'\n" mode)) - (yas--load-directory-2 dir mode) - (insert (format ";;; Do not edit! File generated at %s\n" (current-time-string))))))) - (yas-load-directory top-level-dir nil))) + (yas--with-temporary-redefinitions + ((yas--load-yas-setup-file + (file) + (let ((elfile (concat file ".el"))) + (when (file-exists-p elfile) + (insert ";;; .yas-setup.el support file if any:\n;;;\n") + (insert-file-contents elfile) + (goto-char (point-max)) + ))) + (yas-define-snippets + (mode snippets) + (insert ";;; Snippet definitions:\n;;;\n") + (let ((literal-snippets (list)) + (print-length nil)) + (dolist (snippet snippets) + (let ((key (first snippet)) + (template-content (second snippet)) + (name (third snippet)) + (condition (fourth snippet)) + (group (fifth snippet)) + (expand-env (sixth snippet)) + (file nil) ;; (seventh snippet)) ;; omit on purpose + (binding (eighth snippet)) + (uuid (ninth snippet))) + (push `(,key + ,template-content + ,name + ,condition + ,group + ,expand-env + ,file + ,binding + ,uuid) + literal-snippets))) + (insert (pp-to-string `(yas-define-snippets ',mode ',literal-snippets))) + (insert "\n\n"))) + (yas--load-directory-1 + (dir mode parents &rest ignore) + (let ((output-file (concat (file-name-as-directory dir) ".yas-compiled-snippets.el"))) + (with-temp-file output-file + (insert (format ";;; Compiled snippets and support files for `%s'\n" mode)) + (yas--load-directory-2 dir mode) + (insert (format ";;; Do not edit! File generated at %s\n" (current-time-string))))))) + (yas-load-directory top-level-dir nil))) (defun yas-recompile-all () "Compile every dir in `yas-snippet-dirs'." @@ -3662,18 +3694,18 @@ Returns the newly created snippet." This is according to their relative positions in the buffer, and 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) (setf (yas--field-next fom) nextfom)) ((yas--mirror-p fom) (setf (yas--mirror-next fom) nextfom)) (t (setf (yas--exit-next fom) nextfom)))) - (yas--compare-fom-begs (fom1 fom2) + (yas--compare-fom-begs (fom1 fom2) (if (= (yas--fom-start fom2) (yas--fom-start fom1)) (yas--mirror-p fom2) (>= (yas--fom-start fom2) (yas--fom-start fom1)))) - (yas--link-foms (fom1 fom2) + (yas--link-foms (fom1 fom2) (yas--fom-set-next-fom fom1 fom2))) ;; make some yas--field, yas--mirror and yas--exit soup (let ((soup))