master 4bd7963e2e: (add-hook, remove-hook): Fix leaks (bug#48666)

[Stefan Monnier]

branch: master
commit 4bd7963e2e244ace94afa59124f2637543d74ba2
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    (add-hook, remove-hook): Fix leaks (bug#48666)
    
    * lisp/subr.el (add-hook, remove-hook): Rewrite the hook depth
    management so we only keep the info relevant to functions present on
    the hook.
---
 lisp/subr.el | 65 ++++++++++++++++++++++++++++++++++++------------------------
 1 file changed, 39 insertions(+), 26 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index a78af09c40..1b9b67b705 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1913,26 +1913,34 @@ performance impact when running `add-hook' and 
`remove-hook'."
       (setq hook-value (list hook-value)))
     ;; Do the actual addition if necessary
     (unless (member function hook-value)
-      (when (stringp function)          ;FIXME: Why?
-       (setq function (purecopy function)))
-      ;; All those `equal' tests performed between functions can end up being
-      ;; costly since those functions may be large recursive and even cyclic
-      ;; structures, so we index `hook--depth-alist' with `eq'.  (bug#46326)
-      (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) depth))
-      (setq hook-value
-           (if (< 0 depth)
-               (append hook-value (list function))
-             (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 #'eq)
-                           (alist-get f2 depth-alist 0 nil #'eq))))))))
+      (let ((depth-sym (get hook 'hook--depth-alist)))
+        ;; While the `member' test above has to use `equal' for historical
+        ;; reasons, `equal' is a performance problem on large/cyclic functions,
+        ;; so we index `hook--depth-alist' with `eql'.  (bug#46326)
+        (unless (zerop depth)
+          (unless depth-sym
+            (setq depth-sym (make-symbol "depth-alist"))
+            (set depth-sym nil)
+            (setf (get hook 'hook--depth-alist) depth-sym))
+          (if local (make-local-variable depth-sym))
+          (setf (alist-get function
+                           (if local (symbol-value depth-sym)
+                             (default-value depth-sym))
+                           0)
+                depth))
+        (setq hook-value
+             (if (< 0 depth)
+                 (append hook-value (list function))
+               (cons function hook-value)))
+        (when depth-sym
+          (let ((depth-alist (if local (symbol-value depth-sym)
+                               (default-value depth-sym))))
+            (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 #'eq)
+                               (alist-get f2 depth-alist 0 nil #'eq))))))))))
     ;; Set the actual variable
     (if local
        (progn
@@ -2005,9 +2013,14 @@ one will be removed."
       (when old-fun
         ;; Remove auxiliary depth info to avoid leaks (bug#46414)
         ;; and to avoid the list growing too long.
-        (let* ((depths (get hook 'hook--depth-alist))
-               (di (assq old-fun depths)))
-          (when di (put hook 'hook--depth-alist (delq di depths)))))
+        (let* ((depth-sym (get hook 'hook--depth-alist))
+               (depth-alist (if depth-sym (if local (symbol-value depth-sym)
+                                            (default-value depth-sym))))
+               (di (assq old-fun depth-alist)))
+          (when di
+            (setf (if local (symbol-value depth-sym)
+                    (default-value depth-sym))
+                  (delq di depth-alist)))))
       ;; If the function is on the global hook, we need to shadow it locally
       ;;(when (and local (member function (default-value hook))
       ;;              (not (member (cons 'not function) hook-value)))
@@ -2169,7 +2182,7 @@ can do the job."
               (not (macroexp-const-p append)))
           exp
         (let* ((sym (cadr list-var))
-               (append (eval append))
+               (append (eval append lexical-binding))
                (msg (format-message
                      "`add-to-list' can't use lexical var `%s'; use `push' or 
`cl-pushnew'"
                      sym))
@@ -2718,7 +2731,7 @@ It can be retrieved with `(process-get PROCESS 
PROPNAME)'."
 
 (defconst read-key-full-map
   (let ((map (make-sparse-keymap)))
-    (define-key map [t] 'dummy)
+    (define-key map [t] #'ignore)       ;Dummy binding.
 
     ;; ESC needs to be unbound so that escape sequences in
     ;; `input-decode-map' are still processed by `read-key-sequence'.
@@ -4471,7 +4484,7 @@ is allowed once again.  (Immediately, if `inhibit-quit' 
is nil.)"
           ;; Without this, it will not be handled until the next function
           ;; call, and that might allow it to exit thru a condition-case
           ;; that intends to handle the quit signal next time.
-          (eval '(ignore nil)))))
+          (eval '(ignore nil) t))))
 
 (defmacro while-no-input (&rest body)
   "Execute BODY only as long as there's no pending input.