scratch/derived-mode-add-parents 19445b6b7bb 1/6: subr.el: Provide a functional API around `derived-mode-parent`

[Stefan Monnier]

branch: scratch/derived-mode-add-parents
commit 19445b6b7bb04e44e39ef2e39a620bd3eadb0acd
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    subr.el: Provide a functional API around `derived-mode-parent`
    
    The `derived-mode-parent` property should be an implementation detail,
    so we can change it more easily.  To that end, add functions to set and
    query it.
    
    * lisp/subr.el (derived-mode-all-parents): New function.
    (provided-mode-derived-p): Use it.
    (derived-mode-set-parent): New function.
---
 lisp/subr.el | 31 +++++++++++++++++++++----------
 1 file changed, 21 insertions(+), 10 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index d4173b4daba..6a4c1abfb62 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2678,20 +2678,27 @@ The variable list SPEC is the same as in `if-let*'."
 
 ;; PUBLIC: find if the current mode derives from another.
 
+(defun derived-mode-all-parents (mode &optional known-children)
+  "Return all the parents of MODE, starting with MODE.
+The returned list is not fresh, don't modify it.
+\n(fn MODE)"               ;`known-children' is for internal use only.
+  (if (memq mode known-children)
+      (error "Cycle in the major mode hierarchy: %S" mode)
+    (push mode known-children))
+  (let* ((parent (or (get mode 'derived-mode-parent)
+                     ;; If MODE is an alias, then follow the alias.
+                     (let ((alias (symbol-function mode)))
+                       (and (symbolp alias) alias)))))
+    (cons mode (if parent (derived-mode-all-parents parent known-children)))))
+
 (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.
 If you just want to check `major-mode', use `derived-mode-p'."
   (declare (side-effect-free t))
-  (while
-      (and
-       (not (memq mode modes))
-       (let* ((parent (get mode 'derived-mode-parent)))
-        (setq mode (or parent
-                       ;; If MODE is an alias, then follow the alias.
-                       (let ((alias (symbol-function mode)))
-                         (and (symbolp alias) alias)))))))
-  mode)
+  (let ((ps (derived-mode-all-parents mode)))
+    (while (and ps (not (memq (car ps) modes)))
+      (setq ps (cdr ps)))
+    (car ps)))
 
 (defun derived-mode-p (&rest modes)
   "Non-nil if the current major mode is derived from one of MODES.
@@ -2699,6 +2706,10 @@ Uses the `derived-mode-parent' property of the symbol to 
trace backwards."
   (declare (side-effect-free t))
   (apply #'provided-mode-derived-p major-mode modes))
 
+(defun derived-mode-set-parent (mode parent)
+  "Declare PARENT to be the parent of MODE."
+  (put mode 'derived-mode-parent parent))
+
 (defvar-local major-mode--suspended nil)
 (put 'major-mode--suspended 'permanent-local t)