mirror of
https://github.com/joaotavora/yasnippet.git
synced 2025-10-13 21:13:04 +00:00
Add compile_all target, fix all compilation warnings
* Rakefile (.elc): Set byte-compile-force-lexical-warnings when compiling. (:compile_all): New target that compiles yasnippet-debug.el and yasnippet-tests.el too. * .travis.yml (script): Use it instead of `compile'. Update cl-lib to 0.6.1. Don't error on warnings for Emacs 24.3 on yasnippet-tests.el. * yasnippet-debug.el: Don't use `yas--loaddir' if it's not bound (e.g., when compiling). Require `color' and `edebug' at toplevel. Check if `subr-x' defines `when-let'. (yas-debug-snippet-vars): Remove, it was unused and broken. * yasnippet-tests.el (yas-with-snippet-dirs, (yas-should-expand) (yas--collect-menu-items, yas-should-not-expand, yas-mock-insert) (yas-mock-yank, yas--key-binding, yas-make-file-or-dirs) (yas-variables, yas-call-with-saving-variables) (yas-call-with-snippet-dirs, special-mode, string-suffix-p): Move to top section. (yas-tests--ran-exit-hook): Rename from yas--ran-exit-hook, and move to top-level. * yasnippet.el (yas--letenv): Evaluate the FORMs of ENV.
This commit is contained in:
parent
304c01a44a
commit
dd65fe6186
16
.travis.yml
16
.travis.yml
@ -4,18 +4,26 @@ git:
|
|||||||
submodules: false
|
submodules: false
|
||||||
|
|
||||||
env:
|
env:
|
||||||
|
global:
|
||||||
|
- Wlexical=t
|
||||||
|
- Werror=t
|
||||||
|
- tests_Werror=t # For yasnippet-tests.el
|
||||||
|
matrix:
|
||||||
- EMACS_VERSION=23.4
|
- EMACS_VERSION=23.4
|
||||||
- EMACS_VERSION=24.3
|
# 24.3 gives a bunch of 'value returned from (car value-N) is
|
||||||
|
# unused' warnings.
|
||||||
|
- EMACS_VERSION=24.3 tests_Werror=nil
|
||||||
- EMACS_VERSION=24.5
|
- EMACS_VERSION=24.5
|
||||||
- EMACS_VERSION=25.2
|
- EMACS_VERSION=25.2
|
||||||
|
|
||||||
|
|
||||||
install:
|
install:
|
||||||
- curl -LO https://github.com/npostavs/emacs-travis/releases/download/bins/emacs-bin-${EMACS_VERSION}.tar.gz
|
- curl -LO https://github.com/npostavs/emacs-travis/releases/download/bins/emacs-bin-${EMACS_VERSION}.tar.gz
|
||||||
- tar -xaf emacs-bin-${EMACS_VERSION}.tar.gz -C /
|
- tar -xaf emacs-bin-${EMACS_VERSION}.tar.gz -C /
|
||||||
# Configure $PATH: Emacs installed to /tmp/emacs
|
# Configure $PATH: Emacs installed to /tmp/emacs
|
||||||
- export PATH=/tmp/emacs/bin:${PATH}
|
- export PATH=/tmp/emacs/bin:${PATH}
|
||||||
- if ! emacs -Q --batch --eval "(require 'cl-lib)" ; then
|
- if ! emacs -Q --batch --eval "(require 'cl-lib)" ; then
|
||||||
curl -Lo cl-lib.el http://elpa.gnu.org/packages/cl-lib-0.5.el ;
|
curl -Lo cl-lib.el http://elpa.gnu.org/packages/cl-lib-0.6.1.el ;
|
||||||
export warnings="'(not cl-functions)" ;
|
export warnings="'(not cl-functions)" ;
|
||||||
fi
|
fi
|
||||||
- if ! emacs -Q --batch --eval "(require 'ert)" ; then
|
- if ! emacs -Q --batch --eval "(require 'ert)" ; then
|
||||||
@ -25,7 +33,9 @@ install:
|
|||||||
- emacs --version
|
- emacs --version
|
||||||
|
|
||||||
script:
|
script:
|
||||||
- rake compile
|
- rake yasnippet.elc
|
||||||
|
- rake yasnippet-debug.elc
|
||||||
|
- rake yasnippet-tests.elc Werror=$tests_Werror
|
||||||
- rake tests
|
- rake tests
|
||||||
|
|
||||||
notifications:
|
notifications:
|
||||||
|
16
Rakefile
16
Rakefile
@ -100,14 +100,22 @@ end
|
|||||||
desc "Compile yasnippet.el into yasnippet.elc"
|
desc "Compile yasnippet.el into yasnippet.elc"
|
||||||
|
|
||||||
rule '.elc' => '.el' do |t|
|
rule '.elc' => '.el' do |t|
|
||||||
set_warnings = ""
|
cmdline = $EMACS + ' --batch -L .'
|
||||||
if ENV['warnings']
|
if ENV['warnings']
|
||||||
set_warnings = " --eval \"(setq byte-compile-warnings #{ENV['warnings']})\""
|
cmdline += " --eval \"(setq byte-compile-warnings #{ENV['warnings']})\""
|
||||||
end
|
end
|
||||||
sh "#{$EMACS} --batch -L . --eval \"(setq byte-compile-error-on-warn t)\"" +
|
if ENV['Werror']
|
||||||
"#{set_warnings} -f batch-byte-compile #{t.source}"
|
cmdline += " --eval \"(setq byte-compile-error-on-warn #{ENV['Werror']})\""
|
||||||
|
end
|
||||||
|
if ENV['Wlexical']
|
||||||
|
cmdline += " --eval \"(setq byte-compile-force-lexical-warnings #{ENV['Wlexical']})\""
|
||||||
|
end
|
||||||
|
cmdline +=" -f batch-byte-compile #{t.source}"
|
||||||
|
|
||||||
|
sh cmdline
|
||||||
end
|
end
|
||||||
task :compile => FileList["yasnippet.el"].ext('elc')
|
task :compile => FileList["yasnippet.el"].ext('elc')
|
||||||
|
task :compile_all => FileList["*.el"].ext('elc')
|
||||||
|
|
||||||
task :default => :doc
|
task :default => :doc
|
||||||
|
|
||||||
|
@ -36,10 +36,18 @@
|
|||||||
(file-name-directory (or load-file-name buffer-file-name))
|
(file-name-directory (or load-file-name buffer-file-name))
|
||||||
"Directory that yasnippet was loaded from.")
|
"Directory that yasnippet was loaded from.")
|
||||||
|
|
||||||
(require 'yasnippet (expand-file-name "yasnippet" yas--loaddir))
|
(require 'yasnippet (if (boundp 'yas--loaddir)
|
||||||
|
;; Don't require '-L <path>' when debugging.
|
||||||
|
(expand-file-name "yasnippet" yas--loaddir)))
|
||||||
(require 'cl-lib)
|
(require 'cl-lib)
|
||||||
(eval-when-compile
|
(eval-when-compile
|
||||||
(unless (require 'subr-x nil t)
|
(unless (fboundp 'cl-flet)
|
||||||
|
(defalias 'cl-flet 'flet)))
|
||||||
|
(require 'color nil t)
|
||||||
|
(require 'edebug)
|
||||||
|
(eval-when-compile
|
||||||
|
(unless (and (require 'subr-x nil t) (fboundp 'when-let))
|
||||||
|
;; Introduced in 25.1
|
||||||
(defmacro when-let (key-val &rest body)
|
(defmacro when-let (key-val &rest body)
|
||||||
(declare (indent 1) (debug ((symbolp form) body)))
|
(declare (indent 1) (debug ((symbolp form) body)))
|
||||||
`(let ((,(car key-val) ,(cadr key-val)))
|
`(let ((,(car key-val) ,(cadr key-val)))
|
||||||
@ -73,7 +81,9 @@
|
|||||||
(color
|
(color
|
||||||
(cl-loop with best-color = nil with max-dist = -1
|
(cl-loop with best-color = nil with max-dist = -1
|
||||||
for color = (format "#%06X" (random #x1000000))
|
for color = (format "#%06X" (random #x1000000))
|
||||||
for comp = (apply #'color-rgb-to-hex (color-complement color))
|
for comp = (if (fboundp 'color-complement)
|
||||||
|
(apply #'color-rgb-to-hex (color-complement color))
|
||||||
|
color)
|
||||||
if (< (color-distance color (face-foreground 'default))
|
if (< (color-distance color (face-foreground 'default))
|
||||||
(color-distance comp (face-foreground 'default)))
|
(color-distance comp (face-foreground 'default)))
|
||||||
do (setq color comp)
|
do (setq color comp)
|
||||||
@ -192,7 +202,9 @@
|
|||||||
(yas--debug-format-fom-concise (yas--mirror-next mirror))))))))
|
(yas--debug-format-fom-concise (yas--mirror-next mirror))))))))
|
||||||
|
|
||||||
(defvar yas-debug-target-buffer nil)
|
(defvar yas-debug-target-buffer nil)
|
||||||
(defvar-local yas-debug-target-snippets nil)
|
(defvar yas-debug-target-snippets nil nil)
|
||||||
|
(make-variable-buffer-local 'yas-debug-target-snippets)
|
||||||
|
|
||||||
(defvar yas-debug-undo nil)
|
(defvar yas-debug-undo nil)
|
||||||
|
|
||||||
(defun yas-toggle-debug-undo (value)
|
(defun yas-toggle-debug-undo (value)
|
||||||
@ -246,7 +258,6 @@
|
|||||||
;; want when the caller has a single window open. Good
|
;; want when the caller has a single window open. Good
|
||||||
;; enough for now.
|
;; enough for now.
|
||||||
(when (eq hook 'create)
|
(when (eq hook 'create)
|
||||||
(require 'edebug)
|
|
||||||
(edebug-instrument-function 'yas--snippet-parse-create)
|
(edebug-instrument-function 'yas--snippet-parse-create)
|
||||||
(let ((buf-point (find-function-noselect 'yas--snippet-parse-create)))
|
(let ((buf-point (find-function-noselect 'yas--snippet-parse-create)))
|
||||||
(with-current-buffer (car buf-point)
|
(with-current-buffer (car buf-point)
|
||||||
@ -257,36 +268,6 @@
|
|||||||
(defun yas-debug-snippet-create ()
|
(defun yas-debug-snippet-create ()
|
||||||
(yas-debug-snippets nil 'create))
|
(yas-debug-snippets nil 'create))
|
||||||
|
|
||||||
(defun yas-debug-snippet-vars ()
|
|
||||||
"Debug snippets, fields, mirrors and the `buffer-undo-list'."
|
|
||||||
(interactive)
|
|
||||||
(yas-debug-with-tracebuf ()
|
|
||||||
(printf "Interesting YASnippet vars: \n\n")
|
|
||||||
|
|
||||||
(printf "\nPost command hook: %s\n" post-command-hook)
|
|
||||||
(printf "\nPre command hook: %s\n" pre-command-hook)
|
|
||||||
|
|
||||||
(printf "%s live snippets in total\n" (length (yas-active-snippets 'all-snippets)))
|
|
||||||
(printf "%s overlays in buffer:\n\n" (length (overlays-in (point-min) (point-max))))
|
|
||||||
(printf "%s live snippets at point:\n\n" (length (yas-active-snippets)))
|
|
||||||
|
|
||||||
(yas-debug-snippets outbuf) ;;FIXME: reference to free variable ‘outbuf’
|
|
||||||
|
|
||||||
(printf "\nUndo is %s and point-max is %s.\n"
|
|
||||||
(if (eq buffer-undo-list t)
|
|
||||||
"DISABLED"
|
|
||||||
"ENABLED")
|
|
||||||
(point-max))
|
|
||||||
(unless (eq buffer-undo-list t)
|
|
||||||
(printf "Undpolist has %s elements. First 10 elements follow:\n"
|
|
||||||
(length buffer-undo-list))
|
|
||||||
(let ((first-ten (cl-subseq buffer-undo-list 0
|
|
||||||
(min 19 (length buffer-undo-list)))))
|
|
||||||
(dolist (undo-elem first-ten)
|
|
||||||
(printf "%2s: %s\n" (cl-position undo-elem first-ten)
|
|
||||||
(truncate-string-to-width (format "%s" undo-elem) 70)))))
|
|
||||||
(display-buffer tracebuf))) ;;FIXME: reference to free variable ‘tracebuf’
|
|
||||||
|
|
||||||
(defun yas--debug-format-fom-concise (fom)
|
(defun yas--debug-format-fom-concise (fom)
|
||||||
(when fom
|
(when fom
|
||||||
(cond ((yas--field-p fom)
|
(cond ((yas--field-p fom)
|
||||||
|
@ -22,6 +22,11 @@
|
|||||||
|
|
||||||
;; Test basic snippet mechanics and the loading system
|
;; Test basic snippet mechanics and the loading system
|
||||||
|
|
||||||
|
;; To test this in emacs22 mac osx:
|
||||||
|
;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert.el
|
||||||
|
;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert-x.el
|
||||||
|
;; /usr/bin/emacs -nw -Q -L . -l yasnippet-tests.el --batch -e ert
|
||||||
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(require 'yasnippet)
|
(require 'yasnippet)
|
||||||
@ -30,6 +35,122 @@
|
|||||||
(require 'cl-lib)
|
(require 'cl-lib)
|
||||||
(require 'org)
|
(require 'org)
|
||||||
|
|
||||||
|
|
||||||
|
;;; Helper macros and function
|
||||||
|
|
||||||
|
(defmacro yas-with-snippet-dirs (dirs &rest body)
|
||||||
|
(declare (indent defun) (debug t))
|
||||||
|
`(yas-call-with-snippet-dirs
|
||||||
|
,dirs #'(lambda () ,@body)))
|
||||||
|
|
||||||
|
(defun yas-should-expand (keys-and-expansions)
|
||||||
|
(dolist (key-and-expansion keys-and-expansions)
|
||||||
|
(yas-exit-all-snippets)
|
||||||
|
(erase-buffer)
|
||||||
|
(insert (car key-and-expansion))
|
||||||
|
(ert-simulate-command '(yas-expand))
|
||||||
|
(unless (string= (yas--buffer-contents) (cdr key-and-expansion))
|
||||||
|
(ert-fail (format "\"%s\" should have expanded to \"%s\" but got \"%s\""
|
||||||
|
(car key-and-expansion)
|
||||||
|
(cdr key-and-expansion)
|
||||||
|
(yas--buffer-contents)))))
|
||||||
|
(yas-exit-all-snippets))
|
||||||
|
|
||||||
|
(defun yas--collect-menu-items (menu-keymap)
|
||||||
|
(let ((yas--menu-items ()))
|
||||||
|
(map-keymap (lambda (_binding definition)
|
||||||
|
(when (eq (car-safe definition) 'menu-item)
|
||||||
|
(push definition yas--menu-items)))
|
||||||
|
menu-keymap)
|
||||||
|
yas--menu-items))
|
||||||
|
|
||||||
|
(defun yas-should-not-expand (keys)
|
||||||
|
(dolist (key keys)
|
||||||
|
(yas-exit-all-snippets)
|
||||||
|
(erase-buffer)
|
||||||
|
(insert key)
|
||||||
|
(ert-simulate-command '(yas-expand))
|
||||||
|
(unless (string= (yas--buffer-contents) key)
|
||||||
|
(ert-fail (format "\"%s\" should have stayed put, but instead expanded to \"%s\""
|
||||||
|
key
|
||||||
|
(yas--buffer-contents))))))
|
||||||
|
|
||||||
|
(defun yas-mock-insert (string)
|
||||||
|
(dotimes (i (length string))
|
||||||
|
(let ((last-command-event (aref string i)))
|
||||||
|
(ert-simulate-command '(self-insert-command 1)))))
|
||||||
|
|
||||||
|
(defun yas-mock-yank (string)
|
||||||
|
(let ((interprogram-paste-function (lambda () string)))
|
||||||
|
(ert-simulate-command '(yank nil))))
|
||||||
|
|
||||||
|
(defun yas--key-binding (key)
|
||||||
|
"Like `key-binding', but override `this-command-keys-vector'.
|
||||||
|
This lets `yas--maybe-expand-from-keymap-filter' work as expected."
|
||||||
|
(cl-letf (((symbol-function 'this-command-keys-vector)
|
||||||
|
(lambda () (cl-coerce key 'vector))))
|
||||||
|
(key-binding key)))
|
||||||
|
|
||||||
|
(defun yas-make-file-or-dirs (ass)
|
||||||
|
(let ((file-or-dir-name (car ass))
|
||||||
|
(content (cdr ass)))
|
||||||
|
(cond ((listp content)
|
||||||
|
(make-directory file-or-dir-name 'parents)
|
||||||
|
(let ((default-directory (concat default-directory "/" file-or-dir-name)))
|
||||||
|
(mapc #'yas-make-file-or-dirs content)))
|
||||||
|
((stringp content)
|
||||||
|
(with-temp-buffer
|
||||||
|
(insert content)
|
||||||
|
(write-region nil nil file-or-dir-name nil 'nomessage)))
|
||||||
|
(t
|
||||||
|
(message "[yas] oops don't know this content")))))
|
||||||
|
|
||||||
|
|
||||||
|
(defun yas-variables ()
|
||||||
|
(let ((syms))
|
||||||
|
(mapatoms #'(lambda (sym)
|
||||||
|
(if (and (string-match "^yas-[^/]" (symbol-name sym))
|
||||||
|
(boundp sym))
|
||||||
|
(push sym syms))))
|
||||||
|
syms))
|
||||||
|
|
||||||
|
(defun yas-call-with-saving-variables (fn)
|
||||||
|
(let* ((vars (yas-variables))
|
||||||
|
(saved-values (mapcar #'symbol-value vars)))
|
||||||
|
(unwind-protect
|
||||||
|
(funcall fn)
|
||||||
|
(cl-loop for var in vars
|
||||||
|
for saved in saved-values
|
||||||
|
do (set var saved)))))
|
||||||
|
|
||||||
|
(defun yas-call-with-snippet-dirs (dirs fn)
|
||||||
|
(let* ((default-directory (make-temp-file "yasnippet-fixture" t))
|
||||||
|
(yas-snippet-dirs (mapcar (lambda (d) (expand-file-name (car d))) dirs)))
|
||||||
|
(with-temp-message ""
|
||||||
|
(unwind-protect
|
||||||
|
(progn
|
||||||
|
(mapc #'yas-make-file-or-dirs dirs)
|
||||||
|
(funcall fn))
|
||||||
|
(when (>= emacs-major-version 24)
|
||||||
|
(delete-directory default-directory 'recursive))))))
|
||||||
|
|
||||||
|
;;; Older emacsen
|
||||||
|
;;;
|
||||||
|
(unless (fboundp 'special-mode)
|
||||||
|
;; FIXME: Why provide this default definition here?!?
|
||||||
|
(defalias 'special-mode 'fundamental))
|
||||||
|
|
||||||
|
(unless (fboundp 'string-suffix-p)
|
||||||
|
;; introduced in Emacs 24.4
|
||||||
|
(defun string-suffix-p (suffix string &optional ignore-case)
|
||||||
|
"Return non-nil if SUFFIX is a suffix of STRING.
|
||||||
|
If IGNORE-CASE is non-nil, the comparison is done without paying
|
||||||
|
attention to case differences."
|
||||||
|
(let ((start-pos (- (length string) (length suffix))))
|
||||||
|
(and (>= start-pos 0)
|
||||||
|
(eq t (compare-strings suffix nil nil
|
||||||
|
string start-pos nil ignore-case))))))
|
||||||
|
|
||||||
|
|
||||||
;;; Snippet mechanics
|
;;; Snippet mechanics
|
||||||
|
|
||||||
@ -499,14 +620,9 @@ mapconcat #'(lambda (arg)
|
|||||||
(kill-buffer ,temp-buffer))))))))
|
(kill-buffer ,temp-buffer))))))))
|
||||||
|
|
||||||
(defmacro yas-saving-variables (&rest body)
|
(defmacro yas-saving-variables (&rest body)
|
||||||
|
(declare (debug t))
|
||||||
`(yas-call-with-saving-variables #'(lambda () ,@body)))
|
`(yas-call-with-saving-variables #'(lambda () ,@body)))
|
||||||
|
|
||||||
(defmacro yas-with-snippet-dirs (dirs &rest body)
|
|
||||||
(declare (indent defun))
|
|
||||||
`(yas-call-with-snippet-dirs ,dirs
|
|
||||||
#'(lambda ()
|
|
||||||
,@body)))
|
|
||||||
|
|
||||||
(ert-deftest example-for-issue-474 ()
|
(ert-deftest example-for-issue-474 ()
|
||||||
(yas--with-font-locked-temp-buffer
|
(yas--with-font-locked-temp-buffer
|
||||||
(c-mode)
|
(c-mode)
|
||||||
@ -597,21 +713,22 @@ TODO: correct this bug!"
|
|||||||
"brother from another mother") ;; no newline should be here!
|
"brother from another mother") ;; no newline should be here!
|
||||||
)))
|
)))
|
||||||
|
|
||||||
|
(defvar yas-tests--ran-exit-hook nil)
|
||||||
|
|
||||||
(ert-deftest snippet-exit-hooks ()
|
(ert-deftest snippet-exit-hooks ()
|
||||||
(defvar yas--ran-exit-hook)
|
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
(yas-saving-variables
|
(yas-saving-variables
|
||||||
(let ((yas--ran-exit-hook nil)
|
(let ((yas-tests--ran-exit-hook nil)
|
||||||
(yas-triggers-in-field t))
|
(yas-triggers-in-field t))
|
||||||
(yas-with-snippet-dirs
|
(yas-with-snippet-dirs
|
||||||
'((".emacs.d/snippets"
|
'((".emacs.d/snippets"
|
||||||
("emacs-lisp-mode"
|
("emacs-lisp-mode"
|
||||||
("foo" . "\
|
("foo" . "\
|
||||||
# expand-env: ((yas-after-exit-snippet-hook (lambda () (setq yas--ran-exit-hook t))))
|
# expand-env: ((yas-after-exit-snippet-hook (lambda () (setq yas-tests--ran-exit-hook t))))
|
||||||
# --
|
# --
|
||||||
FOO ${1:f1} ${2:f2}")
|
FOO ${1:f1} ${2:f2}")
|
||||||
("sub" . "\
|
("sub" . "\
|
||||||
# expand-env: ((yas-after-exit-snippet-hook (lambda () (setq yas--ran-exit-hook 'sub))))
|
# expand-env: ((yas-after-exit-snippet-hook (lambda () (setq yas-tests--ran-exit-hook 'sub))))
|
||||||
# --
|
# --
|
||||||
SUB"))))
|
SUB"))))
|
||||||
(yas-reload-all)
|
(yas-reload-all)
|
||||||
@ -619,22 +736,21 @@ SUB"))))
|
|||||||
(yas-minor-mode +1)
|
(yas-minor-mode +1)
|
||||||
(insert "foo")
|
(insert "foo")
|
||||||
(ert-simulate-command '(yas-expand))
|
(ert-simulate-command '(yas-expand))
|
||||||
(should-not yas--ran-exit-hook)
|
(should-not yas-tests--ran-exit-hook)
|
||||||
(yas-mock-insert "sub")
|
(yas-mock-insert "sub")
|
||||||
(ert-simulate-command '(yas-expand))
|
(ert-simulate-command '(yas-expand))
|
||||||
(ert-simulate-command '(yas-next-field))
|
(ert-simulate-command '(yas-next-field))
|
||||||
(should-not yas--ran-exit-hook)
|
(should-not yas-tests--ran-exit-hook)
|
||||||
(ert-simulate-command '(yas-next-field))
|
(ert-simulate-command '(yas-next-field))
|
||||||
(should (eq yas--ran-exit-hook t)))))))
|
(should (eq yas-tests--ran-exit-hook t)))))))
|
||||||
|
|
||||||
(ert-deftest snippet-exit-hooks-bindings ()
|
(ert-deftest snippet-exit-hooks-bindings ()
|
||||||
"Check that `yas-after-exit-snippet-hook' is handled correctly
|
"Check that `yas-after-exit-snippet-hook' is handled correctly
|
||||||
in the case of a buffer-local variable and being overwritten by
|
in the case of a buffer-local variable and being overwritten by
|
||||||
the expand-env field."
|
the expand-env field."
|
||||||
(defvar yas--ran-exit-hook)
|
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
(yas-saving-variables
|
(yas-saving-variables
|
||||||
(let ((yas--ran-exit-hook nil)
|
(let ((yas-tests--ran-exit-hook nil)
|
||||||
(yas-triggers-in-field t)
|
(yas-triggers-in-field t)
|
||||||
(yas-after-exit-snippet-hook nil))
|
(yas-after-exit-snippet-hook nil))
|
||||||
(yas-with-snippet-dirs
|
(yas-with-snippet-dirs
|
||||||
@ -642,21 +758,21 @@ the expand-env field."
|
|||||||
("emacs-lisp-mode"
|
("emacs-lisp-mode"
|
||||||
("foo" . "foobar\n")
|
("foo" . "foobar\n")
|
||||||
("baz" . "\
|
("baz" . "\
|
||||||
# expand-env: ((yas-after-exit-snippet-hook (lambda () (setq yas--ran-exit-hook 'letenv))))
|
# expand-env: ((yas-after-exit-snippet-hook (lambda () (setq yas-tests--ran-exit-hook 'letenv))))
|
||||||
# --
|
# --
|
||||||
foobaz\n"))))
|
foobaz\n"))))
|
||||||
(yas-reload-all)
|
(yas-reload-all)
|
||||||
(emacs-lisp-mode)
|
(emacs-lisp-mode)
|
||||||
(yas-minor-mode +1)
|
(yas-minor-mode +1)
|
||||||
(add-hook 'yas-after-exit-snippet-hook (lambda () (push 'global yas--ran-exit-hook)))
|
(add-hook 'yas-after-exit-snippet-hook (lambda () (push 'global yas-tests--ran-exit-hook)))
|
||||||
(add-hook 'yas-after-exit-snippet-hook (lambda () (push 'local yas--ran-exit-hook)) nil t)
|
(add-hook 'yas-after-exit-snippet-hook (lambda () (push 'local yas-tests--ran-exit-hook)) nil t)
|
||||||
(insert "baz")
|
(insert "baz")
|
||||||
(ert-simulate-command '(yas-expand))
|
(ert-simulate-command '(yas-expand))
|
||||||
(should (eq 'letenv yas--ran-exit-hook))
|
(should (eq 'letenv yas-tests--ran-exit-hook))
|
||||||
(insert "foo")
|
(insert "foo")
|
||||||
(ert-simulate-command '(yas-expand))
|
(ert-simulate-command '(yas-expand))
|
||||||
(should (eq 'global (nth 0 yas--ran-exit-hook)))
|
(should (eq 'global (nth 0 yas-tests--ran-exit-hook)))
|
||||||
(should (eq 'local (nth 1 yas--ran-exit-hook))))))))
|
(should (eq 'local (nth 1 yas-tests--ran-exit-hook))))))))
|
||||||
|
|
||||||
(ert-deftest snippet-mirror-bindings ()
|
(ert-deftest snippet-mirror-bindings ()
|
||||||
"Check that variables defined with the expand-env field are
|
"Check that variables defined with the expand-env field are
|
||||||
@ -784,6 +900,7 @@ hello ${1:$(when (stringp yas-text) (funcall func yas-text))} foo${1:$$(concat \
|
|||||||
;;;
|
;;;
|
||||||
|
|
||||||
(defmacro yas-with-overriden-buffer-list (&rest body)
|
(defmacro yas-with-overriden-buffer-list (&rest body)
|
||||||
|
(declare (debug t))
|
||||||
(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)))
|
||||||
(cl-letf (((symbol-function 'buffer-list)
|
(cl-letf (((symbol-function 'buffer-list)
|
||||||
@ -796,6 +913,7 @@ hello ${1:$(when (stringp yas-text) (funcall func yas-text))} foo${1:$$(concat \
|
|||||||
|
|
||||||
|
|
||||||
(defmacro yas-with-some-interesting-snippet-dirs (&rest body)
|
(defmacro yas-with-some-interesting-snippet-dirs (&rest body)
|
||||||
|
(declare (debug t))
|
||||||
`(yas-saving-variables
|
`(yas-saving-variables
|
||||||
(yas-with-overriden-buffer-list
|
(yas-with-overriden-buffer-list
|
||||||
(yas-with-snippet-dirs
|
(yas-with-snippet-dirs
|
||||||
@ -1259,128 +1377,6 @@ add the snippets associated with the given mode."
|
|||||||
(yas-should-expand '(("car" . "(car )")))))))
|
(yas-should-expand '(("car" . "(car )")))))))
|
||||||
|
|
||||||
|
|
||||||
;;; Helpers
|
|
||||||
;;;
|
|
||||||
(defun yas-should-expand (keys-and-expansions)
|
|
||||||
(dolist (key-and-expansion keys-and-expansions)
|
|
||||||
(yas-exit-all-snippets)
|
|
||||||
(erase-buffer)
|
|
||||||
(insert (car key-and-expansion))
|
|
||||||
(let ((yas-fallback-behavior nil))
|
|
||||||
(ert-simulate-command '(yas-expand)))
|
|
||||||
(unless (string= (yas--buffer-contents) (cdr key-and-expansion))
|
|
||||||
(ert-fail (format "\"%s\" should have expanded to \"%s\" but got \"%s\""
|
|
||||||
(car key-and-expansion)
|
|
||||||
(cdr key-and-expansion)
|
|
||||||
(yas--buffer-contents)))))
|
|
||||||
(yas-exit-all-snippets))
|
|
||||||
|
|
||||||
(defun yas--collect-menu-items (menu-keymap)
|
|
||||||
(let ((yas--menu-items ()))
|
|
||||||
(map-keymap (lambda (_binding definition)
|
|
||||||
(when (eq (car-safe definition) 'menu-item)
|
|
||||||
(push definition yas--menu-items)))
|
|
||||||
menu-keymap)
|
|
||||||
yas--menu-items))
|
|
||||||
|
|
||||||
(defun yas-should-not-expand (keys)
|
|
||||||
(dolist (key keys)
|
|
||||||
(yas-exit-all-snippets)
|
|
||||||
(erase-buffer)
|
|
||||||
(insert key)
|
|
||||||
(let ((yas-fallback-behavior nil))
|
|
||||||
(ert-simulate-command '(yas-expand)))
|
|
||||||
(unless (string= (yas--buffer-contents) key)
|
|
||||||
(ert-fail (format "\"%s\" should have stayed put, but instead expanded to \"%s\""
|
|
||||||
key
|
|
||||||
(yas--buffer-contents))))))
|
|
||||||
|
|
||||||
(defun yas-mock-insert (string)
|
|
||||||
(dotimes (i (length string))
|
|
||||||
(let ((last-command-event (aref string i)))
|
|
||||||
(ert-simulate-command '(self-insert-command 1)))))
|
|
||||||
|
|
||||||
(defun yas-mock-yank (string)
|
|
||||||
(let ((interprogram-paste-function (lambda () string)))
|
|
||||||
(ert-simulate-command '(yank nil))))
|
|
||||||
|
|
||||||
(defun yas--key-binding (key)
|
|
||||||
"Like `key-binding', but override `this-command-keys-vector'.
|
|
||||||
This lets `yas--maybe-expand-from-keymap-filter' work as expected."
|
|
||||||
(cl-letf (((symbol-function 'this-command-keys-vector)
|
|
||||||
(lambda () (cl-coerce key 'vector))))
|
|
||||||
(key-binding key)))
|
|
||||||
|
|
||||||
(defun yas-make-file-or-dirs (ass)
|
|
||||||
(let ((file-or-dir-name (car ass))
|
|
||||||
(content (cdr ass)))
|
|
||||||
(cond ((listp content)
|
|
||||||
(make-directory file-or-dir-name 'parents)
|
|
||||||
(let ((default-directory (concat default-directory "/" file-or-dir-name)))
|
|
||||||
(mapc #'yas-make-file-or-dirs content)))
|
|
||||||
((stringp content)
|
|
||||||
(with-temp-buffer
|
|
||||||
(insert content)
|
|
||||||
(write-region nil nil file-or-dir-name nil 'nomessage)))
|
|
||||||
(t
|
|
||||||
(message "[yas] oops don't know this content")))))
|
|
||||||
|
|
||||||
|
|
||||||
(defun yas-variables ()
|
|
||||||
(let ((syms))
|
|
||||||
(mapatoms #'(lambda (sym)
|
|
||||||
(if (and (string-match "^yas-[^/]" (symbol-name sym))
|
|
||||||
(boundp sym))
|
|
||||||
(push sym syms))))
|
|
||||||
syms))
|
|
||||||
|
|
||||||
(defun yas-call-with-saving-variables (fn)
|
|
||||||
(let* ((vars (yas-variables))
|
|
||||||
(saved-values (mapcar #'symbol-value vars)))
|
|
||||||
(unwind-protect
|
|
||||||
(funcall fn)
|
|
||||||
(cl-loop for var in vars
|
|
||||||
for saved in saved-values
|
|
||||||
do (set var saved)))))
|
|
||||||
|
|
||||||
(defun yas-call-with-snippet-dirs (dirs fn)
|
|
||||||
(let* ((default-directory (make-temp-file "yasnippet-fixture" t))
|
|
||||||
(yas-snippet-dirs (mapcar (lambda (d) (expand-file-name (car d))) dirs)))
|
|
||||||
(with-temp-message ""
|
|
||||||
(unwind-protect
|
|
||||||
(progn
|
|
||||||
(mapc #'yas-make-file-or-dirs dirs)
|
|
||||||
(funcall fn))
|
|
||||||
(when (>= emacs-major-version 24)
|
|
||||||
(delete-directory default-directory 'recursive))))))
|
|
||||||
|
|
||||||
;;; Older emacsen
|
|
||||||
;;;
|
|
||||||
(unless (fboundp 'special-mode)
|
|
||||||
;; FIXME: Why provide this default definition here?!?
|
|
||||||
(defalias 'special-mode 'fundamental))
|
|
||||||
|
|
||||||
(unless (fboundp 'string-suffix-p)
|
|
||||||
;; introduced in Emacs 24.4
|
|
||||||
(defun string-suffix-p (suffix string &optional ignore-case)
|
|
||||||
"Return non-nil if SUFFIX is a suffix of STRING.
|
|
||||||
If IGNORE-CASE is non-nil, the comparison is done without paying
|
|
||||||
attention to case differences."
|
|
||||||
(let ((start-pos (- (length string) (length suffix))))
|
|
||||||
(and (>= start-pos 0)
|
|
||||||
(eq t (compare-strings suffix nil nil
|
|
||||||
string start-pos nil ignore-case))))))
|
|
||||||
|
|
||||||
;;; btw to test this in emacs22 mac osx:
|
|
||||||
;;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert.el
|
|
||||||
;;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert-x.el
|
|
||||||
;;; /usr/bin/emacs -nw -Q -L . -l yasnippet-tests.el --batch -e ert
|
|
||||||
|
|
||||||
|
|
||||||
(put 'yas-saving-variables 'edebug-form-spec t)
|
|
||||||
(put 'yas-with-snippet-dirs '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)
|
|
||||||
|
|
||||||
(provide 'yasnippet-tests)
|
(provide 'yasnippet-tests)
|
||||||
;; Local Variables:
|
;; Local Variables:
|
||||||
|
12
yasnippet.el
12
yasnippet.el
@ -132,6 +132,7 @@
|
|||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(require 'cl-lib)
|
(require 'cl-lib)
|
||||||
|
(declare-function cl-progv-after "cl-extra") ; Needed for 23.4.
|
||||||
(require 'easymenu)
|
(require 'easymenu)
|
||||||
(require 'help-mode)
|
(require 'help-mode)
|
||||||
|
|
||||||
@ -3029,11 +3030,16 @@ DEPTH is a count of how many nested mirrors can affect this mirror"
|
|||||||
|
|
||||||
(defmacro yas--letenv (env &rest body)
|
(defmacro yas--letenv (env &rest body)
|
||||||
"Evaluate BODY with bindings from ENV.
|
"Evaluate BODY with bindings from ENV.
|
||||||
ENV is a list of elements with the form (VAR FORM)."
|
ENV is a lisp expression that evaluates to list of elements with
|
||||||
|
the form (VAR FORM), where VAR is a symbol and FORM is a lisp
|
||||||
|
expression that evaluates to its value."
|
||||||
(declare (debug (form body)) (indent 1))
|
(declare (debug (form body)) (indent 1))
|
||||||
(let ((envvar (make-symbol "env")))
|
(let ((envvar (make-symbol "envvar")))
|
||||||
`(let ((,envvar ,env))
|
`(let ((,envvar ,env))
|
||||||
(cl-progv (mapcar #'car ,envvar) (mapcar #'cadr ,envvar) . ,body))))
|
(cl-progv
|
||||||
|
(mapcar #'car ,envvar)
|
||||||
|
(mapcar (lambda (v-f) (eval (cadr v-f))) ,envvar)
|
||||||
|
,@body))))
|
||||||
|
|
||||||
(defun yas--snippet-map-markers (fun snippet)
|
(defun yas--snippet-map-markers (fun snippet)
|
||||||
"Apply FUN to all marker (sub)fields in SNIPPET.
|
"Apply FUN to all marker (sub)fields in SNIPPET.
|
||||||
|
Loading…
x
Reference in New Issue
Block a user