diff options
| -rw-r--r-- | lisp/subr.el | 51 |
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." |
| 2719 | Uses 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. | ||
| 2744 | Declares the parents of MODE to be its main parent (as defined | ||
| 2745 | in `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))) |