scratch/derived-mode-add-parents 8323394bc80 5/6: Use `derived-mode-add-parents` in remaining uses of `derived-mode-parent`

[Stefan Monnier]

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

    Use `derived-mode-add-parents` in remaining uses of `derived-mode-parent`
    
    Until now multiple inheritance wasn't really used, but some ad-hoc
    code went a bit beyond the normal uses of the mode hierarchy.
    Use the new multiple inheritance code to replace that ad-hoc code,
    thereby eliminating basically all remaining direct uses of the
    `derived-mode-parent` property.
    
    CEDET had its own notion of mode hierrchy using `derived-mode-parent`
    as well as its own `mode-local-parent` property set via
    `define-child-mode`.
    `derived-mode-add-parents` lets us reimplement `define-child-mode`
    such that CEDET can now use the normal API functions.
    
    * lisp/locate.el (locate-mode): Use `derived-mode-add-parents`.
    
    * lisp/cedet/mode-local.el (get-mode-local-parent): Declare obsolete.
    (mode-local-equivalent-mode-p, mode-local-use-bindings-p): Make them
    obsolete aliases.
    (mode-local--set-parent): Rewrite to use `derived-mode-add-parents`.
    Declare as obsolete.
    (mode-local-map-mode-buffers): Use `derived-mode-p`.
    (mode-local-symbol, mode-local--activate-bindings)
    (mode-local--deactivate-bindings, mode-local-describe-bindings-2):
    Use `derived-mode-all-parents`.
    
    * lisp/cedet/srecode/table.el (srecode-get-mode-table):
    * lisp/cedet/srecode/find.el (srecode-table, srecode-load-tables-for-mode)
    (srecode-all-template-hash): Use `derived-mode-all-parents`.
    
    * lisp/cedet/srecode/map.el (srecode-map-entries-for-mode):
    * lisp/cedet/semantic/db.el (semanticdb-equivalent-mode):
    Use `provided-mode-derived-p` now that it obeys `define-child-mode`.
---
 lisp/cedet/mode-local.el       | 65 ++++++++++++++----------------------------
 lisp/cedet/semantic/db.el      |  2 +-
 lisp/cedet/semantic/grammar.el |  2 +-
 lisp/cedet/semantic/lex-spp.el |  6 ++--
 lisp/cedet/srecode/find.el     | 64 +++++++++++++++++------------------------
 lisp/cedet/srecode/map.el      |  2 +-
 lisp/cedet/srecode/table.el    | 51 +++++++++++++++------------------
 lisp/locate.el                 | 52 +++++++++++++--------------------
 8 files changed, 96 insertions(+), 148 deletions(-)

diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el
index c1a48bc50c8..4fb4460d4c6 100644
--- a/lisp/cedet/mode-local.el
+++ b/lisp/cedet/mode-local.el
@@ -68,22 +68,15 @@ walk through.  It defaults to `buffer-list'."
            (when (or (not predicate) (funcall predicate))
              (funcall function))))))
 
-(defsubst get-mode-local-parent (mode)
+(defun get-mode-local-parent (mode)
   "Return the mode parent of the major mode MODE.
 Return nil if MODE has no parent."
+  (declare (obsolete derived-mode-all-parents "30.1"))
   (or (get mode 'mode-local-parent)
       (get mode 'derived-mode-parent)))
 
-;; FIXME doc (and function name) seems wrong.
-;; Return a list of MODE and all its parent modes, if any.
-;; Lists parent modes first.
-(defun mode-local-equivalent-mode-p (mode)
-  "Is the major-mode in the current buffer equivalent to a mode in MODES."
-  (let ((modes nil))
-    (while mode
-      (setq modes (cons mode modes)
-           mode  (get-mode-local-parent mode)))
-    modes))
+(define-obsolete-function-alias 'mode-local-equivalent-mode-p
+  #'derived-mode-all-parents "30.1")
 
 (defun mode-local-map-mode-buffers (function modes)
   "Run FUNCTION on every file buffer with major mode in MODES.
@@ -91,13 +84,7 @@ MODES can be a symbol or a list of symbols.
 FUNCTION does not have arguments."
   (setq modes (ensure-list modes))
   (mode-local-map-file-buffers
-   function (lambda ()
-              (let ((mm (mode-local-equivalent-mode-p major-mode))
-                    (ans nil))
-                (while (and (not ans) mm)
-                  (setq ans (memq (car mm) modes)
-                        mm (cdr mm)) )
-                ans))))
+   function (lambda () (apply #'derived-mode-p modes))))
 
 ;;; Hook machinery
 ;;
@@ -145,7 +132,8 @@ after changing the major mode."
   "Set parent of major mode MODE to PARENT mode.
 To work properly, this function should be called after PARENT mode
 local variables have been defined."
-  (put mode 'mode-local-parent parent)
+  (declare (obsolete derived-mode-add-parents "30.1"))
+  (derived-mode-add-parents mode (list parent))
   ;; Refresh mode bindings to get mode local variables inherited from
   ;; PARENT. To work properly, the following should be called after
   ;; PARENT mode local variables have been defined.
@@ -159,13 +147,8 @@ definition."
   (declare (obsolete define-derived-mode "27.1") (indent 2))
   `(mode-local--set-parent ',mode ',parent))
 
-(defun mode-local-use-bindings-p (this-mode desired-mode)
-  "Return non-nil if THIS-MODE can use bindings of DESIRED-MODE."
-  (let ((ans nil))
-    (while (and (not ans) this-mode)
-      (setq ans (eq this-mode desired-mode))
-      (setq this-mode (get-mode-local-parent this-mode)))
-    ans))
+(define-obsolete-function-alias 'mode-local-use-bindings-p
+  #'provided-mode-derived-p "30.1")
 
 
 ;;; Core bindings API
@@ -270,11 +253,13 @@ its parents."
         (setq mode major-mode
               bind (and mode-local-symbol-table
                         (intern-soft name mode-local-symbol-table))))
-    (while (and mode (not bind))
-      (or (and (get mode 'mode-local-symbol-table)
-               (setq bind (intern-soft
-                           name (get mode 'mode-local-symbol-table))))
-          (setq mode (get-mode-local-parent mode))))
+    (let ((parents (derived-mode-all-parents mode)))
+      (while (and parents (not bind))
+        (or (and (get (car parents) 'mode-local-symbol-table)
+                 (setq bind (intern-soft
+                             name (get (car parents)
+                                       'mode-local-symbol-table))))
+            (setq parents (cdr parents)))))
     bind))
 
 (defsubst mode-local-symbol-value (symbol &optional mode property)
@@ -311,16 +296,12 @@ Elements are (SYMBOL . PREVIOUS-VALUE), describing one 
variable."
       (mode-local-on-major-mode-change)
 
     ;; Do the normal thing.
-    (let (modes table old-locals)
+    (let (table old-locals)
       (unless mode
         (setq-local mode-local--init-mode major-mode)
        (setq mode major-mode))
-      ;; Get MODE's parents & MODE in the right order.
-      (while mode
-       (setq modes (cons mode modes)
-             mode  (get-mode-local-parent mode)))
       ;; Activate mode bindings following parent modes order.
-      (dolist (mode modes)
+      (dolist (mode (derived-mode-all-parents mode))
        (when (setq table (get mode 'mode-local-symbol-table))
          (mapatoms
            (lambda (var)
@@ -345,14 +326,13 @@ If MODE is not specified it defaults to current 
`major-mode'."
     (kill-local-variable 'mode-local--init-mode)
     (setq mode major-mode))
   (let (table)
-    (while mode
+    (dolist (mode (derived-mode-all-parents mode))
       (when (setq table (get mode 'mode-local-symbol-table))
         (mapatoms
          (lambda (var)
            (when (get var 'mode-variable-flag)
              (kill-local-variable (intern (symbol-name var)))))
-         table))
-      (setq mode (get-mode-local-parent mode)))))
+         table)))))
 
 (defmacro with-mode-local-symbol (mode &rest body)
   "With the local bindings of MODE symbol, evaluate BODY.
@@ -866,12 +846,11 @@ META-NAME is a cons (OVERLOADABLE-SYMBOL . MAJOR-MODE)."
     (when table
       (princ "\n- Buffer local\n")
       (mode-local-print-bindings table))
-    (while mode
+    (dolist (mode (derived-mode-all-parents mode))
       (setq table (get mode 'mode-local-symbol-table))
       (when table
         (princ (format-message "\n- From `%s'\n" mode))
-        (mode-local-print-bindings table))
-      (setq mode (get-mode-local-parent mode)))))
+        (mode-local-print-bindings table)))))
 
 (defun mode-local-describe-bindings-1 (buffer-or-mode &optional interactive-p)
   "Display mode local bindings active in BUFFER-OR-MODE.
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index 7c7ee749249..0c78493542f 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -799,7 +799,7 @@ local variable."
      (null (oref table major-mode))
      ;; nil means the same as major-mode
      (and (not semantic-equivalent-major-modes)
-         (mode-local-use-bindings-p major-mode (oref table major-mode)))
+         (provided-mode-derived-p major-mode (oref table major-mode)))
      (and semantic-equivalent-major-modes
          (member (oref table major-mode) semantic-equivalent-major-modes))
      )
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index 60c57210b8f..15ad18ad886 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -644,7 +644,7 @@ The symbols in the list are local variables in
                    (cond
                     (x (cdr x))
                     ((symbolp S) (symbol-value S))))))
-             template ""))
+             template))
 
 (defun semantic-grammar-header ()
   "Return text of a generated standard header."
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el
index 6a16845ecf2..35f09e7a784 100644
--- a/lisp/cedet/semantic/lex-spp.el
+++ b/lisp/cedet/semantic/lex-spp.el
@@ -434,8 +434,7 @@ continue processing recursively."
               (symbolp (car (car val))))
          (mapconcat (lambda (subtok)
                       (semantic-lex-spp-one-token-to-txt subtok))
-                    val
-                    ""))
+                    val))
         ;; If val is nil, that's probably wrong.
         ;; Found a system header case where this was true.
         ((null val) "")
@@ -699,8 +698,7 @@ be merged recursively."
                 (message "Invalid merge macro encountered; \
 will return empty string instead.")
                 "")))
-            txt
-            ""))
+            txt))
 
 (defun semantic-lex-spp-find-closing-macro ()
   "Find next macro which closes a scope through a close-paren.
diff --git a/lisp/cedet/srecode/find.el b/lisp/cedet/srecode/find.el
index cfd64edfc98..6d64a26e46c 100644
--- a/lisp/cedet/srecode/find.el
+++ b/lisp/cedet/srecode/find.el
@@ -34,12 +34,12 @@
 (defun srecode-table (&optional mode)
   "Return the currently active Semantic Recoder table for this buffer.
 Optional argument MODE specifies the mode table to use."
-  (let* ((modeq (or mode major-mode))
-        (table (srecode-get-mode-table modeq)))
+  (let ((modes (derived-mode-all-parents (or mode major-mode)))
+       (table nil))
 
     ;; If there isn't one, keep searching backwards for a table.
-    (while (and (not table) (setq modeq (get-mode-local-parent modeq)))
-      (setq table (srecode-get-mode-table modeq)))
+    (while (and modes (not (setq table (srecode-get-mode-table (car modes)))))
+      (setq modes (cdr modes)))
 
     ;; Last ditch effort.
     (when (not table)
@@ -57,35 +57,23 @@ Templates are found in the SRecode Template Map.
 See `srecode-get-maps' for more.
 APPNAME is the name of an application.  In this case,
 all template files for that application will be loaded."
-  (let ((files
-        (apply #'append
-               (mapcar
-                (if appname
+  (dolist (mmode (cons 'default (reverse (derived-mode-all-parents mmode))))
+    (let ((files
+          (apply #'append
+                 (mapcar
+                  (if appname
+                      (lambda (map)
+                        (srecode-map-entries-for-app-and-mode map appname 
mmode))
                     (lambda (map)
-                      (srecode-map-entries-for-app-and-mode map appname mmode))
-                  (lambda (map)
-                    (srecode-map-entries-for-mode map mmode)))
-                (srecode-get-maps))))
-       )
-    ;; Don't recurse if we are already the 'default state.
-    (when (not (eq mmode 'default))
-      ;; Are we a derived mode?  If so, get the parent mode's
-      ;; templates loaded too.
-      (if (get-mode-local-parent mmode)
-         (srecode-load-tables-for-mode (get-mode-local-parent mmode)
-                                       appname)
-       ;; No parent mode, all templates depend on the defaults being
-       ;; loaded in, so get that in instead.
-       (srecode-load-tables-for-mode 'default appname)))
+                      (srecode-map-entries-for-mode map mmode)))
+                  (srecode-get-maps)))))
 
-    ;; Load in templates for our major mode.
-    (dolist (f files)
-      (let ((mt (srecode-get-mode-table mmode))
-           )
-         (when (or (not mt) (not (srecode-mode-table-find mt (car f))))
-           (srecode-compile-file (car f)))
-       ))
-    ))
+      ;; Load in templates for our major mode.
+      (when files
+       (let ((mt (srecode-get-mode-table mmode)))
+         (dolist (f files)
+           (when (not (and mt (srecode-mode-table-find mt (car f))))
+             (srecode-compile-file (car f)))))))))
 
 ;;; PROJECT
 ;;
@@ -227,12 +215,12 @@ Optional argument MODE is the major mode to look for.
 Optional argument HASH is the hash table to fill in.
 Optional argument PREDICATE can be used to filter the returned
 templates."
-  (let* ((mhash       (or hash (make-hash-table :test 'equal)))
-        (mmode       (or mode major-mode))
-        (parent-mode (get-mode-local-parent mmode)))
-    ;; Get the parent hash table filled into our current hash.
-    (unless (eq mode 'default)
-      (srecode-all-template-hash (or parent-mode 'default) mhash))
+  (let* ((mhash       (or hash (make-hash-table :test 'equal))))
+    (dolist (mmode (cons 'default
+                        ;; Get the parent hash table filled into our
+                        ;; current hash.
+                        (reverse (derived-mode-all-parents
+                                  (or mode major-mode)))))
 
     ;; Load up the hash table for our current mode.
     (let* ((mt   (srecode-get-mode-table mmode))
@@ -246,7 +234,7 @@ templates."
                               (funcall predicate temp))
                       (puthash key temp mhash)))
                   (oref tab namehash))))
-      mhash)))
+      mhash))))
 
 (defun srecode-calculate-default-template-string (hash)
   "Calculate the name of the template to use as a DEFAULT.
diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el
index 004bb7adddb..44e465c69b1 100644
--- a/lisp/cedet/srecode/map.el
+++ b/lisp/cedet/srecode/map.el
@@ -76,7 +76,7 @@ Each app keys to an alist of files and modes (as above.)")
   "Return the entries in MAP for major MODE."
   (let ((ans nil))
     (dolist (f (oref map files))
-      (when (mode-local-use-bindings-p mode (cdr f))
+      (when (provided-mode-derived-p mode (cdr f))
        (setq ans (cons f ans))))
     ans))
 
diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el
index de151049f7f..e5ab53dd253 100644
--- a/lisp/cedet/srecode/table.el
+++ b/lisp/cedet/srecode/table.el
@@ -137,41 +137,36 @@ Tracks all the template-tables for a specific major 
mode.")
   "Get the SRecoder mode table for the major mode MODE.
 This will find the mode table specific to MODE, and then
 calculate all inherited templates from parent modes."
-  (let ((table nil)
-       (tmptable nil))
-    (while mode
-      (setq tmptable (eieio-instance-tracker-find
-                     mode 'major-mode 'srecode-mode-table-list)
-           mode (get-mode-local-parent mode))
-      (when tmptable
-       (if (not table)
-           (progn
-             ;; If this is the first, update tables to have
-             ;; all the mode specific tables in it.
-             (setq table tmptable)
-             (oset table tables (oref table modetables)))
-         ;; If there already is a table, then reset the tables
-         ;; slot to include all the tables belonging to this new child node.
-         (oset table tables (append (oref table modetables)
-                                    (oref tmptable modetables)))))
-      )
+  (let ((table nil))
+    (dolist (mode (derived-mode-all-parents mode))
+      (let ((tmptable (eieio-instance-tracker-find
+                      mode 'major-mode 'srecode-mode-table-list)))
+       (when tmptable
+         (if (not table)
+             (progn
+               ;; If this is the first, update tables to have
+               ;; all the mode specific tables in it.
+               (setq table tmptable)
+               (oset table tables (oref table modetables)))
+           ;; If there already is a table, then reset the tables
+           ;; slot to include all the tables belonging to this new child node.
+           (oset table tables (append (oref table modetables)
+                                      (oref tmptable modetables)))))
+       ))
     table))
 
 (defun srecode-make-mode-table (mode)
   "Get the SRecoder mode table for the major mode MODE."
   (let ((old (eieio-instance-tracker-find
              mode 'major-mode 'srecode-mode-table-list)))
-    (if old
-       old
-      (let* ((ms (if (stringp mode) mode (symbol-name mode)))
-            (new (srecode-mode-table ms
-                                     :major-mode mode
-                                     :modetables nil
-                                     :tables nil)))
-       ;; Save this new mode table in that mode's variable.
-       (eval `(setq-mode-local ,mode srecode-table ,new) t)
+    (or old
+       (let* ((new (srecode-mode-table :major-mode mode
+                                       :modetables nil
+                                       :tables nil)))
+         ;; Save this new mode table in that mode's variable.
+         (eval `(setq-mode-local ,mode srecode-table ,new) t)
 
-       new))))
+         new))))
 
 (cl-defmethod srecode-mode-table-find ((mt srecode-mode-table) file)
   "Look in the mode table MT for a template table from FILE.
diff --git a/lisp/locate.el b/lisp/locate.el
index 63386e18ebb..caccf644c02 100644
--- a/lisp/locate.el
+++ b/lisp/locate.el
@@ -141,13 +141,11 @@ system, or of all files that you have access to.  Consult 
the
 documentation of that program for the details about how it determines
 which file names match SEARCH-STRING.  (Those details vary highly with
 the version.)"
-  :type 'string
-  :group 'locate)
+  :type 'string)
 
 (defcustom locate-post-command-hook nil
   "List of hook functions run after `locate' (see `run-hooks')."
-  :type  'hook
-  :group 'locate)
+  :type  'hook)
 
 (defvar locate-history-list nil
   "The history list used by the \\[locate] command.")
@@ -162,13 +160,11 @@ This function should take one argument, a string (the 
name to find)
 and return a list of strings.  The first element of the list should be
 the name of a command to be executed by a shell, the remaining elements
 should be the arguments to that command (including the name to find)."
-  :type 'function
-  :group 'locate)
+  :type 'function)
 
 (defcustom locate-buffer-name "*Locate*"
   "Name of the buffer to show results from the \\[locate] command."
-  :type 'string
-  :group 'locate)
+  :type 'string)
 
 (defcustom locate-fcodes-file nil
   "File name for the database of file names used by `locate'.
@@ -179,20 +175,17 @@ Just setting this variable does not actually change the 
database
 that `locate' searches.  The executive program that the Emacs
 function `locate' uses, as given by the variables `locate-command'
 or `locate-make-command-line', determines the database."
-  :type '(choice (const :tag "None" nil) file)
-  :group 'locate)
+  :type '(choice (const :tag "None" nil) file))
 
 (defcustom locate-header-face nil
   "Face used to highlight the locate header."
-  :type '(choice (const :tag "None" nil) face)
-  :group 'locate)
+  :type '(choice (const :tag "None" nil) face))
 
 ;;;###autoload
 (defcustom locate-ls-subdir-switches (purecopy "-al")
   "`ls' switches for inserting subdirectories in `*Locate*' buffers.
 This should contain the \"-l\" switch, but not the \"-F\" or \"-b\" switches."
   :type 'string
-  :group 'locate
   :version "22.1")
 
 (defcustom locate-update-when-revert nil
@@ -202,13 +195,11 @@ If non-nil, offer to update the locate database when 
reverting that buffer.
 option `locate-update-path'.)
 If nil, reverting does not update the locate database."
   :type 'boolean
-  :group 'locate
   :version "22.1")
 
 (defcustom locate-update-command "updatedb"
   "The executable program used to update the locate database."
-  :type 'string
-  :group 'locate)
+  :type 'string)
 
 (defcustom locate-update-path "/"
   "The default directory from where `locate-update-command' is called.
@@ -218,7 +209,6 @@ can be achieved by setting this option to \"/su::\" or 
\"/sudo::\"
 permissions are sufficient to run the command, you can set this
 option to \"/\"."
   :type 'string
-  :group 'locate
   :version "22.1")
 
 (defcustom locate-prompt-for-command nil
@@ -227,13 +217,11 @@ Otherwise, that behavior is invoked via a prefix argument.
 
 Setting this option non-nil actually inverts the meaning of a prefix arg;
 that is, with a prefix arg, you get the default behavior."
-  :group 'locate
   :type 'boolean)
 
 (defcustom locate-mode-hook nil
   "List of hook functions run by `locate-mode' (see `run-mode-hooks')."
-  :type  'hook
-  :group 'locate)
+  :type  'hook)
 
 ;; Functions
 
@@ -371,17 +359,17 @@ except that FILTER is not optional."
 (defvar locate-mode-map
   (let ((map (copy-keymap dired-mode-map)))
     ;; Undefine Useless Dired Menu bars
-    (define-key map [menu-bar Dired]   'undefined)
-    (define-key map [menu-bar subdir]  'undefined)
-    (define-key map [menu-bar mark executables] 'undefined)
-    (define-key map [menu-bar mark directory]   'undefined)
-    (define-key map [menu-bar mark directories] 'undefined)
-    (define-key map [menu-bar mark symlinks]    'undefined)
-    (define-key map [M-mouse-2] 'locate-mouse-view-file)
-    (define-key map "\C-c\C-t"  'locate-tags)
-    (define-key map "l"       'locate-do-redisplay)
-    (define-key map "U"       'dired-unmark-all-files)
-    (define-key map "V"       'locate-find-directory)
+    (define-key map [menu-bar Dired]   #'undefined)
+    (define-key map [menu-bar subdir]  #'undefined)
+    (define-key map [menu-bar mark executables] #'undefined)
+    (define-key map [menu-bar mark directory]   #'undefined)
+    (define-key map [menu-bar mark directories] #'undefined)
+    (define-key map [menu-bar mark symlinks]    #'undefined)
+    (define-key map [M-mouse-2] #'locate-mouse-view-file)
+    (define-key map "\C-c\C-t"  #'locate-tags)
+    (define-key map "l"       #'locate-do-redisplay)
+    (define-key map "U"       #'dired-unmark-all-files)
+    (define-key map "V"       #'locate-find-directory)
     map)
   "Local keymap for Locate mode buffers.")
 
@@ -486,7 +474,7 @@ do not work in subdirectories.
 
   (setq-local revert-buffer-function #'locate-update)
   (setq-local page-delimiter "\n\n"))
-(put 'locate-mode 'derived-mode-parent 'dired-mode)
+(derived-mode-add-parents 'locate-mode '(dired-mode special-mode))
 
 (defun locate-do-setup (search-string)
   (goto-char (point-min))