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

Add compile_all target, fix all compilation warnings

Browse Source 
* 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:
Noam Postavsky 2017-07-18 20:15:14 -04:00
parent 304c01a44a
commit dd65fe6186
5 changed files with 192 additions and 191 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
.travis.yml
View File

@ -4,10 +4,18 @@ git:
submodules: false
env:
- EMACS_VERSION=23.4
- EMACS_VERSION=24.3
- EMACS_VERSION=24.5
- EMACS_VERSION=25.2
global:
- Wlexical=t
- Werror=t
- tests_Werror=t # For yasnippet-tests.el
matrix:
- EMACS_VERSION=23.4
# 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=25.2
install:
- curl -LO https://github.com/npostavs/emacs-travis/releases/download/bins/emacs-bin-${EMACS_VERSION}.tar.gz
@ -15,7 +23,7 @@ install:
# Configure $PATH: Emacs installed to /tmp/emacs
- export PATH=/tmp/emacs/bin:${PATH}
- 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)" ;
fi
- if ! emacs -Q --batch --eval "(require 'ert)" ; then
@ -25,7 +33,9 @@ install:
- emacs --version
script:
- rake compile
- rake yasnippet.elc
- rake yasnippet-debug.elc
- rake yasnippet-tests.elc Werror=$tests_Werror
- rake tests
notifications:

16
Rakefile
View File

@ -100,14 +100,22 @@ end
desc "Compile yasnippet.el into yasnippet.elc"
rule '.elc' => '.el' do |t|
set_warnings = ""
cmdline = $EMACS + ' --batch -L .'
if ENV['warnings']
set_warnings = " --eval \"(setq byte-compile-warnings #{ENV['warnings']})\""
cmdline += " --eval \"(setq byte-compile-warnings #{ENV['warnings']})\""
end
sh "#{$EMACS} --batch -L . --eval \"(setq byte-compile-error-on-warn t)\"" +
"#{set_warnings} -f batch-byte-compile #{t.source}"
if ENV['Werror']
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
task :compile => FileList["yasnippet.el"].ext('elc')
task :compile_all => FileList["*.el"].ext('elc')
task :default => :doc

51
yasnippet-debug.el
View File

@ -36,10 +36,18 @@
(file-name-directory (or load-file-name buffer-file-name))
"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)
(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)
(declare (indent 1) (debug ((symbolp form) body)))
`(let ((,(car key-val) ,(cadr key-val)))
@ -73,7 +81,9 @@
(color
(cl-loop with best-color = nil with max-dist = -1
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))
(color-distance comp (face-foreground 'default)))
do (setq color comp)
@ -192,7 +202,9 @@
(yas--debug-format-fom-concise (yas--mirror-next mirror))))))))
(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)
(defun yas-toggle-debug-undo (value)
@ -246,7 +258,6 @@
;; want when the caller has a single window open. Good
;; enough for now.
(when (eq hook 'create)
(require 'edebug)
(edebug-instrument-function 'yas--snippet-parse-create)
(let ((buf-point (find-function-noselect 'yas--snippet-parse-create)))
(with-current-buffer (car buf-point)
@ -257,36 +268,6 @@
(defun yas-debug-snippet-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)
(when fom
(cond ((yas--field-p fom)

282
yasnippet-tests.el
View File

@ -22,6 +22,11 @@
;; 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:
(require 'yasnippet)
@ -30,6 +35,122 @@
(require 'cl-lib)
(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
@ -499,14 +620,9 @@ mapconcat #'(lambda (arg)
(kill-buffer ,temp-buffer))))))))
(defmacro yas-saving-variables (&rest body)
(declare (debug t))
`(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 ()
(yas--with-font-locked-temp-buffer
(c-mode)
@ -597,21 +713,22 @@ TODO: correct this bug!"
"brother from another mother") ;; no newline should be here!
)))
(defvar yas-tests--ran-exit-hook nil)
(ert-deftest snippet-exit-hooks ()
(defvar yas--ran-exit-hook)
(with-temp-buffer
(yas-saving-variables
(let ((yas--ran-exit-hook nil)
(let ((yas-tests--ran-exit-hook nil)
(yas-triggers-in-field t))
(yas-with-snippet-dirs
'((".emacs.d/snippets"
("emacs-lisp-mode"
("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}")
("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"))))
(yas-reload-all)
@ -619,22 +736,21 @@ SUB"))))
(yas-minor-mode +1)
(insert "foo")
(ert-simulate-command '(yas-expand))
(should-not yas--ran-exit-hook)
(should-not yas-tests--ran-exit-hook)
(yas-mock-insert "sub")
(ert-simulate-command '(yas-expand))
(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))
(should (eq yas--ran-exit-hook t)))))))
(should (eq yas-tests--ran-exit-hook t)))))))
(ert-deftest snippet-exit-hooks-bindings ()
"Check that `yas-after-exit-snippet-hook' is handled correctly
in the case of a buffer-local variable and being overwritten by
the expand-env field."
(defvar yas--ran-exit-hook)
(with-temp-buffer
(yas-saving-variables
(let ((yas--ran-exit-hook nil)
(let ((yas-tests--ran-exit-hook nil)
(yas-triggers-in-field t)
(yas-after-exit-snippet-hook nil))
(yas-with-snippet-dirs
@ -642,21 +758,21 @@ the expand-env field."
("emacs-lisp-mode"
("foo" . "foobar\n")
("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"))))
(yas-reload-all)
(emacs-lisp-mode)
(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 'local yas--ran-exit-hook)) nil t)
(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-tests--ran-exit-hook)) nil t)
(insert "baz")
(ert-simulate-command '(yas-expand))
(should (eq 'letenv yas--ran-exit-hook))
(should (eq 'letenv yas-tests--ran-exit-hook))
(insert "foo")
(ert-simulate-command '(yas-expand))
(should (eq 'global (nth 0 yas--ran-exit-hook)))
(should (eq 'local (nth 1 yas--ran-exit-hook))))))))
(should (eq 'global (nth 0 yas-tests--ran-exit-hook)))
(should (eq 'local (nth 1 yas-tests--ran-exit-hook))))))))
(ert-deftest snippet-mirror-bindings ()
"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)
(declare (debug t))
(let ((saved-sym (make-symbol "yas--buffer-list")))
`(let ((,saved-sym (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)
(declare (debug t))
`(yas-saving-variables
(yas-with-overriden-buffer-list
(yas-with-snippet-dirs
@ -1259,128 +1377,6 @@ add the snippets associated with the given mode."
(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)
;; Local Variables:

12
yasnippet.el
View File

@ -132,6 +132,7 @@
;;; Code:
(require 'cl-lib)
(declare-function cl-progv-after "cl-extra") ; Needed for 23.4.
(require 'easymenu)
(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)
"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))
(let ((envvar (make-symbol "env")))
(let ((envvar (make-symbol "envvar")))
`(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)
"Apply FUN to all marker (sub)fields in SNIPPET.