[elpa] master 048d030 22/42: Fix line-relative snapshotting for org src blocks

[Noam Postavsky]

branch: master
commit 048d030b6869eb94ca6450c0bf6c7d41d7e9431d
Author: Noam Postavsky <address@hidden>
Commit: Noam Postavsky <address@hidden>

    Fix line-relative snapshotting for org src blocks
    
    There was some half-backed code getting confused between "plain"
    snapshort info and line+snapshot info leading to some type errors when
    expanding snippets in org-mode src blocks.  I had wrongly assumed the
    failures were only due to org version 9 changes (in fact, the org
    changes only affect snippet expansion for text-mode (and probably
    other non-fontifying modes too)).  Reorganize the snapshotting
    functions so that line+snaphot has the line info after the marker,
    next to the rest of the snapshot info.  This removes the need for list
    manipulation and simplifies the code.  Furthermore, let the
    restoration functions take the info as a list, rather than separate
    arguments, this removes the need for several uses of `apply'.
    * yasnippet.el (yas--snapshot-location): Renamed from
    yas--snapshot-marker-location, don't return marker.
    (yas--snapshot-line-location): New function.
    (yas--goto-saved-location): Take single list arg.  Return point.
    (yas--restore-marker-location): Remove, open code callers.
    (yas--goto-saved-line-location)
    (yas--restore-overlay-line-location): New functions.
    (yas--prepare-snippets-for-move, yas--finish-moving-snippets)
    (yas--auto-fill, yas--indent-region): Adjust callers of previously
    mentioned functions accordingly.
    * yasnippet-tests.el (yas-org-native-tab-in-source-block-text):
    Renamed from yas-org-native-tab-in-source-block.
    (yas-org-native-tab-in-source-block-emacs-lisp): New test.
    (do-yas-org-native-tab-in-source-block): Take MODE parameter.
---
 yasnippet-tests.el |  38 +++++++++---
 yasnippet.el       | 174 ++++++++++++++++++++++++++++-------------------------
 2 files changed, 120 insertions(+), 92 deletions(-)

diff --git a/yasnippet-tests.el b/yasnippet-tests.el
index 9434ff7..c555a9e 100644
--- a/yasnippet-tests.el
+++ b/yasnippet-tests.el
@@ -1567,17 +1567,35 @@ TODO: be meaner"
       (should (eq (key-binding [(tab)]) 'yas-expand))
       (should (eq (key-binding (kbd "TAB")) 'yas-expand))))))
 
-(ert-deftest yas-org-native-tab-in-source-block ()
+(ert-deftest yas-org-native-tab-in-source-block-text ()
   "Test expansion of snippets in org source blocks."
-  :expected-result (if (and (fboundp 'org-in-src-block-p) (version< 
(org-version) "9"))
+  ;; org 9+ no longer runs fontification for text-mode, so our hacks
+  ;; don't work.  Note that old ert doesn't have skipping, so we have
+  ;; to expect failure instead.
+  :expected-result (if (and (fboundp 'org-in-src-block-p)
+                            (version< (org-version) "9"))
                        :passed :failed)
+  (let ((text-mode-hook #'yas-minor-mode))
+    (do-yas-org-native-tab-in-source-block "text")))
+
+(ert-deftest yas-org-native-tab-in-source-block-emacs-lisp ()
+  "Test expansion of snippets in org source blocks."
+  :expected-result (if (fboundp 'org-in-src-block-p)
+                       :passed :failed)
+  (let ((emacs-lisp-mode-hook #'yas-minor-mode)
+        ;; This makes the test a bit less comprehensive, but it's
+        ;; needed to avoid bumping into Emacs Bug#35264.
+        (org-src-preserve-indentation t))
+    (do-yas-org-native-tab-in-source-block "emacs-lisp")))
+
+(defun do-yas-org-native-tab-in-source-block (mode)
   (yas-saving-variables
    (yas-with-snippet-dirs
-    '((".emacs.d/snippets"
-       ("text-mode"
+    `((".emacs.d/snippets"
+       (,(concat mode "-mode")
         ("T" . "${1:one} $1\n${2:two} $2\n<<$0>> done!"))))
-    (let ((text-mode-hook '(yas-minor-mode))
-          (org-src-tab-acts-natively t)
+    ;; Binding both text and prog mode hook should cover everything.
+    (let ((org-src-tab-acts-natively t)
           ;; Org 8.x requires this in order for
           ;; `org-src-tab-acts-natively' to have effect.
           (org-src-fontify-natively t))
@@ -1586,7 +1604,7 @@ TODO: be meaner"
       (yas--with-font-locked-temp-buffer
        (org-mode)
        (yas-minor-mode 1)
-       (insert "#+BEGIN_SRC text\nT\n#+END_SRC")
+       (insert "#+BEGIN_SRC " mode "\nT\n#+END_SRC")
        (if (fboundp 'font-lock-ensure)
            (font-lock-ensure)
          (jit-lock-fontify-now))
@@ -1602,9 +1620,9 @@ TODO: be meaner"
        ;; Check snippet expansion, ignore leading whitespace due to
        ;; `org-edit-src-content-indentation'.
        (should (looking-at "\
-[[:space:]]*one one
-[[:space:]]*two two
-[[:space:]]*<<>> done!")))))))
+\[[:space:]]*one one
+\[[:space:]]*two two
+\[[:space:]]*<<>> done!")))))))
 
 
 (ert-deftest test-yas-activate-extra-modes ()
diff --git a/yasnippet.el b/yasnippet.el
index d457afd..656fd2c 100644
--- a/yasnippet.el
+++ b/yasnippet.el
@@ -3505,10 +3505,7 @@ This renders the snippet as ordinary text."
       (dolist (snippet snippets)
         (yas--snippet-map-markers
          (lambda (m)
-           (goto-char m)
-           (beginning-of-line)
-           (prog1 (cons (count-lines (point-min) (point))
-                        (yas--snapshot-marker-location m))
+           (prog1 (cons m (yas--snapshot-line-location m))
              (set-marker m nil)))
          snippet)
         (let ((ctrl-ov (yas--snapshot-overlay-line-location
@@ -3516,7 +3513,7 @@ This renders the snippet as ordinary text."
           (push (list ctrl-ov dst-base-line snippet) to-move)
           (delete-overlay (car ctrl-ov))))
       (with-current-buffer buf
-        (setq yas--snippets-to-move (nconc to-move yas--snippets-to-move))))))
+        (cl-callf2 nconc to-move yas--snippets-to-move)))))
 
 (defun yas--on-buffer-kill ()
   ;; Org mode uses temp buffers for fontification and "native tab",
@@ -3542,18 +3539,16 @@ This renders the snippet as ordinary text."
            for base-pos = (progn (goto-char (point-min))
                                  (forward-line base-line) (point))
            do (yas--snippet-map-markers
-               (lambda (l-m-r-w)
-                 (goto-char base-pos)
-                 (forward-line (nth 0 l-m-r-w))
-                 (save-restriction
-                   (narrow-to-region (line-beginning-position)
-                                     (line-end-position))
-                   (yas--restore-marker-location (cdr l-m-r-w)))
-                 (nth 1 l-m-r-w))
+               (lambda (saved-location)
+                 (let ((m (pop saved-location)))
+                   (set-marker m (yas--goto-saved-line-location
+                                  base-pos saved-location))
+                   m))
                snippet)
            (goto-char base-pos)
-           (yas--restore-overlay-location ctrl-ov)
-           (yas--maybe-move-to-active-field snippet))
+           (yas--restore-overlay-line-location base-pos ctrl-ov)
+           (yas--maybe-move-to-active-field snippet)
+           (push snippet yas--active-snippets))
   (setq yas--snippets-to-move nil))
 
 (defun yas--safely-call-fun (fun)
@@ -3808,7 +3803,7 @@ field start.  This hook does nothing if an undo is in 
progress."
     (dolist (snippet snippets)
       (dolist (m (yas--collect-snippet-markers snippet))
         (when (and (<= beg m) (<= m end))
-          (push (yas--snapshot-marker-location m beg end) remarkers)))
+          (push (cons m (yas--snapshot-location m beg end)) remarkers)))
       (push (yas--snapshot-overlay-location
              (yas--snippet-control-overlay snippet) beg end)
             reoverlays))
@@ -3858,7 +3853,9 @@ field start.  This hook does nothing if an undo is in 
progress."
     (save-excursion
       (save-restriction
         (narrow-to-region beg end)
-        (mapc #'yas--restore-marker-location remarkers)
+        (dolist (remarker remarkers)
+          (set-marker (car remarker)
+                      (yas--goto-saved-location (cdr remarker))))
         (mapc #'yas--restore-overlay-location reoverlays))
       (mapc (lambda (snippet)
               (yas--letenv (yas--snippet-expand-env snippet)
@@ -4337,35 +4334,54 @@ Meant to be called in a narrowed buffer, does various 
passes"
 ;; current paragraph instead of line.
 ;;
 ;; 2. Moving snippets from an `org-src' temp buffer into the main org
-;; buffer, in this case we need to count the line offsets (because org
-;; may add indentation on each line making character positions
-;; unreliable).
+;; buffer, in this case we need to count the relative line number
+;; (because org may add indentation on each line making character
+;; positions unreliable).
+;;
+;; Data formats:
+;; (LOCATION) = (REGEXP WS-COUNT)
+;; MARKER -> (MARKER . (LOCATION))
+;; OVERLAY -> (OVERLAY LOCATION-BEG LOCATION-END)
+;;
+;; For `org-src' temp buffer, add a line number to format:
+;; (LINE-LOCATION) = (LINE . (LOCATION))
+;; MARKER@LINE -> (MARKER . (LINE-LOCATION))
+;; OVERLAY@LINE -> (OVERLAY LINE-LOCATION-BEG LINE-LOCATION-END)
 ;;
 ;; This is all best-effort heuristic stuff, but it should cover 99% of
 ;; use-cases.
 
-(defun yas--snapshot-marker-location (marker &optional beg end)
-  "Returns info for restoring MARKER's location after indent.
-The returned value is a list of the form (MARKER REGEXP WS-COUNT)."
+(defun yas--snapshot-location (position &optional beg end)
+  "Returns info for restoring POSITIONS's location after indent.
+The returned value is a list of the form (REGEXP WS-COUNT).
+POSITION may be either a marker or just a buffer position.  The
+REGEXP matches text between BEG..END which default to the current
+line if omitted."
+  (goto-char position)
   (unless beg (setq beg (line-beginning-position)))
   (unless end (setq end (line-end-position)))
-  (let ((before (split-string (buffer-substring-no-properties beg marker)
+  (let ((before (split-string (buffer-substring-no-properties beg position)
                               "[[:space:]\n]+" t))
-        (after (split-string (buffer-substring-no-properties marker end)
+        (after (split-string (buffer-substring-no-properties position end)
                              "[[:space:]\n]+" t)))
-    (list marker
-          (concat "[[:space:]\n]*"
+    (list (concat "[[:space:]\n]*"
                   (mapconcat (lambda (s)
-                               (if (eq s marker) "\\(\\)"
+                               (if (eq s position) "\\(\\)"
                                  (regexp-quote s)))
-                             (nconc before (list marker) after)
+                             (nconc before (list position) after)
                              "[[:space:]\n]*"))
-          (progn (goto-char marker)
-                 (skip-chars-forward "[:space:]\n" end)
-                 (- (point) marker)))))
+          (progn (skip-chars-forward "[:space:]\n" end)
+                 (- (point) position)))))
+
+(defun yas--snapshot-line-location (position &optional beg end)
+  "Like `yas--snapshot-location', but return also line number.
+Returned format is (LINE REGEXP WS-COUNT)."
+  (goto-char position)
+  (cons (count-lines (point-min) (line-beginning-position))
+        (yas--snapshot-location position beg end)))
 
 (defun yas--snapshot-overlay-location (overlay beg end)
-  "Like `yas--snapshot-marker-location' for overlays.
+  "Like `yas--snapshot-location' for overlays.
 The returned format is (OVERLAY (RE WS) (RE WS)).  Either of
 the (RE WS) lists may be nil if the start or end, respectively,
 of the overlay is outside the range BEG .. END."
@@ -4373,67 +4389,59 @@ of the overlay is outside the range BEG .. END."
         (oend (overlay-end overlay)))
     (list overlay
           (when (and (<= beg obeg) (< obeg end))
-            (cdr (yas--snapshot-marker-location obeg beg end)))
+            (yas--snapshot-location obeg beg end))
           (when (and (<= beg oend) (< oend end))
-            (cdr (yas--snapshot-marker-location oend beg end))))))
+            (yas--snapshot-location oend beg end)))))
 
 (defun yas--snapshot-overlay-line-location (overlay)
   "Return info for restoring OVERLAY's line based location.
 The returned format is (OVERLAY (LINE RE WS) (LINE RE WS))."
-  (let ((loc-beg (progn (goto-char (overlay-start overlay))
-                        (yas--snapshot-marker-location (point))))
-        (loc-end (progn (goto-char (overlay-end overlay))
-                        (yas--snapshot-marker-location (point)))))
-    (setcar loc-beg (count-lines (point-min) (progn (goto-char (car loc-beg))
-                                                    
(line-beginning-position))))
-    (setcar loc-end (count-lines (point-min) (progn (goto-char (car loc-end))
-                                                    
(line-beginning-position))))
-    (list overlay loc-beg loc-end)))
-
-(defun yas--goto-saved-location (regexp ws-count)
-  "Move point to location saved by `yas--snapshot-marker-location'.
-Buffer must be narrowed to BEG..END used to create the snapshot info."
-  (goto-char (point-min))
-  (if (not (looking-at regexp))
-      (lwarn '(yasnippet re-marker) :warning
-             "Couldn't find: %S" regexp)
-    (goto-char (match-beginning 1))
-    (skip-chars-forward "[:space:]\n")
-    (skip-chars-backward "[:space:]\n" (- (point) ws-count))))
-
-(defun yas--restore-marker-location (re-marker)
-  "Restores marker based on info from `yas--snapshot-marker-location'.
+  (list overlay
+        (yas--snapshot-line-location (overlay-start overlay))
+        (yas--snapshot-line-location (overlay-end overlay))))
+
+(defun yas--goto-saved-location (re-count)
+  "Move to and return point saved by `yas--snapshot-location'.
 Buffer must be narrowed to BEG..END used to create the snapshot info."
-  (apply #'yas--goto-saved-location (cdr re-marker))
-  (set-marker (car re-marker) (point)))
+  (let ((regexp (pop re-count))
+        (ws-count (pop re-count)))
+    (goto-char (point-min))
+    (if (not (looking-at regexp))
+        (lwarn '(yasnippet re-marker) :warning
+               "Couldn't find: %S" regexp)
+      (goto-char (match-beginning 1))
+      (skip-chars-forward "[:space:]\n")
+      (skip-chars-backward "[:space:]\n" (- (point) ws-count)))
+    (point)))
 
 (defun yas--restore-overlay-location (ov-locations)
-  "Restores marker based on info from `yas--snapshot-marker-location'.
+  "Restores marker based on info from `yas--snapshot-overlay-location'.
 Buffer must be narrowed to BEG..END used to create the snapshot info."
   (cl-destructuring-bind (overlay loc-beg loc-end) ov-locations
     (move-overlay overlay
                   (if (not loc-beg) (overlay-start overlay)
-                    (apply #'yas--goto-saved-location loc-beg)
-                    (point))
+                    (yas--goto-saved-location loc-beg))
                   (if (not loc-end) (overlay-end overlay)
-                    (apply #'yas--goto-saved-location loc-end)
-                    (point)))))
-
-
-(defun yas--restore-overlay-line-location (ov-locations)
-  "Restores overlay based on info from `yas--snapshot-overlay-line-location'."
+                    (yas--goto-saved-location loc-end)))))
+
+(defun yas--goto-saved-line-location (base-pos l-re-count)
+  "Move to and return point saved by `yas--snapshot-line-location'.
+Additionally requires BASE-POS to tell where the line numbers are
+relative to."
+  (goto-char base-pos)
+  (forward-line (pop l-re-count))
   (save-restriction
-    (move-overlay (car ov-locations)
-                  (save-excursion
-                    (forward-line (car (nth 1 ov-locations)))
-                    (narrow-to-region (line-beginning-position) 
(line-end-position))
-                    (apply #'yas--goto-saved-location (cdr (nth 1 
ov-locations)))
-                    (point))
-                  (save-excursion
-                    (forward-line (car (nth 2 ov-locations)))
-                    (narrow-to-region (line-beginning-position) 
(line-end-position))
-                    (apply #'yas--goto-saved-location (cdr (nth 2 
ov-locations)))
-                    (point)))))
+    (narrow-to-region (line-beginning-position)
+                      (line-end-position))
+    (yas--goto-saved-location l-re-count)))
+
+(defun yas--restore-overlay-line-location (base-pos ov-locations)
+  "Restores marker based on info from `yas--snapshot-overlay-line-location'."
+  (cl-destructuring-bind (overlay beg-l-r-w end-l-r-w)
+      ov-locations
+    (move-overlay overlay
+                  (yas--goto-saved-line-location base-pos beg-l-r-w)
+                  (yas--goto-saved-line-location base-pos end-l-r-w))))
 
 (defun yas--indent-region (from to snippet)
   "Indent the lines between FROM and TO with `indent-according-to-mode'.
@@ -4452,14 +4460,16 @@ The SNIPPET's markers are preserved."
                  (let ((remarkers nil))
                    (dolist (m snippet-markers)
                      (when (and (<= bol m) (<= m eol))
-                       (push (yas--snapshot-marker-location m bol eol)
+                       (push (cons m (yas--snapshot-location m bol eol))
                              remarkers)))
                    (unwind-protect
                        (progn (back-to-indentation)
                               (indent-according-to-mode))
                      (save-restriction
                        (narrow-to-region bol (line-end-position))
-                       (mapc #'yas--restore-marker-location remarkers))))
+                       (dolist (remarker remarkers)
+                         (set-marker (car remarker)
+                                     (yas--goto-saved-location (cdr 
remarker)))))))
                  while (and (zerop (forward-line 1))
                             (< (point) to)))))))