From 94bd529d08e975c879e1c8cde8f16b2ac34078d7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sat, 4 Apr 2015 14:13:15 +0100 Subject: [PATCH] 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. --- snippet-tests.el | 43 +++++++++++++++++++++++++------------------ snippet.el | 27 +++++++++++++++------------ 2 files changed, 40 insertions(+), 30 deletions(-) diff --git a/snippet-tests.el b/snippet-tests.el index 16d2930..e9e9f50 100644 --- a/snippet-tests.el +++ b/snippet-tests.el @@ -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) diff --git a/snippet.el b/snippet.el index 3334ec9..1b6ec2c 100644 --- a/snippet.el +++ b/snippet.el @@ -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))