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))
(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--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'
;; as ultimate ancestor.
'fundamental-mode)
,(let ((alias (symbol-function mode)))
(when (symbolp alias) alias))
,@(gethash mode yas--parents)))))))))))
(defun yas--modes-to-activate (&optional mode) (defun yas--modes-to-activate (&optional mode)
"Compute list of mode symbols that are active for `yas-expand' and friends." "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* ((modes
(let* ((explored (if mode (list mode) ; Building up list in reverse. (delete-dups
(cons major-mode (reverse yas--extra-modes)))) (remq nil `(,(or mode major-mode)
(yas--dfs ;; FIXME: Alternative major modes should use
(lambda (mode) ;; `derived-mode-add-parents', but until that
(cl-loop for neighbour ;; becomes common, use `major-mode-remap-alist'
;; FIXME: Use `derived-mode-all-parents'. ;; as a crutch to supplement the mode hierarchy.
in (cl-list* (or (get mode 'derived-mode-parent) ,(and (boundp 'major-mode-remap-alist)
;; Consider `fundamental-mode' (car (rassq (or mode major-mode)
;; as ultimate ancestor. major-mode-remap-alist)))
'fundamental-mode) ,@(unless mode (reverse yas--extra-modes)))))))
(symbol-function mode) (yas--merge-ordered-lists
(and (boundp 'major-mode-remap-alist) (mapcar #'yas--all-parents modes))))
(car (rassq mode
major-mode-remap-alist)))
(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)))
(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.")