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

Make dynamic version of all tests and fix bugs

Browse Source 
* 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 2015-04-04 15:07:15 +01:00
parent 94bd529d08
commit 04591a4a86
2 changed files with 129 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

151
snippet-tests.el
View File

@ -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")
" bar "
(&mirror 1)))
(contrived ((&field 1)
(&field 2)
(&field 3)))
(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
;; static version
((&field 1)
(&field 2)
(&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,29 +66,65 @@
(insert " and its mirror: ")
(&mirror 1 (s e)
(insert s))))
(mirror-of-nested-field ("a "
(&field 1 (&nested (&field 2 "nested")
" "
(&field 3 "field")))
(&mirror 3 (concat ", nested mirroring: "
field-string))))
(more-nesting ("a "
(&field 1 (&nested
"'"
(&field 2 "rain")
(&mirror 2 (apply #'string
(reverse
(string-to-list
field-string))))
"'"))
(&field 3 " and a field:")
" "
(&mirror 1)))
(printf ("printf (\""
(&field 1 "%s")
(&mirror 1 (if (string-match "%" field-string) "\"," "\")"))
(&field 2)
(&mirror 1 (if (string-match "%" field-string) "\)" ""))))
(mirror-of-nested-field
;; static
("a "
(&field 1 (&nested (&field 2 "nested")
" "
(&field 3 "field")))
(&mirror 3 (concat ", nested mirroring: "
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")
(&mirror 2 (apply #'string
(reverse
(string-to-list
field-string))))
"'"))
(&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
;; static
("printf (\""
(&field 1 "%s")
(&mirror 1 (if (string-match "%" field-string) "\"," "\")"))
(&field 2)
(&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)
" " (upcase (emacs-version)) " "
(&mirror 1)))
(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"
&exit
(&field 2)
&field
(&field last)
(&field 1)))))
(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
View File

@ -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)