[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/fcr 162a69669f: Arrange to load `nadvice` later in `loadup.el`
From: |
Stefan Monnier |
Subject: |
scratch/fcr 162a69669f: Arrange to load `nadvice` later in `loadup.el` |
Date: |
Fri, 31 Dec 2021 01:53:16 -0500 (EST) |
branch: scratch/fcr
commit 162a69669f74f532ad7da304ae2faac0a5e48259
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
Arrange to load `nadvice` later in `loadup.el`
This is done simply so as to avoid scattering nadvice's code into
`simple.el` and `cl-print.el`.
* lisp/loadup.el ("emacs-lisp/nadvice"): Move down after "simple".
* lisp/help.el (help-command-error-confusable-suggestions): Make it
call `command-error-default`.
(command-error-function): Replace the top-level call to `add-function`
with a simple `setq` since `add-function` is not available at this
stage any more.
* lisp/emacs-lisp/nadvice.el (interactive-form) <advice>:
(cl-print-object) <advice>: Rename from `advice--get-interactive-form`
and `advice--cl-print-object`.
* lisp/emacs-lisp/cl-print.el (cl-print-object) <advice>:
* lisp/simple.el (interactive-form) <advice>: Move to `nadvice.el`.
(pre-redisplay-function): Replace the top-level call to `add-function`
with a simple `setq` since `add-function` is not available at this
stage any more.
* lisp/emacs-lisp/cl-generic.el: Use `fcr-object` instead of `advice`
as representative of the FCR specializers to prefill the dispatcher table.
---
lisp/emacs-lisp/cl-generic.el | 2 +-
lisp/emacs-lisp/cl-print.el | 10 ++--------
lisp/emacs-lisp/nadvice.el | 5 ++---
lisp/help.el | 11 ++++++++---
lisp/loadup.el | 2 +-
lisp/simple.el | 12 +++---------
6 files changed, 17 insertions(+), 25 deletions(-)
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index bc5978efb4..2700df37de 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1313,7 +1313,7 @@ Used internally for the (major-mode MODE) context
specializers."
(list cl-generic--fcr-generalizer))))
(cl-call-next-method)))
-(cl--generic-prefill-dispatchers 0 advice)
+(cl--generic-prefill-dispatchers 0 fcr-object)
;;; Support for unloading.
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index d5d9356923..83af57fd9b 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -221,14 +221,8 @@ into a button whose action shows the function's
disassembly.")
'byte-code-function object)))))
(princ ")" stream))
-;; This belongs in nadvice.el, of course, but some load-ordering issues make it
-;; complicated: cl-generic uses macros from cl-macs and cl-macs uses advice-add
-;; from nadvice, so nadvice needs to be loaded before cl-generic and hence
-;; can't use cl-defmethod.
-(cl-defmethod cl-print-object ((object advice) stream)
- ;; FIXME: η-reduce!
- (advice--cl-print-object object stream))
-
+;; This belongs in fcr.el, of course, but some load-ordering issues make it
+;; complicated.
(cl-defmethod cl-print-object ((object accessor) stream)
;; FIXME: η-reduce!
(fcr--accessor-cl-print object stream))
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index ca7443bba8..4aeb41d4f2 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -178,14 +178,13 @@ function of type `advice'.")
(cadr (or iff ifm)))))
-;; This is the `advice' method of `interactive-form'.
-(defun advice--get-interactive-form (ad)
+(cl-defmethod interactive-form ((ad advice) &optional _)
(let ((car (advice--car ad))
(cdr (advice--cdr ad)))
(when (or (commandp car) (commandp cdr))
`(interactive ,(advice--make-interactive-form car cdr)))))
-(defun advice--cl-print-object (object stream)
+(cl-defmethod cl-print-object ((object advice) stream)
(cl-assert (advice--p object))
(princ "#f(advice " stream)
(cl-print-object (advice--car object) stream)
diff --git a/lisp/help.el b/lisp/help.el
index 4773263872..70e319b291 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -2094,7 +2094,10 @@ the suggested string to use instead. See
confusables ", ")
string))))
-(defun help-command-error-confusable-suggestions (data _context _signal)
+(defun help-command-error-confusable-suggestions (data context signal)
+ ;; Delegate most of the work to the original default value of
+ ;; `command-error-function' implemented in C.
+ (command-error-default-function data context signal)
(pcase data
(`(void-variable ,var)
(let ((suggestions (help-uni-confusable-suggestions
@@ -2103,8 +2106,10 @@ the suggested string to use instead. See
(princ (concat "\n " suggestions) t))))
(_ nil)))
-(add-function :after command-error-function
- #'help-command-error-confusable-suggestions)
+(when (eq command-error-function #'command-error-default-function)
+ ;; Override the default set in the C code.
+ (setq command-error-function
+ #'help-command-error-confusable-suggestions))
(define-obsolete-function-alias 'help-for-help-internal #'help-for-help "28.1")
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 7db3c70869..f02dcd6788 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -197,7 +197,6 @@
(load "button") ;After loaddefs, because of define-minor-mode!
(load "emacs-lisp/cl-preloaded")
(load "emacs-lisp/fcr") ;Used by cl-generic and nadvice
-(load "emacs-lisp/nadvice")
(load "obarray") ;abbrev.el is implemented in terms of obarrays.
(load "abbrev") ;lisp-mode.el and simple.el use define-abbrev-table.
(load "help")
@@ -250,6 +249,7 @@
;; A particularly demanding file to load; 1600 does not seem to be enough.
(load "emacs-lisp/cl-generic"))
(load "simple")
+(load "emacs-lisp/nadvice")
(load "minibuffer") ;Needs cl-generic (and define-minor-mode).
(load "frame")
(load "startup")
diff --git a/lisp/simple.el b/lisp/simple.el
index bfbfe1b285..f8d963fd01 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2384,12 +2384,6 @@ ORIGINAL-NAME is used internally only."
spec)))
(_ (internal--interactive-form cmd))))
-(cl-defmethod interactive-form ((function advice) &optional _)
- ;; This should ideally be in `nadvice.el' but `nadvice.el' is loaded before
- ;; `cl-generic.el' so it can't use `cl-defmethod'.
- ;; FIXME: η-reduce!
- (advice--get-interactive-form function))
-
(defun command-execute (cmd &optional record-flag keys special)
;; BEWARE: Called directly from the C code.
"Execute CMD as an editor command.
@@ -6551,9 +6545,9 @@ is set to the buffer displayed in that window.")
(with-current-buffer (window-buffer win)
(run-hook-with-args 'pre-redisplay-functions win))))))
-(add-function :before pre-redisplay-function
- #'redisplay--pre-redisplay-functions)
-
+(when (eq pre-redisplay-function #'ignore)
+ ;; Override the default set in the C code.
+ (setq pre-redisplay-function #'redisplay--pre-redisplay-functions))
(defvar-local mark-ring nil
"The list of former marks of the current buffer, most recent first.")
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- scratch/fcr 162a69669f: Arrange to load `nadvice` later in `loadup.el`,
Stefan Monnier <=