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

Fix line-relative snapshotting for org src blocks

Browse Source 
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.
This commit is contained in:
Noam Postavsky 2019-03-31 21:12:11 -04:00
parent dabc719921
commit 048d030b68
2 changed files with 118 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
yasnippet-tests.el
View File

@ -1567,17 +1567,35 @@ TODO: be meaner"
(should (eq (key-binding [(tab)]) 'yas-expand)) (should (eq (key-binding [(tab)]) 'yas-expand))
(should (eq (key-binding (kbd "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." "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) :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-saving-variables
(yas-with-snippet-dirs (yas-with-snippet-dirs
'((".emacs.d/snippets" `((".emacs.d/snippets"
("text-mode" (,(concat mode "-mode")
("T" . "${1:one} $1\n${2:two} $2\n<<$0>> done!")))) ("T" . "${1:one} $1\n${2:two} $2\n<<$0>> done!"))))
(let ((text-mode-hook '(yas-minor-mode)) ;; Binding both text and prog mode hook should cover everything.
(org-src-tab-acts-natively t) (let ((org-src-tab-acts-natively t)
;; Org 8.x requires this in order for ;; Org 8.x requires this in order for
;; `org-src-tab-acts-natively' to have effect. ;; `org-src-tab-acts-natively' to have effect.
(org-src-fontify-natively t)) (org-src-fontify-natively t))
@ -1586,7 +1604,7 @@ TODO: be meaner"
(yas--with-font-locked-temp-buffer (yas--with-font-locked-temp-buffer
(org-mode) (org-mode)
(yas-minor-mode 1) (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) (if (fboundp 'font-lock-ensure)
(font-lock-ensure) (font-lock-ensure)
(jit-lock-fontify-now)) (jit-lock-fontify-now))
@ -1602,9 +1620,9 @@ TODO: be meaner"
;; Check snippet expansion, ignore leading whitespace due to ;; Check snippet expansion, ignore leading whitespace due to
;; `org-edit-src-content-indentation'. ;; `org-edit-src-content-indentation'.
(should (looking-at "\ (should (looking-at "\
[[:space:]]*one one \[[:space:]]*one one
[[:space:]]*two two \[[:space:]]*two two
[[:space:]]*<<>> done!"))))))) \[[:space:]]*<<>> done!")))))))
(ert-deftest test-yas-activate-extra-modes () (ert-deftest test-yas-activate-extra-modes ()

158
yasnippet.el
View File

@ -3505,10 +3505,7 @@ This renders the snippet as ordinary text."
(dolist (snippet snippets) (dolist (snippet snippets)
(yas--snippet-map-markers (yas--snippet-map-markers
(lambda (m) (lambda (m)
(goto-char m) (prog1 (cons m (yas--snapshot-line-location m))
(beginning-of-line)
(prog1 (cons (count-lines (point-min) (point))
(yas--snapshot-marker-location m))
(set-marker m nil))) (set-marker m nil)))
snippet) snippet)
(let ((ctrl-ov (yas--snapshot-overlay-line-location (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) (push (list ctrl-ov dst-base-line snippet) to-move)
(delete-overlay (car ctrl-ov)))) (delete-overlay (car ctrl-ov))))
(with-current-buffer buf (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 () (defun yas--on-buffer-kill ()
;; Org mode uses temp buffers for fontification and "native tab", ;; 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)) for base-pos = (progn (goto-char (point-min))
(forward-line base-line) (point)) (forward-line base-line) (point))
do (yas--snippet-map-markers do (yas--snippet-map-markers
(lambda (l-m-r-w) (lambda (saved-location)
(goto-char base-pos) (let ((m (pop saved-location)))
(forward-line (nth 0 l-m-r-w)) (set-marker m (yas--goto-saved-line-location
(save-restriction base-pos saved-location))
(narrow-to-region (line-beginning-position) m))
(line-end-position))
(yas--restore-marker-location (cdr l-m-r-w)))
(nth 1 l-m-r-w))
snippet) snippet)
(goto-char base-pos) (goto-char base-pos)
(yas--restore-overlay-location ctrl-ov) (yas--restore-overlay-line-location base-pos ctrl-ov)
(yas--maybe-move-to-active-field snippet)) (yas--maybe-move-to-active-field snippet)
(push snippet yas--active-snippets))
(setq yas--snippets-to-move nil)) (setq yas--snippets-to-move nil))
(defun yas--safely-call-fun (fun) (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 (snippet snippets)
(dolist (m (yas--collect-snippet-markers snippet)) (dolist (m (yas--collect-snippet-markers snippet))
(when (and (<= beg m) (<= m end)) (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 (push (yas--snapshot-overlay-location
(yas--snippet-control-overlay snippet) beg end) (yas--snippet-control-overlay snippet) beg end)
reoverlays)) reoverlays))
@ -3858,7 +3853,9 @@ field start. This hook does nothing if an undo is in progress."
(save-excursion (save-excursion
(save-restriction (save-restriction
(narrow-to-region beg end) (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 #'yas--restore-overlay-location reoverlays))
(mapc (lambda (snippet) (mapc (lambda (snippet)
(yas--letenv (yas--snippet-expand-env 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. ;; current paragraph instead of line.
;; ;;
;; 2. Moving snippets from an `org-src' temp buffer into the main org ;; 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 ;; buffer, in this case we need to count the relative line number
;; may add indentation on each line making character positions ;; (because org may add indentation on each line making character
;; unreliable). ;; 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 ;; This is all best-effort heuristic stuff, but it should cover 99% of
;; use-cases. ;; use-cases.
(defun yas--snapshot-marker-location (marker &optional beg end) (defun yas--snapshot-location (position &optional beg end)
"Returns info for restoring MARKER's location after indent. "Returns info for restoring POSITIONS's location after indent.
The returned value is a list of the form (MARKER REGEXP WS-COUNT)." 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 beg (setq beg (line-beginning-position)))
(unless end (setq end (line-end-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)) "[[:space:]\n]+" t))
(after (split-string (buffer-substring-no-properties marker end) (after (split-string (buffer-substring-no-properties position end)
"[[:space:]\n]+" t))) "[[:space:]\n]+" t)))
(list marker (list (concat "[[:space:]\n]*"
(concat "[[:space:]\n]*"
(mapconcat (lambda (s) (mapconcat (lambda (s)
(if (eq s marker) "\\(\\)" (if (eq s position) "\\(\\)"
(regexp-quote s))) (regexp-quote s)))
(nconc before (list marker) after) (nconc before (list position) after)
"[[:space:]\n]*")) "[[:space:]\n]*"))
(progn (goto-char marker) (progn (skip-chars-forward "[:space:]\n" end)
(skip-chars-forward "[:space:]\n" end) (- (point) position)))))
(- (point) marker)))))
(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) (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 returned format is (OVERLAY (RE WS) (RE WS)). Either of
the (RE WS) lists may be nil if the start or end, respectively, the (RE WS) lists may be nil if the start or end, respectively,
of the overlay is outside the range BEG .. END." 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))) (oend (overlay-end overlay)))
(list overlay (list overlay
(when (and (<= beg obeg) (< obeg end)) (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)) (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) (defun yas--snapshot-overlay-line-location (overlay)
"Return info for restoring OVERLAY's line based location. "Return info for restoring OVERLAY's line based location.
The returned format is (OVERLAY (LINE RE WS) (LINE RE WS))." The returned format is (OVERLAY (LINE RE WS) (LINE RE WS))."
(let ((loc-beg (progn (goto-char (overlay-start overlay)) (list overlay
(yas--snapshot-marker-location (point)))) (yas--snapshot-line-location (overlay-start overlay))
(loc-end (progn (goto-char (overlay-end overlay)) (yas--snapshot-line-location (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) (defun yas--goto-saved-location (re-count)
"Move point to location saved by `yas--snapshot-marker-location'. "Move to and return point saved by `yas--snapshot-location'.
Buffer must be narrowed to BEG..END used to create the snapshot info." Buffer must be narrowed to BEG..END used to create the snapshot info."
(let ((regexp (pop re-count))
(ws-count (pop re-count)))
(goto-char (point-min)) (goto-char (point-min))
(if (not (looking-at regexp)) (if (not (looking-at regexp))
(lwarn '(yasnippet re-marker) :warning (lwarn '(yasnippet re-marker) :warning
"Couldn't find: %S" regexp) "Couldn't find: %S" regexp)
(goto-char (match-beginning 1)) (goto-char (match-beginning 1))
(skip-chars-forward "[:space:]\n") (skip-chars-forward "[:space:]\n")
(skip-chars-backward "[:space:]\n" (- (point) ws-count)))) (skip-chars-backward "[:space:]\n" (- (point) ws-count)))
(point)))
(defun yas--restore-marker-location (re-marker)
"Restores marker based on info from `yas--snapshot-marker-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)))
(defun yas--restore-overlay-location (ov-locations) (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." Buffer must be narrowed to BEG..END used to create the snapshot info."
(cl-destructuring-bind (overlay loc-beg loc-end) ov-locations (cl-destructuring-bind (overlay loc-beg loc-end) ov-locations
(move-overlay overlay (move-overlay overlay
(if (not loc-beg) (overlay-start overlay) (if (not loc-beg) (overlay-start overlay)
(apply #'yas--goto-saved-location loc-beg) (yas--goto-saved-location loc-beg))
(point))
(if (not loc-end) (overlay-end overlay) (if (not loc-end) (overlay-end overlay)
(apply #'yas--goto-saved-location loc-end) (yas--goto-saved-location loc-end)))))
(point)))))
(defun yas--goto-saved-line-location (base-pos l-re-count)
(defun yas--restore-overlay-line-location (ov-locations) "Move to and return point saved by `yas--snapshot-line-location'.
"Restores overlay based on info from `yas--snapshot-overlay-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 (save-restriction
(move-overlay (car ov-locations) (narrow-to-region (line-beginning-position)
(save-excursion (line-end-position))
(forward-line (car (nth 1 ov-locations))) (yas--goto-saved-location l-re-count)))
(narrow-to-region (line-beginning-position) (line-end-position))
(apply #'yas--goto-saved-location (cdr (nth 1 ov-locations))) (defun yas--restore-overlay-line-location (base-pos ov-locations)
(point)) "Restores marker based on info from `yas--snapshot-overlay-line-location'."
(save-excursion (cl-destructuring-bind (overlay beg-l-r-w end-l-r-w)
(forward-line (car (nth 2 ov-locations))) ov-locations
(narrow-to-region (line-beginning-position) (line-end-position)) (move-overlay overlay
(apply #'yas--goto-saved-location (cdr (nth 2 ov-locations))) (yas--goto-saved-line-location base-pos beg-l-r-w)
(point))))) (yas--goto-saved-line-location base-pos end-l-r-w))))
(defun yas--indent-region (from to snippet) (defun yas--indent-region (from to snippet)
"Indent the lines between FROM and TO with `indent-according-to-mode'. "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)) (let ((remarkers nil))
(dolist (m snippet-markers) (dolist (m snippet-markers)
(when (and (<= bol m) (<= m eol)) (when (and (<= bol m) (<= m eol))
(push (yas--snapshot-marker-location m bol eol) (push (cons m (yas--snapshot-location m bol eol))
remarkers))) remarkers)))
(unwind-protect (unwind-protect
(progn (back-to-indentation) (progn (back-to-indentation)
(indent-according-to-mode)) (indent-according-to-mode))
(save-restriction (save-restriction
(narrow-to-region bol (line-end-position)) (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)) while (and (zerop (forward-line 1))
(< (point) to))))))) (< (point) to)))))))