aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/subr.el51
1 files changed, 36 insertions, 15 deletions
diff --git a/lisp/subr.el b/lisp/subr.el
index 16f327ff699..b000787a5d6 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2688,22 +2688,37 @@ The returned list is not fresh, don't modify it.
2688 (if (memq mode known-children) 2688 (if (memq mode known-children)
2689 (error "Cycle in the major mode hierarchy: %S" mode) 2689 (error "Cycle in the major mode hierarchy: %S" mode)
2690 (push mode known-children)) 2690 (push mode known-children))
2691 (let* ((parent (or (get mode 'derived-mode-parent) 2691 ;; The mode hierarchy (or DAG, actually), is very static, but we
2692 ;; need to react to changes because `parent' may not be defined
2693 ;; yet (e.g. it's still just an autoload), so the recursive call
2694 ;; to `derived-mode-all-parents' may return an
2695 ;; invalid/incomplete result which we'll need to update when the
2696 ;; mode actually gets loaded.
2697 (let* ((all-parents
2698 (lambda (parent)
2699 ;; Can't use `cl-lib' here (nor `gv') :-(
2700 ;;(cl-assert (not (equal parent mode)))
2701 ;;(cl-pushnew mode (get parent 'derived-mode--followers))
2702 (let ((followers (get parent 'derived-mode--followers)))
2703 (unless (memq mode followers)
2704 (put parent 'derived-mode--followers
2705 (cons mode followers))))
2706 (derived-mode-all-parents parent known-children)))
2707 (parent (or (get mode 'derived-mode-parent)
2692 ;; If MODE is an alias, then follow the alias. 2708 ;; If MODE is an alias, then follow the alias.
2693 (let ((alias (symbol-function mode))) 2709 (let ((alias (symbol-function mode)))
2694 (and (symbolp alias) alias))))) 2710 (and (symbolp alias) alias))))
2711 (parents (cons mode (if parent (funcall all-parents parent))))
2712 (extras (get mode 'derived-mode-extra-parents)))
2695 (put mode 'derived-mode--all-parents 2713 (put mode 'derived-mode--all-parents
2696 (cons mode 2714 (if (null extras) ;; Common case.
2697 (when parent 2715 parents
2698 ;; Can't use `cl-lib' here (nor `gv') :-( 2716 (delete-dups
2699 ;;(cl-assert (not (equal parent mode))) 2717 (apply #'append
2700 ;;(cl-pushnew mode (get parent 'derived-mode--followers)) 2718 parents (mapcar (lambda (extra)
2701 (let ((followers (get parent 'derived-mode--followers))) 2719 (copy-sequence
2702 (unless (memq mode followers) 2720 (funcall all-parents extra)))
2703 (put parent 'derived-mode--followers 2721 extras)))))))))
2704 (cons mode followers))))
2705 (derived-mode-all-parents
2706 parent known-children))))))))
2707 2722
2708(defun provided-mode-derived-p (mode &rest modes) 2723(defun provided-mode-derived-p (mode &rest modes)
2709 "Non-nil if MODE is derived from one of MODES. 2724 "Non-nil if MODE is derived from one of MODES.
@@ -2715,8 +2730,7 @@ If you just want to check `major-mode', use `derived-mode-p'."
2715 (car ps))) 2730 (car ps)))
2716 2731
2717(defun derived-mode-p (&rest modes) 2732(defun derived-mode-p (&rest modes)
2718 "Non-nil if the current major mode is derived from one of MODES. 2733 "Non-nil if the current major mode is derived from one of MODES."
2719Uses the `derived-mode-parent' property of the symbol to trace backwards."
2720 (declare (side-effect-free t)) 2734 (declare (side-effect-free t))
2721 (apply #'provided-mode-derived-p major-mode modes)) 2735 (apply #'provided-mode-derived-p major-mode modes))
2722 2736
@@ -2725,6 +2739,13 @@ Uses the `derived-mode-parent' property of the symbol to trace backwards."
2725 (put mode 'derived-mode-parent parent) 2739 (put mode 'derived-mode-parent parent)
2726 (derived-mode--flush mode)) 2740 (derived-mode--flush mode))
2727 2741
2742(defun derived-mode-add-parents (mode extra-parents)
2743 "Add EXTRA-PARENTS to the parents of MODE.
2744Declares the parents of MODE to be its main parent (as defined
2745in `define-derived-mode') plus EXTRA-PARENTS."
2746 (put mode 'derived-mode-extra-parents extra-parents)
2747 (derived-mode--flush mode))
2748
2728(defun derived-mode--flush (mode) 2749(defun derived-mode--flush (mode)
2729 (put mode 'derived-mode--all-parents nil) 2750 (put mode 'derived-mode--all-parents nil)
2730 (let ((followers (get mode 'derived-mode--followers))) 2751 (let ((followers (get mode 'derived-mode--followers)))