From f39d7f2b5e92e085927918cf4f9da4ba8df8f366 Mon Sep 17 00:00:00 2001 From: Andrew Schwartzmeyer Date: Fri, 21 Sep 2018 00:10:47 -0700 Subject: [PATCH] Fix 'provided-mode-derived-p' when the parent is an alias Authors of Emacs packages often derive from an alias of a mode instead of the mode directly. This is especially the case when deriving from 'prog-mode' as it is relatively new. Unfortunately, using 'derived-mode-p' to check if some mode is derived from an alias of 'prog-mode' does not work as expected. The bug is that 'provided-mode-derived-p' should not only return non-nil when MODE is one of MODES, but also when MODE is an alias of one of MODES. * lisp/subr.el (provided-mode-derived-p): Return non-nil when MODE is an alias of any of MODES (Bug#32795). * test/lisp/subr-tests.el: Add tests for the above. --- lisp/subr.el | 9 +++++++-- test/lisp/subr-tests.el | 12 ++++++++++++ 2 files changed, 19 insertions(+), 2 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index 7582b6cdb..6c625b40d 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1919,9 +1919,14 @@ delay-mode-hooks (defun provided-mode-derived-p (mode &rest modes) "Non-nil if MODE is derived from one of MODES. Uses the `derived-mode-parent' property of the symbol to trace backwards. +Non-nil even if MODE is derived from an alias of any of MODES. If you just want to check `major-mode', use `derived-mode-p'." - (while (and (not (memq mode modes)) - (setq mode (get mode 'derived-mode-parent)))) + (while + (and + (not (memq mode modes)) + (let* ((parent (get mode 'derived-mode-parent)) + (parentfn (symbol-function parent))) + (setq mode (if (and parentfn (symbolp parentfn)) parentfn parent))))) mode) (defun derived-mode-p (&rest modes) diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 430d71903..a9f72c26d 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -62,6 +62,18 @@ (quote (0 font-lock-keyword-face)))))))) +(ert-deftest provided-mode-derived-p () + ;; base case: `derived-mode' directly derives `prog-mode' + (should (progn + (define-derived-mode derived-mode prog-mode "test") + (provided-mode-derived-p 'derived-mode 'prog-mode))) + ;; edge case: `derived-mode' derives an alias of `prog-mode' + (should (progn + (defalias 'parent-mode + (if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode)) + (define-derived-mode derived-mode parent-mode "test") + (provided-mode-derived-p 'derived-mode 'prog-mode)))) + (ert-deftest number-sequence-test () (should (= (length (number-sequence (1- most-positive-fixnum) most-positive-fixnum)) -- 2.19.0