emacs-diffs
[Top][All Lists]
Advanced

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

scratch/oclosure de320e2003 25/25: Arrange to load `nadvice` later in `l


From: Stefan Monnier
Subject: scratch/oclosure de320e2003 25/25: Arrange to load `nadvice` later in `loadup.el`
Date: Fri, 31 Dec 2021 15:41:00 -0500 (EST)

branch: scratch/oclosure
commit de320e200312d057baef229430c7ca3b4436f3af
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 `oclosure-object` instead of `advice`
    as representative of the OClosure 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 46fd2de484..36d6276cb1 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--oclosure-generalizer))))
    (cl-call-next-method)))
 
-(cl--generic-prefill-dispatchers 0 advice)
+(cl--generic-prefill-dispatchers 0 oclosure-object)
 
 ;;; Support for unloading.
 
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 6521c3bf7c..0131913a06 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 oclosure.el, of course, but some load-ordering issues make 
it
+;; complicated.
 (cl-defmethod cl-print-object ((object accessor) stream)
   ;; FIXME: η-reduce!
   (oclosure--accessor-cl-print object stream))
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 90861a0ee7..789431cb35 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 33c81f3e8c..154f831ead 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/oclosure")          ;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 65234732cb..d7576a7c03 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.")



reply via email to

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