[elpa] master 4ee3835 08/63: Use expand-env for all snippet evaluations

[Noam Postavsky]

branch: master
commit 4ee3835adf3352406aaa7dacc24f676f97b3cac2
Author: Noam Postavsky <address@hidden>
Commit: Noam Postavsky <address@hidden>

    Use expand-env for all snippet evaluations
    
    * yasnippet.el (yas--snippet): New field, expand-env.
    (yas--letenv): New macro, evaluate body with a given environment.
    (yas--find-next-field, yas--safely-run-hooks):
    (yas--on-field-overlay-modification):
    (yas-expand-snippet, yas--snippet-create): Use it.
---
 yasnippet.el | 117 +++++++++++++++++++++++++++++++----------------------------
 1 file changed, 62 insertions(+), 55 deletions(-)

diff --git a/yasnippet.el b/yasnippet.el
index 5339206..fa70339 100644
--- a/yasnippet.el
+++ b/yasnippet.el
@@ -2902,10 +2902,11 @@ Use this in primary and mirror transformations to tget."
 (put 'yas--active-field-overlay 'permanent-local t)
 (put 'yas--field-protection-overlays 'permanent-local t)
 
-(cl-defstruct (yas--snippet (:constructor yas--make-snippet ()))
+(cl-defstruct (yas--snippet (:constructor yas--make-snippet (expand-env)))
   "A snippet.
 
 ..."
+  expand-env
   (fields '())
   (exit nil)
   (id (yas--snippet-next-id) :read-only t)
@@ -2954,6 +2955,12 @@ DEPTH is a count of how many nested mirrors can affect 
this mirror"
   marker
   next)
 
+(defmacro yas--letenv (env &rest body)
+  "Evaluate BODY with bindings from ENV.
+ENV is a list of elements with the form (VAR FORM)."
+  (declare (debug (form body)) (indent 1))
+  `(eval (cl-list* 'let* ,env ',body)))
+
 (defun yas--apply-transform (field-or-mirror field &optional empty-on-nil-p)
   "Calculate transformed string for FIELD-OR-MIRROR from FIELD.
 
@@ -3102,15 +3109,16 @@ If there's none, exit the snippet."
   (let* ((snippet (car (yas-active-snippets)))
          (active-field (overlay-get yas--active-field-overlay 'yas--field))
          (target-field (yas--find-next-field arg snippet active-field)))
-    ;; Apply transform to active field.
-    (when active-field
-      (let ((yas-moving-away-p t))
-        (when (yas--field-update-display active-field)
-          (yas--update-mirrors snippet))))
-    ;; Now actually move...
-    (if target-field
-        (yas--move-to-field snippet target-field)
-      (yas-exit-snippet snippet))))
+    (yas--letenv (yas--snippet-expand-env snippet)
+      ;; Apply transform to active field.
+      (when active-field
+        (let ((yas-moving-away-p t))
+          (when (yas--field-update-display active-field)
+            (yas--update-mirrors snippet))))
+      ;; Now actually move...
+      (if target-field
+          (yas--move-to-field snippet target-field)
+        (yas-exit-snippet snippet)))))
 
 (defun yas--place-overlays (snippet field)
   "Correctly place overlays for SNIPPET's FIELD."
@@ -3239,25 +3247,26 @@ If so cleans up the whole snippet up."
          (snippet-exit-transform))
     (dolist (snippet snippets)
       (let ((active-field (yas--snippet-active-field snippet)))
-        (setq snippet-exit-transform (yas--snippet-force-exit snippet))
-        (cond ((or snippet-exit-transform
-                   (not (and active-field (yas--field-contains-point-p 
active-field))))
-               (setq snippets-left (delete snippet snippets-left))
-               (setf (yas--snippet-force-exit snippet) nil)
-               (yas--commit-snippet snippet))
-              ((and active-field
-                    (or (not yas--active-field-overlay)
-                        (not (overlay-buffer yas--active-field-overlay))))
-               ;;
-               ;; stacked expansion: this case is mainly for recent
-               ;; snippet exits that place us back int the field of
-               ;; another snippet
-               ;;
-               (save-excursion
-                 (yas--move-to-field snippet active-field)
-                 (yas--update-mirrors snippet)))
-              (t
-               nil))))
+        (yas--letenv (yas--snippet-expand-env snippet)
+          (setq snippet-exit-transform (yas--snippet-force-exit snippet))
+          (cond ((or snippet-exit-transform
+                     (not (and active-field (yas--field-contains-point-p 
active-field))))
+                 (setq snippets-left (delete snippet snippets-left))
+                 (setf (yas--snippet-force-exit snippet) nil)
+                 (yas--commit-snippet snippet))
+                ((and active-field
+                      (or (not yas--active-field-overlay)
+                          (not (overlay-buffer yas--active-field-overlay))))
+                 ;;
+                 ;; stacked expansion: this case is mainly for recent
+                 ;; snippet exits that place us back int the field of
+                 ;; another snippet
+                 ;;
+                 (save-excursion
+                   (yas--move-to-field snippet active-field)
+                   (yas--update-mirrors snippet)))
+                (t
+                 nil)))))
     (unless (or (null snippets) snippets-left)
       (if snippet-exit-transform
           (yas--eval-lisp-no-saves snippet-exit-transform))
@@ -3428,14 +3437,15 @@ field start.  This hook does nothing if an undo is in 
progress."
            (field (overlay-get overlay 'yas--field))
            (snippet (overlay-get yas--active-field-overlay 'yas--snippet)))
       (save-match-data
-        (when (yas--skip-and-clear-field-p field beg end length)
-          ;; We delete text starting from the END of insertion.
-          (yas--skip-and-clear field end))
-        (setf (yas--field-modified-p field) t)
-        (yas--advance-end-maybe field (overlay-end overlay))
-        (save-excursion
-          (yas--field-update-display field))
-        (yas--update-mirrors snippet)))))
+        (yas--letenv (yas--snippet-expand-env snippet)
+          (when (yas--skip-and-clear-field-p field beg end length)
+            ;; We delete text starting from the END of insertion.
+            (yas--skip-and-clear field end))
+          (setf (yas--field-modified-p field) t)
+          (yas--advance-end-maybe field (overlay-end overlay))
+          (save-excursion
+            (yas--field-update-display field))
+          (yas--update-mirrors snippet))))))
 
 ;;; Apropos protection overlays:
 ;;
@@ -3582,13 +3592,9 @@ considered when expanding the snippet."
                    ;; insert things that are not valid in the
                    ;; major-mode language syntax anyway.
                    (syntax-propertize-function nil))
+               (insert content)
                (setq snippet
-                     (if expand-env
-                         (eval `(let* ,expand-env
-                                  (insert content)
-                                  (yas--snippet-create start (point))))
-                       (insert content)
-                       (yas--snippet-create start (point)))))
+                     (yas--snippet-create expand-env start (point))))
              ;; Invalidate any syntax-propertizing done while 
`syntax-propertize-function' was nil
              (syntax-ppss-flush-cache start))
 
@@ -3668,27 +3674,28 @@ After revival, push the `yas--take-care-of-redo' in the
       (push `(apply yas--take-care-of-redo ,beg ,end ,snippet)
             buffer-undo-list))))
 
-(defun yas--snippet-create (begin end)
+(defun yas--snippet-create (expand-env begin end)
   "Create a snippet from a template inserted at BEGIN to END.
 
 Returns the newly created snippet."
   (save-restriction
     (narrow-to-region begin end)
-    (let ((snippet (yas--make-snippet)))
-      (goto-char begin)
-      (yas--snippet-parse-create snippet)
+    (let ((snippet (yas--make-snippet expand-env)))
+      (yas--letenv expand-env
+        (goto-char begin)
+        (yas--snippet-parse-create snippet)
 
-      ;; Sort and link each field
-      (yas--snippet-sort-fields snippet)
+        ;; Sort and link each field
+        (yas--snippet-sort-fields snippet)
 
-      ;; Create keymap overlay for snippet
-      (setf (yas--snippet-control-overlay snippet)
-            (yas--make-control-overlay snippet (point-min) (point-max)))
+        ;; Create keymap overlay for snippet
+        (setf (yas--snippet-control-overlay snippet)
+              (yas--make-control-overlay snippet (point-min) (point-max)))
 
-      ;; Move to end
-      (goto-char (point-max))
+        ;; Move to end
+        (goto-char (point-max))
 
-      snippet)))
+        snippet))))
 
 
 ;;; Apropos adjacencies and "fom's":