From: Stefan Monnier Date: Fri, 31 Dec 2021 06:53:11 +0000 (-0500) Subject: Arrange to load `nadvice` later in `loadup.el` X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=162a69669f74f532ad7da304ae2faac0a5e48259;p=emacs.git 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) : (cl-print-object) : Rename from `advice--get-interactive-form` and `advice--cl-print-object`. * lisp/emacs-lisp/cl-print.el (cl-print-object) : * lisp/simple.el (interactive-form) : 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. --- diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index bc5978efb47..2700df37de2 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 d5d93569232..83af57fd9b4 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 ca7443bba81..4aeb41d4f26 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 4773263872d..70e319b2913 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 7db3c70869b..f02dcd6788d 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 bfbfe1b2855..f8d963fd017 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.")