yasnippet.el: Use derived-mode-all-parents when available

This allows YASnippet to obey `derived-mode-add-parents`, which should
become the standard way to indicate "loose" relationships (such as
the fact that `js3-mode` is related to `js-mode` or for TS modes).

* yasnippet.el (yas--merge-ordered-lists, yas--all-parents): New functions.
(yas--modes-to-activate): Use them.
This commit is contained in:
Stefan Monnier 2024-01-04 15:13:51 -05:00
parent bd2fdc8f7d
commit ae36504a5f

View File

@ -132,8 +132,7 @@
;;; Code: ;;; Code:
(require 'cl-lib) (require 'cl-lib)
(require 'eldoc) ; Needed for 24. (require 'eldoc) ; Needed for Emacs<25.
(declare-function cl-progv-after "cl-extra") ; Needed for 23.4.
(require 'easymenu) (require 'easymenu)
(require 'help-mode) (require 'help-mode)
@ -773,7 +772,7 @@ ensure your use `make-local-variable' when you set it.")
"A hash table of mode symbols to `yas--table' objects.") "A hash table of mode symbols to `yas--table' objects.")
(defvar yas--parents (make-hash-table) (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 This list is populated when reading the \".yas-parents\" files
found when traversing snippet directories with found when traversing snippet directories with
@ -805,31 +804,59 @@ which decides on the snippet to expand.")
yas--direct-keymaps)) yas--direct-keymaps))
yas--tables)) yas--tables))
(defun yas--modes-to-activate (&optional mode) (defalias 'yas--merge-ordered-lists
"Compute list of mode symbols that are active for `yas-expand' and friends." (if (fboundp 'merge-ordered-lists) ;Emacs≥30.
(defvar yas--dfs) ;We rely on dynbind. We could use `letrec' instead! #'merge-ordered-lists
(let* ((explored (if mode (list mode) ; Building up list in reverse. (lambda (lists)
(cons major-mode (reverse yas--extra-modes)))) (setq lists (delq nil lists))
(yas--dfs (if (null (cdr lists)) (car lists) ;Common case.
(lambda (mode) (delete-dups (apply #'append
(cl-loop for neighbour ;; Prevent sharing the tail.
;; FIXME: Use `derived-mode-all-parents'. (append lists '(()) )))))))
in (cl-list* (or (get mode 'derived-mode-parent)
(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.
(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' ;; Consider `fundamental-mode'
;; as ultimate ancestor. ;; as ultimate ancestor.
'fundamental-mode) 'fundamental-mode)
(symbol-function mode) ,(let ((alias (symbol-function mode)))
(and (boundp 'major-mode-remap-alist) (when (symbolp alias) alias))
(car (rassq mode ,@(gethash mode yas--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)
;; 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))) major-mode-remap-alist)))
(gethash mode yas--parents)) ,@(unless mode (reverse yas--extra-modes)))))))
when (and neighbour (yas--merge-ordered-lists
(not (memq neighbour explored)) (mapcar #'yas--all-parents modes))))
(symbolp neighbour))
do (push neighbour explored)
(funcall yas--dfs neighbour)))))
(mapc yas--dfs explored)
(nreverse explored)))
(defvar yas-minor-mode-hook nil (defvar yas-minor-mode-hook nil
"Hook run when `yas-minor-mode' is turned on.") "Hook run when `yas-minor-mode' is turned on.")