mirror of
https://github.com/joaotavora/yasnippet.git
synced 2025-10-13 13:13:03 +00:00
Make dynamic version of all tests and fix bugs
* snippet-tests.el (cl-lib): require it (snippet--fixtures): Renamed from `snippet--test-snippets-alist'. Add dynamic versions to all tests. (snippet--get-fixture): Use `snippet--fixtures' * snippet.el (with-dynamic-snippet): Relax syntax restrictions. (&mirror): Update edebug spec. (snippet--call-with-inserting-object): Don't try to set the start of an object to its previous object's end, if that object hasn't got an end yet. (snippet--call-with-inserting-object): Fix previous bugfix.
This commit is contained in:
João Távora
parent
94bd529d08
commit
04591a4a86
@ -27,25 +27,37 @@
|
||||
(require 'snippet)
|
||||
(require 'ert)
|
||||
(require 'ert-x)
|
||||
(require 'cl-lib)
|
||||
|
||||
(defvar snippet--test-snippets-alist nil)
|
||||
(setq snippet--test-snippets-alist
|
||||
`((basic ((&field 1 "foo")
|
||||
(defvar snippet--fixtures nil
|
||||
"An alist of (NAME . (STATIC-FIXTURE DYNAMIC-FIXTURE))")
|
||||
(setq snippet--fixtures
|
||||
`((basic
|
||||
;; static version
|
||||
((&field 1 "foo")
|
||||
" bar "
|
||||
(&mirror 1))
|
||||
;; dynamic version
|
||||
((&field 1 "foo")
|
||||
(insert " bar ")
|
||||
(&mirror 1)))
|
||||
(contrived ((&field 1)
|
||||
(contrived
|
||||
;; static version
|
||||
((&field 1)
|
||||
(&field 2)
|
||||
(&field 3)))
|
||||
(&field 3))
|
||||
;; dynamic version
|
||||
((cl-loop for i from 1 upto 3
|
||||
do (&field i))))
|
||||
(nested
|
||||
;; static
|
||||
;;
|
||||
;; static version
|
||||
("a "
|
||||
(&field 1 (&nested (&field 2 "nested")
|
||||
" "
|
||||
(&field 3 "field")))
|
||||
" and its mirror: "
|
||||
(&mirror 1))
|
||||
;; dynamic
|
||||
;; dynamic version
|
||||
((insert "a ")
|
||||
(&field 1
|
||||
(&field 2 (insert "nested"))
|
||||
@ -54,13 +66,25 @@
|
||||
(insert " and its mirror: ")
|
||||
(&mirror 1 (s e)
|
||||
(insert s))))
|
||||
(mirror-of-nested-field ("a "
|
||||
(mirror-of-nested-field
|
||||
;; static
|
||||
("a "
|
||||
(&field 1 (&nested (&field 2 "nested")
|
||||
" "
|
||||
(&field 3 "field")))
|
||||
(&mirror 3 (concat ", nested mirroring: "
|
||||
field-string))))
|
||||
(more-nesting ("a "
|
||||
field-string)))
|
||||
;; dynamic
|
||||
((insert "a ")
|
||||
(&field 1
|
||||
(&field 2 (insert "nested"))
|
||||
(insert " ")
|
||||
(&field 3 (insert "field")))
|
||||
(&mirror 3 (s)
|
||||
(insert ", nested mirroring: " s))))
|
||||
(more-nesting ; FIXME: horribly contrived, what is "rain"?
|
||||
;; static
|
||||
("a "
|
||||
(&field 1 (&nested
|
||||
"'"
|
||||
(&field 2 "rain")
|
||||
@ -71,12 +95,36 @@
|
||||
"'"))
|
||||
(&field 3 " and a field:")
|
||||
" "
|
||||
(&mirror 1))
|
||||
;; dynamic
|
||||
((insert "a ")
|
||||
(&field 1
|
||||
(insert "'")
|
||||
(&field 2 "rain")
|
||||
(&mirror 2 (s)
|
||||
(apply #'string
|
||||
(reverse
|
||||
(string-to-list
|
||||
s))))
|
||||
(insert "'"))
|
||||
(&field 3 " and a field:")
|
||||
(insert " ")
|
||||
(&mirror 1)))
|
||||
(printf ("printf (\""
|
||||
(printf
|
||||
;; static
|
||||
("printf (\""
|
||||
(&field 1 "%s")
|
||||
(&mirror 1 (if (string-match "%" field-string) "\"," "\")"))
|
||||
(&field 2)
|
||||
(&mirror 1 (if (string-match "%" field-string) "\)" ""))))
|
||||
(&mirror 1 (if (string-match "%" field-string) "\)" "")))
|
||||
;; dynamic
|
||||
((insert "printf (\"")
|
||||
(&field 1 "%s")
|
||||
(&mirror 1 (f)
|
||||
(if (string-match "%" f) "\"," "\")"))
|
||||
(&field 2)
|
||||
(&mirror 1 (f)
|
||||
(if (string-match "%" f) "\)" ""))))
|
||||
(sprintf-maybe
|
||||
;; static version
|
||||
;;
|
||||
@ -106,22 +154,37 @@
|
||||
(&mirror 1
|
||||
(field-string _field-empty-p)
|
||||
(if (string-match "%" field-string) "\)" ""))))
|
||||
(emacs-version ((&field 1 emacs-version)
|
||||
(emacs-version
|
||||
;; static version
|
||||
((&field 1 emacs-version)
|
||||
" " (upcase (emacs-version)) " "
|
||||
(&mirror 1))
|
||||
;; dynamic version
|
||||
((&field 1 emacs-version)
|
||||
(insert " " (upcase (emacs-version)) " ")
|
||||
(&mirror 1)))
|
||||
(wrap-selected-region ("foo"
|
||||
selected-text
|
||||
"baz"
|
||||
(&field 1 selected-text)))
|
||||
(navigate-fields ("foo"
|
||||
(navigate-fields
|
||||
;; static version
|
||||
("foo"
|
||||
&exit
|
||||
(&field 2)
|
||||
&field
|
||||
(&field last)
|
||||
(&field 1))
|
||||
;; dynamic version
|
||||
((insert "foo")
|
||||
(&exit)
|
||||
(&field 2)
|
||||
(&field)
|
||||
(&field last)
|
||||
(&field 1)))))
|
||||
|
||||
(defun snippet--get-fixture (name &optional dynamic-p)
|
||||
(let* ((assoc (assoc name snippet--test-snippets-alist)))
|
||||
(let* ((assoc (assoc name snippet--fixtures)))
|
||||
(if dynamic-p
|
||||
(caddr assoc)
|
||||
(cadr assoc))))
|
||||
|
||||
33
snippet.el
33
snippet.el
@ -314,7 +314,9 @@ pairs. Its meaning is not decided yet"
|
||||
(snippet--current-field)
|
||||
(snippet--prev-object)
|
||||
(snippet--all-objects))
|
||||
(cl-macrolet ((&field (field-name &body field-forms)
|
||||
(cl-macrolet ((&field (&optional (field-name nil field-name-provided-p) &body field-forms)
|
||||
(unless field-name-provided-p
|
||||
(setf field-name (make-symbol "_ignored")))
|
||||
`(let ((fn (lambda () ,@field-forms))
|
||||
(field
|
||||
(setf (gethash ',field-name snippet--fields)
|
||||
@ -324,14 +326,21 @@ pairs. Its meaning is not decided yet"
|
||||
(snippet--inserting-object
|
||||
field snippet--prev-object
|
||||
(setf snippet--prev-object field)
|
||||
(let ((snippet--current-field field))
|
||||
(funcall fn)))
|
||||
(let* ((snippet--current-field field)
|
||||
(retval (funcall fn)))
|
||||
(when (stringp retval) (insert retval))))
|
||||
(push field snippet--all-objects)))
|
||||
(&mirror (field-name mirror-args &body mirror-forms)
|
||||
(cond ((> (length mirror-args) 2)
|
||||
(&mirror (field-name &optional (mirror-args nil mirror-args-provided-p) &body mirror-forms)
|
||||
(cond ((not mirror-args-provided-p)
|
||||
(setq mirror-args `(,(intern "field-string") ,(make-symbol "_ignored")))
|
||||
(setq mirror-forms `((insert ,(intern "field-string")))))
|
||||
((> (length mirror-args) 2)
|
||||
(error "At most two args in mirror transforms"))
|
||||
((not (cadr mirror-args))
|
||||
(setcdr mirror-args '(_--snippet-ignored))))
|
||||
(t
|
||||
(nconc mirror-args
|
||||
(cl-loop for i from (length mirror-args)
|
||||
below 2
|
||||
collect (make-symbol "_ignored")))))
|
||||
`(let* ((fn (lambda ,mirror-args ,@mirror-forms))
|
||||
(mirror (make-instance 'snippet--mirror
|
||||
:parent snippet--current-field
|
||||
@ -369,7 +378,7 @@ pairs. Its meaning is not decided yet"
|
||||
`(defun ,name ,args ,docstring
|
||||
(with-dynamic-snippet ,@body)))
|
||||
|
||||
(def-edebug-spec &mirror (sexp sexp &rest form))
|
||||
(def-edebug-spec &mirror (sexp &optional sexp &rest form))
|
||||
(def-edebug-spec &field (sexp &rest form))
|
||||
|
||||
(put '&field 'lisp-indent-function 'defun)
|
||||
@ -419,14 +428,16 @@ pairs. Its meaning is not decided yet"
|
||||
(snippet--object-end
|
||||
(snippet--object-parent prev)))
|
||||
((and prev
|
||||
(snippet--object-end prev)
|
||||
(= (point) (snippet--object-end prev)))
|
||||
(snippet--object-end prev))
|
||||
(t
|
||||
(point-marker)))))
|
||||
(funcall fn)
|
||||
;; Only set the object's end if not set yet, i.e. when running its function
|
||||
;; some nested field might have set it already.
|
||||
(unless (snippet--object-end object)
|
||||
;; Don't set the object's end if its already set and matches point. i.e. when
|
||||
;; running its function some nested field might have set it already and
|
||||
(unless (and (snippet--object-end object)
|
||||
(= (snippet--object-end object) (point)))
|
||||
(setf (snippet--object-end object)
|
||||
(point-marker)))
|
||||
(when (snippet--object-parent object)
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user