emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

scratch/derived-mode-add-parents 492920dd5b4 3/6: Use new `derived-mode-


From: Stefan Monnier
Subject: scratch/derived-mode-add-parents 492920dd5b4 3/6: Use new `derived-mode-all/set-parents` functions.
Date: Thu, 9 Nov 2023 00:34:53 -0500 (EST)

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

    Use new `derived-mode-all/set-parents` functions.
    
    Try and avoid using the `derived-mode-parent` property directly
    and use the new API functions instead.
    
    * lisp/emacs-lisp/derived.el (define-derived-mode):
    Use `derived-mode-set-parent`.
    
    * lisp/loadhist.el (unload--set-major-mode):
    * lisp/info-look.el (info-lookup-select-mode):
    * lisp/ibuf-ext.el (ibuffer-list-buffer-modes):
    * lisp/files.el (dir-locals--get-sort-score):
    * lisp/emacs-lisp/cl-generic.el (cl--generic-derived-specializers):
    Use `derived-mode-all-parents`.
---
 lisp/emacs-lisp/cl-generic.el |  7 ++-----
 lisp/emacs-lisp/derived.el    |  4 +++-
 lisp/files.el                 | 13 ++++---------
 lisp/help-fns.el              |  1 +
 lisp/ibuf-ext.el              | 31 +++++++++++++++++--------------
 lisp/info-look.el             | 28 ++++++++++++++--------------
 lisp/loadhist.el              | 10 +++++-----
 lisp/so-long.el               |  3 +--
 8 files changed, 47 insertions(+), 50 deletions(-)

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 5346678dab0..56eb83e6f75 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1391,11 +1391,8 @@ See the full list and their hierarchy in 
`cl--typeof-types'."
 
 (defun cl--generic-derived-specializers (mode &rest _)
   ;; FIXME: Handle (derived-mode <mode1> ... <modeN>)
-  (let ((specializers ()))
-    (while mode
-      (push `(derived-mode ,mode) specializers)
-      (setq mode (get mode 'derived-mode-parent)))
-    (nreverse specializers)))
+  (mapcar (lambda (mode) `(derived-mode ,mode))
+          (derived-mode-all-parents mode)))
 
 (cl-generic-define-generalizer cl--generic-derived-generalizer
   90 (lambda (name) `(and (symbolp ,name) (functionp ,name) ,name))
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index b35994364a7..dec5883767d 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -240,7 +240,9 @@ No problems result if this variable is not bound.
               (unless (get ',abbrev 'variable-documentation)
                 (put ',abbrev 'variable-documentation
                      (purecopy ,(format "Abbrev table for `%s'." child))))))
-       (put ',child 'derived-mode-parent ',parent)
+       (if (fboundp 'derived-mode-set-parent) ;; Emacs≥30.1
+           (derived-mode-set-parent ',child ',parent)
+         (put ',child 'derived-mode-parent ',parent))
        ,(if group `(put ',child 'custom-mode-group ,group))
 
        (defun ,child ()
diff --git a/lisp/files.el b/lisp/files.el
index 3d838cd3b8c..d729bdf8c25 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -228,7 +228,7 @@ If non-nil, this directory is used instead of 
`temporary-file-directory'
 by programs that create small temporary files.  This is for systems that
 have fast storage with limited space, such as a RAM disk."
   :group 'files
-  :initialize 'custom-initialize-delay
+  :initialize #'custom-initialize-delay
   :type '(choice (const nil) directory))
 
 ;; The system null device. (Should reference NULL_DEVICE from C.)
@@ -434,7 +434,7 @@ ignored."
                         ,@(mapcar (lambda (algo)
                                     (list 'const algo))
                                   (secure-hash-algorithms)))))
-  :initialize 'custom-initialize-delay
+  :initialize #'custom-initialize-delay
   :version "21.1")
 
 (defvar auto-save--timer nil "Timer for `auto-save-visited-mode'.")
@@ -1296,7 +1296,7 @@ Tip: You can use this expansion of remote identifier 
components
 (defcustom remote-shell-program (or (executable-find "ssh") "ssh")
   "Program to use to execute commands on a remote host (i.e. ssh)."
   :version "29.1"
-  :initialize 'custom-initialize-delay
+  :initialize #'custom-initialize-delay
   :group 'environment
   :type 'file)
 
@@ -4585,12 +4585,7 @@ applied in order then that means the more specific modes 
will
 variables will override modes."
   (let ((key (car node)))
     (cond ((null key) -1)
-          ((symbolp key)
-           (let ((mode key)
-                 (depth 0))
-             (while (setq mode (get mode 'derived-mode-parent))
-               (setq depth (1+ depth)))
-             depth))
+          ((symbolp key) (length (derived-mode-all-parents key)))
           ((stringp key)
            (+ 1000 (length key)))
           (t -2))))
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index e93c535bbef..e723d97cfc2 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -742,6 +742,7 @@ the C sources, too."
 (defun help-fns--parent-mode (function)
   ;; If this is a derived mode, link to the parent.
   (let ((parent-mode (and (symbolp function)
+                          ;; FIXME: Should we mention other parent modes?
                           (get function
                                'derived-mode-parent))))
     (when parent-mode
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index 37065f5d41a..70c7516f903 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -400,9 +400,9 @@ format.  See `ibuffer-update-saved-filters-format' and
     (error "This buffer is not in Ibuffer mode"))
   (cond (ibuffer-auto-mode
          (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed) ; 
Initialize state vector
-         (add-hook 'post-command-hook 'ibuffer-auto-update-changed))
+         (add-hook 'post-command-hook #'ibuffer-auto-update-changed))
         (t
-         (remove-hook 'post-command-hook 'ibuffer-auto-update-changed))))
+         (remove-hook 'post-command-hook #'ibuffer-auto-update-changed))))
 
 (defun ibuffer-auto-update-changed ()
   (when (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed)
@@ -557,7 +557,7 @@ See `ibuffer-do-view-and-eval' for that."
    (list (read--expression "Eval in buffers (form): "))
    :opstring "evaluated in"
    :modifier-p :maybe)
-  (eval form))
+  (eval form t))
 
 ;;;###autoload (autoload 'ibuffer-do-view-and-eval "ibuf-ext")
 (define-ibuffer-op view-and-eval (form)
@@ -575,7 +575,7 @@ To evaluate a form without viewing the buffer, see 
`ibuffer-do-eval'."
     (unwind-protect
        (progn
          (switch-to-buffer buf)
-         (eval form))
+         (eval form t))
       (switch-to-buffer ibuffer-buf))))
 
 ;;;###autoload (autoload 'ibuffer-do-rename-uniquely "ibuf-ext")
@@ -1185,10 +1185,12 @@ Interactively, prompt for NAME, and use the current 
filters."
      (concat " [filter: " (cdr qualifier) "]"))
     ('or
      (concat " [OR" (mapconcat #'ibuffer-format-qualifier
-                               (cdr qualifier) "") "]"))
+                               (cdr qualifier))
+             "]"))
     ('and
      (concat " [AND" (mapconcat #'ibuffer-format-qualifier
-                                (cdr qualifier) "") "]"))
+                                (cdr qualifier))
+             "]"))
     (_
      (let ((type (assq (car qualifier) ibuffer-filtering-alist)))
        (unless qualifier
@@ -1202,11 +1204,12 @@ Interactively, prompt for NAME, and use the current 
filters."
 If INCLUDE-PARENTS is non-nil then include parent modes."
   (let ((modes))
     (dolist (buf (buffer-list))
-      (let ((this-mode (buffer-local-value 'major-mode buf)))
-        (while (and this-mode (not (memq this-mode modes)))
-          (push this-mode modes)
-          (setq this-mode (and include-parents
-                               (get this-mode 'derived-mode-parent))))))
+      (let ((this-modes (derived-mode-all-parents
+                         (buffer-local-value 'major-mode buf))))
+        (while (and this-modes (not (memq (car this-modes) modes)))
+          (push (car this-modes) modes)
+          (setq this-modes (and include-parents
+                                (cdr this-modes))))))
     (mapcar #'symbol-name modes)))
 
 
@@ -1391,7 +1394,7 @@ matches against the value of `default-directory' in that 
buffer."
   (:description "predicate"
    :reader (read-minibuffer "Filter by predicate (form): "))
   (with-current-buffer buf
-    (eval qualifier)))
+    (eval qualifier t)))
 
 ;;;###autoload (autoload 'ibuffer-filter-chosen-by-completion "ibuf-ext")
 (defun ibuffer-filter-chosen-by-completion ()
@@ -1508,7 +1511,7 @@ Ordering is lexicographic."
   "Emulate `bs-show' from the bs.el package."
   (interactive)
   (ibuffer t "*Ibuffer-bs*" '((filename . ".*")) nil t)
-  (define-key (current-local-map) "a" 'ibuffer-bs-toggle-all))
+  (define-key (current-local-map) "a" #'ibuffer-bs-toggle-all))
 
 (defun ibuffer-bs-toggle-all ()
   "Emulate `bs-toggle-show-all' from the bs.el package."
@@ -1746,7 +1749,7 @@ You can then feed the file name(s) to other commands with 
\\[yank]."
                        (t (file-name-nondirectory name))))))
            buffers))
          (string
-          (mapconcat 'identity (delete "" file-names) " ")))
+          (mapconcat #'identity (delete "" file-names) " ")))
     (unless (string= string "")
       (if (eq last-command 'kill-region)
           (kill-append string nil)
diff --git a/lisp/info-look.el b/lisp/info-look.el
index eeb758e5b85..8653a292a16 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -53,13 +53,13 @@ Automatically becomes buffer local when set in any 
fashion.")
 (make-variable-buffer-local 'info-lookup-mode)
 
 (defcustom info-lookup-other-window-flag t
-  "Non-nil means pop up the Info buffer in another window."
-  :group 'info-lookup :type 'boolean)
+ "Non-nil means pop up the Info buffer in another window."
+ :type 'boolean)
 
 (defcustom info-lookup-highlight-face 'match
   "Face for highlighting looked up help items.
 Setting this variable to nil disables highlighting."
-  :group 'info-lookup :type 'face)
+  :type 'face)
 
 (defvar info-lookup-highlight-overlay nil
   "Overlay object used for highlighting.")
@@ -73,7 +73,7 @@ List elements are cons cells of the form
 
 If a file name matches REGEXP, then use help mode MODE instead of the
 buffer's major mode."
-  :group 'info-lookup :type '(repeat (cons (regexp :tag "Regexp")
+  :type '(repeat (cons (regexp :tag "Regexp")
                                           (symbol :tag "Mode"))))
 
 (defvar info-lookup-history nil
@@ -167,13 +167,13 @@ the value of `:mode' as HELP-MODE, etc..
 
 If no topic or mode option has been specified, then the help topic defaults
 to `symbol', and the help mode defaults to the current major mode."
-  (apply 'info-lookup-add-help* nil arg))
+  (apply #'info-lookup-add-help* nil arg))
 
 (defun info-lookup-maybe-add-help (&rest arg)
   "Add a help specification if none is defined.
 See the documentation of the function `info-lookup-add-help'
 for more details."
-  (apply 'info-lookup-add-help* t arg))
+  (apply #'info-lookup-add-help* t arg))
 
 (defun info-lookup-add-help* (maybe &rest arg)
   (let (topic mode regexp ignore-case doc-spec
@@ -349,18 +349,18 @@ If optional argument QUERY is non-nil, query for the help 
mode."
        (setq file-name-alist (cdr file-name-alist)))))
 
   ;; If major-mode has no setups in info-lookup-alist, under any topic, then
-  ;; search up through derived-mode-parent to find a parent mode which does
-  ;; have some setups.  This means that a `define-derived-mode' with no
+  ;; search up through `derived-mode-all-parents' to find a parent mode which
+  ;; does have some setups.  This means that a `define-derived-mode' with no
   ;; setups of its own will select its parent mode for lookups, if one of
   ;; its parents has some setups.  Good for example on `makefile-gmake-mode'
   ;; and similar derivatives of `makefile-mode'.
   ;;
-  (let ((mode major-mode)) ;; Look for `mode' with some setups.
-    (while (and mode (not info-lookup-mode))
+  (let ((modes (derived-mode-all-parents major-mode))) ;; Look for `mode' with 
some setups.
+    (while (and modes (not info-lookup-mode))
       (dolist (topic-cell info-lookup-alist) ;; Usually only two topics here.
-        (if (info-lookup->mode-value (car topic-cell) mode)
-            (setq info-lookup-mode mode)))
-      (setq mode (get mode 'derived-mode-parent))))
+        (if (info-lookup->mode-value (car topic-cell) (car modes))
+            (setq info-lookup-mode (car modes))))
+      (setq modes (cdr modes))))
 
   (or info-lookup-mode (setq info-lookup-mode major-mode)))
 
@@ -526,7 +526,7 @@ different window."
                (nconc (condition-case nil
                           (info-lookup-make-completions topic mode)
                         (error nil))
-                      (apply 'append
+                      (apply #'append
                              (mapcar (lambda (arg)
                                        (info-lookup->completions topic arg))
                                      refer-modes))))
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 3800ea70ea4..8a571661e89 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -149,14 +149,14 @@ documentation of `unload-feature' for details.")
   (save-current-buffer
     (dolist (buffer (buffer-list))
       (set-buffer buffer)
-      (let ((proposed major-mode))
+      (let ((proposed (derived-mode-all-parents major-mode)))
         ;; Look for a predecessor mode not defined in the feature we're 
processing
-        (while (and proposed (rassq proposed unload-function-defs-list))
-          (setq proposed (get proposed 'derived-mode-parent)))
-        (unless (eq proposed major-mode)
+        (while (and proposed (rassq (car proposed) unload-function-defs-list))
+          (setq proposed (cdr proposed)))
+        (unless (eq (car proposed) major-mode)
           ;; Two cases: either proposed is nil, and we want to switch to 
fundamental
           ;; mode, or proposed is not nil and not major-mode, and so we use it.
-          (funcall (or proposed 'fundamental-mode)))))))
+          (funcall (or (car proposed) 'fundamental-mode)))))))
 
 (defvar loadhist-unload-filename nil)
 
diff --git a/lisp/so-long.el b/lisp/so-long.el
index b7cfce31173..e5f7b81e717 100644
--- a/lisp/so-long.el
+++ b/lisp/so-long.el
@@ -783,8 +783,7 @@ an example."
   :package-version '(so-long . "1.0"))
 (make-variable-buffer-local 'so-long-file-local-mode-function)
 
-;; `provided-mode-derived-p' was added in 26.1
-(unless (fboundp 'provided-mode-derived-p)
+(unless (fboundp 'provided-mode-derived-p) ;Only in Emacs≥26.1
   (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.



reply via email to

[Prev in Thread] Current Thread [Next in Thread]