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

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

7
yasnippet-tests.el
View File

@ -297,9 +297,10 @@ 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)
(ert-fail "yas--load-directory-2 shouldn't be called when snippets have been compiled"))) (declare (ignore dummies))
(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))))

138
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,49 +1913,50 @@ 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
(file) ((yas--load-yas-setup-file
(let ((elfile (concat file ".el"))) (file)
(when (file-exists-p elfile) (let ((elfile (concat file ".el")))
(insert ";;; .yas-setup.el support file if any:\n;;;\n") (when (file-exists-p elfile)
(insert-file-contents elfile) (insert ";;; .yas-setup.el support file if any:\n;;;\n")
(goto-char (point-max)) (insert-file-contents elfile)
))) (goto-char (point-max))
(yas-define-snippets )))
(mode snippets) (yas-define-snippets
(insert ";;; Snippet definitions:\n;;;\n") (mode snippets)
(let ((literal-snippets (list)) (insert ";;; Snippet definitions:\n;;;\n")
(print-length nil)) (let ((literal-snippets (list))
(dolist (snippet snippets) (print-length nil))
(let ((key (first snippet)) (dolist (snippet snippets)
(template-content (second snippet)) (let ((key (first snippet))
(name (third snippet)) (template-content (second snippet))
(condition (fourth snippet)) (name (third snippet))
(group (fifth snippet)) (condition (fourth snippet))
(expand-env (sixth snippet)) (group (fifth snippet))
(file nil) ;; (seventh snippet)) ;; omit on purpose (expand-env (sixth snippet))
(binding (eighth snippet)) (file nil) ;; (seventh snippet)) ;; omit on purpose
(uuid (ninth snippet))) (binding (eighth snippet))
(push `(,key (uuid (ninth snippet)))
,template-content (push `(,key
,name ,template-content
,condition ,name
,group ,condition
,expand-env ,group
,file ,expand-env
,binding ,file
,uuid) ,binding
literal-snippets))) ,uuid)
(insert (pp-to-string `(yas-define-snippets ',mode ',literal-snippets))) literal-snippets)))
(insert "\n\n"))) (insert (pp-to-string `(yas-define-snippets ',mode ',literal-snippets)))
(yas--load-directory-1 (insert "\n\n")))
(dir mode parents &rest ignore) (yas--load-directory-1
(let ((output-file (concat (file-name-as-directory dir) ".yas-compiled-snippets.el"))) (dir mode parents &rest ignore)
(with-temp-file output-file (let ((output-file (concat (file-name-as-directory dir) ".yas-compiled-snippets.el")))
(insert (format ";;; Compiled snippets and support files for `%s'\n" mode)) (with-temp-file output-file
(yas--load-directory-2 dir mode) (insert (format ";;; Compiled snippets and support files for `%s'\n" mode))
(insert (format ";;; Do not edit! File generated at %s\n" (current-time-string))))))) (yas--load-directory-2 dir mode)
(yas-load-directory top-level-dir nil))) (insert (format ";;; Do not edit! File generated at %s\n" (current-time-string)))))))
(yas-load-directory top-level-dir nil)))
(defun yas-recompile-all () (defun yas-recompile-all ()
"Compile every dir in `yas-snippet-dirs'." "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 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)
(setf (yas--mirror-next fom) nextfom)) (setf (yas--mirror-next fom) nextfom))
(t (t
(setf (yas--exit-next fom) nextfom)))) (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)) (if (= (yas--fom-start fom2) (yas--fom-start fom1))
(yas--mirror-p fom2) (yas--mirror-p fom2)
(>= (yas--fom-start fom2) (yas--fom-start fom1)))) (>= (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))) (yas--fom-set-next-fom fom1 fom2)))
;; make some yas--field, yas--mirror and yas--exit soup ;; make some yas--field, yas--mirror and yas--exit soup
(let ((soup)) (let ((soup))