daniel/emacs
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

update packages

Browse Source
This commit is contained in:
Daniel Weschke
2025-03-11 21:14:26 +01:00
parent 45d49daef0
commit 14dcaaddde
440 changed files with 13229 additions and 8718 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
lisp/yasnippet/yasnippet-pkg.el
View File

@@ -1,7 +1,7 @@
(define-package "yasnippet" "20230914.1400" "Yet another snippet extension for Emacs"
(define-package "yasnippet" "20250112.1504" "Yet another snippet extension for Emacs"
'((cl-lib "0.5")
(emacs "24.4"))
:commit "52a1c5031912243c791c55e0fe345d04f219b507" :maintainers
:commit "03b1b11547eab76851574eadd18e2ad186b2a080" :maintainers
'(("Noam Postavsky" . "npostavs@gmail.com"))
:maintainer
'("Noam Postavsky" . "npostavs@gmail.com")

578
lisp/yasnippet/yasnippet.el
View File

@@ -1,11 +1,11 @@
;;; yasnippet.el --- Yet another snippet extension for Emacs -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2023 Free Software Foundation, Inc.
;; Copyright (C) 2008-2025 Free Software Foundation, Inc.
;; Authors: pluskid <pluskid@gmail.com>,
;; João Távora <joaotavora@gmail.com>,
;; Noam Postavsky <npostavs@gmail.com>
;; Maintainer: Noam Postavsky <npostavs@gmail.com>
;; Version: 0.14.0
;; Version: 0.14.1
;; X-URL: http://github.com/joaotavora/yasnippet
;; Keywords: convenience, emulation
;; URL: http://github.com/joaotavora/yasnippet
@@ -132,8 +132,7 @@
;;; Code:
(require 'cl-lib)
(require 'eldoc) ; Needed for 24.
(declare-function cl-progv-after "cl-extra") ; Needed for 23.4.
(require 'eldoc) ; Needed for Emacs<25.
(require 'easymenu)
(require 'help-mode)
@@ -342,8 +341,8 @@ If non-nil insert region contents. This can be overridden on a
per-snippet basis. A value of `cua' is considered equivalent to
`?0' for backwards compatibility."
:type '(choice (character :tag "Insert from register")
(const t :tag "Insert region contents")
(const nil :tag "Don't insert anything")
(const :tag "Insert region contents" t)
(const :tag "Don't insert anything" nil)
(const cua))) ; backwards compat
(defcustom yas-good-grace t
@@ -422,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))
@@ -490,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.
@@ -539,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"
@@ -555,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
@@ -649,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)
@@ -763,7 +772,7 @@ expanded.")
:help "Display some information about YASnippet"]))
(define-obsolete-variable-alias 'yas-extra-modes 'yas--extra-modes "0.9.1")
(defvar yas--extra-modes nil
(defvar yas--extra-modes nil ;FIXME: Use `defvar-local'?
"An internal list of modes for which to also lookup snippets.
This variable probably makes more sense as buffer-local, so
@@ -773,7 +782,7 @@ ensure your use `make-local-variable' when you set it.")
"A hash table of mode symbols to `yas--table' objects.")
(defvar yas--parents (make-hash-table)
"A hash table of mode symbols do lists of direct parent mode symbols.
"A hash table of mode symbols to lists of direct parent mode symbols.
This list is populated when reading the \".yas-parents\" files
found when traversing snippet directories with
@@ -805,29 +814,72 @@ which decides on the snippet to expand.")
yas--direct-keymaps))
yas--tables))
(defalias 'yas--merge-ordered-lists
(if (fboundp 'merge-ordered-lists) ;Emacs≥30.
#'merge-ordered-lists
(lambda (lists)
(setq lists (delq nil lists))
(if (null (cdr lists)) (car lists) ;Common case.
(delete-dups (apply #'append
;; Prevent sharing the tail.
(append lists '(()) )))))))
(defun yas--flush-all-parents (mode)
(if (get mode 'yas--all-parents)
(put mode 'yas--all-parents nil)))
(defun yas--all-parents (mode)
"Like `derived-mode-all-parents' but obeying `yas--parents'."
(or (get mode 'yas--all-parents) ;; FIXME: Use `with-memoization'?
(progn
(put mode 'yas--all-parents (list mode)) ;; Stop inf-loop with cycles.
(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))))
(delete-dups
(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))
,@(get mode 'derived-mode-extra-parents)
,@(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."
(defvar yas--dfs) ;We rely on dynbind. We could use `letrec' instead!
(let* ((explored (if mode (list mode) ; Building up list in reverse.
(cons major-mode (reverse yas--extra-modes))))
(yas--dfs
(lambda (mode)
(cl-loop for neighbour
in (cl-list* (or (get mode 'derived-mode-parent)
;; Consider `fundamental-mode'
;; as ultimate ancestor.
'fundamental-mode)
;; NOTE: `fboundp' check is redundant
;; since Emacs 24.4.
(and (fboundp mode) (symbol-function mode))
(gethash mode yas--parents))
when (and neighbour
(not (memq neighbour explored))
(symbolp neighbour))
do (push neighbour explored)
(funcall yas--dfs neighbour)))))
(mapc yas--dfs explored)
(nreverse explored)))
(let* ((modes
(delete-dups
(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))))))))
(yas--merge-ordered-lists
(mapcar #'yas--all-parents modes))))
(defvar yas-minor-mode-hook nil
"Hook run when `yas-minor-mode' is turned on.")
@@ -889,13 +941,8 @@ Key bindings:
The function can be called in the hook of a minor mode to
activate snippets associated with that mode."
(interactive
(let (modes
symbol)
(maphash (lambda (k _)
(setq modes (cons (list k) modes)))
yas--parents)
(setq symbol (completing-read
"Activate mode: " modes nil t))
(let ((symbol (completing-read
"Activate mode: " yas--parents nil t)))
(list
(when (not (string= "" symbol))
(intern symbol)))))
@@ -909,9 +956,8 @@ activate snippets associated with that mode."
(list (intern
(completing-read
"Deactivate mode: " (mapcar #'list yas--extra-modes) nil t))))
(set (make-local-variable 'yas--extra-modes)
(remove mode
yas--extra-modes)))
(setq-local yas--extra-modes
(remove mode yas--extra-modes)))
(defun yas-temp-buffer-p (&optional buffer)
(eq (aref (buffer-name buffer) 0) ?\s))
@@ -923,20 +969,10 @@ activate snippets associated with that mode."
Functions are called with no argument, and should return non-nil to prevent
`yas-global-mode' from enabling yasnippet in this buffer.
In Emacsen < 24, this variable is buffer-local. Because
`yas-minor-mode-on' is called by `yas-global-mode' after
executing the buffer's major mode hook, setting this variable
there is an effective way to define exceptions to the \"global\"
activation behaviour.
In Emacsen >= 24, only the global value is used. To define
Only the global value is used. To define
per-mode exceptions to the \"global\" activation behaviour, call
`yas-minor-mode' with a negative argument directily in the major
mode's hook.")
(unless (> emacs-major-version 23)
(with-no-warnings
(make-variable-buffer-local 'yas-dont-activate)))
mode's hook.") ;; FIXME: Why do we say "Only the global value is used"?
(defun yas-minor-mode-on ()
"Turn on YASnippet minor mode.
@@ -964,7 +1000,7 @@ Honour `yas-dont-activate-functions', which see."
;;; Major mode stuff
(defvar yas--font-lock-keywords
(append '(("^#.*$" . font-lock-comment-face))
(append '(("^#.*$" (0 'font-lock-comment-face)))
(with-temp-buffer
(let ((prog-mode-hook nil)
(emacs-lisp-mode-hook nil))
@@ -975,14 +1011,14 @@ Honour `yas-dont-activate-functions', which see."
(cadr font-lock-keywords)
font-lock-keywords))
'(("\\$\\([0-9]+\\)"
(0 font-lock-keyword-face)
(1 font-lock-string-face t))
(0 'font-lock-keyword-face)
(1 'font-lock-string-face t))
("\\${\\([0-9]+\\):?"
(0 font-lock-keyword-face)
(1 font-lock-warning-face t))
("\\(\\$(\\)" 1 font-lock-preprocessor-face)
(0 'font-lock-keyword-face)
(1 'font-lock-warning-face t))
("\\(\\$(\\)" 1 'font-lock-preprocessor-face)
("}"
(0 font-lock-keyword-face)))))
(0 'font-lock-keyword-face)))))
(defvar snippet-mode-map
(let ((map (make-sparse-keymap)))
@@ -1003,23 +1039,13 @@ Honour `yas-dont-activate-functions', which see."
;;;###autoload(autoload 'snippet-mode "yasnippet" "A mode for editing yasnippets" t nil)
(eval-and-compile
(if (fboundp 'prog-mode)
;; `prog-mode' is new in 24.1.
(define-derived-mode snippet-mode prog-mode "Snippet"
"A mode for editing yasnippets"
(setq font-lock-defaults '(yas--font-lock-keywords))
(set (make-local-variable 'require-final-newline) nil)
(set (make-local-variable 'comment-start) "#")
(set (make-local-variable 'comment-start-skip) "#+[\t ]*")
(add-hook 'after-save-hook #'yas-maybe-load-snippet-buffer nil t))
(define-derived-mode snippet-mode fundamental-mode "Snippet"
"A mode for editing yasnippets"
(setq font-lock-defaults '(yas--font-lock-keywords))
(set (make-local-variable 'require-final-newline) nil)
(set (make-local-variable 'comment-start) "#")
(set (make-local-variable 'comment-start-skip) "#+[\t ]*")
(add-hook 'after-save-hook #'yas-maybe-load-snippet-buffer nil t))))
(define-derived-mode snippet-mode prog-mode "Snippet"
"A mode for editing yasnippets"
(setq font-lock-defaults '(yas--font-lock-keywords))
(setq-local require-final-newline nil)
(setq-local comment-start "#")
(setq-local comment-start-skip "#+[\t ]*")
(add-hook 'after-save-hook #'yas-maybe-load-snippet-buffer nil t))
(defun yas-snippet-mode-buffer-p ()
"Return non-nil if current buffer should be in `snippet-mode'.
@@ -1273,7 +1299,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)))))
@@ -1311,14 +1337,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))))
@@ -1343,9 +1370,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
@@ -1357,7 +1388,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
@@ -1483,7 +1514,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."
@@ -1497,7 +1528,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)
@@ -1581,7 +1612,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)))
@@ -1589,31 +1619,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)
@@ -1721,12 +1747,10 @@ Optional PROMPT sets the prompt to use."
(redisplay)
(or
(x-popup-menu
(if (fboundp 'posn-at-point)
(let ((x-y (posn-x-y (posn-at-point (point)))))
(list (list (+ (car x-y) 10)
(+ (cdr x-y) 20))
(selected-window)))
t)
(let ((x-y (posn-x-y (posn-at-point (point)))))
(list (list (+ (car x-y) 10)
(+ (cdr x-y) 20))
(selected-window)))
`(,prompt ("title"
,@(cl-mapcar (lambda (c d) `(,(concat " " d) . ,c))
choices
@@ -1810,23 +1834,22 @@ 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"))
;; Normal case.
(let ((snippet-table (yas--table-get-create mode))
(uuids nil)
(template nil))
(dolist (snippet snippets)
(setq template (yas--define-snippets-1 snippet
snippet-table)))
snippet-table))
(let ((uuid (yas--template-uuid template)))
(if (member uuid uuids)
;; It's normal for a snippet to override another one
;; in `snippet-table`, but not one in `snippets`.
(message "Multiple snippets with same identity: %S" uuid)
(push uuid uuids))))
template)))
@@ -1853,6 +1876,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)))
@@ -1922,7 +1948,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)))))
@@ -1988,6 +2015,9 @@ prefix argument."
(with-current-buffer buffer
yas--editing-template))
(buffer-list))))
(mapatoms #'yas--flush-all-parents)
;; Warn if there are buffers visiting snippets, since reloading will break
;; any on-line editing of those buffers.
;;
@@ -2071,7 +2101,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)))
@@ -2100,6 +2130,9 @@ This works by stubbing a few functions, then calling
(or (ignore-errors (car (let ((default-directory yas--loaddir))
(process-lines "git" "describe"
"--tags" "--dirty"))))
(eval-when-compile
(and (fboundp 'package-get-version)
(package-get-version)))
(when (and (featurep 'package)
(fboundp 'package-desc-version)
(fboundp 'package-version-join))
@@ -2549,7 +2582,7 @@ visited file in `snippet-mode'."
(cond ((and file (file-readable-p file))
(find-file-other-window file)
(snippet-mode)
(set (make-local-variable 'yas--editing-template) template))
(setq-local yas--editing-template template))
(file
(message "Original file %s no longer exists!" file))
(t
@@ -2571,9 +2604,10 @@ visited file in `snippet-mode'."
(pp-to-string (yas--template-content template))
(yas--template-content template))))
(snippet-mode)
(set (make-local-variable 'yas--editing-template) template)
(set (make-local-variable 'default-directory)
(car (cdr (car (yas--guess-snippet-directories (yas--template-table template))))))))))
(setq-local yas--editing-template template)
(setq-local default-directory
(car (cdr (car (yas--guess-snippet-directories
(yas--template-table template))))))))))
(defun yas--guess-snippet-directories-1 (table)
"Guess possible snippet subdirectories for TABLE."
@@ -2649,11 +2683,11 @@ NO-TEMPLATE is non-nil."
(kill-all-local-variables)
(snippet-mode)
(yas-minor-mode 1)
(set (make-local-variable 'yas--guessed-modes)
(mapcar (lambda (d) (yas--table-mode (car d)))
guessed-directories))
(set (make-local-variable 'default-directory)
(car (cdr (car guessed-directories))))
(setq-local yas--guessed-modes
(mapcar (lambda (d) (yas--table-mode (car d)))
guessed-directories))
(setq-local default-directory
(car (cdr (car guessed-directories))))
(if (and (not no-template) yas-new-snippet-default)
(yas-expand-snippet yas-new-snippet-default))))
@@ -2703,8 +2737,8 @@ neither do the elements of PARENTS."
ido-mode)
'ido-completing-read 'completing-read)))
(unless yas--guessed-modes
(set (make-local-variable 'yas--guessed-modes)
(or (yas--compute-major-mode-and-parents buffer-file-name))))
(setq-local yas--guessed-modes
(yas--compute-major-mode-and-parents buffer-file-name)))
(intern
(funcall prompt (format "Choose or enter a table (yas guesses %s): "
(if yas--guessed-modes
@@ -2736,11 +2770,12 @@ Return the `yas--template' object created"
;;
(t
(unless yas--guessed-modes
(set (make-local-variable 'yas--guessed-modes) (or (yas--compute-major-mode-and-parents buffer-file-name))))
(setq-local yas--guessed-modes
(or (yas--compute-major-mode-and-parents buffer-file-name))))
(let* ((table (yas--table-get-create table)))
(set (make-local-variable 'yas--editing-template)
(yas--define-snippets-1 (yas--parse-template buffer-file-name)
table)))))
(setq-local yas--editing-template
(yas--define-snippets-1 (yas--parse-template buffer-file-name)
table)))))
(when interactive
(yas--message 3 "Snippet \"%s\" loaded for %s."
(yas--template-name yas--editing-template)
@@ -2749,18 +2784,20 @@ Return the `yas--template' object created"
(defun yas-maybe-load-snippet-buffer ()
"Added to `after-save-hook' in `snippet-mode'."
(let* ((mode (intern (file-name-sans-extension
(file-name-nondirectory
(directory-file-name default-directory)))))
(current-snippet
(apply #'yas--define-snippets-2 (yas--table-get-create mode)
(yas--parse-template buffer-file-name)))
(uuid (yas--template-uuid current-snippet)))
(unless (equal current-snippet
(if uuid (yas--get-template-by-uuid mode uuid)
(yas--lookup-snippet-1
(yas--template-name current-snippet) mode)))
(yas-load-snippet-buffer mode t))))
(save-excursion ;; Issue #1146. Here or in `yas--parse-template`?
(let* ((mode (intern (file-name-sans-extension
(file-name-nondirectory
(directory-file-name default-directory)))))
(current-snippet
(apply #'yas--define-snippets-2 (yas--table-get-create mode)
;; FIXME: `yas-load-snippet-buffer' will *re*parse!
(yas--parse-template buffer-file-name)))
(uuid (yas--template-uuid current-snippet)))
(unless (equal current-snippet
(if uuid (yas--get-template-by-uuid mode uuid)
(yas--lookup-snippet-1
(yas--template-name current-snippet) mode)))
(yas-load-snippet-buffer mode t)))))
(defun yas-load-snippet-buffer-and-close (table &optional kill)
"Load and save the snippet, then `quit-window' if saved.
@@ -2917,7 +2954,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)")))
@@ -3097,14 +3135,13 @@ other fields."
;;; Snippet expansion and field management
(defvar yas--active-field-overlay nil
(defvar-local yas--active-field-overlay nil
"Overlays the currently active field.")
(defvar yas--active-snippets nil
(defvar-local yas--active-snippets nil
"List of currently active snippets")
(make-variable-buffer-local 'yas--active-snippets)
(defvar yas--field-protection-overlays nil
(defvar-local yas--field-protection-overlays nil
"Two overlays protect the current active field.")
(defvar yas-selected-text nil
@@ -3113,8 +3150,6 @@ other fields."
(defvar yas--start-column nil
"The column where the snippet expansion started.")
(make-variable-buffer-local 'yas--active-field-overlay)
(make-variable-buffer-local 'yas--field-protection-overlays)
(put 'yas--active-field-overlay 'permanent-local t)
(put 'yas--field-protection-overlays 'permanent-local t)
@@ -3494,8 +3529,7 @@ This renders the snippet as ordinary text."
(yas--message 4 "Snippet %s exited." (yas--snippet-id snippet)))
(defvar yas--snippets-to-move nil)
(make-variable-buffer-local 'yas--snippets-to-move)
(defvar-local yas--snippets-to-move nil)
(defun yas--prepare-snippets-for-move (beg end buf pos)
"Gather snippets in BEG..END for moving to POS in BUF."
@@ -3594,8 +3628,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
@@ -3709,7 +3743,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
@@ -3762,13 +3796,10 @@ BEG, END and LENGTH like overlay modification hooks."
(defun yas--merge-and-drop-dups (list1 list2 cmp key)
;; `delete-consecutive-dups' + `cl-merge'.
(funcall (if (fboundp 'delete-consecutive-dups)
#'delete-consecutive-dups ; 24.4
#'delete-dups)
(cl-merge 'list list1 list2 cmp :key key)))
(delete-consecutive-dups
(cl-merge 'list list1 list2 cmp :key key)))
(defvar yas--before-change-modified-snippets nil)
(make-variable-buffer-local 'yas--before-change-modified-snippets)
(defvar-local yas--before-change-modified-snippets nil)
(defun yas--gather-active-snippets (overlay beg end then-delete)
;; Add active snippets in BEG..END into an OVERLAY keyed entry of
@@ -3793,8 +3824,7 @@ BEG, END and LENGTH like overlay modification hooks."
(when then-delete
(cl-callf2 delq old yas--before-change-modified-snippets)))))
(defvar yas--todo-snippet-indent nil nil)
(make-variable-buffer-local 'yas--todo-snippet-indent)
(defvar-local yas--todo-snippet-indent nil nil)
(defun yas--on-field-overlay-modification (overlay after? beg end &optional length)
"Clears the field and updates mirrors, conditionally.
@@ -3928,14 +3958,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.")
@@ -3980,15 +4012,13 @@ SNIPPET may be a snippet structure (e.g., as returned by
`yas-lookup-snippet'), or just a snippet body (which is a string
for normal snippets, and a list for command snippets)."
(cl-assert (and yas-minor-mode
(memq 'yas--post-command-handler post-command-hook))
(memq #'yas--post-command-handler post-command-hook))
nil
"[yas] `yas-expand-snippet' needs properly setup `yas-minor-mode'")
(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)))
@@ -4035,9 +4065,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
@@ -4102,30 +4130,40 @@ Returns the newly created snippet."
(yas--letenv expand-env
;; Put a single undo action for the expanded snippet's
;; content.
(let ((buffer-undo-list t))
(goto-char begin)
;; Call before and after change functions manually,
;; otherwise cc-mode's cache can get messed up. Don't use
;; `inhibit-modification-hooks' for that, that blocks
;; overlay and text property hooks as well! FIXME: Maybe
;; use `combine-change-calls'? (Requires Emacs 27+ though.)
(run-hook-with-args 'before-change-functions begin end)
(let ((before-change-functions nil)
(after-change-functions nil))
;; Some versions of cc-mode (might be the one with Emacs
;; 24.3 only) fail when inserting snippet content in a
;; narrowed buffer, so make sure to insert before
;; narrowing.
(insert content)
(narrow-to-region begin (point))
(goto-char (point-min))
(yas--snippet-parse-create snippet))
(run-hook-with-args 'after-change-functions
(point-min) (point-max)
(- end begin)))
(when (listp buffer-undo-list)
(push (cons (point-min) (point-max))
buffer-undo-list))
(unwind-protect
(let ((buffer-undo-list t))
(goto-char begin)
(if (> emacs-major-version 29)
;; Don't use the workaround for CC-mode's cache,
;; since it was presumably a bug in CC-mode, so either
;; it's fixed already, or it should get fixed.
(progn
(insert content)
(narrow-to-region begin (point))
(goto-char (point-min))
(yas--snippet-parse-create snippet))
;; Call before and after change functions manually,
;; otherwise cc-mode's cache can get messed up. Don't use
;; `inhibit-modification-hooks' for that, that blocks
;; overlay and text property hooks as well! FIXME: Maybe
;; use `combine-change-calls'? (Requires Emacs 27+ though.)
(run-hook-with-args 'before-change-functions begin end)
(let ((before-change-functions nil)
(after-change-functions nil))
;; Some versions of cc-mode (might be the one with Emacs
;; 24.3 only) fail when inserting snippet content in a
;; narrowed buffer, so make sure to insert before
;; narrowing.
(insert content)
(narrow-to-region begin (point))
(goto-char (point-min))
(yas--snippet-parse-create snippet))
(run-hook-with-args 'after-change-functions
(point-min) (point-max)
(- end begin))))
(when (listp buffer-undo-list)
(push (cons (point-min) (point-max))
buffer-undo-list)))
;; Indent, collecting undo information normally.
(yas--indent snippet)
@@ -4503,7 +4541,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)
@@ -4695,20 +4734,22 @@ When multiple expressions are found, only the last one counts."
(point)))
(number (and (match-string-no-properties 1)
(string-to-number (match-string-no-properties 1))))
(brand-new-field (and real-match-end-0
;; break if on "$(" immediately
;; after the ":", this will be
;; caught as a mirror with
;; transform later.
(not (string-match-p "\\`\\$[ \t\n]*("
(match-string-no-properties 2)))
;; allow ${0: some exit text}
;; (not (and number (zerop number)))
(yas--make-field number
(yas--make-marker (match-beginning 2))
(yas--make-marker (1- real-match-end-0))
parent-field))))
(when brand-new-field
(field2 (match-string-no-properties 2))
(simple-fom (string-match-p "\\`[0-9]+\\'" field2))
(brand-new-field
(and ;; break if on "$(" immediately after the ":", this
;; will be caught as a mirror with transform later.
(not (string-match-p "\\`\\$[ \t\n]*(" field2))
;; allow ${0: some exit text}
;; (not (and number (zerop number)))
(yas--make-field number
(yas--make-marker (match-beginning 2))
(yas--make-marker (1- real-match-end-0))
parent-field))))
(cond
((and (not number) simple-fom)
(yas--one-simple-fom snippet field2))
(brand-new-field
(goto-char real-match-end-0)
(push (cons (1- real-match-end-0) real-match-end-0)
yas--dollar-regions)
@@ -4717,9 +4758,11 @@ When multiple expressions are found, only the last one counts."
(push brand-new-field (yas--snippet-fields snippet))
(save-excursion
(save-restriction
(narrow-to-region (yas--field-start brand-new-field) (yas--field-end brand-new-field))
(narrow-to-region (yas--field-start brand-new-field)
(yas--field-end brand-new-field))
(goto-char (point-min))
(yas--field-parse-create snippet brand-new-field)))))))
(yas--field-parse-create snippet brand-new-field))))))))
;; if we entered from a parent field, now search for the
;; `yas--multi-dollar-lisp-expression-regexp'. This is used for
;; primary field transformations
@@ -4776,31 +4819,35 @@ When multiple expressions are found, only the last one counts."
(defun yas--simple-fom-create (snippet)
"Parse the simple \"$n\" fields/mirrors/exitmarkers in SNIPPET."
(while (re-search-forward yas--simple-mirror-regexp nil t)
(let ((number (string-to-number (match-string-no-properties 1))))
(cond ((zerop number)
(setf (yas--snippet-exit snippet)
(yas--make-exit (yas--make-marker (match-end 0))))
(push (cons (match-beginning 0) (yas--exit-marker (yas--snippet-exit snippet)))
yas--dollar-regions))
(t
(let ((field (yas--snippet-find-field snippet number))
(fom))
(if field
(push
(setq fom (yas--make-mirror
(yas--make-marker (match-beginning 0))
(yas--make-marker (match-beginning 0))
nil))
(yas--field-mirrors field))
(yas--one-simple-fom snippet (match-string-no-properties 1))))
(defun yas--one-simple-fom (snippet numstring)
(let ((number (string-to-number numstring)))
(cond ((zerop number)
(setf (yas--snippet-exit snippet)
(yas--make-exit (yas--make-marker (match-end 0))))
(push (cons (match-beginning 0)
(yas--exit-marker (yas--snippet-exit snippet)))
yas--dollar-regions))
(t
(let ((field (yas--snippet-find-field snippet number))
(fom))
(if field
(push
(setq fom (yas--make-field number
(yas--make-marker (match-beginning 0))
(yas--make-marker (match-beginning 0))
nil))
(yas--snippet-fields snippet)))
(yas--calculate-simple-fom-parentage snippet fom))
(push (cons (match-beginning 0) (match-end 0))
yas--dollar-regions))))))
(setq fom (yas--make-mirror
(yas--make-marker (match-beginning 0))
(yas--make-marker (match-beginning 0))
nil))
(yas--field-mirrors field))
(push
(setq fom (yas--make-field number
(yas--make-marker (match-beginning 0))
(yas--make-marker (match-beginning 0))
nil))
(yas--snippet-fields snippet)))
(yas--calculate-simple-fom-parentage snippet fom))
(push (cons (match-beginning 0) (match-end 0))
yas--dollar-regions)))))
(defun yas--delete-regions (regions)
"Sort disjuct REGIONS by start point, then delete from the back."
@@ -4946,6 +4993,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: