From 9fffbc025f80ef22a77ccc62f53baa990568b214 Mon Sep 17 00:00:00 2001 From: Simeon Simeonov Date: Sat, 10 Feb 2024 20:40:19 +0100 Subject: Upgrade yasnippet --- .emacs.d/lisp/yasnippet.el | 216 ++++++++++++++++++++++++--------------------- 1 file changed, 115 insertions(+), 101 deletions(-) diff --git a/.emacs.d/lisp/yasnippet.el b/.emacs.d/lisp/yasnippet.el index f5210d5..d130cb9 100644 --- a/.emacs.d/lisp/yasnippet.el +++ b/.emacs.d/lisp/yasnippet.el @@ -5,7 +5,7 @@ ;; João Távora , ;; Noam Postavsky ;; Maintainer: Noam Postavsky -;; Version: 0.14.0 +;; Version: 0.14.1 ;; X-URL: http://github.com/joaotavora/yasnippet ;; Keywords: convenience, emulation ;; URL: http://github.com/joaotavora/yasnippet @@ -421,7 +421,12 @@ The condition will respect the value of `yas-keymap-disable-hook'." (defvar yas-keymap (let ((map (make-sparse-keymap))) - (define-key map [(tab)] (yas-filtered-definition 'yas-next-field-or-maybe-expand)) + ;; Modes should always bind to TAB instead of `tab', so as not to override + ;; bindings that should take higher precedence but which bind to `TAB` + ;; instead (relying on `function-key-map` to remap `tab` to TAB). + ;; If this causes problem because of another package that binds to `tab`, + ;; complain to that other package! + ;; (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)) @@ -489,18 +494,19 @@ Attention: This hook is not run when exiting nested/stacked snippet expansion!") "Hook run just before expanding a snippet.") (defconst yas-not-string-or-comment-condition - '(if (let ((ppss (syntax-ppss))) - (or (nth 3 ppss) (nth 4 ppss))) - '(require-snippet-condition . force-in-comment) - t) + (lambda () + (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. To use, set `yas-buffer-local-condition' to this value.") (defcustom yas-buffer-local-condition t "Snippet expanding condition. -This variable is a Lisp form which is evaluated every time a -snippet expansion is attempted: +This variable is either a Lisp function (called with no arguments) +or a Lisp form. It is evaluated every time a snippet expansion is attempted: * If it evaluates to nil, no snippets can be expanded. @@ -538,12 +544,13 @@ inside comments, in `python-mode' only, with the exception of snippets returning the symbol `force-in-comment' in their conditions. - (add-hook \\='python-mode-hook - (lambda () - (setq yas-buffer-local-condition - \\='(if (python-syntax-comment-or-string-p) - \\='(require-snippet-condition . force-in-comment) - t))))" + (add-hook \\='python-mode-hook + (lambda () + (setq yas-buffer-local-condition + (lambda () + (if (python-syntax-comment-or-string-p) + \\='(require-snippet-condition . force-in-comment) + t)))))" :type `(choice (const :tag "Disable snippet expansion inside strings and comments" @@ -554,9 +561,12 @@ conditions. sexp)) (defcustom yas-keymap-disable-hook nil - "The `yas-keymap' bindings are disabled if any function in this list returns non-nil. + "Abnormal hook run to decide when `yas-keymap' bindings are enabled. +The bindings are disabled whenever 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')." +override bindings from other packages (e.g., `company-mode'). +This is run (several times) every time we perform a key lookup, so +it has to be fast." :type 'hook) (defcustom yas-overlay-priority 100 @@ -648,7 +658,7 @@ expanded.") ;; instead (relying on `function-key-map` to remap `tab` to TAB). ;; If this causes problem because of another package that binds to `tab`, ;; complain to that other package! - ;;(define-key map [(tab)] yas-maybe-expand) + ;;(define-key map [tab] yas-maybe-expand) (define-key map (kbd "TAB") yas-maybe-expand) (define-key map "\C-c&\C-s" #'yas-insert-snippet) (define-key map "\C-c&\C-n" #'yas-new-snippet) @@ -819,42 +829,49 @@ which decides on the snippet to expand.") (or (get mode 'yas--all-parents) ;; FIXME: Use `with-memoization'? (progn (put mode 'yas--all-parents (list mode)) ;; Stop inf-loop with cycles. - (put mode 'yas--all-parents - (if (fboundp 'derived-mode-all-parents) - (let* ((ap (derived-mode-all-parents mode)) - (extras - (mapcar (lambda (parent) - (yas--merge-ordered-lists - (mapcar #'yas--all-parents - (gethash parent yas--parents)))) - ap))) - (yas--merge-ordered-lists - (cons (append ap '(fundamental-mode)) extras))) - (cons mode - (yas--merge-ordered-lists - (mapcar #'yas--all-parents - (remq nil - `(,(or (get mode 'derived-mode-parent) - ;; Consider `fundamental-mode' - ;; as ultimate ancestor. - 'fundamental-mode) - ,(let ((alias (symbol-function mode))) - (when (symbolp alias) alias)) - ,@(gethash mode yas--parents))))))))))) + (let ((all-parents + (if (fboundp 'derived-mode-all-parents) + (let* ((ap (derived-mode-all-parents mode)) + (extras + (mapcar (lambda (parent) + (yas--merge-ordered-lists + (mapcar #'yas--all-parents + (gethash parent yas--parents)))) + ap))) + (cl-assert (eq mode (car ap))) + (cons mode + (yas--merge-ordered-lists + (cons (if (eq mode 'fundamental-mode) () + (append (cdr ap) '(fundamental-mode))) + extras)))) + (cons mode + (yas--merge-ordered-lists + (mapcar #'yas--all-parents + (remq nil + `(,(or (get mode 'derived-mode-parent) + ;; Consider `fundamental-mode' + ;; as ultimate ancestor. + 'fundamental-mode) + ,(let ((alias (symbol-function mode))) + (when (symbolp alias) alias)) + ,@(gethash mode yas--parents))))))))) + (dolist (parent all-parents) + (cl-pushnew mode (get parent 'yas--cached-children))) + (put mode 'yas--all-parents all-parents))))) (defun yas--modes-to-activate (&optional mode) "Compute list of mode symbols that are active for `yas-expand' and friends." (let* ((modes (delete-dups - (remq nil `(,(or mode major-mode) + (remq nil `(,@(unless mode yas--extra-modes) + ,(or mode major-mode) ;; FIXME: Alternative major modes should use ;; `derived-mode-add-parents', but until that ;; becomes common, use `major-mode-remap-alist' ;; as a crutch to supplement the mode hierarchy. ,(and (boundp 'major-mode-remap-alist) (car (rassq (or mode major-mode) - major-mode-remap-alist))) - ,@(unless mode (reverse yas--extra-modes))))))) + major-mode-remap-alist)))))))) (yas--merge-ordered-lists (mapcar #'yas--all-parents modes)))) @@ -1276,7 +1293,7 @@ Return TEMPLATE." (cl-assert menu-keymap) (yas--delete-from-keymap menu-keymap (yas--template-uuid template)) - ;; Add necessary subgroups as necessary. + ;; Add subgroups as necessary. ;; (dolist (subgroup group) (let ((subgroup-keymap (lookup-key menu-keymap (vector (make-symbol subgroup))))) @@ -1314,14 +1331,15 @@ string and TEMPLATE is a `yas--template' structure." ;;; Filtering/condition logic -(defun yas--eval-condition (condition) +(defun yas--funcall-condition (fun &rest args) (condition-case err (save-excursion (save-restriction (save-match-data - (eval condition t)))) + (apply fun args)))) (error (progn - (yas--message 1 "Error in condition evaluation: %s" (error-message-string err)) + (yas--message 1 "Error in condition evaluation: %s" + (error-message-string err)) nil)))) @@ -1346,9 +1364,13 @@ This function implements the rules described in conditions to filter out potential expansions." (if (eq 'always yas-buffer-local-condition) 'always - (let ((local-condition (or (and (consp yas-buffer-local-condition) - (yas--eval-condition yas-buffer-local-condition)) - yas-buffer-local-condition))) + (let ((local-condition + (or (cond + ((functionp yas-buffer-local-condition) + (yas--funcall-condition yas-buffer-local-condition)) + ((consp yas-buffer-local-condition) + (yas--funcall-condition #'eval yas-buffer-local-condition t))) + yas-buffer-local-condition))) (when local-condition (if (eq local-condition t) t @@ -1360,7 +1382,7 @@ conditions to filter out potential expansions." (defun yas--template-can-expand-p (condition requirement) "Evaluate CONDITION and REQUIREMENT and return a boolean." (let* ((result (or (null condition) - (yas--eval-condition condition)))) + (yas--funcall-condition #'eval condition t)))) (cond ((eq requirement t) result) (t @@ -1486,7 +1508,7 @@ Also tries to work around Emacs Bug#30931." (yas--safely-call-fun (apply-partially #'eval form))) (defun yas--read-lisp (string &optional nil-on-error) - "Read STRING as a elisp expression and return it. + "Read STRING as an Elisp expression and return it. In case STRING in an invalid expression and NIL-ON-ERROR is nil, return an expression that when evaluated will issue an error." @@ -1500,7 +1522,7 @@ return an expression that when evaluated will issue an error." (when (and keybinding (not (string-match "keybinding" keybinding))) (condition-case err - (let ((res (or (and (string-match "^\\[.*\\]$" keybinding) + (let ((res (or (and (string-match "\\`\\[.*\\]\\'" keybinding) (read keybinding)) (read-kbd-macro keybinding 'need-vector)))) res) @@ -1584,7 +1606,6 @@ Here's a list of currently recognized directives: (file-name-nondirectory file))) (key nil) template - bound condition (group (and file (yas--calculate-group file))) @@ -1592,31 +1613,27 @@ Here's a list of currently recognized directives: binding uuid) (if (re-search-forward "^# --\\s-*\n" nil t) - (progn (setq template - (buffer-substring-no-properties (point) - (point-max))) - (setq bound (point)) - (goto-char (point-min)) - (while (re-search-forward "^# *\\([^ ]+?\\) *: *\\(.*?\\)[[:space:]]*$" bound t) - (when (string= "uuid" (match-string-no-properties 1)) - (setq uuid (match-string-no-properties 2))) - (when (string= "type" (match-string-no-properties 1)) - (setq type (if (string= "command" (match-string-no-properties 2)) - 'command - 'snippet))) - (when (string= "key" (match-string-no-properties 1)) - (setq key (match-string-no-properties 2))) - (when (string= "name" (match-string-no-properties 1)) - (setq name (match-string-no-properties 2))) - (when (string= "condition" (match-string-no-properties 1)) - (setq condition (yas--read-lisp (match-string-no-properties 2)))) - (when (string= "group" (match-string-no-properties 1)) - (setq group (match-string-no-properties 2))) - (when (string= "expand-env" (match-string-no-properties 1)) - (setq expand-env (yas--read-lisp (match-string-no-properties 2) - 'nil-on-error))) - (when (string= "binding" (match-string-no-properties 1)) - (setq binding (match-string-no-properties 2))))) + (let ((bound (point))) + (setq template + (buffer-substring-no-properties (point) + (point-max))) + (goto-char (point-min)) + (while (re-search-forward + "^# *\\([^ ]+?\\) *: *\\(.*?\\)[[:space:]]*$" bound t) + (let ((val (match-string-no-properties 2))) + (pcase (match-string-no-properties 1) + ("uuid" (setq uuid val)) + ("type" (setq type (intern val))) + ("key" (setq key val)) + ("name" (setq name val)) + ("condition" (setq condition (yas--read-lisp val))) + ("group" (setq group val)) + ("expand-env" + (setq expand-env (yas--read-lisp val 'nil-on-error))) + ("binding" (setq binding val)) + ("contributor" nil) ;Documented in `snippet-development.org'. + (dir (message "Ignoring unknown directive %S in file: %s" + dir file)))))) (setq template (buffer-substring-no-properties (point-min) (point-max)))) (unless (or key binding) @@ -1811,14 +1828,6 @@ the current buffers contents." (if yas--creating-compiled-snippets (let ((print-length nil)) (insert ";;; Snippet definitions:\n;;;\n") - (dolist (snippet snippets) - ;; Fill in missing elements with nil. - (setq snippet (append snippet (make-list (- 10 (length snippet)) nil))) - ;; Move LOAD-FILE to SAVE-FILE because we will load from the - ;; compiled file, not LOAD-FILE. - (let ((load-file (nth 6 snippet))) - (setcar (nthcdr 6 snippet) nil) - (setcar (nthcdr 9 snippet) load-file))) (insert (pp-to-string `(yas-define-snippets ',mode ',snippets))) (insert "\n\n")) @@ -1854,6 +1863,9 @@ the current buffers contents." (defun yas--define-parents (mode parents) "Add PARENTS to the list of MODE's parents." + (dolist (child (get mode 'yas--cached-children)) + (put child 'yas--all-parents nil)) ;Flush the cache for children. + (put 'mode 'yas--cached-children nil) (puthash mode (cl-remove-duplicates (append parents (gethash mode yas--parents))) @@ -1923,7 +1935,8 @@ With prefix argument USE-JIT do jit-loading of snippets." (current-time-string))))) ;; Normal case. (unless (file-exists-p (expand-file-name ".yas-skip" directory)) - (unless (and (load (expand-file-name ".yas-compiled-snippets" directory) 'noerror (<= yas-verbosity 3)) + (unless (and (load (expand-file-name ".yas-compiled-snippets" directory) + 'noerror (<= yas-verbosity 3)) (progn (yas--message 4 "Loaded compiled snippets from %s" directory) t)) (yas--message 4 "Loading snippet files from %s" directory) (yas--load-directory-2 directory mode-sym))))) @@ -2072,7 +2085,7 @@ prefix argument." This works by stubbing a few functions, then calling `yas-load-directory'." - (interactive "DTop level snippet directory?") + (interactive "DTop level snippet directory? ") (let ((yas--creating-compiled-snippets t)) (yas-load-directory top-level-dir nil))) @@ -2923,7 +2936,8 @@ DEBUG is for debugging the YASnippet engine itself." (if (and condition original-buffer) (with-current-buffer original-buffer - (if (yas--eval-condition condition) + (if (yas--funcall-condition + #'eval condition t) "(y)" "(s)")) "(a)"))) @@ -3596,8 +3610,8 @@ If so cleans up the whole snippet up." (yas--commit-snippet snippet) (setq exited-snippets-p t)) ((and active-field - (or (not yas--active-field-overlay) - (not (overlay-buffer yas--active-field-overlay)))) + (not (and yas--active-field-overlay + (overlay-buffer yas--active-field-overlay)))) ;; ;; stacked expansion: this case is mainly for recent ;; snippet exits that place us back int the field of @@ -3711,7 +3725,7 @@ Otherwise deletes a character normally by calling `delete-char'." (t (call-interactively 'delete-char)))) (defun yas--skip-and-clear (field &optional from) - "Deletes the region of FIELD and sets it's modified state to t. + "Delete the region of FIELD and set its modified state to t. If given, FROM indicates position to start at instead of FIELD's beginning." ;; Just before skipping-and-clearing the field, mark its children ;; fields as modified, too. If the children have mirrors-in-fields @@ -3926,14 +3940,16 @@ Move the overlays, or create them if they do not exit." (overlay-put ov 'face 'yas--field-debug-face) (overlay-put ov 'yas--snippet snippet) ;; (overlay-put ov 'evaporate t) - (overlay-put ov 'modification-hooks '(yas--on-protection-overlay-modification))))))) + (overlay-put ov 'modification-hooks + '(yas--on-protection-overlay-modification))))))) -(defun yas--on-protection-overlay-modification (_overlay after? beg end &optional length) +(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 + (>= beg (overlay-end overlay)) ;Emacs=29.1 bug#65929 (yas--undo-in-progress)) (let ((snippets (yas-active-snippets))) (yas--message 2 "Committing snippets. Action would destroy a protection overlay.") @@ -3984,9 +4000,7 @@ for normal snippets, and a list for command snippets)." (run-hooks 'yas-before-expand-snippet-hook) (let* ((clear-field - (let ((field (and yas--active-field-overlay - (overlay-buffer yas--active-field-overlay) - (overlay-get yas--active-field-overlay 'yas--field)))) + (let ((field (yas-current-field))) (and field (yas--skip-and-clear-field-p field (point) (point) 0) field))) @@ -4033,9 +4047,7 @@ for normal snippets, and a list for command snippets)." ;; Stacked-expansion: This checks for stacked expansion, save the ;; `yas--previous-active-field' and advance its boundary. - (let ((existing-field (and yas--active-field-overlay - (overlay-buffer yas--active-field-overlay) - (overlay-get yas--active-field-overlay 'yas--field)))) + (let ((existing-field (yas-current-field))) (when existing-field (setf (yas--snippet-previous-active-field snippet) existing-field) (yas--advance-end-maybe-previous-fields @@ -4510,7 +4522,8 @@ The SNIPPET's markers are preserved." remarkers))) (unwind-protect (progn (back-to-indentation) - (indent-according-to-mode)) + (with-demoted-errors "%S" + (indent-according-to-mode))) (save-restriction (narrow-to-region bol (line-end-position)) (dolist (remarker remarkers) @@ -4953,6 +4966,7 @@ When multiple expressions are found, only the last one counts." ;; When not in an undo, check if we must commit the snippet ;; (user exited it). (yas--check-commit-snippet)))) + ;; FIXME: Why? ((debug error) (signal (car err) (cdr err))))) ;;; Fancy docs: -- cgit v1.3