From db92e83797bf2f1af4e0b0383283a49968746b51 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 23 Apr 2021 16:50:12 -0400 Subject: [PATCH] * lisp/subr.el (add-hook): Try and fix bug#46326 Use `eq` indexing on `hook--depth-alist`. (remove-hook): Remove old entries from `hook--depth-alist`. --- lisp/subr.el | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index c2be26a15f5..d9fb404c80d 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1830,12 +1830,13 @@ function, it is changed to a list of functions." (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 'remove #'equal) - depth)) + (push (cons function depth) (get hook 'hook--depth-alist))) (setq hook-value (if (< 0 depth) (append hook-value (list function)) @@ -1845,8 +1846,8 @@ function, it is changed to a list of functions." (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)))))))) + (< (alist-get f1 depth-alist 0 nil #'eq) + (alist-get f2 depth-alist 0 nil #'eq)))))))) ;; Set the actual variable (if local (progn @@ -1907,11 +1908,20 @@ one will be removed." (not (and (consp (symbol-value hook)) (memq t (symbol-value hook))))) (setq local t)) - (let ((hook-value (if local (symbol-value hook) (default-value hook)))) + (let ((hook-value (if local (symbol-value hook) (default-value hook))) + (old-fun nil)) ;; Remove the function, for both the list and the non-list cases. (if (or (not (listp hook-value)) (eq (car hook-value) 'lambda)) - (if (equal hook-value function) (setq hook-value nil)) - (setq hook-value (delete function (copy-sequence hook-value)))) + (when (equal hook-value function) + (setq old-fun hook-value) + (setq hook-value nil)) + (when (setq old-fun (car (member function hook-value))) + (setq hook-value (remq old-fun hook-value)))) + (when old-fun + ;; Remove auxiliary depth info to avoid leaks. + (put hook 'hook--depth-alist + (delq (assq old-fun (get hook 'hook--depth-alist)) + (get hook 'hook--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))) -- 2.39.2