Fix interaction with c auto-fill

Save and restore all snippet marker and overlays in the current
paragraph around auto-fill calls.  Extend the marker/overlay snapshot
and restore mechanisms to work in multiline regions.

* yasnippet.el (yas-minor-mode): Install our auto-fill function around
the default one.
(yas--original-auto-fill-function): New variable.
(yas--auto-fill): New function, saves snippet markers & overlays,
calls original auto-fill-function, then restores markers and overlays.
(yas--snapshot-marker-location): Take new optional parameters BEG END,
allow for newlines in whitespace sequences (even if newline doesn't
have whitespace syntax).
(yas--snapshot-overlay-location): New function, takes BEG END,
produced non-line based location snapshots.
(yas--snapshot-overlay-line-location): Renamed from old
`yas--snapshot-overlay-location' function.
(yas--restore-overlay-line-location): Renamed from old
`yas--restore-overlay-location' function, narrow to line before calling
`yas--goto-saved-location'.
(yas--goto-saved-location): Use whole narrowed buffer instead of
assuming current line.
(yas--restore-overlay-location): New function, assume whole narrowed
buffer may be used.
(yas--prepare-snippets-for-move, yas--finish-moving-snippets):
(yas--indent-region): Adjust callers.
This commit is contained in:
Noam Postavsky 2017-03-22 23:40:58 -04:00
parent 30913fdfb7
commit 22eeb1ef0e

View File

@ -558,6 +558,10 @@ conditions.
(defvar yas--snippet-id-seed 0 (defvar yas--snippet-id-seed 0
"Contains the next id for a snippet.") "Contains the next id for a snippet.")
(defvar yas--original-auto-fill-function nil
"The original value of `auto-fill-function'.")
(make-variable-buffer-local 'yas--original-auto-fill-function)
(defun yas--snippet-next-id () (defun yas--snippet-next-id ()
(let ((id yas--snippet-id-seed)) (let ((id yas--snippet-id-seed))
(cl-incf yas--snippet-id-seed) (cl-incf yas--snippet-id-seed)
@ -796,12 +800,18 @@ Key bindings:
(set-default name nil) (set-default name nil)
(set (make-local-variable name) t))) (set (make-local-variable name) t)))
;; Perform JIT loads ;; Perform JIT loads
;; (yas--load-pending-jits)
(yas--load-pending-jits)) ;; Install auto-fill handler.
(when (and auto-fill-function
(not (eq auto-fill-function #'yas--auto-fill)))
(setq yas--original-auto-fill-function auto-fill-function)
(setq auto-fill-function #'yas--auto-fill)))
(t (t
;; Uninstall the direct keymaps and the post-command hook ;; Uninstall the direct keymaps, post-command hook, and
;; ;; auto-fill handler.
(remove-hook 'post-command-hook #'yas--post-command-handler t) (remove-hook 'post-command-hook #'yas--post-command-handler t)
(when (local-variable-p 'yas--original-auto-fill-function)
(setq auto-fill-function yas--original-auto-fill-function))
(setq emulation-mode-map-alists (setq emulation-mode-map-alists
(remove 'yas--direct-keymaps emulation-mode-map-alists))))) (remove 'yas--direct-keymaps emulation-mode-map-alists)))))
@ -3307,7 +3317,7 @@ This renders the snippet as ordinary text."
(yas--snapshot-marker-location m)) (yas--snapshot-marker-location m))
(set-marker m nil))) (set-marker m nil)))
snippet) snippet)
(let ((ctrl-ov (yas--snapshot-overlay-location (let ((ctrl-ov (yas--snapshot-overlay-line-location
(yas--snippet-control-overlay snippet)))) (yas--snippet-control-overlay snippet))))
(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))))
@ -3341,7 +3351,10 @@ This renders the snippet as ordinary text."
(lambda (l-m-r-w) (lambda (l-m-r-w)
(goto-char base-pos) (goto-char base-pos)
(forward-line (nth 0 l-m-r-w)) (forward-line (nth 0 l-m-r-w))
(yas--restore-marker-location (cdr 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)) (nth 1 l-m-r-w))
snippet) snippet)
(goto-char base-pos) (goto-char base-pos)
@ -3560,6 +3573,33 @@ field start. This hook does nothing if an undo is in progress."
(yas--update-mirrors snippet))) (yas--update-mirrors snippet)))
(lwarn '(yasnippet zombie) :warning "Killing zombie snippet!") (lwarn '(yasnippet zombie) :warning "Killing zombie snippet!")
(delete-overlay overlay))))) (delete-overlay overlay)))))
(defun yas--auto-fill ()
(let* ((orig-point (point))
(end (progn (forward-paragraph) (point)))
(beg (progn (backward-paragraph) (point)))
(snippets (yas-active-snippets beg end))
(remarkers nil)
(reoverlays nil))
(dolist (snippet snippets)
(dolist (m (yas--collect-snippet-markers snippet))
(push (yas--snapshot-marker-location m beg end) remarkers))
(push (yas--snapshot-overlay-location
(yas--snippet-control-overlay snippet) beg end)
reoverlays))
(goto-char orig-point)
(let ((yas--inhibit-overlay-hooks t))
(funcall yas--original-auto-fill-function))
(save-excursion
(setq end (progn (forward-paragraph) (point)))
(setq beg (progn (backward-paragraph) (point))))
(save-excursion
(save-restriction
(narrow-to-region beg end)
(mapc #'yas--restore-marker-location remarkers)
(mapc #'yas--restore-overlay-location reoverlays))
(mapc #'yas--update-mirrors snippets))))
;;; Apropos protection overlays: ;;; Apropos protection overlays:
;; ;;
@ -4036,34 +4076,48 @@ Meant to be called in a narrowed buffer, does various passes"
;; indentation generally affects whitespace at the beginning, not the ;; indentation generally affects whitespace at the beginning, not the
;; end. ;; end.
;; ;;
;; Two other cases where we apply a similar strategy:
;;
;; 1. Handling `auto-fill-mode', in this case we need to use the
;; 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).
;;
;; 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) (defun yas--snapshot-marker-location (marker &optional beg end)
"Returns info for restoring MARKER's location after indent. "Returns info for restoring MARKER'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 (MARKER REGEXP WS-COUNT)."
If MARKER is not on current line, then return nil." (unless beg (setq beg (line-beginning-position)))
(when (and (<= (line-beginning-position) marker) (unless end (setq end (line-end-position)))
(<= marker (line-end-position))) (let ((before (split-string (buffer-substring-no-properties beg marker)
(let ((before "[[:space:]\n]+" t))
(split-string (buffer-substring-no-properties (after (split-string (buffer-substring-no-properties marker end)
(line-beginning-position) marker) "[[:space:]]+" t)) "[[:space:]\n]+" t)))
(after (list marker
(split-string (buffer-substring-no-properties (concat "[[:space:]\n]*"
marker (line-end-position)) "[[:space:]]+" t))) (mapconcat (lambda (s)
(list marker (if (eq s marker) "\\(\\)"
(concat "[[:space:]]*" (regexp-quote s)))
(mapconcat (lambda (s) (nconc before (list marker) after)
(if (eq s marker) "\\(\\)" "[[:space:]\n]*"))
(regexp-quote s))) (progn (goto-char marker)
(nconc before (list marker) after) (skip-syntax-forward " " end)
"[[:space:]]*")) (- (point) marker)))))
(progn (goto-char marker)
(skip-syntax-forward " " (line-end-position))
(- (point) marker))))))
(defun yas--snapshot-overlay-location (overlay) (defun yas--snapshot-overlay-location (overlay beg end)
"Like `yas--snapshot-marker-location', but for overlays. "Like `yas--snapshot-marker-location' for overlays.
The returned format is (OVERLAY (RE WS) (RE WS))."
(list overlay
(cdr (yas--snapshot-marker-location (overlay-start overlay) beg end))
(cdr (yas--snapshot-marker-location (overlay-end overlay) 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))." The returned format is (OVERLAY (LINE RE WS) (LINE RE WS))."
(let ((loc-beg (progn (goto-char (overlay-start overlay)) (let ((loc-beg (progn (goto-char (overlay-start overlay))
(yas--snapshot-marker-location (point)))) (yas--snapshot-marker-location (point))))
@ -4076,35 +4130,47 @@ The returned format is (OVERLAY (LINE RE WS) (LINE RE WS))."
(list overlay loc-beg loc-end))) (list overlay loc-beg loc-end)))
(defun yas--goto-saved-location (regexp ws-count) (defun yas--goto-saved-location (regexp ws-count)
"Move point to location saved by `yas--snapshot-marker-location'." "Move point to location saved by `yas--snapshot-marker-location'.
(beginning-of-line) Buffer must be narrowed to BEG..END used to create the snapshot info."
(save-restriction (goto-char (point-min))
;; Narrowing is the only way to limit `looking-at'. (if (not (looking-at regexp))
(narrow-to-region (point) (line-end-position)) (lwarn '(yasnippet re-marker) :warning
(if (not (looking-at regexp)) "Couldn't find: %S" regexp)
(lwarn '(yasnippet re-marker) :warning (goto-char (match-beginning 1))
"Couldn't find: %S" regexp) (skip-syntax-forward " ")
(goto-char (match-beginning 1)) (skip-syntax-backward " " (- (point) ws-count))))
(skip-syntax-forward " ")
(skip-syntax-backward " " (- (point) ws-count)))))
(defun yas--restore-marker-location (re-marker) (defun yas--restore-marker-location (re-marker)
"Restores marker based on info from `yas--snapshot-marker-location'. "Restores marker based on info from `yas--snapshot-marker-location'.
Assumes point is currently on the 'same' line as before." Buffer must be narrowed to BEG..END used to create the snapshot info."
(apply #'yas--goto-saved-location (cdr re-marker)) (apply #'yas--goto-saved-location (cdr re-marker))
(set-marker (car re-marker) (point))) (set-marker (car re-marker) (point)))
(defun yas--restore-overlay-location (ov-locations) (defun yas--restore-overlay-location (ov-locations)
"Restores overlay based on info from `yas--snapshot-overlay-location'." "Restores marker based on info from `yas--snapshot-marker-location'.
(move-overlay (car ov-locations) Buffer must be narrowed to BEG..END used to create the snapshot info."
(save-excursion (cl-destructuring-bind (overlay loc-beg loc-end) ov-locations
(forward-line (car (nth 1 ov-locations))) (move-overlay overlay
(apply #'yas--goto-saved-location (cdr (nth 1 ov-locations))) (progn (apply #'yas--goto-saved-location loc-beg)
(point)) (point))
(save-excursion (progn (apply #'yas--goto-saved-location loc-end)
(forward-line (car (nth 2 ov-locations))) (point)))))
(apply #'yas--goto-saved-location (cdr (nth 2 ov-locations)))
(point))))
(defun yas--restore-overlay-line-location (ov-locations)
"Restores overlay based on info from `yas--snapshot-overlay-line-location'."
(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)))))
(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'.
@ -4115,15 +4181,21 @@ The SNIPPET's markers are preserved."
(goto-char from) (goto-char from)
(save-restriction (save-restriction
(widen) (widen)
(cl-loop if (/= (line-beginning-position) (line-end-position)) do (cl-loop for bol = (line-beginning-position)
for eol = (line-end-position)
if (/= bol eol) do
;; Indent each non-empty line. ;; Indent each non-empty line.
(let ((remarkers (let ((remarkers nil))
(delq nil (mapcar #'yas--snapshot-marker-location (dolist (m snippet-markers)
snippet-markers)))) (when (and (<= bol m) (<= m eol))
(push (yas--snapshot-marker-location m bol eol)
remarkers)))
(unwind-protect (unwind-protect
(progn (back-to-indentation) (progn (back-to-indentation)
(indent-according-to-mode)) (indent-according-to-mode))
(mapc #'yas--restore-marker-location remarkers))) (save-restriction
(narrow-to-region bol (line-end-position))
(mapc #'yas--restore-marker-location remarkers))))
while (and (zerop (forward-line 1)) while (and (zerop (forward-line 1))
(< (point) to))))))) (< (point) to)))))))