diff options
Diffstat (limited to '.emacs.d/lisp/yasnippet.el')
| -rw-r--r-- | .emacs.d/lisp/yasnippet.el | 532 |
1 files changed, 322 insertions, 210 deletions
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 | |||
| 413 | `yas-clear-field' only when at the beginning of an | 413 | `yas-clear-field' only when at the beginning of an |
| 414 | unmodified snippet field.") | 414 | unmodified snippet field.") |
| 415 | 415 | ||
| 416 | (defvar yas-keymap (let ((map (make-sparse-keymap))) | 416 | (defun yas-filtered-definition (def) |
| 417 | (define-key map [(tab)] 'yas-next-field-or-maybe-expand) | 417 | "Return a condition key definition. |
| 418 | (define-key map (kbd "TAB") 'yas-next-field-or-maybe-expand) | 418 | The condition will respect the value of `yas-keymap-disable-hook'." |
| 419 | (define-key map [(shift tab)] 'yas-prev-field) | 419 | `(menu-item "" ,def |
| 420 | (define-key map [backtab] 'yas-prev-field) | 420 | :filter ,(lambda (cmd) (unless (run-hook-with-args-until-success |
| 421 | (define-key map (kbd "C-g") 'yas-abort-snippet) | 421 | 'yas-keymap-disable-hook) |
| 422 | (define-key map (kbd "C-d") yas-maybe-skip-and-clear-field) | 422 | cmd)))) |
| 423 | (define-key map (kbd "DEL") yas-maybe-clear-field) | 423 | |
| 424 | map) | 424 | (defvar yas-keymap |
| 425 | (let ((map (make-sparse-keymap))) | ||
| 426 | (define-key map [(tab)] (yas-filtered-definition 'yas-next-field-or-maybe-expand)) | ||
| 427 | (define-key map (kbd "TAB") (yas-filtered-definition 'yas-next-field-or-maybe-expand)) | ||
| 428 | (define-key map [(shift tab)] (yas-filtered-definition 'yas-prev-field)) | ||
| 429 | (define-key map [backtab] (yas-filtered-definition 'yas-prev-field)) | ||
| 430 | (define-key map (kbd "C-g") (yas-filtered-definition 'yas-abort-snippet)) | ||
| 431 | ;; Yes, filters can be chained! | ||
| 432 | (define-key map (kbd "C-d") (yas-filtered-definition yas-maybe-skip-and-clear-field)) | ||
| 433 | (define-key map (kbd "DEL") (yas-filtered-definition yas-maybe-clear-field)) | ||
| 434 | map) | ||
| 425 | "The active keymap while a snippet expansion is in progress.") | 435 | "The active keymap while a snippet expansion is in progress.") |
| 426 | 436 | ||
| 427 | (defvar yas-key-syntaxes (list #'yas-try-key-from-whitespace | 437 | (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 | |||
| 481 | "Hooks to run just before expanding a snippet.") | 491 | "Hooks to run just before expanding a snippet.") |
| 482 | 492 | ||
| 483 | (defconst yas-not-string-or-comment-condition | 493 | (defconst yas-not-string-or-comment-condition |
| 484 | '(if (and (let ((ppss (syntax-ppss))) | 494 | '(if (let ((ppss (syntax-ppss))) |
| 485 | (or (nth 3 ppss) (nth 4 ppss))) | 495 | (or (nth 3 ppss) (nth 4 ppss))) |
| 486 | (memq this-command '(yas-expand yas-expand-from-trigger-key | ||
| 487 | yas-expand-from-keymap))) | ||
| 488 | '(require-snippet-condition . force-in-comment) | 496 | '(require-snippet-condition . force-in-comment) |
| 489 | t) | 497 | t) |
| 490 | "Disables snippet expansion in strings and comments. | 498 | "Disables snippet expansion in strings and comments. |
| @@ -547,12 +555,28 @@ conditions. | |||
| 547 | (const :tag "Disable all snippet expansion" nil) | 555 | (const :tag "Disable all snippet expansion" nil) |
| 548 | sexp)) | 556 | sexp)) |
| 549 | 557 | ||
| 558 | (defcustom yas-keymap-disable-hook nil | ||
| 559 | "The `yas-keymap' bindings are disabled if any function in this list returns non-nil. | ||
| 560 | This is useful to control whether snippet navigation bindings | ||
| 561 | override bindings from other packages (e.g., `company-mode')." | ||
| 562 | :type 'hook) | ||
| 563 | |||
| 550 | (defcustom yas-overlay-priority 100 | 564 | (defcustom yas-overlay-priority 100 |
| 551 | "Priority to use for yasnippets overlays. | 565 | "Priority to use for yasnippets overlays. |
| 552 | This is useful to control whether snippet navigation bindings | 566 | This is useful to control whether snippet navigation bindings |
| 553 | override bindings from other packages (e.g., `company-mode')." | 567 | override `keymap' overlay property bindings from other packages." |
| 554 | :type 'integer) | 568 | :type 'integer) |
| 555 | 569 | ||
| 570 | (defcustom yas-inhibit-overlay-modification-protection nil | ||
| 571 | "If nil, changing text outside the active field aborts the snippet. | ||
| 572 | This protection is intended to prevent yasnippet from ending up | ||
| 573 | in an inconsistent state. However, some packages (e.g., the | ||
| 574 | company completion package) may trigger this protection when it | ||
| 575 | is not needed. In that case, setting this variable to non-nil | ||
| 576 | can be useful." | ||
| 577 | ;; See also `yas--on-protection-overlay-modification'. | ||
| 578 | :type 'boolean) | ||
| 579 | |||
| 556 | 580 | ||
| 557 | ;;; Internal variables | 581 | ;;; Internal variables |
| 558 | 582 | ||
| @@ -918,9 +942,12 @@ activate snippets associated with that mode." | |||
| 918 | (remove mode | 942 | (remove mode |
| 919 | yas--extra-modes))) | 943 | yas--extra-modes))) |
| 920 | 944 | ||
| 945 | (defun yas-temp-buffer-p (&optional buffer) | ||
| 946 | (eq (aref (buffer-name buffer) 0) ?\s)) | ||
| 947 | |||
| 921 | (define-obsolete-variable-alias 'yas-dont-activate | 948 | (define-obsolete-variable-alias 'yas-dont-activate |
| 922 | 'yas-dont-activate-functions "0.9.2") | 949 | 'yas-dont-activate-functions "0.9.2") |
| 923 | (defvar yas-dont-activate-functions (list #'minibufferp) | 950 | (defvar yas-dont-activate-functions (list #'minibufferp #'yas-temp-buffer-p) |
| 924 | "Special hook to control which buffers `yas-global-mode' affects. | 951 | "Special hook to control which buffers `yas-global-mode' affects. |
| 925 | Functions are called with no argument, and should return non-nil to prevent | 952 | Functions are called with no argument, and should return non-nil to prevent |
| 926 | `yas-global-mode' from enabling yasnippet in this buffer. | 953 | `yas-global-mode' from enabling yasnippet in this buffer. |
| @@ -1665,10 +1692,8 @@ Here's a list of currently recognized directives: | |||
| 1665 | (let ((where (if (region-active-p) | 1692 | (let ((where (if (region-active-p) |
| 1666 | (cons (region-beginning) (region-end)) | 1693 | (cons (region-beginning) (region-end)) |
| 1667 | (cons (point) (point))))) | 1694 | (cons (point) (point))))) |
| 1668 | (yas-expand-snippet (yas--template-content yas--current-template) | 1695 | (yas-expand-snippet yas--current-template |
| 1669 | (car where) | 1696 | (car where) (cdr where))))))) |
| 1670 | (cdr where) | ||
| 1671 | (yas--template-expand-env yas--current-template))))))) | ||
| 1672 | 1697 | ||
| 1673 | (defun yas--key-from-desc (text) | 1698 | (defun yas--key-from-desc (text) |
| 1674 | "Return a yasnippet key from a description string TEXT." | 1699 | "Return a yasnippet key from a description string TEXT." |
| @@ -2345,6 +2370,10 @@ object satisfying `yas--field-p' to restrict the expansion to." | |||
| 2345 | (yas--fallback)))) | 2370 | (yas--fallback)))) |
| 2346 | 2371 | ||
| 2347 | (defun yas--maybe-expand-from-keymap-filter (cmd) | 2372 | (defun yas--maybe-expand-from-keymap-filter (cmd) |
| 2373 | "Check whether a snippet may be expanded. | ||
| 2374 | If there are expandable snippets, return CMD (this is useful for | ||
| 2375 | conditional keybindings) or the list of expandable snippet | ||
| 2376 | template objects if CMD is nil (this is useful as a more general predicate)." | ||
| 2348 | (let* ((yas--condition-cache-timestamp (current-time)) | 2377 | (let* ((yas--condition-cache-timestamp (current-time)) |
| 2349 | (vec (cl-subseq (this-command-keys-vector) | 2378 | (vec (cl-subseq (this-command-keys-vector) |
| 2350 | (if current-prefix-arg | 2379 | (if current-prefix-arg |
| @@ -2369,14 +2398,12 @@ object satisfying `yas--field-p' to restrict the expansion to." | |||
| 2369 | Prompt the user if TEMPLATES has more than one element, else | 2398 | Prompt the user if TEMPLATES has more than one element, else |
| 2370 | expand immediately. Common gateway for | 2399 | expand immediately. Common gateway for |
| 2371 | `yas-expand-from-trigger-key' and `yas-expand-from-keymap'." | 2400 | `yas-expand-from-trigger-key' and `yas-expand-from-keymap'." |
| 2372 | (let ((yas--current-template (or (and (cl-rest templates) ;; more than one | 2401 | (let ((yas--current-template |
| 2373 | (yas--prompt-for-template (mapcar #'cdr templates))) | 2402 | (or (and (cl-rest templates) ;; more than one |
| 2374 | (cdar templates)))) | 2403 | (yas--prompt-for-template (mapcar #'cdr templates))) |
| 2404 | (cdar templates)))) | ||
| 2375 | (when yas--current-template | 2405 | (when yas--current-template |
| 2376 | (yas-expand-snippet (yas--template-content yas--current-template) | 2406 | (yas-expand-snippet yas--current-template start end)))) |
| 2377 | start | ||
| 2378 | end | ||
| 2379 | (yas--template-expand-env yas--current-template))))) | ||
| 2380 | 2407 | ||
| 2381 | ;; Apropos the trigger key and the fallback binding: | 2408 | ;; Apropos the trigger key and the fallback binding: |
| 2382 | ;; | 2409 | ;; |
| @@ -2521,10 +2548,7 @@ by condition." | |||
| 2521 | (cons (region-beginning) (region-end)) | 2548 | (cons (region-beginning) (region-end)) |
| 2522 | (cons (point) (point))))) | 2549 | (cons (point) (point))))) |
| 2523 | (if yas--current-template | 2550 | (if yas--current-template |
| 2524 | (yas-expand-snippet (yas--template-content yas--current-template) | 2551 | (yas-expand-snippet yas--current-template (car where) (cdr where)) |
| 2525 | (car where) | ||
| 2526 | (cdr where) | ||
| 2527 | (yas--template-expand-env yas--current-template)) | ||
| 2528 | (yas--message 1 "No snippets can be inserted here!")))) | 2552 | (yas--message 1 "No snippets can be inserted here!")))) |
| 2529 | 2553 | ||
| 2530 | (defun yas-visit-snippet-file () | 2554 | (defun yas-visit-snippet-file () |
| @@ -2812,17 +2836,17 @@ DEBUG is for debugging the YASnippet engine itself." | |||
| 2812 | :name (nth 2 parsed) | 2836 | :name (nth 2 parsed) |
| 2813 | :expand-env (nth 5 parsed))))) | 2837 | :expand-env (nth 5 parsed))))) |
| 2814 | (cond (yas--current-template | 2838 | (cond (yas--current-template |
| 2815 | (let ((buffer-name (format "*testing snippet: %s*" (yas--template-name yas--current-template)))) | 2839 | (let ((buffer-name |
| 2840 | (format "*testing snippet: %s*" | ||
| 2841 | (yas--template-name yas--current-template)))) | ||
| 2816 | (kill-buffer (get-buffer-create buffer-name)) | 2842 | (kill-buffer (get-buffer-create buffer-name)) |
| 2817 | (switch-to-buffer (get-buffer-create buffer-name)) | 2843 | (switch-to-buffer (get-buffer-create buffer-name)) |
| 2818 | (setq buffer-undo-list nil) | 2844 | (setq buffer-undo-list nil) |
| 2819 | (condition-case nil (funcall test-mode) (error nil)) | 2845 | (condition-case nil (funcall test-mode) (error nil)) |
| 2820 | (yas-minor-mode 1) | 2846 | (yas-minor-mode 1) |
| 2821 | (setq buffer-read-only nil) | 2847 | (setq buffer-read-only nil) |
| 2822 | (yas-expand-snippet (yas--template-content yas--current-template) | 2848 | (yas-expand-snippet yas--current-template |
| 2823 | (point-min) | 2849 | (point-min) (point-max)) |
| 2824 | (point-max) | ||
| 2825 | (yas--template-expand-env yas--current-template)) | ||
| 2826 | (when (and debug | 2850 | (when (and debug |
| 2827 | (require 'yasnippet-debug nil t)) | 2851 | (require 'yasnippet-debug nil t)) |
| 2828 | (yas-debug-snippets "*YASnippet trace*" 'snippet-navigation) | 2852 | (yas-debug-snippets "*YASnippet trace*" 'snippet-navigation) |
| @@ -3502,10 +3526,7 @@ This renders the snippet as ordinary text." | |||
| 3502 | (dolist (snippet snippets) | 3526 | (dolist (snippet snippets) |
| 3503 | (yas--snippet-map-markers | 3527 | (yas--snippet-map-markers |
| 3504 | (lambda (m) | 3528 | (lambda (m) |
| 3505 | (goto-char m) | 3529 | (prog1 (cons m (yas--snapshot-line-location m)) |
| 3506 | (beginning-of-line) | ||
| 3507 | (prog1 (cons (count-lines (point-min) (point)) | ||
| 3508 | (yas--snapshot-marker-location m)) | ||
| 3509 | (set-marker m nil))) | 3530 | (set-marker m nil))) |
| 3510 | snippet) | 3531 | snippet) |
| 3511 | (let ((ctrl-ov (yas--snapshot-overlay-line-location | 3532 | (let ((ctrl-ov (yas--snapshot-overlay-line-location |
| @@ -3513,23 +3534,27 @@ This renders the snippet as ordinary text." | |||
| 3513 | (push (list ctrl-ov dst-base-line snippet) to-move) | 3534 | (push (list ctrl-ov dst-base-line snippet) to-move) |
| 3514 | (delete-overlay (car ctrl-ov)))) | 3535 | (delete-overlay (car ctrl-ov)))) |
| 3515 | (with-current-buffer buf | 3536 | (with-current-buffer buf |
| 3516 | (setq yas--snippets-to-move (nconc to-move yas--snippets-to-move)))))) | 3537 | (cl-callf2 nconc to-move yas--snippets-to-move))))) |
| 3517 | 3538 | ||
| 3518 | (defun yas--on-buffer-kill () | 3539 | (defun yas--on-buffer-kill () |
| 3519 | ;; Org mode uses temp buffers for fontification and "native tab", | 3540 | ;; Org mode uses temp buffers for fontification and "native tab", |
| 3520 | ;; move all the snippets to the original org-mode buffer when it's | 3541 | ;; move all the snippets to the original org-mode buffer when it's |
| 3521 | ;; killed. | 3542 | ;; killed. |
| 3522 | (let ((org-marker nil)) | 3543 | (let ((org-marker nil) |
| 3544 | (org-buffer nil)) | ||
| 3523 | (when (and yas-minor-mode | 3545 | (when (and yas-minor-mode |
| 3524 | (or (bound-and-true-p org-edit-src-from-org-mode) | 3546 | (or (bound-and-true-p org-edit-src-from-org-mode) |
| 3525 | (bound-and-true-p org-src--from-org-mode)) | 3547 | (bound-and-true-p org-src--from-org-mode)) |
| 3526 | (markerp | 3548 | (markerp |
| 3527 | (setq org-marker | 3549 | (setq org-marker |
| 3528 | (or (bound-and-true-p org-edit-src-beg-marker) | 3550 | (or (bound-and-true-p org-edit-src-beg-marker) |
| 3529 | (bound-and-true-p org-src--beg-marker))))) | 3551 | (bound-and-true-p org-src--beg-marker)))) |
| 3552 | ;; If the org source buffer is killed before the temp | ||
| 3553 | ;; fontification one, org-marker might point nowhere. | ||
| 3554 | (setq org-buffer (marker-buffer org-marker))) | ||
| 3530 | (yas--prepare-snippets-for-move | 3555 | (yas--prepare-snippets-for-move |
| 3531 | (point-min) (point-max) | 3556 | (point-min) (point-max) |
| 3532 | (marker-buffer org-marker) org-marker)))) | 3557 | org-buffer org-marker)))) |
| 3533 | 3558 | ||
| 3534 | (add-hook 'kill-buffer-hook #'yas--on-buffer-kill) | 3559 | (add-hook 'kill-buffer-hook #'yas--on-buffer-kill) |
| 3535 | 3560 | ||
| @@ -3539,18 +3564,16 @@ This renders the snippet as ordinary text." | |||
| 3539 | for base-pos = (progn (goto-char (point-min)) | 3564 | for base-pos = (progn (goto-char (point-min)) |
| 3540 | (forward-line base-line) (point)) | 3565 | (forward-line base-line) (point)) |
| 3541 | do (yas--snippet-map-markers | 3566 | do (yas--snippet-map-markers |
| 3542 | (lambda (l-m-r-w) | 3567 | (lambda (saved-location) |
| 3543 | (goto-char base-pos) | 3568 | (let ((m (pop saved-location))) |
| 3544 | (forward-line (nth 0 l-m-r-w)) | 3569 | (set-marker m (yas--goto-saved-line-location |
| 3545 | (save-restriction | 3570 | base-pos saved-location)) |
| 3546 | (narrow-to-region (line-beginning-position) | 3571 | m)) |
| 3547 | (line-end-position)) | ||
| 3548 | (yas--restore-marker-location (cdr l-m-r-w))) | ||
| 3549 | (nth 1 l-m-r-w)) | ||
| 3550 | snippet) | 3572 | snippet) |
| 3551 | (goto-char base-pos) | 3573 | (goto-char base-pos) |
| 3552 | (yas--restore-overlay-location ctrl-ov) | 3574 | (yas--restore-overlay-line-location base-pos ctrl-ov) |
| 3553 | (yas--maybe-move-to-active-field snippet)) | 3575 | (yas--maybe-move-to-active-field snippet) |
| 3576 | (push snippet yas--active-snippets)) | ||
| 3554 | (setq yas--snippets-to-move nil)) | 3577 | (setq yas--snippets-to-move nil)) |
| 3555 | 3578 | ||
| 3556 | (defun yas--safely-call-fun (fun) | 3579 | (defun yas--safely-call-fun (fun) |
| @@ -3755,13 +3778,49 @@ BEG, END and LENGTH like overlay modification hooks." | |||
| 3755 | (= beg (yas--field-start field)) ; Insertion at field start? | 3778 | (= beg (yas--field-start field)) ; Insertion at field start? |
| 3756 | (not (yas--field-modified-p field)))) | 3779 | (not (yas--field-modified-p field)))) |
| 3757 | 3780 | ||
| 3781 | |||
| 3782 | (defun yas--merge-and-drop-dups (list1 list2 cmp key) | ||
| 3783 | ;; `delete-consecutive-dups' + `cl-merge'. | ||
| 3784 | (funcall (if (fboundp 'delete-consecutive-dups) | ||
| 3785 | #'delete-consecutive-dups ; 24.4 | ||
| 3786 | #'delete-dups) | ||
| 3787 | (cl-merge 'list list1 list2 cmp :key key))) | ||
| 3788 | |||
| 3789 | (defvar yas--before-change-modified-snippets nil) | ||
| 3790 | (make-variable-buffer-local 'yas--before-change-modified-snippets) | ||
| 3791 | |||
| 3792 | (defun yas--gather-active-snippets (overlay beg end then-delete) | ||
| 3793 | ;; Add active snippets in BEG..END into an OVERLAY keyed entry of | ||
| 3794 | ;; `yas--before-change-modified-snippets'. Return accumulated list. | ||
| 3795 | ;; If THEN-DELETE is non-nil, delete the entry. | ||
| 3796 | (let ((new (yas-active-snippets beg end)) | ||
| 3797 | (old (assq overlay yas--before-change-modified-snippets))) | ||
| 3798 | (prog1 (cond ((and new old) | ||
| 3799 | (setf (cdr old) | ||
| 3800 | (yas--merge-and-drop-dups | ||
| 3801 | (cdr old) new | ||
| 3802 | ;; Sort like `yas-active-snippets'. | ||
| 3803 | #'>= #'yas--snippet-id))) | ||
| 3804 | (new (unless then-delete | ||
| 3805 | ;; Don't add new entry if we're about to | ||
| 3806 | ;; remove it anyway. | ||
| 3807 | (push (cons overlay new) | ||
| 3808 | yas--before-change-modified-snippets)) | ||
| 3809 | new) | ||
| 3810 | (old (cdr old)) | ||
| 3811 | (t nil)) | ||
| 3812 | (when then-delete | ||
| 3813 | (cl-callf2 delq old yas--before-change-modified-snippets))))) | ||
| 3814 | |||
| 3815 | (defvar yas--todo-snippet-indent nil nil) | ||
| 3816 | (make-variable-buffer-local 'yas--todo-snippet-indent) | ||
| 3817 | |||
| 3758 | (defun yas--on-field-overlay-modification (overlay after? beg end &optional length) | 3818 | (defun yas--on-field-overlay-modification (overlay after? beg end &optional length) |
| 3759 | "Clears the field and updates mirrors, conditionally. | 3819 | "Clears the field and updates mirrors, conditionally. |
| 3760 | 3820 | ||
| 3761 | Only clears the field if it hasn't been modified and point is at | 3821 | Only clears the field if it hasn't been modified and point is at |
| 3762 | field start. This hook does nothing if an undo is in progress." | 3822 | field start. This hook does nothing if an undo is in progress." |
| 3763 | (unless (or (not after?) | 3823 | (unless (or yas--inhibit-overlay-hooks |
| 3764 | yas--inhibit-overlay-hooks | ||
| 3765 | (not (overlayp yas--active-field-overlay)) ; Avoid Emacs bug #21824. | 3824 | (not (overlayp yas--active-field-overlay)) ; Avoid Emacs bug #21824. |
| 3766 | ;; If a single change hits multiple overlays of the same | 3825 | ;; If a single change hits multiple overlays of the same |
| 3767 | ;; snippet, then we delete the snippet the first time, | 3826 | ;; 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." | |||
| 3774 | (field (overlay-get overlay 'yas--field)) | 3833 | (field (overlay-get overlay 'yas--field)) |
| 3775 | (snippet (overlay-get yas--active-field-overlay 'yas--snippet))) | 3834 | (snippet (overlay-get yas--active-field-overlay 'yas--snippet))) |
| 3776 | (if (yas--snippet-live-p snippet) | 3835 | (if (yas--snippet-live-p snippet) |
| 3777 | (save-match-data | 3836 | (if after? |
| 3778 | (yas--letenv (yas--snippet-expand-env snippet) | 3837 | (save-match-data |
| 3779 | (when (yas--skip-and-clear-field-p field beg end length) | 3838 | (yas--letenv (yas--snippet-expand-env snippet) |
| 3780 | ;; We delete text starting from the END of insertion. | 3839 | (when (yas--skip-and-clear-field-p field beg end length) |
| 3781 | (yas--skip-and-clear field end)) | 3840 | ;; We delete text starting from the END of insertion. |
| 3782 | (setf (yas--field-modified-p field) t) | 3841 | (yas--skip-and-clear field end)) |
| 3783 | ;; Adjust any pending active fields in case of stacked | 3842 | (setf (yas--field-modified-p field) t) |
| 3784 | ;; expansion. | 3843 | ;; Adjust any pending active fields in case of stacked |
| 3785 | (let ((pfield field) | 3844 | ;; expansion. |
| 3786 | (psnippets (yas-active-snippets beg end))) | 3845 | (let ((pfield field) |
| 3787 | (while (and pfield psnippets) | 3846 | (psnippets (yas--gather-active-snippets |
| 3788 | (let ((psnippet (pop psnippets))) | 3847 | overlay beg end t))) |
| 3789 | (cl-assert (memq pfield (yas--snippet-fields psnippet))) | 3848 | (while (and pfield psnippets) |
| 3790 | (yas--advance-end-maybe pfield (overlay-end overlay)) | 3849 | (let ((psnippet (pop psnippets))) |
| 3791 | (setq pfield (yas--snippet-previous-active-field psnippet))))) | 3850 | (cl-assert (memq pfield (yas--snippet-fields psnippet))) |
| 3792 | (save-excursion | 3851 | (yas--advance-end-maybe pfield (overlay-end overlay)) |
| 3793 | (yas--field-update-display field)) | 3852 | (setq pfield (yas--snippet-previous-active-field psnippet))))) |
| 3794 | (yas--update-mirrors snippet))) | 3853 | ;; Update fields now, but delay auto indentation until |
| 3854 | ;; post-command. We don't want to run indentation on | ||
| 3855 | ;; the intermediate state where field text might be | ||
| 3856 | ;; removed (and hence the field could be deleted along | ||
| 3857 | ;; with leading indentation). | ||
| 3858 | (let ((yas-indent-line nil)) | ||
| 3859 | (save-excursion | ||
| 3860 | (yas--field-update-display field)) | ||
| 3861 | (yas--update-mirrors snippet)) | ||
| 3862 | (unless (or (not (eq yas-indent-line 'auto)) | ||
| 3863 | (memq snippet yas--todo-snippet-indent)) | ||
| 3864 | (push snippet yas--todo-snippet-indent)))) | ||
| 3865 | ;; Remember active snippets to use for after the change. | ||
| 3866 | (yas--gather-active-snippets overlay beg end nil)) | ||
| 3795 | (lwarn '(yasnippet zombie) :warning "Killing zombie snippet!") | 3867 | (lwarn '(yasnippet zombie) :warning "Killing zombie snippet!") |
| 3796 | (delete-overlay overlay))))) | 3868 | (delete-overlay overlay))))) |
| 3797 | 3869 | ||
| 3870 | (defun yas--do-todo-snippet-indent () | ||
| 3871 | ;; Do pending indentation of snippet fields, called from | ||
| 3872 | ;; `yas--post-command-handler'. | ||
| 3873 | (when yas--todo-snippet-indent | ||
| 3874 | (save-excursion | ||
| 3875 | (cl-loop for snippet in yas--todo-snippet-indent | ||
| 3876 | do (yas--indent-mirrors-of-snippet | ||
| 3877 | snippet (yas--snippet-field-mirrors snippet))) | ||
| 3878 | (setq yas--todo-snippet-indent nil)))) | ||
| 3879 | |||
| 3798 | (defun yas--auto-fill () | 3880 | (defun yas--auto-fill () |
| 3881 | ;; Preserve snippet markers during auto-fill. | ||
| 3799 | (let* ((orig-point (point)) | 3882 | (let* ((orig-point (point)) |
| 3800 | (end (progn (forward-paragraph) (point))) | 3883 | (end (progn (forward-paragraph) (point))) |
| 3801 | (beg (progn (backward-paragraph) (point))) | 3884 | (beg (progn (backward-paragraph) (point))) |
| @@ -3805,57 +3888,59 @@ field start. This hook does nothing if an undo is in progress." | |||
| 3805 | (dolist (snippet snippets) | 3888 | (dolist (snippet snippets) |
| 3806 | (dolist (m (yas--collect-snippet-markers snippet)) | 3889 | (dolist (m (yas--collect-snippet-markers snippet)) |
| 3807 | (when (and (<= beg m) (<= m end)) | 3890 | (when (and (<= beg m) (<= m end)) |
| 3808 | (push (yas--snapshot-marker-location m beg end) remarkers))) | 3891 | (push (cons m (yas--snapshot-location m beg end)) remarkers))) |
| 3809 | (push (yas--snapshot-overlay-location | 3892 | (push (yas--snapshot-overlay-location |
| 3810 | (yas--snippet-control-overlay snippet) beg end) | 3893 | (yas--snippet-control-overlay snippet) beg end) |
| 3811 | reoverlays)) | 3894 | reoverlays)) |
| 3812 | (goto-char orig-point) | 3895 | (goto-char orig-point) |
| 3813 | (let ((yas--inhibit-overlay-hooks t)) | 3896 | (let ((yas--inhibit-overlay-hooks t)) |
| 3814 | (if (null yas--original-auto-fill-function) | 3897 | (if yas--original-auto-fill-function |
| 3815 | ;; Try to get more info on #873/919. | 3898 | (funcall yas--original-auto-fill-function) |
| 3816 | (let ((yas--fill-fun-values `((t ,(default-value 'yas--original-auto-fill-function)))) | 3899 | ;; Shouldn't happen, gather more info about it (see #873/919). |
| 3817 | (fill-fun-values `((t ,(default-value 'auto-fill-function)))) | 3900 | (let ((yas--fill-fun-values `((t ,(default-value 'yas--original-auto-fill-function)))) |
| 3818 | ;; Listing 2 buffers with the same value is enough | 3901 | (fill-fun-values `((t ,(default-value 'auto-fill-function)))) |
| 3819 | (print-length 3)) | 3902 | ;; Listing 2 buffers with the same value is enough |
| 3820 | (save-current-buffer | 3903 | (print-length 3)) |
| 3821 | (dolist (buf (let ((bufs (buffer-list))) | 3904 | (save-current-buffer |
| 3822 | ;; List the current buffer first. | 3905 | (dolist (buf (let ((bufs (buffer-list))) |
| 3823 | (setq bufs (cons (current-buffer) | 3906 | ;; List the current buffer first. |
| 3824 | (remq (current-buffer) bufs))))) | 3907 | (setq bufs (cons (current-buffer) |
| 3825 | (set-buffer buf) | 3908 | (remq (current-buffer) bufs))))) |
| 3826 | (let* ((yf-cell (assq yas--original-auto-fill-function | 3909 | (set-buffer buf) |
| 3827 | yas--fill-fun-values)) | 3910 | (let* ((yf-cell (assq yas--original-auto-fill-function |
| 3828 | (af-cell (assq auto-fill-function fill-fun-values))) | 3911 | yas--fill-fun-values)) |
| 3829 | (when (local-variable-p 'yas--original-auto-fill-function) | 3912 | (af-cell (assq auto-fill-function fill-fun-values))) |
| 3830 | (if yf-cell (setcdr yf-cell (cons buf (cdr yf-cell))) | 3913 | (when (local-variable-p 'yas--original-auto-fill-function) |
| 3831 | (push (list yas--original-auto-fill-function buf) yas--fill-fun-values))) | 3914 | (if yf-cell (setcdr yf-cell (cons buf (cdr yf-cell))) |
| 3832 | (when (local-variable-p 'auto-fill-function) | 3915 | (push (list yas--original-auto-fill-function buf) yas--fill-fun-values))) |
| 3833 | (if af-cell (setcdr af-cell (cons buf (cdr af-cell))) | 3916 | (when (local-variable-p 'auto-fill-function) |
| 3834 | (push (list auto-fill-function buf) fill-fun-values)))))) | 3917 | (if af-cell (setcdr af-cell (cons buf (cdr af-cell))) |
| 3835 | (lwarn '(yasnippet auto-fill bug) :error | 3918 | (push (list auto-fill-function buf) fill-fun-values)))))) |
| 3836 | "`yas--original-auto-fill-function' unexpectedly nil in %S! Disabling auto-fill. | 3919 | (lwarn '(yasnippet auto-fill bug) :error |
| 3920 | "`yas--original-auto-fill-function' unexpectedly nil in %S! Disabling auto-fill. | ||
| 3837 | %S | 3921 | %S |
| 3838 | `auto-fill-function': %S\n%s" | 3922 | `auto-fill-function': %S\n%s" |
| 3839 | (current-buffer) yas--fill-fun-values fill-fun-values | 3923 | (current-buffer) yas--fill-fun-values fill-fun-values |
| 3840 | (if (fboundp 'backtrace--print-frame) | 3924 | (if (fboundp 'backtrace--print-frame) |
| 3841 | (with-output-to-string | 3925 | (with-output-to-string |
| 3842 | (mapc (lambda (frame) | 3926 | (mapc (lambda (frame) |
| 3843 | (apply #'backtrace--print-frame frame)) | 3927 | (apply #'backtrace--print-frame frame)) |
| 3844 | yas--watch-auto-fill-backtrace)) | 3928 | yas--watch-auto-fill-backtrace)) |
| 3845 | "")) | 3929 | "")) |
| 3846 | ;; Try to avoid repeated triggering of this bug. | 3930 | ;; Try to avoid repeated triggering of this bug. |
| 3847 | (auto-fill-mode -1) | 3931 | (auto-fill-mode -1) |
| 3848 | ;; Don't pop up more than once in a session (still log though). | 3932 | ;; Don't pop up more than once in a session (still log though). |
| 3849 | (defvar warning-suppress-types) ; `warnings' is autoloaded by `lwarn'. | 3933 | (defvar warning-suppress-types) ; `warnings' is autoloaded by `lwarn'. |
| 3850 | (add-to-list 'warning-suppress-types '(yasnippet auto-fill bug))) | 3934 | (add-to-list 'warning-suppress-types '(yasnippet auto-fill bug))))) |
| 3851 | (funcall yas--original-auto-fill-function))) | ||
| 3852 | (save-excursion | 3935 | (save-excursion |
| 3853 | (setq end (progn (forward-paragraph) (point))) | 3936 | (setq end (progn (forward-paragraph) (point))) |
| 3854 | (setq beg (progn (backward-paragraph) (point)))) | 3937 | (setq beg (progn (backward-paragraph) (point)))) |
| 3855 | (save-excursion | 3938 | (save-excursion |
| 3856 | (save-restriction | 3939 | (save-restriction |
| 3857 | (narrow-to-region beg end) | 3940 | (narrow-to-region beg end) |
| 3858 | (mapc #'yas--restore-marker-location remarkers) | 3941 | (dolist (remarker remarkers) |
| 3942 | (set-marker (car remarker) | ||
| 3943 | (yas--goto-saved-location (cdr remarker)))) | ||
| 3859 | (mapc #'yas--restore-overlay-location reoverlays)) | 3944 | (mapc #'yas--restore-overlay-location reoverlays)) |
| 3860 | (mapc (lambda (snippet) | 3945 | (mapc (lambda (snippet) |
| 3861 | (yas--letenv (yas--snippet-expand-env snippet) | 3946 | (yas--letenv (yas--snippet-expand-env snippet) |
| @@ -3909,6 +3994,7 @@ Move the overlays, or create them if they do not exit." | |||
| 3909 | (defun yas--on-protection-overlay-modification (_overlay after? beg end &optional length) | 3994 | (defun yas--on-protection-overlay-modification (_overlay after? beg end &optional length) |
| 3910 | "Commit the snippet if the protection overlay is being killed." | 3995 | "Commit the snippet if the protection overlay is being killed." |
| 3911 | (unless (or yas--inhibit-overlay-hooks | 3996 | (unless (or yas--inhibit-overlay-hooks |
| 3997 | yas-inhibit-overlay-modification-protection | ||
| 3912 | (not after?) | 3998 | (not after?) |
| 3913 | (= length (- end beg)) ; deletion or insertion | 3999 | (= length (- end beg)) ; deletion or insertion |
| 3914 | (yas--undo-in-progress)) | 4000 | (yas--undo-in-progress)) |
| @@ -4334,35 +4420,54 @@ Meant to be called in a narrowed buffer, does various passes" | |||
| 4334 | ;; current paragraph instead of line. | 4420 | ;; current paragraph instead of line. |
| 4335 | ;; | 4421 | ;; |
| 4336 | ;; 2. Moving snippets from an `org-src' temp buffer into the main org | 4422 | ;; 2. Moving snippets from an `org-src' temp buffer into the main org |
| 4337 | ;; buffer, in this case we need to count the line offsets (because org | 4423 | ;; buffer, in this case we need to count the relative line number |
| 4338 | ;; may add indentation on each line making character positions | 4424 | ;; (because org may add indentation on each line making character |
| 4339 | ;; unreliable). | 4425 | ;; positions unreliable). |
| 4426 | ;; | ||
| 4427 | ;; Data formats: | ||
| 4428 | ;; (LOCATION) = (REGEXP WS-COUNT) | ||
| 4429 | ;; MARKER -> (MARKER . (LOCATION)) | ||
| 4430 | ;; OVERLAY -> (OVERLAY LOCATION-BEG LOCATION-END) | ||
| 4431 | ;; | ||
| 4432 | ;; For `org-src' temp buffer, add a line number to format: | ||
| 4433 | ;; (LINE-LOCATION) = (LINE . (LOCATION)) | ||
| 4434 | ;; MARKER@LINE -> (MARKER . (LINE-LOCATION)) | ||
| 4435 | ;; OVERLAY@LINE -> (OVERLAY LINE-LOCATION-BEG LINE-LOCATION-END) | ||
| 4340 | ;; | 4436 | ;; |
| 4341 | ;; This is all best-effort heuristic stuff, but it should cover 99% of | 4437 | ;; This is all best-effort heuristic stuff, but it should cover 99% of |
| 4342 | ;; use-cases. | 4438 | ;; use-cases. |
| 4343 | 4439 | ||
| 4344 | (defun yas--snapshot-marker-location (marker &optional beg end) | 4440 | (defun yas--snapshot-location (position &optional beg end) |
| 4345 | "Returns info for restoring MARKER's location after indent. | 4441 | "Returns info for restoring POSITIONS's location after indent. |
| 4346 | The returned value is a list of the form (MARKER REGEXP WS-COUNT)." | 4442 | The returned value is a list of the form (REGEXP WS-COUNT). |
| 4443 | POSITION may be either a marker or just a buffer position. The | ||
| 4444 | REGEXP matches text between BEG..END which default to the current | ||
| 4445 | line if omitted." | ||
| 4446 | (goto-char position) | ||
| 4347 | (unless beg (setq beg (line-beginning-position))) | 4447 | (unless beg (setq beg (line-beginning-position))) |
| 4348 | (unless end (setq end (line-end-position))) | 4448 | (unless end (setq end (line-end-position))) |
| 4349 | (let ((before (split-string (buffer-substring-no-properties beg marker) | 4449 | (let ((before (split-string (buffer-substring-no-properties beg position) |
| 4350 | "[[:space:]\n]+" t)) | 4450 | "[[:space:]\n]+" t)) |
| 4351 | (after (split-string (buffer-substring-no-properties marker end) | 4451 | (after (split-string (buffer-substring-no-properties position end) |
| 4352 | "[[:space:]\n]+" t))) | 4452 | "[[:space:]\n]+" t))) |
| 4353 | (list marker | 4453 | (list (concat "[[:space:]\n]*" |
| 4354 | (concat "[[:space:]\n]*" | ||
| 4355 | (mapconcat (lambda (s) | 4454 | (mapconcat (lambda (s) |
| 4356 | (if (eq s marker) "\\(\\)" | 4455 | (if (eq s position) "\\(\\)" |
| 4357 | (regexp-quote s))) | 4456 | (regexp-quote s))) |
| 4358 | (nconc before (list marker) after) | 4457 | (nconc before (list position) after) |
| 4359 | "[[:space:]\n]*")) | 4458 | "[[:space:]\n]*")) |
| 4360 | (progn (goto-char marker) | 4459 | (progn (skip-chars-forward "[:space:]\n" end) |
| 4361 | (skip-chars-forward "[:space:]\n" end) | 4460 | (- (point) position))))) |
| 4362 | (- (point) marker))))) | 4461 | |
| 4462 | (defun yas--snapshot-line-location (position &optional beg end) | ||
| 4463 | "Like `yas--snapshot-location', but return also line number. | ||
| 4464 | Returned format is (LINE REGEXP WS-COUNT)." | ||
| 4465 | (goto-char position) | ||
| 4466 | (cons (count-lines (point-min) (line-beginning-position)) | ||
| 4467 | (yas--snapshot-location position beg end))) | ||
| 4363 | 4468 | ||
| 4364 | (defun yas--snapshot-overlay-location (overlay beg end) | 4469 | (defun yas--snapshot-overlay-location (overlay beg end) |
| 4365 | "Like `yas--snapshot-marker-location' for overlays. | 4470 | "Like `yas--snapshot-location' for overlays. |
| 4366 | The returned format is (OVERLAY (RE WS) (RE WS)). Either of | 4471 | The returned format is (OVERLAY (RE WS) (RE WS)). Either of |
| 4367 | the (RE WS) lists may be nil if the start or end, respectively, | 4472 | the (RE WS) lists may be nil if the start or end, respectively, |
| 4368 | of the overlay is outside the range BEG .. END." | 4473 | of the overlay is outside the range BEG .. END." |
| @@ -4370,67 +4475,59 @@ of the overlay is outside the range BEG .. END." | |||
| 4370 | (oend (overlay-end overlay))) | 4475 | (oend (overlay-end overlay))) |
| 4371 | (list overlay | 4476 | (list overlay |
| 4372 | (when (and (<= beg obeg) (< obeg end)) | 4477 | (when (and (<= beg obeg) (< obeg end)) |
| 4373 | (cdr (yas--snapshot-marker-location obeg beg end))) | 4478 | (yas--snapshot-location obeg beg end)) |
| 4374 | (when (and (<= beg oend) (< oend end)) | 4479 | (when (and (<= beg oend) (< oend end)) |
| 4375 | (cdr (yas--snapshot-marker-location oend beg end)))))) | 4480 | (yas--snapshot-location oend beg end))))) |
| 4376 | 4481 | ||
| 4377 | (defun yas--snapshot-overlay-line-location (overlay) | 4482 | (defun yas--snapshot-overlay-line-location (overlay) |
| 4378 | "Return info for restoring OVERLAY's line based location. | 4483 | "Return info for restoring OVERLAY's line based location. |
| 4379 | The returned format is (OVERLAY (LINE RE WS) (LINE RE WS))." | 4484 | The returned format is (OVERLAY (LINE RE WS) (LINE RE WS))." |
| 4380 | (let ((loc-beg (progn (goto-char (overlay-start overlay)) | 4485 | (list overlay |
| 4381 | (yas--snapshot-marker-location (point)))) | 4486 | (yas--snapshot-line-location (overlay-start overlay)) |
| 4382 | (loc-end (progn (goto-char (overlay-end overlay)) | 4487 | (yas--snapshot-line-location (overlay-end overlay)))) |
| 4383 | (yas--snapshot-marker-location (point))))) | ||
| 4384 | (setcar loc-beg (count-lines (point-min) (progn (goto-char (car loc-beg)) | ||
| 4385 | (line-beginning-position)))) | ||
| 4386 | (setcar loc-end (count-lines (point-min) (progn (goto-char (car loc-end)) | ||
| 4387 | (line-beginning-position)))) | ||
| 4388 | (list overlay loc-beg loc-end))) | ||
| 4389 | |||
| 4390 | (defun yas--goto-saved-location (regexp ws-count) | ||
| 4391 | "Move point to location saved by `yas--snapshot-marker-location'. | ||
| 4392 | Buffer must be narrowed to BEG..END used to create the snapshot info." | ||
| 4393 | (goto-char (point-min)) | ||
| 4394 | (if (not (looking-at regexp)) | ||
| 4395 | (lwarn '(yasnippet re-marker) :warning | ||
| 4396 | "Couldn't find: %S" regexp) | ||
| 4397 | (goto-char (match-beginning 1)) | ||
| 4398 | (skip-chars-forward "[:space:]\n") | ||
| 4399 | (skip-chars-backward "[:space:]\n" (- (point) ws-count)))) | ||
| 4400 | 4488 | ||
| 4401 | (defun yas--restore-marker-location (re-marker) | 4489 | (defun yas--goto-saved-location (re-count) |
| 4402 | "Restores marker based on info from `yas--snapshot-marker-location'. | 4490 | "Move to and return point saved by `yas--snapshot-location'. |
| 4403 | Buffer must be narrowed to BEG..END used to create the snapshot info." | 4491 | Buffer must be narrowed to BEG..END used to create the snapshot info." |
| 4404 | (apply #'yas--goto-saved-location (cdr re-marker)) | 4492 | (let ((regexp (pop re-count)) |
| 4405 | (set-marker (car re-marker) (point))) | 4493 | (ws-count (pop re-count))) |
| 4494 | (goto-char (point-min)) | ||
| 4495 | (if (not (looking-at regexp)) | ||
| 4496 | (lwarn '(yasnippet re-marker) :warning | ||
| 4497 | "Couldn't find: %S" regexp) | ||
| 4498 | (goto-char (match-beginning 1)) | ||
| 4499 | (skip-chars-forward "[:space:]\n") | ||
| 4500 | (skip-chars-backward "[:space:]\n" (- (point) ws-count))) | ||
| 4501 | (point))) | ||
| 4406 | 4502 | ||
| 4407 | (defun yas--restore-overlay-location (ov-locations) | 4503 | (defun yas--restore-overlay-location (ov-locations) |
| 4408 | "Restores marker based on info from `yas--snapshot-marker-location'. | 4504 | "Restores marker based on info from `yas--snapshot-overlay-location'. |
| 4409 | Buffer must be narrowed to BEG..END used to create the snapshot info." | 4505 | Buffer must be narrowed to BEG..END used to create the snapshot info." |
| 4410 | (cl-destructuring-bind (overlay loc-beg loc-end) ov-locations | 4506 | (cl-destructuring-bind (overlay loc-beg loc-end) ov-locations |
| 4411 | (move-overlay overlay | 4507 | (move-overlay overlay |
| 4412 | (if (not loc-beg) (overlay-start overlay) | 4508 | (if (not loc-beg) (overlay-start overlay) |
| 4413 | (apply #'yas--goto-saved-location loc-beg) | 4509 | (yas--goto-saved-location loc-beg)) |
| 4414 | (point)) | ||
| 4415 | (if (not loc-end) (overlay-end overlay) | 4510 | (if (not loc-end) (overlay-end overlay) |
| 4416 | (apply #'yas--goto-saved-location loc-end) | 4511 | (yas--goto-saved-location loc-end))))) |
| 4417 | (point))))) | ||
| 4418 | 4512 | ||
| 4419 | 4513 | (defun yas--goto-saved-line-location (base-pos l-re-count) | |
| 4420 | (defun yas--restore-overlay-line-location (ov-locations) | 4514 | "Move to and return point saved by `yas--snapshot-line-location'. |
| 4421 | "Restores overlay based on info from `yas--snapshot-overlay-line-location'." | 4515 | Additionally requires BASE-POS to tell where the line numbers are |
| 4516 | relative to." | ||
| 4517 | (goto-char base-pos) | ||
| 4518 | (forward-line (pop l-re-count)) | ||
| 4422 | (save-restriction | 4519 | (save-restriction |
| 4423 | (move-overlay (car ov-locations) | 4520 | (narrow-to-region (line-beginning-position) |
| 4424 | (save-excursion | 4521 | (line-end-position)) |
| 4425 | (forward-line (car (nth 1 ov-locations))) | 4522 | (yas--goto-saved-location l-re-count))) |
| 4426 | (narrow-to-region (line-beginning-position) (line-end-position)) | 4523 | |
| 4427 | (apply #'yas--goto-saved-location (cdr (nth 1 ov-locations))) | 4524 | (defun yas--restore-overlay-line-location (base-pos ov-locations) |
| 4428 | (point)) | 4525 | "Restores marker based on info from `yas--snapshot-overlay-line-location'." |
| 4429 | (save-excursion | 4526 | (cl-destructuring-bind (overlay beg-l-r-w end-l-r-w) |
| 4430 | (forward-line (car (nth 2 ov-locations))) | 4527 | ov-locations |
| 4431 | (narrow-to-region (line-beginning-position) (line-end-position)) | 4528 | (move-overlay overlay |
| 4432 | (apply #'yas--goto-saved-location (cdr (nth 2 ov-locations))) | 4529 | (yas--goto-saved-line-location base-pos beg-l-r-w) |
| 4433 | (point))))) | 4530 | (yas--goto-saved-line-location base-pos end-l-r-w)))) |
| 4434 | 4531 | ||
| 4435 | (defun yas--indent-region (from to snippet) | 4532 | (defun yas--indent-region (from to snippet) |
| 4436 | "Indent the lines between FROM and TO with `indent-according-to-mode'. | 4533 | "Indent the lines between FROM and TO with `indent-according-to-mode'. |
| @@ -4449,14 +4546,16 @@ The SNIPPET's markers are preserved." | |||
| 4449 | (let ((remarkers nil)) | 4546 | (let ((remarkers nil)) |
| 4450 | (dolist (m snippet-markers) | 4547 | (dolist (m snippet-markers) |
| 4451 | (when (and (<= bol m) (<= m eol)) | 4548 | (when (and (<= bol m) (<= m eol)) |
| 4452 | (push (yas--snapshot-marker-location m bol eol) | 4549 | (push (cons m (yas--snapshot-location m bol eol)) |
| 4453 | remarkers))) | 4550 | remarkers))) |
| 4454 | (unwind-protect | 4551 | (unwind-protect |
| 4455 | (progn (back-to-indentation) | 4552 | (progn (back-to-indentation) |
| 4456 | (indent-according-to-mode)) | 4553 | (indent-according-to-mode)) |
| 4457 | (save-restriction | 4554 | (save-restriction |
| 4458 | (narrow-to-region bol (line-end-position)) | 4555 | (narrow-to-region bol (line-end-position)) |
| 4459 | (mapc #'yas--restore-marker-location remarkers)))) | 4556 | (dolist (remarker remarkers) |
| 4557 | (set-marker (car remarker) | ||
| 4558 | (yas--goto-saved-location (cdr remarker))))))) | ||
| 4460 | while (and (zerop (forward-line 1)) | 4559 | while (and (zerop (forward-line 1)) |
| 4461 | (< (point) to))))))) | 4560 | (< (point) to))))))) |
| 4462 | 4561 | ||
| @@ -4754,46 +4853,58 @@ When multiple expressions are found, only the last one counts." | |||
| 4754 | (parent 1) | 4853 | (parent 1) |
| 4755 | (t 0)))))) | 4854 | (t 0)))))) |
| 4756 | 4855 | ||
| 4856 | (defun yas--snippet-field-mirrors (snippet) | ||
| 4857 | ;; Make a list of (FIELD . MIRROR). | ||
| 4858 | (cl-sort | ||
| 4859 | (cl-mapcan (lambda (field) | ||
| 4860 | (mapcar (lambda (mirror) | ||
| 4861 | (cons field mirror)) | ||
| 4862 | (yas--field-mirrors field))) | ||
| 4863 | (yas--snippet-fields snippet)) | ||
| 4864 | ;; Then sort this list so that entries with mirrors with | ||
| 4865 | ;; parent fields appear before. This was important for | ||
| 4866 | ;; fixing #290, and also handles the case where a mirror in | ||
| 4867 | ;; a field causes another mirror to need reupdating. | ||
| 4868 | #'> :key (lambda (fm) (yas--calculate-mirror-depth (cdr fm))))) | ||
| 4869 | |||
| 4870 | (defun yas--indent-mirrors-of-snippet (snippet &optional f-ms) | ||
| 4871 | ;; Indent mirrors of SNIPPET. F-MS is the return value of | ||
| 4872 | ;; (yas--snippet-field-mirrors SNIPPET). | ||
| 4873 | (when (eq yas-indent-line 'auto) | ||
| 4874 | (let ((yas--inhibit-overlay-hooks t)) | ||
| 4875 | (cl-loop for (beg . end) in | ||
| 4876 | (cl-sort (mapcar (lambda (f-m) | ||
| 4877 | (let ((mirror (cdr f-m))) | ||
| 4878 | (cons (yas--mirror-start mirror) | ||
| 4879 | (yas--mirror-end mirror)))) | ||
| 4880 | (or f-ms | ||
| 4881 | (yas--snippet-field-mirrors snippet))) | ||
| 4882 | #'< :key #'car) | ||
| 4883 | do (yas--indent-region beg end snippet))))) | ||
| 4884 | |||
| 4757 | (defun yas--update-mirrors (snippet) | 4885 | (defun yas--update-mirrors (snippet) |
| 4758 | "Update all the mirrors of SNIPPET." | 4886 | "Update all the mirrors of SNIPPET." |
| 4759 | (yas--save-restriction-and-widen | 4887 | (yas--save-restriction-and-widen |
| 4760 | (save-excursion | 4888 | (save-excursion |
| 4761 | (cl-loop | 4889 | (let ((f-ms (yas--snippet-field-mirrors snippet))) |
| 4762 | for (field . mirror) | 4890 | (cl-loop |
| 4763 | in (cl-sort | 4891 | for (field . mirror) in f-ms |
| 4764 | ;; Make a list of (FIELD . MIRROR). | 4892 | ;; Before updating a mirror with a parent-field, maybe advance |
| 4765 | (cl-mapcan (lambda (field) | 4893 | ;; its start (#290). |
| 4766 | (mapcar (lambda (mirror) | 4894 | do (let ((parent-field (yas--mirror-parent-field mirror))) |
| 4767 | (cons field mirror)) | 4895 | (when parent-field |
| 4768 | (yas--field-mirrors field))) | 4896 | (yas--advance-start-maybe mirror (yas--fom-start parent-field)))) |
| 4769 | (yas--snippet-fields snippet)) | 4897 | ;; Update this mirror. |
| 4770 | ;; Then sort this list so that entries with mirrors with | 4898 | do (yas--mirror-update-display mirror field) |
| 4771 | ;; parent fields appear before. This was important for | 4899 | ;; `yas--place-overlays' is needed since the active field and |
| 4772 | ;; fixing #290, and also handles the case where a mirror in | 4900 | ;; protected overlays might have been changed because of insertions |
| 4773 | ;; a field causes another mirror to need reupdating. | 4901 | ;; in `yas--mirror-update-display'. |
| 4774 | #'> :key (lambda (fm) (yas--calculate-mirror-depth (cdr fm)))) | 4902 | do (let ((active-field (yas--snippet-active-field snippet))) |
| 4775 | ;; Before updating a mirror with a parent-field, maybe advance | 4903 | (when active-field (yas--place-overlays snippet active-field)))) |
| 4776 | ;; its start (#290). | 4904 | ;; Delay indenting until we're done all mirrors. We must do |
| 4777 | do (let ((parent-field (yas--mirror-parent-field mirror))) | 4905 | ;; this to avoid losing whitespace between fields that are |
| 4778 | (when parent-field | 4906 | ;; still empty (i.e., they will be non-empty after updating). |
| 4779 | (yas--advance-start-maybe mirror (yas--fom-start parent-field)))) | 4907 | (yas--indent-mirrors-of-snippet snippet f-ms))))) |
| 4780 | ;; Update this mirror. | ||
| 4781 | do (yas--mirror-update-display mirror field) | ||
| 4782 | ;; Delay indenting until we're done all mirrors. We must do | ||
| 4783 | ;; this to avoid losing whitespace between fields that are | ||
| 4784 | ;; still empty (i.e., they will be non-empty after updating). | ||
| 4785 | when (eq yas-indent-line 'auto) | ||
| 4786 | collect (cons (yas--mirror-start mirror) (yas--mirror-end mirror)) | ||
| 4787 | into indent-regions | ||
| 4788 | ;; `yas--place-overlays' is needed since the active field and | ||
| 4789 | ;; protected overlays might have been changed because of insertions | ||
| 4790 | ;; in `yas--mirror-update-display'. | ||
| 4791 | do (let ((active-field (yas--snippet-active-field snippet))) | ||
| 4792 | (when active-field (yas--place-overlays snippet active-field))) | ||
| 4793 | finally do | ||
| 4794 | (let ((yas--inhibit-overlay-hooks t)) | ||
| 4795 | (cl-loop for (beg . end) in (cl-sort indent-regions #'< :key #'car) | ||
| 4796 | do (yas--indent-region beg end snippet))))))) | ||
| 4797 | 4908 | ||
| 4798 | (defun yas--mirror-update-display (mirror field) | 4909 | (defun yas--mirror-update-display (mirror field) |
| 4799 | "Update MIRROR according to FIELD (and mirror transform)." | 4910 | "Update MIRROR according to FIELD (and mirror transform)." |
| @@ -4851,6 +4962,7 @@ When multiple expressions are found, only the last one counts." | |||
| 4851 | ;; Don't pop up more than once in a session (still log though). | 4962 | ;; Don't pop up more than once in a session (still log though). |
| 4852 | (defvar warning-suppress-types) ; `warnings' is autoloaded by `lwarn'. | 4963 | (defvar warning-suppress-types) ; `warnings' is autoloaded by `lwarn'. |
| 4853 | (add-to-list 'warning-suppress-types '(yasnippet auto-fill bug))) | 4964 | (add-to-list 'warning-suppress-types '(yasnippet auto-fill bug))) |
| 4965 | (yas--do-todo-snippet-indent) | ||
| 4854 | (condition-case err | 4966 | (condition-case err |
| 4855 | (progn (yas--finish-moving-snippets) | 4967 | (progn (yas--finish-moving-snippets) |
| 4856 | (cond ((eq 'undo this-command) | 4968 | (cond ((eq 'undo this-command) |
