summaryrefslogtreecommitdiff
path: root/.emacs.d/lisp/yasnippet.el
diff options
context:
space:
mode:
Diffstat (limited to '.emacs.d/lisp/yasnippet.el')
-rw-r--r--.emacs.d/lisp/yasnippet.el532
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
414unmodified snippet field.") 414unmodified 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) 418The 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.
560This is useful to control whether snippet navigation bindings
561override 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.
552This is useful to control whether snippet navigation bindings 566This is useful to control whether snippet navigation bindings
553override bindings from other packages (e.g., `company-mode')." 567override `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.
572This protection is intended to prevent yasnippet from ending up
573in an inconsistent state. However, some packages (e.g., the
574company completion package) may trigger this protection when it
575is not needed. In that case, setting this variable to non-nil
576can 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.
925Functions are called with no argument, and should return non-nil to prevent 952Functions 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.
2374If there are expandable snippets, return CMD (this is useful for
2375conditional keybindings) or the list of expandable snippet
2376template 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."
2369Prompt the user if TEMPLATES has more than one element, else 2398Prompt the user if TEMPLATES has more than one element, else
2370expand immediately. Common gateway for 2399expand 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
3761Only clears the field if it hasn't been modified and point is at 3821Only clears the field if it hasn't been modified and point is at
3762field start. This hook does nothing if an undo is in progress." 3822field 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.
4346The returned value is a list of the form (MARKER REGEXP WS-COUNT)." 4442The returned value is a list of the form (REGEXP WS-COUNT).
4443POSITION may be either a marker or just a buffer position. The
4444REGEXP matches text between BEG..END which default to the current
4445line 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.
4464Returned 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.
4366The returned format is (OVERLAY (RE WS) (RE WS)). Either of 4471The returned format is (OVERLAY (RE WS) (RE WS)). Either of
4367the (RE WS) lists may be nil if the start or end, respectively, 4472the (RE WS) lists may be nil if the start or end, respectively,
4368of the overlay is outside the range BEG .. END." 4473of 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.
4379The returned format is (OVERLAY (LINE RE WS) (LINE RE WS))." 4484The 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'.
4392Buffer 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'.
4403Buffer must be narrowed to BEG..END used to create the snapshot info." 4491Buffer 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'.
4409Buffer must be narrowed to BEG..END used to create the snapshot info." 4505Buffer 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'." 4515Additionally requires BASE-POS to tell where the line numbers are
4516relative 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)