1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-22 07:09:54 +00:00

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`.
This commit is contained in:
Stefan Monnier 2023-11-08 22:53:39 -05:00
parent 9c6b22bb3e
commit 492920dd5b
8 changed files with 47 additions and 50 deletions

View File

@ -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))

View File

@ -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 ()

View File

@ -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))))

View File

@ -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

View File

@ -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)

View File

@ -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))))

View File

@ -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)

View File

@ -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.