unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#36736: patch
@ 2019-07-20  1:45 dick
  0 siblings, 0 replies; only message in thread
From: dick @ 2019-07-20  1:45 UTC (permalink / raw)
  To: 36736

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: patch --]
[-- Type: text/x-diff, Size: 5838 bytes --]

From b8da0de6541fa5a966c30306c1f135bc60590ff0 Mon Sep 17 00:00:00 2001
From: dickmao <none>
Date: Fri, 19 Jul 2019 18:18:31 -0400
Subject: [PATCH] Avoid clobbering gnus-group-change-level-function

Gnus backends may add additional hooks via
`gnus-group-change-level-functions' but should not modify
`gnus-group-change-level-function'.
* lisp/gnus/gnus-group.el (gnus-group-kill-group): run-hook-with-args
  on `gnus-group-change-level-functions'.
* lisp/gnus/gnus-srvr.el (gnus-server-kill-server): run-hook-with-args
  on `gnus-group-change-level-functions'.
* lisp/gnus/gnus-start.el (gnus-group-change-level): run-hook-with-args
  on `gnus-group-change-level-functions'.
* lisp/gnus/gnus-topic.el (gnus-topic-mode): avoid clobbering
  `gnus-group-change-level-function'.  Mirror LOCAL flag in `add-hook'
  to `remove-hook' for `gnus-check-bogus-groups-hook'.
* lisp/gnus/gnus.el (gnus-group-change-level-function): define abnormal
  hook variable `gnus-group-change-level-functions'.
---
 lisp/gnus/gnus-group.el |  5 ++---
 lisp/gnus/gnus-srvr.el  |  5 ++---
 lisp/gnus/gnus-start.el |  5 ++---
 lisp/gnus/gnus-topic.el |  8 ++++----
 lisp/gnus/gnus.el       | 13 +++++++++++--
 5 files changed, 21 insertions(+), 15 deletions(-)

diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 299ebdec50..d95aa1ad8c 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -3919,9 +3919,8 @@ gnus-group-kill-group
 	(setq gnus-newsrc-alist
 	      (delq (assoc group gnus-newsrc-alist)
 		    gnus-newsrc-alist))
-	(when gnus-group-change-level-function
-	  (funcall gnus-group-change-level-function
-		   group gnus-level-killed 3))
+	(run-hook-with-args 'gnus-group-change-level-functions
+                            group gnus-level-killed 3)
 	(cond
 	 ((setq entry (gnus-group-entry group))
 	  (push (cons (car entry) (nth 1 entry))
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index 972ff28e63..8d0b36298f 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -432,9 +432,8 @@ gnus-server-kill-server
 	(setq gnus-newsrc-alist
 	      (delq (assoc group gnus-newsrc-alist)
 		    gnus-newsrc-alist))
-	(when gnus-group-change-level-function
-	  (funcall gnus-group-change-level-function
-		   group gnus-level-killed 3)))))
+        (run-hook-with-args 'gnus-group-change-level-functions
+                            group gnus-level-killed 3))))
   (gnus-server-position-point))
 
 (defun gnus-server-yank-server ()
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index d726ee5aab..f5ded7a4fa 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -1351,9 +1351,8 @@ gnus-group-change-level
 	  (gnus-dribble-enter
 	   (format "(gnus-group-set-info '%S)" info)
 	   (concat "^(gnus-group-set-info '(\"" (regexp-quote group) "\"")))))
-      (when gnus-group-change-level-function
-	(funcall gnus-group-change-level-function
-		 group level oldlevel previous)))))
+      (run-hook-with-args 'gnus-group-change-level-functions
+                          group level oldlevel previous))))
 
 (defun gnus-check-bogus-newsgroups (&optional confirm)
   "Remove bogus newsgroups.
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index e2c728df8f..1daee1dcfb 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -1143,7 +1143,7 @@ gnus-topic-mode
 	   'gnus-topic-update-topics-containing-group)
       (set (make-local-variable 'gnus-group-sort-alist-function)
 	   'gnus-group-sort-topic)
-      (setq gnus-group-change-level-function 'gnus-topic-change-level)
+      (add-hook 'gnus-group-change-level-functions 'gnus-topic-change-level nil 'local)
       (setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group)
       (add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist
 		nil 'local)
@@ -1154,8 +1154,8 @@ gnus-topic-mode
     ;; Remove topic infestation.
     (unless gnus-topic-mode
       (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
-      (setq gnus-group-change-level-function nil)
-      (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist)
+      (remove-hook 'gnus-group-change-level-functions 'gnus-topic-change-level 'local)
+      (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist 'local)
       (setq gnus-group-prepare-function 'gnus-group-prepare-flat)
       (setq gnus-group-sort-alist-function 'gnus-group-sort-flat))
     (when (called-interactively-p 'any)
@@ -1741,7 +1741,7 @@ gnus-topic-move
 
 (defun gnus-subscribe-topics (newsgroup)
   (catch 'end
-    (let (match gnus-group-change-level-function)
+    (let (match gnus-group-change-level-functions)
       (dolist (topic (gnus-topic-list))
 	(when (and (setq match (cdr (assq 'subscribe
 					  (gnus-topic-parameters topic))))
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 9ee7db9e20..abb8b7c9f8 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -2112,10 +2112,19 @@ gnus-apply-kill-hook
 
 (defcustom gnus-group-change-level-function nil
   "Function run when a group level is changed.
-It is called with three parameters -- GROUP, LEVEL and OLDLEVEL."
+It is called with four parameters -- GROUP, LEVEL, OLDLEVEL, and optionally PREVIOUS"
   :group 'gnus-group-levels
   :type '(choice (const nil)
-		 function))
+		 function)
+  :set (lambda (symbol value)
+         (set-default symbol value)
+         (when value
+           (set-default 'gnus-group-change-level-functions (list value)))))
+
+(defvar gnus-group-change-level-functions nil
+  "\"Abnormal\" hook run when a group level is changed.
+Each function element is called with three parameters -- GROUP, LEVEL, OLDLEVEL, and optionally PREVIOUS.
+Its default value is determined by the :set method of `gnus-group-change-level-function'")
 
 ;;; Face thingies.
 
-- 
2.22.0






^ permalink raw reply related	[flat|nested] only message in thread

only message in thread, other threads:[~2019-07-20  1:45 UTC | newest]

Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2019-07-20  1:45 bug#36736: patch dick

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).