Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-17 01:34:21 +00:00
Code Issues Projects Releases Packages Wiki Activity

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

Browse source 
* 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.
This commit is contained in:
Stefan Monnier 2022-02-22 10:18:43 -05:00
parent 09bd220d86
commit 4bd7963e2e
1 changed files with 39 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

65
lisp/subr.el
View file

@ -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.