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: ...@@ -142,7 +142,7 @@ in Lisp Interaction mode:
(add-hook 'lisp-interaction-mode-hook 'auto-fill-mode) (add-hook 'lisp-interaction-mode-hook 'auto-fill-mode)
@end example @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 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 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 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 ...@@ -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 in which they are executed does not matter. Any dependence on the order
is asking for trouble. However, the order is predictable: normally, is asking for trouble. However, the order is predictable: normally,
@var{function} goes at the front of the hook list, so it is executed @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 first (barring another @code{add-hook} call).
@var{append} is non-@code{nil}, the new hook function goes at the end of
the hook list and is executed last. 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 @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 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. ...@@ -1508,6 +1508,13 @@ documentation of the new mode and its commands.
* Incompatible Lisp Changes in Emacs 27.1 * 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 ** In 'compilation-error-regexp-alist' the old undocumented feature
where 'line' could be a function of 2 arguments has been dropped. where 'line' could be a function of 2 arguments has been dropped.
...@@ -1639,6 +1646,12 @@ valid event type. ...@@ -1639,6 +1646,12 @@ valid event type.
* Lisp Changes in Emacs 27.1 * 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. ** New 'help-fns-describe-variable-functions' hook.
Makes it possible to add metadata information to 'describe-variable'. Makes it possible to add metadata information to 'describe-variable'.
......
...@@ -246,7 +246,7 @@ functions when `parse-sexp-lookup-properties' is non-nil. The ...@@ -246,7 +246,7 @@ functions when `parse-sexp-lookup-properties' is non-nil. The
cache is flushed from position START, defaulting to point." cache is flushed from position START, defaulting to point."
(declare (debug ((form &optional form) body)) (indent 1)) (declare (debug ((form &optional form) body)) (indent 1))
(let ((start-var (make-symbol "start"))) (let ((start-var (make-symbol "start")))
`(let ((syntax-propertize-function nil) `(let ((syntax-propertize-function #'ignore)
(,start-var ,(or start '(point)))) (,start-var ,(or start '(point))))
(unwind-protect (unwind-protect
(with-syntax-table ,table (with-syntax-table ,table
...@@ -564,13 +564,6 @@ happened." ...@@ -564,13 +564,6 @@ happened."
(matching-paren (char-after)))) (matching-paren (char-after))))
(save-excursion (newline 1 t))))))) (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 () (defun electric-pair-will-use-region ()
(and (use-region-p) (and (use-region-p)
(memq (car (electric-pair-syntax-info last-command-event)) (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'." ...@@ -622,8 +615,14 @@ To toggle the mode in a single buffer, use `electric-pair-local-mode'."
(if electric-pair-mode (if electric-pair-mode
(progn (progn
(add-hook 'post-self-insert-hook (add-hook 'post-self-insert-hook
#'electric-pair-post-self-insert-function) #'electric-pair-post-self-insert-function
(electric--sort-post-self-insertion-hook) ;; 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 (add-hook 'self-insert-uses-region-functions
#'electric-pair-will-use-region)) #'electric-pair-will-use-region))
(remove-hook 'post-self-insert-hook (remove-hook 'post-self-insert-hook
......
...@@ -190,17 +190,6 @@ Returns nil when we can't find this char." ...@@ -190,17 +190,6 @@ Returns nil when we can't find this char."
(eq (char-before) last-command-event))))) (eq (char-before) last-command-event)))))
pos))) 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. ;;; Electric indentation.
;; Autoloading variables is generally undesirable, but major modes ;; Autoloading variables is generally undesirable, but major modes
...@@ -297,8 +286,6 @@ or comment." ...@@ -297,8 +286,6 @@ or comment."
(indent-according-to-mode) (indent-according-to-mode)
(error (throw 'indent-error nil))))))))) (error (throw 'indent-error nil)))))))))
(put 'electric-indent-post-self-insert-function 'priority 60)
(defun electric-indent-just-newline (arg) (defun electric-indent-just-newline (arg)
"Insert just a newline, without any auto-indentation." "Insert just a newline, without any auto-indentation."
(interactive "*P") (interactive "*P")
...@@ -341,8 +328,8 @@ use `electric-indent-local-mode'." ...@@ -341,8 +328,8 @@ use `electric-indent-local-mode'."
(remove-hook 'post-self-insert-hook (remove-hook 'post-self-insert-hook
#'electric-indent-post-self-insert-function)) #'electric-indent-post-self-insert-function))
(add-hook 'post-self-insert-hook (add-hook 'post-self-insert-hook
#'electric-indent-post-self-insert-function) #'electric-indent-post-self-insert-function
(electric--sort-post-self-insertion-hook))) 60)))
;;;###autoload ;;;###autoload
(define-minor-mode electric-indent-local-mode (define-minor-mode electric-indent-local-mode
...@@ -472,8 +459,6 @@ If multiple rules match, only first one is executed.") ...@@ -472,8 +459,6 @@ If multiple rules match, only first one is executed.")
('after-stay (save-excursion (funcall nl-after))) ('after-stay (save-excursion (funcall nl-after)))
('around (funcall nl-before) (funcall nl-after)))))))) ('around (funcall nl-before) (funcall nl-after))))))))
(put 'electric-layout-post-self-insert-function 'priority 40)
;;;###autoload ;;;###autoload
(define-minor-mode electric-layout-mode (define-minor-mode electric-layout-mode
"Automatically insert newlines around some chars. "Automatically insert newlines around some chars.
...@@ -482,8 +467,8 @@ The variable `electric-layout-rules' says when and how to insert newlines." ...@@ -482,8 +467,8 @@ The variable `electric-layout-rules' says when and how to insert newlines."
:global t :group 'electricity :global t :group 'electricity
(cond (electric-layout-mode (cond (electric-layout-mode
(add-hook 'post-self-insert-hook (add-hook 'post-self-insert-hook
#'electric-layout-post-self-insert-function) #'electric-layout-post-self-insert-function
(electric--sort-post-self-insertion-hook)) 40))
(t (t
(remove-hook 'post-self-insert-hook (remove-hook 'post-self-insert-hook
#'electric-layout-post-self-insert-function)))) #'electric-layout-post-self-insert-function))))
...@@ -623,8 +608,6 @@ This requotes when a quoting key is typed." ...@@ -623,8 +608,6 @@ This requotes when a quoting key is typed."
(replace-match (string q>>)) (replace-match (string q>>))
(setq last-command-event q>>)))))))))) (setq last-command-event q>>))))))))))
(put 'electric-quote-post-self-insert-function 'priority 10)
;;;###autoload ;;;###autoload
(define-minor-mode electric-quote-mode (define-minor-mode electric-quote-mode
"Toggle on-the-fly requoting (Electric Quote mode). "Toggle on-the-fly requoting (Electric Quote mode).
...@@ -651,8 +634,8 @@ use `electric-quote-local-mode'." ...@@ -651,8 +634,8 @@ use `electric-quote-local-mode'."
(remove-hook 'post-self-insert-hook (remove-hook 'post-self-insert-hook
#'electric-quote-post-self-insert-function)) #'electric-quote-post-self-insert-function))
(add-hook 'post-self-insert-hook (add-hook 'post-self-insert-hook
#'electric-quote-post-self-insert-function) #'electric-quote-post-self-insert-function
(electric--sort-post-self-insertion-hook))) 10)))
;;;###autoload ;;;###autoload
(define-minor-mode electric-quote-local-mode (define-minor-mode electric-quote-local-mode
......
...@@ -298,7 +298,7 @@ END) suitable for `syntax-propertize-function'." ...@@ -298,7 +298,7 @@ END) suitable for `syntax-propertize-function'."
;; between syntax-ppss and syntax-propertize, we also have to make ;; between syntax-ppss and syntax-propertize, we also have to make
;; sure the flush function is installed here (bug#29767). ;; sure the flush function is installed here (bug#29767).
(add-hook 'before-change-functions (add-hook 'before-change-functions
#'syntax-ppss-flush-cache t t)) #'syntax-ppss-flush-cache 99 t))
(save-excursion (save-excursion
(with-silent-modifications (with-silent-modifications
(make-local-variable 'syntax-propertize--done) ;Just in case! (make-local-variable 'syntax-propertize--done) ;Just in case!
...@@ -430,7 +430,7 @@ These are valid when the buffer has no restriction.") ...@@ -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 ;; Unregister if there's no cache left. Sadly this doesn't work
;; because `before-change-functions' is temporarily bound to nil here. ;; because `before-change-functions' is temporarily bound to nil here.
;; (unless cache ;; (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) (setcar cell last)
(setcdr cell cache))) (setcdr cell cache)))
)) ))
...@@ -534,13 +534,14 @@ running the hook." ...@@ -534,13 +534,14 @@ running the hook."
;; Setup the before-change function if necessary. ;; Setup the before-change function if necessary.
(unless (or ppss-cache ppss-last) (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 ;; Note: combine-change-calls-1 needs to be kept in sync
;; with this! ;; with this!
(add-hook 'before-change-functions (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. ;; Use the best of OLD-POS and CACHE.
(if (or (not old-pos) (< old-pos pt-min)) (if (or (not old-pos) (< old-pos pt-min))
......
...@@ -653,6 +653,9 @@ that requires a literal mode spec at compile time." ...@@ -653,6 +653,9 @@ that requires a literal mode spec at compile time."
(make-local-hook 'after-change-functions)) (make-local-hook 'after-change-functions))
(add-hook 'before-change-functions 'c-before-change nil t) (add-hook 'before-change-functions 'c-before-change nil t)
(setq c-just-done-before-change nil) (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) (add-hook 'after-change-functions 'c-after-change nil t)
(when (boundp 'font-lock-extend-after-change-region-function) (when (boundp 'font-lock-extend-after-change-region-function)
(set (make-local-variable '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'." ...@@ -1604,12 +1604,23 @@ be a list of the form returned by `event-start' and `event-end'."
;;;; Hook manipulation functions. ;;;; 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. "Add to the value of HOOK the function FUNCTION.
FUNCTION is not added if already present. 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 The place where the function is added depends on the DEPTH
FUNCTION is added at the end. 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 optional fourth argument, LOCAL, if non-nil, says to modify
the hook's buffer-local value rather than its global value. 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 ...@@ -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." function, it is changed to a list of functions."
(or (boundp hook) (set hook nil)) (or (boundp hook) (set hook nil))
(or (default-boundp hook) (set-default 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) (if local (unless (local-variable-if-set-p hook)
(set (make-local-variable hook) (list t))) (set (make-local-variable hook) (list t)))
;; Detect the case where make-local-variable was used on a hook ;; 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." ...@@ -1634,12 +1646,25 @@ function, it is changed to a list of functions."
(setq hook-value (list hook-value))) (setq hook-value (list hook-value)))
;; Do the actual addition if necessary ;; Do the actual addition if necessary
(unless (member function hook-value) (unless (member function hook-value)
(when (stringp function) (when (stringp function) ;FIXME: Why?
(setq function (purecopy function))) (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 (setq hook-value
(if append (if (< 0 depth)
(append hook-value (list function)) (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 ;; Set the actual variable
(if local (if local
(progn (progn
......
...@@ -61,6 +61,9 @@ ...@@ -61,6 +61,9 @@
(quote (quote
(0 font-lock-keyword-face)))))))) (0 font-lock-keyword-face))))))))
(defalias 'subr-tests--parent-mode
(if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode))
(ert-deftest provided-mode-derived-p () (ert-deftest provided-mode-derived-p ()
;; base case: `derived-mode' directly derives `prog-mode' ;; base case: `derived-mode' directly derives `prog-mode'
(should (progn (should (progn
...@@ -68,9 +71,7 @@ ...@@ -68,9 +71,7 @@
(provided-mode-derived-p 'derived-mode 'prog-mode))) (provided-mode-derived-p 'derived-mode 'prog-mode)))
;; edge case: `derived-mode' derives an alias of `prog-mode' ;; edge case: `derived-mode' derives an alias of `prog-mode'
(should (progn (should (progn
(defalias 'parent-mode (define-derived-mode derived-mode subr-tests--parent-mode "test")
(if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode))
(define-derived-mode derived-mode parent-mode "test")
(provided-mode-derived-p 'derived-mode 'prog-mode)))) (provided-mode-derived-p 'derived-mode 'prog-mode))))
(ert-deftest number-sequence-test () (ert-deftest number-sequence-test ()
...@@ -373,5 +374,31 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350." ...@@ -373,5 +374,31 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350."
(should (equal (flatten-tree '(1 ("foo" "bar") 2)) (should (equal (flatten-tree '(1 ("foo" "bar") 2))
'(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) (provide 'subr-tests)
;;; subr-tests.el ends here ;;; 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