Subject: bug#35508: 27.0.50; Fine-ordering of functions on hooks

From: Stefan Monnier <[email-masked]>
Date: Tue, 30 Apr 2019 16:37:08 -0400

Package: Emacs
Version: 27.0.50

Occasionally it's important to control the relative ordering of
functions on hooks.  It's usually a bad idea, but sometimes alternatives
are worse.  When such needs show up, packages usually resort to ugly
tricks such as using some other hook (e.g. post-command-hook) to try and
detect when the ordering was broken and re-impose the desired ordering
by hand.

An example I saw recently is in `c-after-font-lock-init`.

A few months ago the idea came up again (tho I can't remember in
which context), which finally motivated me to look at this.

So, I suggest the patch below which generalizes the `append` argument of
`add-hook` to a `depth` argument similar to the `depth` used in
`add-function`.

Any objection/comment?

        Stefan

diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 97e9be9918..9d98cf64fd 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -142,7 +142,7 @@ Setting Hooks
 (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,16 @@ Setting Hooks
 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).
+
+But 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.
 
 @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
diff --git a/etc/NEWS b/etc/NEWS
index f6676e0e0b..aee5d7c91a 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1555,6 +1555,10 @@ never worked reliably, and now causes an error.
 
 * Lisp Changes in Emacs 27.1
 
+** The 'append' arg of 'add-hook' is generalized to a finer notion of 'depth'
+This allows to more precisely control the ordering of functions,
+as was already possible in 'add-function'.
+
 ** New 'help-fns-describe-variable-functions' hook.
 Makes it possible to add metadata information to describe-variable.
 
diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el
index 3be09d87b4..3caceee279 100644
--- a/lisp/elec-pair.el
+++ b/lisp/elec-pair.el
@@ -564,13 +564,6 @@ electric-pair-post-self-insert-function
                       (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 @@ electric-pair-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
diff --git a/lisp/electric.el b/lisp/electric.el
index 07da2f1d9e..53e53bd975 100644
--- a/lisp/electric.el
+++ b/lisp/electric.el
@@ -190,17 +190,6 @@ electric--after-char-pos
                            (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 @@ electric-indent-post-self-insert-function
                 (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 @@ electric-indent-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 @@ electric-layout-post-self-insert-function-1
               ('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 @@ electric-layout-mode
   :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 @@ electric-quote-post-self-insert-function
                     (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 @@ electric-quote-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
diff --git a/lisp/subr.el b/lisp/subr.el
index f68f9dd419..f11cbaabdc 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1602,12 +1602,20 @@ 'user-original-login-name
 
 ;;;; Hook manipulation functions.
 
-(defun add-hook (hook function &optional append local)
+(defun add-hook (hook function &optional depth local)
   "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, 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.  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.
@@ -1620,6 +1628,7 @@ add-hook
 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
@@ -1632,12 +1641,22 @@ add-hook
       (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)))
+      (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
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index c458eef2f9..36470d0650 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -373,5 +373,25 @@ subr-test--frames-1
   (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)))
+  (add-hook 'subr-tests--hook 'f7 t)
+  (should (equal subr-tests--hook '(f5 f6 f2 f1 f4 f3 f7)))
+  )
+
 (provide 'subr-tests)
 ;;; subr-tests.el ends here