From 4c26733f60877130c49bd79fff5fb1e02cff3b1c Mon Sep 17 00:00:00 2001 From: Simeon Simeonov Date: Wed, 22 May 2019 08:31:21 +0200 Subject: Update php-mode and yasnippet --- .emacs.d/lisp/yasnippet.el | 536 +++++++++++++++++++++++++++------------------ 1 file changed, 324 insertions(+), 212 deletions(-) (limited to '.emacs.d/lisp/yasnippet.el') diff --git a/.emacs.d/lisp/yasnippet.el b/.emacs.d/lisp/yasnippet.el index 065e709..9951940 100644 --- a/.emacs.d/lisp/yasnippet.el +++ b/.emacs.d/lisp/yasnippet.el @@ -413,15 +413,25 @@ This can be used as a key definition in keymaps to bind a key to `yas-clear-field' only when at the beginning of an unmodified snippet field.") -(defvar yas-keymap (let ((map (make-sparse-keymap))) - (define-key map [(tab)] 'yas-next-field-or-maybe-expand) - (define-key map (kbd "TAB") 'yas-next-field-or-maybe-expand) - (define-key map [(shift tab)] 'yas-prev-field) - (define-key map [backtab] 'yas-prev-field) - (define-key map (kbd "C-g") 'yas-abort-snippet) - (define-key map (kbd "C-d") yas-maybe-skip-and-clear-field) - (define-key map (kbd "DEL") yas-maybe-clear-field) - map) +(defun yas-filtered-definition (def) + "Return a condition key definition. +The condition will respect the value of `yas-keymap-disable-hook'." + `(menu-item "" ,def + :filter ,(lambda (cmd) (unless (run-hook-with-args-until-success + 'yas-keymap-disable-hook) + cmd)))) + +(defvar yas-keymap + (let ((map (make-sparse-keymap))) + (define-key map [(tab)] (yas-filtered-definition 'yas-next-field-or-maybe-expand)) + (define-key map (kbd "TAB") (yas-filtered-definition 'yas-next-field-or-maybe-expand)) + (define-key map [(shift tab)] (yas-filtered-definition 'yas-prev-field)) + (define-key map [backtab] (yas-filtered-definition 'yas-prev-field)) + (define-key map (kbd "C-g") (yas-filtered-definition 'yas-abort-snippet)) + ;; Yes, filters can be chained! + (define-key map (kbd "C-d") (yas-filtered-definition yas-maybe-skip-and-clear-field)) + (define-key map (kbd "DEL") (yas-filtered-definition yas-maybe-clear-field)) + map) "The active keymap while a snippet expansion is in progress.") (defvar yas-key-syntaxes (list #'yas-try-key-from-whitespace @@ -481,10 +491,8 @@ Attention: These hooks are not run when exiting nested/stacked snippet expansion "Hooks to run just before expanding a snippet.") (defconst yas-not-string-or-comment-condition - '(if (and (let ((ppss (syntax-ppss))) - (or (nth 3 ppss) (nth 4 ppss))) - (memq this-command '(yas-expand yas-expand-from-trigger-key - yas-expand-from-keymap))) + '(if (let ((ppss (syntax-ppss))) + (or (nth 3 ppss) (nth 4 ppss))) '(require-snippet-condition . force-in-comment) t) "Disables snippet expansion in strings and comments. @@ -547,12 +555,28 @@ conditions. (const :tag "Disable all snippet expansion" nil) sexp)) +(defcustom yas-keymap-disable-hook nil + "The `yas-keymap' bindings are disabled if any function in this list returns non-nil. +This is useful to control whether snippet navigation bindings +override bindings from other packages (e.g., `company-mode')." + :type 'hook) + (defcustom yas-overlay-priority 100 "Priority to use for yasnippets overlays. This is useful to control whether snippet navigation bindings -override bindings from other packages (e.g., `company-mode')." +override `keymap' overlay property bindings from other packages." :type 'integer) +(defcustom yas-inhibit-overlay-modification-protection nil + "If nil, changing text outside the active field aborts the snippet. +This protection is intended to prevent yasnippet from ending up +in an inconsistent state. However, some packages (e.g., the +company completion package) may trigger this protection when it +is not needed. In that case, setting this variable to non-nil +can be useful." + ;; See also `yas--on-protection-overlay-modification'. + :type 'boolean) + ;;; Internal variables @@ -918,9 +942,12 @@ activate snippets associated with that mode." (remove mode yas--extra-modes))) +(defun yas-temp-buffer-p (&optional buffer) + (eq (aref (buffer-name buffer) 0) ?\s)) + (define-obsolete-variable-alias 'yas-dont-activate 'yas-dont-activate-functions "0.9.2") -(defvar yas-dont-activate-functions (list #'minibufferp) +(defvar yas-dont-activate-functions (list #'minibufferp #'yas-temp-buffer-p) "Special hook to control which buffers `yas-global-mode' affects. Functions are called with no argument, and should return non-nil to prevent `yas-global-mode' from enabling yasnippet in this buffer. @@ -1665,10 +1692,8 @@ Here's a list of currently recognized directives: (let ((where (if (region-active-p) (cons (region-beginning) (region-end)) (cons (point) (point))))) - (yas-expand-snippet (yas--template-content yas--current-template) - (car where) - (cdr where) - (yas--template-expand-env yas--current-template))))))) + (yas-expand-snippet yas--current-template + (car where) (cdr where))))))) (defun yas--key-from-desc (text) "Return a yasnippet key from a description string TEXT." @@ -2345,6 +2370,10 @@ object satisfying `yas--field-p' to restrict the expansion to." (yas--fallback)))) (defun yas--maybe-expand-from-keymap-filter (cmd) + "Check whether a snippet may be expanded. +If there are expandable snippets, return CMD (this is useful for +conditional keybindings) or the list of expandable snippet +template objects if CMD is nil (this is useful as a more general predicate)." (let* ((yas--condition-cache-timestamp (current-time)) (vec (cl-subseq (this-command-keys-vector) (if current-prefix-arg @@ -2369,14 +2398,12 @@ object satisfying `yas--field-p' to restrict the expansion to." Prompt the user if TEMPLATES has more than one element, else expand immediately. Common gateway for `yas-expand-from-trigger-key' and `yas-expand-from-keymap'." - (let ((yas--current-template (or (and (cl-rest templates) ;; more than one - (yas--prompt-for-template (mapcar #'cdr templates))) - (cdar templates)))) + (let ((yas--current-template + (or (and (cl-rest templates) ;; more than one + (yas--prompt-for-template (mapcar #'cdr templates))) + (cdar templates)))) (when yas--current-template - (yas-expand-snippet (yas--template-content yas--current-template) - start - end - (yas--template-expand-env yas--current-template))))) + (yas-expand-snippet yas--current-template start end)))) ;; Apropos the trigger key and the fallback binding: ;; @@ -2521,10 +2548,7 @@ by condition." (cons (region-beginning) (region-end)) (cons (point) (point))))) (if yas--current-template - (yas-expand-snippet (yas--template-content yas--current-template) - (car where) - (cdr where) - (yas--template-expand-env yas--current-template)) + (yas-expand-snippet yas--current-template (car where) (cdr where)) (yas--message 1 "No snippets can be inserted here!")))) (defun yas-visit-snippet-file () @@ -2812,17 +2836,17 @@ DEBUG is for debugging the YASnippet engine itself." :name (nth 2 parsed) :expand-env (nth 5 parsed))))) (cond (yas--current-template - (let ((buffer-name (format "*testing snippet: %s*" (yas--template-name yas--current-template)))) + (let ((buffer-name + (format "*testing snippet: %s*" + (yas--template-name yas--current-template)))) (kill-buffer (get-buffer-create buffer-name)) (switch-to-buffer (get-buffer-create buffer-name)) (setq buffer-undo-list nil) (condition-case nil (funcall test-mode) (error nil)) (yas-minor-mode 1) (setq buffer-read-only nil) - (yas-expand-snippet (yas--template-content yas--current-template) - (point-min) - (point-max) - (yas--template-expand-env yas--current-template)) + (yas-expand-snippet yas--current-template + (point-min) (point-max)) (when (and debug (require 'yasnippet-debug nil t)) (yas-debug-snippets "*YASnippet trace*" 'snippet-navigation) @@ -3502,10 +3526,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 @@ -3513,23 +3534,27 @@ 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", ;; move all the snippets to the original org-mode buffer when it's ;; killed. - (let ((org-marker nil)) + (let ((org-marker nil) + (org-buffer nil)) (when (and yas-minor-mode (or (bound-and-true-p org-edit-src-from-org-mode) (bound-and-true-p org-src--from-org-mode)) (markerp (setq org-marker (or (bound-and-true-p org-edit-src-beg-marker) - (bound-and-true-p org-src--beg-marker))))) + (bound-and-true-p org-src--beg-marker)))) + ;; If the org source buffer is killed before the temp + ;; fontification one, org-marker might point nowhere. + (setq org-buffer (marker-buffer org-marker))) (yas--prepare-snippets-for-move (point-min) (point-max) - (marker-buffer org-marker) org-marker)))) + org-buffer org-marker)))) (add-hook 'kill-buffer-hook #'yas--on-buffer-kill) @@ -3539,18 +3564,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) @@ -3755,13 +3778,49 @@ BEG, END and LENGTH like overlay modification hooks." (= beg (yas--field-start field)) ; Insertion at field start? (not (yas--field-modified-p field)))) + +(defun yas--merge-and-drop-dups (list1 list2 cmp key) + ;; `delete-consecutive-dups' + `cl-merge'. + (funcall (if (fboundp 'delete-consecutive-dups) + #'delete-consecutive-dups ; 24.4 + #'delete-dups) + (cl-merge 'list list1 list2 cmp :key key))) + +(defvar yas--before-change-modified-snippets nil) +(make-variable-buffer-local 'yas--before-change-modified-snippets) + +(defun yas--gather-active-snippets (overlay beg end then-delete) + ;; Add active snippets in BEG..END into an OVERLAY keyed entry of + ;; `yas--before-change-modified-snippets'. Return accumulated list. + ;; If THEN-DELETE is non-nil, delete the entry. + (let ((new (yas-active-snippets beg end)) + (old (assq overlay yas--before-change-modified-snippets))) + (prog1 (cond ((and new old) + (setf (cdr old) + (yas--merge-and-drop-dups + (cdr old) new + ;; Sort like `yas-active-snippets'. + #'>= #'yas--snippet-id))) + (new (unless then-delete + ;; Don't add new entry if we're about to + ;; remove it anyway. + (push (cons overlay new) + yas--before-change-modified-snippets)) + new) + (old (cdr old)) + (t nil)) + (when then-delete + (cl-callf2 delq old yas--before-change-modified-snippets))))) + +(defvar yas--todo-snippet-indent nil nil) +(make-variable-buffer-local 'yas--todo-snippet-indent) + (defun yas--on-field-overlay-modification (overlay after? beg end &optional length) "Clears the field and updates mirrors, conditionally. Only clears the field if it hasn't been modified and point is at field start. This hook does nothing if an undo is in progress." - (unless (or (not after?) - yas--inhibit-overlay-hooks + (unless (or yas--inhibit-overlay-hooks (not (overlayp yas--active-field-overlay)) ; Avoid Emacs bug #21824. ;; If a single change hits multiple overlays of the same ;; snippet, then we delete the snippet the first time, @@ -3774,28 +3833,52 @@ 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))) (if (yas--snippet-live-p snippet) - (save-match-data - (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) - ;; Adjust any pending active fields in case of stacked - ;; expansion. - (let ((pfield field) - (psnippets (yas-active-snippets beg end))) - (while (and pfield psnippets) - (let ((psnippet (pop psnippets))) - (cl-assert (memq pfield (yas--snippet-fields psnippet))) - (yas--advance-end-maybe pfield (overlay-end overlay)) - (setq pfield (yas--snippet-previous-active-field psnippet))))) - (save-excursion - (yas--field-update-display field)) - (yas--update-mirrors snippet))) + (if after? + (save-match-data + (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) + ;; Adjust any pending active fields in case of stacked + ;; expansion. + (let ((pfield field) + (psnippets (yas--gather-active-snippets + overlay beg end t))) + (while (and pfield psnippets) + (let ((psnippet (pop psnippets))) + (cl-assert (memq pfield (yas--snippet-fields psnippet))) + (yas--advance-end-maybe pfield (overlay-end overlay)) + (setq pfield (yas--snippet-previous-active-field psnippet))))) + ;; Update fields now, but delay auto indentation until + ;; post-command. We don't want to run indentation on + ;; the intermediate state where field text might be + ;; removed (and hence the field could be deleted along + ;; with leading indentation). + (let ((yas-indent-line nil)) + (save-excursion + (yas--field-update-display field)) + (yas--update-mirrors snippet)) + (unless (or (not (eq yas-indent-line 'auto)) + (memq snippet yas--todo-snippet-indent)) + (push snippet yas--todo-snippet-indent)))) + ;; Remember active snippets to use for after the change. + (yas--gather-active-snippets overlay beg end nil)) (lwarn '(yasnippet zombie) :warning "Killing zombie snippet!") (delete-overlay overlay))))) +(defun yas--do-todo-snippet-indent () + ;; Do pending indentation of snippet fields, called from + ;; `yas--post-command-handler'. + (when yas--todo-snippet-indent + (save-excursion + (cl-loop for snippet in yas--todo-snippet-indent + do (yas--indent-mirrors-of-snippet + snippet (yas--snippet-field-mirrors snippet))) + (setq yas--todo-snippet-indent nil)))) + (defun yas--auto-fill () + ;; Preserve snippet markers during auto-fill. (let* ((orig-point (point)) (end (progn (forward-paragraph) (point))) (beg (progn (backward-paragraph) (point))) @@ -3805,57 +3888,59 @@ 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)) (goto-char orig-point) (let ((yas--inhibit-overlay-hooks t)) - (if (null yas--original-auto-fill-function) - ;; Try to get more info on #873/919. - (let ((yas--fill-fun-values `((t ,(default-value 'yas--original-auto-fill-function)))) - (fill-fun-values `((t ,(default-value 'auto-fill-function)))) - ;; Listing 2 buffers with the same value is enough - (print-length 3)) - (save-current-buffer - (dolist (buf (let ((bufs (buffer-list))) - ;; List the current buffer first. - (setq bufs (cons (current-buffer) - (remq (current-buffer) bufs))))) - (set-buffer buf) - (let* ((yf-cell (assq yas--original-auto-fill-function - yas--fill-fun-values)) - (af-cell (assq auto-fill-function fill-fun-values))) - (when (local-variable-p 'yas--original-auto-fill-function) - (if yf-cell (setcdr yf-cell (cons buf (cdr yf-cell))) - (push (list yas--original-auto-fill-function buf) yas--fill-fun-values))) - (when (local-variable-p 'auto-fill-function) - (if af-cell (setcdr af-cell (cons buf (cdr af-cell))) - (push (list auto-fill-function buf) fill-fun-values)))))) - (lwarn '(yasnippet auto-fill bug) :error - "`yas--original-auto-fill-function' unexpectedly nil in %S! Disabling auto-fill. + (if yas--original-auto-fill-function + (funcall yas--original-auto-fill-function) + ;; Shouldn't happen, gather more info about it (see #873/919). + (let ((yas--fill-fun-values `((t ,(default-value 'yas--original-auto-fill-function)))) + (fill-fun-values `((t ,(default-value 'auto-fill-function)))) + ;; Listing 2 buffers with the same value is enough + (print-length 3)) + (save-current-buffer + (dolist (buf (let ((bufs (buffer-list))) + ;; List the current buffer first. + (setq bufs (cons (current-buffer) + (remq (current-buffer) bufs))))) + (set-buffer buf) + (let* ((yf-cell (assq yas--original-auto-fill-function + yas--fill-fun-values)) + (af-cell (assq auto-fill-function fill-fun-values))) + (when (local-variable-p 'yas--original-auto-fill-function) + (if yf-cell (setcdr yf-cell (cons buf (cdr yf-cell))) + (push (list yas--original-auto-fill-function buf) yas--fill-fun-values))) + (when (local-variable-p 'auto-fill-function) + (if af-cell (setcdr af-cell (cons buf (cdr af-cell))) + (push (list auto-fill-function buf) fill-fun-values)))))) + (lwarn '(yasnippet auto-fill bug) :error + "`yas--original-auto-fill-function' unexpectedly nil in %S! Disabling auto-fill. %S `auto-fill-function': %S\n%s" - (current-buffer) yas--fill-fun-values fill-fun-values - (if (fboundp 'backtrace--print-frame) - (with-output-to-string - (mapc (lambda (frame) - (apply #'backtrace--print-frame frame)) - yas--watch-auto-fill-backtrace)) - "")) - ;; Try to avoid repeated triggering of this bug. - (auto-fill-mode -1) - ;; Don't pop up more than once in a session (still log though). - (defvar warning-suppress-types) ; `warnings' is autoloaded by `lwarn'. - (add-to-list 'warning-suppress-types '(yasnippet auto-fill bug))) - (funcall yas--original-auto-fill-function))) + (current-buffer) yas--fill-fun-values fill-fun-values + (if (fboundp 'backtrace--print-frame) + (with-output-to-string + (mapc (lambda (frame) + (apply #'backtrace--print-frame frame)) + yas--watch-auto-fill-backtrace)) + "")) + ;; Try to avoid repeated triggering of this bug. + (auto-fill-mode -1) + ;; Don't pop up more than once in a session (still log though). + (defvar warning-suppress-types) ; `warnings' is autoloaded by `lwarn'. + (add-to-list 'warning-suppress-types '(yasnippet auto-fill bug))))) (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) + (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) @@ -3909,6 +3994,7 @@ Move the overlays, or create them if they do not exit." (defun yas--on-protection-overlay-modification (_overlay after? beg end &optional length) "Commit the snippet if the protection overlay is being killed." (unless (or yas--inhibit-overlay-hooks + yas-inhibit-overlay-modification-protection (not after?) (= length (- end beg)) ; deletion or insertion (yas--undo-in-progress)) @@ -4334,35 +4420,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." @@ -4370,67 +4475,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'. @@ -4449,14 +4546,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))))))) @@ -4754,46 +4853,58 @@ When multiple expressions are found, only the last one counts." (parent 1) (t 0)))))) +(defun yas--snippet-field-mirrors (snippet) + ;; Make a list of (FIELD . MIRROR). + (cl-sort + (cl-mapcan (lambda (field) + (mapcar (lambda (mirror) + (cons field mirror)) + (yas--field-mirrors field))) + (yas--snippet-fields snippet)) + ;; Then sort this list so that entries with mirrors with + ;; parent fields appear before. This was important for + ;; fixing #290, and also handles the case where a mirror in + ;; a field causes another mirror to need reupdating. + #'> :key (lambda (fm) (yas--calculate-mirror-depth (cdr fm))))) + +(defun yas--indent-mirrors-of-snippet (snippet &optional f-ms) + ;; Indent mirrors of SNIPPET. F-MS is the return value of + ;; (yas--snippet-field-mirrors SNIPPET). + (when (eq yas-indent-line 'auto) + (let ((yas--inhibit-overlay-hooks t)) + (cl-loop for (beg . end) in + (cl-sort (mapcar (lambda (f-m) + (let ((mirror (cdr f-m))) + (cons (yas--mirror-start mirror) + (yas--mirror-end mirror)))) + (or f-ms + (yas--snippet-field-mirrors snippet))) + #'< :key #'car) + do (yas--indent-region beg end snippet))))) + (defun yas--update-mirrors (snippet) "Update all the mirrors of SNIPPET." (yas--save-restriction-and-widen (save-excursion - (cl-loop - for (field . mirror) - in (cl-sort - ;; Make a list of (FIELD . MIRROR). - (cl-mapcan (lambda (field) - (mapcar (lambda (mirror) - (cons field mirror)) - (yas--field-mirrors field))) - (yas--snippet-fields snippet)) - ;; Then sort this list so that entries with mirrors with - ;; parent fields appear before. This was important for - ;; fixing #290, and also handles the case where a mirror in - ;; a field causes another mirror to need reupdating. - #'> :key (lambda (fm) (yas--calculate-mirror-depth (cdr fm)))) - ;; Before updating a mirror with a parent-field, maybe advance - ;; its start (#290). - do (let ((parent-field (yas--mirror-parent-field mirror))) - (when parent-field - (yas--advance-start-maybe mirror (yas--fom-start parent-field)))) - ;; Update this mirror. - do (yas--mirror-update-display mirror field) - ;; Delay indenting until we're done all mirrors. We must do - ;; this to avoid losing whitespace between fields that are - ;; still empty (i.e., they will be non-empty after updating). - when (eq yas-indent-line 'auto) - collect (cons (yas--mirror-start mirror) (yas--mirror-end mirror)) - into indent-regions - ;; `yas--place-overlays' is needed since the active field and - ;; protected overlays might have been changed because of insertions - ;; in `yas--mirror-update-display'. - do (let ((active-field (yas--snippet-active-field snippet))) - (when active-field (yas--place-overlays snippet active-field))) - finally do - (let ((yas--inhibit-overlay-hooks t)) - (cl-loop for (beg . end) in (cl-sort indent-regions #'< :key #'car) - do (yas--indent-region beg end snippet))))))) + (let ((f-ms (yas--snippet-field-mirrors snippet))) + (cl-loop + for (field . mirror) in f-ms + ;; Before updating a mirror with a parent-field, maybe advance + ;; its start (#290). + do (let ((parent-field (yas--mirror-parent-field mirror))) + (when parent-field + (yas--advance-start-maybe mirror (yas--fom-start parent-field)))) + ;; Update this mirror. + do (yas--mirror-update-display mirror field) + ;; `yas--place-overlays' is needed since the active field and + ;; protected overlays might have been changed because of insertions + ;; in `yas--mirror-update-display'. + do (let ((active-field (yas--snippet-active-field snippet))) + (when active-field (yas--place-overlays snippet active-field)))) + ;; Delay indenting until we're done all mirrors. We must do + ;; this to avoid losing whitespace between fields that are + ;; still empty (i.e., they will be non-empty after updating). + (yas--indent-mirrors-of-snippet snippet f-ms))))) (defun yas--mirror-update-display (mirror field) "Update MIRROR according to FIELD (and mirror transform)." @@ -4851,6 +4962,7 @@ When multiple expressions are found, only the last one counts." ;; Don't pop up more than once in a session (still log though). (defvar warning-suppress-types) ; `warnings' is autoloaded by `lwarn'. (add-to-list 'warning-suppress-types '(yasnippet auto-fill bug))) + (yas--do-todo-snippet-indent) (condition-case err (progn (yas--finish-moving-snippets) (cond ((eq 'undo this-command) -- cgit v1.3