Commit fe0cb43f authored by Stefan Monnier's avatar Stefan Monnier

* lisp/subr.el (add-hook): Turn `append` into `depth` (bug#35508)

Make it possible to control the relative ordering of functions on hooks by
specifying `depth` in the same was as was possible with `add-function`.

* lisp/electric.el (electric--sort-post-self-insertion-hook):
Delete function.
(electric-indent-mode, electric-layout-mode, electric-quote-mode):
* lisp/elec-pair.el (electric-pair-mode): Use new `depth` arg instead of
electric--sort-post-self-insertion-hook.

* lisp/emacs-lisp/syntax.el (syntax-propertize, syntax-ppss):
Use new `depth` arg to make sure noone accidentally gets added
after syntax-ppss-flush-cache.

* doc/lispref/modes.texi (Setting Hooks): Document new `depth` arg.

* test/lisp/subr-tests.el (subr-tests-add-hook-depth): New test.
parent 49cdbb4a
Pipeline #1829 failed with stage
in 51 minutes and 6 seconds
......@@ -142,7 +142,7 @@ in Lisp Interaction mode:
(add-hook 'lisp-interaction-mode-hook 'auto-fill-mode)
@end example
@defun add-hook hook function &optional append local
@defun add-hook hook function &optional depth local
This function is the handy way to add function @var{function} to hook
variable @var{hook}. You can use it for abnormal hooks as well as for
normal hooks. @var{function} can be any Lisp function that can accept
......@@ -167,9 +167,18 @@ For a normal hook, hook functions should be designed so that the order
in which they are executed does not matter. Any dependence on the order
is asking for trouble. However, the order is predictable: normally,
@var{function} goes at the front of the hook list, so it is executed
first (barring another @code{add-hook} call). If the optional argument
@var{append} is non-@code{nil}, the new hook function goes at the end of
the hook list and is executed last.
first (barring another @code{add-hook} call).
In some cases, it is important to control the relative ordering of functions
on the hook. The optional argument @var{depth} lets you indicate where the
function should be inserted in the list: it should then be a number
between -100 and 100 where the higher the value, the closer to the end of the
list the function should go. The @var{depth} defaults to 0 and for backward
compatibility when @var{depth} is a non-nil symbol it is interpreted as a depth
of 90. Furthermore, when @var{depth} is strictly greater than 0 the function
is added @emph{after} rather than before functions of the same depth.
One should never use a depth of 100 (or -100), because one can never be
sure that no other function will ever need to come before (or after) us.
@code{add-hook} can handle the cases where @var{hook} is void or its
value is a single function; it sets or changes the value to a list of
......
......@@ -1508,6 +1508,13 @@ documentation of the new mode and its commands.
* Incompatible Lisp Changes in Emacs 27.1
+++
** add-hook does not always add to the front or the end any more.
The replacement of `append` with `depth` implies that the function is not
always added to the very front (when append/depth is nil) or the very end (when
append/depth is t) any more because other functions on the hook may have
specified higher/lower depths.
** In 'compilation-error-regexp-alist' the old undocumented feature
where 'line' could be a function of 2 arguments has been dropped.
......@@ -1639,6 +1646,12 @@ valid event type.
* Lisp Changes in Emacs 27.1
+++
** The 'append' arg of 'add-hook' is generalized to a finer notion of 'depth'
This makes it possible to control the ordering of functions more precisely,
as was already possible in 'add-function' and `advice-add`.
---
** New 'help-fns-describe-variable-functions' hook.
Makes it possible to add metadata information to 'describe-variable'.
......
......@@ -246,7 +246,7 @@ functions when `parse-sexp-lookup-properties' is non-nil. The
cache is flushed from position START, defaulting to point."
(declare (debug ((form &optional form) body)) (indent 1))
(let ((start-var (make-symbol "start")))
`(let ((syntax-propertize-function nil)
`(let ((syntax-propertize-function #'ignore)
(,start-var ,(or start '(point))))
(unwind-protect
(with-syntax-table ,table
......@@ -564,13 +564,6 @@ happened."
(matching-paren (char-after))))
(save-excursion (newline 1 t)))))))
;; Prioritize this to kick in after
;; `electric-layout-post-self-insert-function': that considerably
;; simplifies interoperation when `electric-pair-mode',
;; `electric-layout-mode' and `electric-indent-mode' are used
;; together. Use `vc-region-history' on these lines for more info.
(put 'electric-pair-post-self-insert-function 'priority 50)
(defun electric-pair-will-use-region ()
(and (use-region-p)
(memq (car (electric-pair-syntax-info last-command-event))
......@@ -622,8 +615,14 @@ To toggle the mode in a single buffer, use `electric-pair-local-mode'."
(if electric-pair-mode
(progn
(add-hook 'post-self-insert-hook
#'electric-pair-post-self-insert-function)
(electric--sort-post-self-insertion-hook)
#'electric-pair-post-self-insert-function
;; Prioritize this to kick in after
;; `electric-layout-post-self-insert-function': that
;; considerably simplifies interoperation when
;; `electric-pair-mode', `electric-layout-mode' and
;; `electric-indent-mode' are used together.
;; Use `vc-region-history' on these lines for more info.
50)
(add-hook 'self-insert-uses-region-functions
#'electric-pair-will-use-region))
(remove-hook 'post-self-insert-hook
......
......@@ -190,17 +190,6 @@ Returns nil when we can't find this char."
(eq (char-before) last-command-event)))))
pos)))
(defun electric--sort-post-self-insertion-hook ()
"Ensure order of electric functions in `post-self-insertion-hook'.
Hooks in this variable interact in non-trivial ways, so a
relative order must be maintained within it."
(setq-default post-self-insert-hook
(sort (default-value 'post-self-insert-hook)
#'(lambda (fn1 fn2)
(< (or (if (symbolp fn1) (get fn1 'priority)) 0)
(or (if (symbolp fn2) (get fn2 'priority)) 0))))))
;;; Electric indentation.
;; Autoloading variables is generally undesirable, but major modes
......@@ -297,8 +286,6 @@ or comment."
(indent-according-to-mode)
(error (throw 'indent-error nil)))))))))
(put 'electric-indent-post-self-insert-function 'priority 60)
(defun electric-indent-just-newline (arg)
"Insert just a newline, without any auto-indentation."
(interactive "*P")
......@@ -341,8 +328,8 @@ use `electric-indent-local-mode'."
(remove-hook 'post-self-insert-hook
#'electric-indent-post-self-insert-function))
(add-hook 'post-self-insert-hook
#'electric-indent-post-self-insert-function)
(electric--sort-post-self-insertion-hook)))
#'electric-indent-post-self-insert-function
60)))
;;;###autoload
(define-minor-mode electric-indent-local-mode
......@@ -472,8 +459,6 @@ If multiple rules match, only first one is executed.")
('after-stay (save-excursion (funcall nl-after)))
('around (funcall nl-before) (funcall nl-after))))))))
(put 'electric-layout-post-self-insert-function 'priority 40)
;;;###autoload
(define-minor-mode electric-layout-mode
"Automatically insert newlines around some chars.
......@@ -482,8 +467,8 @@ The variable `electric-layout-rules' says when and how to insert newlines."
:global t :group 'electricity
(cond (electric-layout-mode
(add-hook 'post-self-insert-hook
#'electric-layout-post-self-insert-function)
(electric--sort-post-self-insertion-hook))
#'electric-layout-post-self-insert-function
40))
(t
(remove-hook 'post-self-insert-hook
#'electric-layout-post-self-insert-function))))
......@@ -623,8 +608,6 @@ This requotes when a quoting key is typed."
(replace-match (string q>>))
(setq last-command-event q>>))))))))))
(put 'electric-quote-post-self-insert-function 'priority 10)
;;;###autoload
(define-minor-mode electric-quote-mode
"Toggle on-the-fly requoting (Electric Quote mode).
......@@ -651,8 +634,8 @@ use `electric-quote-local-mode'."
(remove-hook 'post-self-insert-hook
#'electric-quote-post-self-insert-function))
(add-hook 'post-self-insert-hook
#'electric-quote-post-self-insert-function)
(electric--sort-post-self-insertion-hook)))
#'electric-quote-post-self-insert-function
10)))
;;;###autoload
(define-minor-mode electric-quote-local-mode
......
......@@ -298,7 +298,7 @@ END) suitable for `syntax-propertize-function'."
;; between syntax-ppss and syntax-propertize, we also have to make
;; sure the flush function is installed here (bug#29767).
(add-hook 'before-change-functions
#'syntax-ppss-flush-cache t t))
#'syntax-ppss-flush-cache 99 t))
(save-excursion
(with-silent-modifications
(make-local-variable 'syntax-propertize--done) ;Just in case!
......@@ -430,7 +430,7 @@ These are valid when the buffer has no restriction.")
;; Unregister if there's no cache left. Sadly this doesn't work
;; because `before-change-functions' is temporarily bound to nil here.
;; (unless cache
;; (remove-hook 'before-change-functions 'syntax-ppss-flush-cache t))
;; (remove-hook 'before-change-functions #'syntax-ppss-flush-cache t))
(setcar cell last)
(setcdr cell cache)))
))
......@@ -534,13 +534,14 @@ running the hook."
;; Setup the before-change function if necessary.
(unless (or ppss-cache ppss-last)
;; We should be either the very last function on
;; before-change-functions or the very first on
;; after-change-functions.
;; Note: combine-change-calls-1 needs to be kept in sync
;; with this!
(add-hook 'before-change-functions
'syntax-ppss-flush-cache t t))
#'syntax-ppss-flush-cache
;; We should be either the very last function on
;; before-change-functions or the very first on
;; after-change-functions.
99 t))
;; Use the best of OLD-POS and CACHE.
(if (or (not old-pos) (< old-pos pt-min))
......
......@@ -653,6 +653,9 @@ that requires a literal mode spec at compile time."
(make-local-hook 'after-change-functions))
(add-hook 'before-change-functions 'c-before-change nil t)
(setq c-just-done-before-change nil)
;; FIXME: We should use the new `depth' arg in Emacs-27 (e.g. a depth of -10
;; would do since font-lock uses a(n implicit) depth of 0) so we don't need
;; c-after-font-lock-init.
(add-hook 'after-change-functions 'c-after-change nil t)
(when (boundp 'font-lock-extend-after-change-region-function)
(set (make-local-variable 'font-lock-extend-after-change-region-function)
......
......@@ -1604,12 +1604,23 @@ be a list of the form returned by `event-start' and `event-end'."
;;;; Hook manipulation functions.
(defun add-hook (hook function &optional append local)
(defun add-hook (hook function &optional depth local)
;; Note: the -100..100 depth range is arbitrary and was chosen to match the
;; range used in add-function.
"Add to the value of HOOK the function FUNCTION.
FUNCTION is not added if already present.
FUNCTION is added (if necessary) at the beginning of the hook list
unless the optional argument APPEND is non-nil, in which case
FUNCTION is added at the end.
The place where the function is added depends on the DEPTH
parameter. DEPTH defaults to 0. By convention, it should be
a number between -100 and 100 where 100 means that the function
should be at the very end of the list, whereas -100 means that
the function should always come first.
Since nothing is \"always\" true, don't use 100 nor -100.
When two functions have the same depth, the new one gets added after the
old one if depth is strictly positive and before otherwise.
For backward compatibility reasons, a symbol other than nil is
interpreted as a DEPTH of 90.
The optional fourth argument, LOCAL, if non-nil, says to modify
the hook's buffer-local value rather than its global value.
......@@ -1622,6 +1633,7 @@ HOOK is void, it is first set to nil. If HOOK's value is a single
function, it is changed to a list of functions."
(or (boundp hook) (set hook nil))
(or (default-boundp hook) (set-default hook nil))
(unless (numberp depth) (setq depth (if depth 90 0)))
(if local (unless (local-variable-if-set-p hook)
(set (make-local-variable hook) (list t)))
;; Detect the case where make-local-variable was used on a hook
......@@ -1634,12 +1646,25 @@ function, it is changed to a list of functions."
(setq hook-value (list hook-value)))
;; Do the actual addition if necessary
(unless (member function hook-value)
(when (stringp function)
(when (stringp function) ;FIXME: Why?
(setq function (purecopy function)))
(when (or (get hook 'hook--depth-alist) (not (zerop depth)))
;; Note: The main purpose of the above `when' test is to avoid running
;; this `setf' before `gv' is loaded during bootstrap.
(setf (alist-get function (get hook 'hook--depth-alist)
0 'remove #'equal)
depth))
(setq hook-value
(if append
(if (< 0 depth)
(append hook-value (list function))
(cons function hook-value))))
(cons function hook-value)))
(let ((depth-alist (get hook 'hook--depth-alist)))
(when depth-alist
(setq hook-value
(sort (if (< 0 depth) hook-value (copy-sequence hook-value))
(lambda (f1 f2)
(< (alist-get f1 depth-alist 0 nil #'equal)
(alist-get f2 depth-alist 0 nil #'equal))))))))
;; Set the actual variable
(if local
(progn
......
......@@ -61,6 +61,9 @@
(quote
(0 font-lock-keyword-face))))))))
(defalias 'subr-tests--parent-mode
(if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode))
(ert-deftest provided-mode-derived-p ()
;; base case: `derived-mode' directly derives `prog-mode'
(should (progn
......@@ -68,9 +71,7 @@
(provided-mode-derived-p 'derived-mode 'prog-mode)))
;; edge case: `derived-mode' derives an alias of `prog-mode'
(should (progn
(defalias 'parent-mode
(if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode))
(define-derived-mode derived-mode parent-mode "test")
(define-derived-mode derived-mode subr-tests--parent-mode "test")
(provided-mode-derived-p 'derived-mode 'prog-mode))))
(ert-deftest number-sequence-test ()
......@@ -373,5 +374,31 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350."
(should (equal (flatten-tree '(1 ("foo" "bar") 2))
'(1 "foo" "bar" 2))))
(defvar subr-tests--hook nil)
(ert-deftest subr-tests-add-hook-depth ()
"Test the `depth' arg of `add-hook'."
(setq-default subr-tests--hook nil)
(add-hook 'subr-tests--hook 'f1)
(add-hook 'subr-tests--hook 'f2)
(should (equal subr-tests--hook '(f2 f1)))
(add-hook 'subr-tests--hook 'f3 t)
(should (equal subr-tests--hook '(f2 f1 f3)))
(add-hook 'subr-tests--hook 'f4 50)
(should (equal subr-tests--hook '(f2 f1 f4 f3)))
(add-hook 'subr-tests--hook 'f5 -50)
(should (equal subr-tests--hook '(f5 f2 f1 f4 f3)))
(add-hook 'subr-tests--hook 'f6)
(should (equal subr-tests--hook '(f5 f6 f2 f1 f4 f3)))
;; Make sure `t' is equivalent to 90.
(add-hook 'subr-tests--hook 'f7 90)
(add-hook 'subr-tests--hook 'f8 t)
(should (equal subr-tests--hook '(f5 f6 f2 f1 f4 f3 f7 f8)))
;; Make sue `nil' is equivalent to 0.
(add-hook 'subr-tests--hook 'f9 0)
(add-hook 'subr-tests--hook 'f10)
(should (equal subr-tests--hook '(f5 f10 f9 f6 f2 f1 f4 f3 f7 f8)))
)
(provide 'subr-tests)
;;; subr-tests.el ends here
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment