Fix nesting bug

* snippet-tests.el (nested-skip-fields, navigate-fields-and-exit):
Fix test.
(wrap-selected-region): Use eval trick temporarily.
(snippet--test-fixture): New helper.

* snippet.el (snippet--debug-snippet): More stable sort in
debugging helper.

* snippet.el (with-dynamic-snippet): Fix nesting.
(snippet--call-with-inserting-object): Fix setting the `prev'
slot.
(snippet--call-with-inserting-object): Fix nesting.
This commit is contained in:
João Távora 2015-04-04 14:13:15 +01:00
parent 08784e769f
commit 94bd529d08
2 changed files with 40 additions and 30 deletions

View File

@ -197,7 +197,7 @@
;; this should exit the snippet now, since the two remaining
;; fields should be skipped
(ert-simulate-command '(snippet-next-field))
(should (null (overlay-buffer snippet--field-overlay))))
(should (null snippet--field-overlay)))
(snippet--define-expansion-test mirror-of-nested-field mirror-of-nested-field()
(should (equal (buffer-string) "a nested field, nested mirroring: field"))
@ -274,25 +274,23 @@
(ert-simulate-command '((lambda () (interactive) (insert "bar"))))
(set-mark (point))
(goto-char (point-max))
(snippet--insert-test-snippet 'wrap-selected-region)
(eval `(with-static-snippet ,@(snippet--get-fixture 'wrap-selected-region)))
(should (equal (buffer-string)
"foobarbazbar"))))
(ert-deftest navigate-fields-and-exit ()
(with-temp-buffer
(snippet--insert-test-snippet 'navigate-fields)
(should (equal (buffer-string) "foo"))
(ert-simulate-command '((lambda () (interactive) (insert "quam"))))
(ert-simulate-command '(snippet-next-field))
(ert-simulate-command '((lambda () (interactive) (insert "bar"))))
(ert-simulate-command '(snippet-next-field))
(ert-simulate-command '((lambda () (interactive) (insert "baz"))))
(ert-simulate-command '(snippet-next-field))
(ert-simulate-command '((lambda () (interactive) (insert "quux"))))
(ert-simulate-command '(snippet-next-field))
(should (equal (buffer-string) "foobarbazquuxquam"))
(should (null (overlay-buffer snippet--field-overlay)))
(should (looking-at "barbazquuxquam"))))
(snippet--define-expansion-test navigate-fields-and-exit navigate-fields()
(should (equal (buffer-string) "foo"))
(ert-simulate-command '((lambda () (interactive) (insert "quam"))))
(ert-simulate-command '(snippet-next-field))
(ert-simulate-command '((lambda () (interactive) (insert "bar"))))
(ert-simulate-command '(snippet-next-field))
(ert-simulate-command '((lambda () (interactive) (insert "baz"))))
(ert-simulate-command '(snippet-next-field))
(ert-simulate-command '((lambda () (interactive) (insert "quux"))))
(ert-simulate-command '(snippet-next-field))
(should (equal (buffer-string) "foobarbazquuxquam"))
(should (null snippet--field-overlay))
(should (looking-at "barbazquuxquam")))
;;; input validation
@ -347,7 +345,8 @@
(should-error (snippet--canonicalize-form '(&eval (foo) (bar)))))
;; pretty forms
;; misc
;;
(cl-loop for sym in (list 'snippet--define-expansion-test)
for regexp = (format "(\\(%S\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)"
sym)
@ -356,5 +355,13 @@
`((,regexp (1 font-lock-keyword-face)
(2 font-lock-variable-name-face)))))
(defun snippet--test-fixture (fixture &optional dynamic)
(with-current-buffer (get-buffer-create "*snippet-test*")
(erase-buffer)
(switch-to-buffer (current-buffer))
(if dynamic
(eval `(with-dynamic-snippet ,@(snippet--get-fixture fixture 'dynamic-p)))
(eval `(with-static-snippet ,@(snippet--get-fixture fixture nil))))))
(provide 'snippet-tests)

View File

@ -315,18 +315,17 @@ pairs. Its meaning is not decided yet"
(snippet--prev-object)
(snippet--all-objects))
(cl-macrolet ((&field (field-name &body field-forms)
`(let* ((field
(setf (gethash ',field-name snippet--fields)
(make-instance 'snippet--field
:name ',field-name
:parent snippet--current-field)))
(fn (lambda ()
(let ((snippet--current-field field))
,@field-forms))))
`(let ((fn (lambda () ,@field-forms))
(field
(setf (gethash ',field-name snippet--fields)
(make-instance 'snippet--field
:name ',field-name
:parent snippet--current-field))))
(snippet--inserting-object
field snippet--prev-object
(funcall fn))
(setf snippet--prev-object field)
(setf snippet--prev-object field)
(let ((snippet--current-field field))
(funcall fn)))
(push field snippet--all-objects)))
(&mirror (field-name mirror-args &body mirror-forms)
(cond ((> (length mirror-args) 2)
@ -404,6 +403,7 @@ pairs. Its meaning is not decided yet"
(defun snippet--call-with-inserting-object (object prev fn)
(when prev
(setf (snippet--object-prev object) prev)
(cl-assert (null (snippet--object-next prev)) nil
"previous object already has another sucessor")
(setf (snippet--object-next prev) object))
@ -424,8 +424,11 @@ pairs. Its meaning is not decided yet"
(t
(point-marker)))))
(funcall fn)
(setf (snippet--object-end object)
(point-marker))
;; 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)
(setf (snippet--object-end object)
(point-marker)))
(when (snippet--object-parent object)
(setf (snippet--object-end
(snippet--object-parent object))