bug-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

bug#38136: [PATCH] Make gnus-group-get-new-news a non blocking thread


From: dick . r . chiang
Subject: bug#38136: [PATCH] Make gnus-group-get-new-news a non blocking thread
Date: Fri, 08 Nov 2019 09:56:41 -0500
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux)

>From 834327d458c54bb0e1f25c6259ee640df0ba8b0e Mon Sep 17 00:00:00 2001
From: dickmao <none>
Date: Fri, 8 Nov 2019 09:51:59 -0500
Subject: [PATCH] Make `gnus-group-get-new-news` a non-blocking thread

* lisp/gnus/gnus-demon.el (gnus-demon-scan-news):
Add threaded optional argument.
* lisp/gnus/gnus-group.el (gnus-group-get-new-news):
Add threaded optional argument.
(gnus-threaded-get-unread-articles): This defcustom activates threading.
It defaults to nil.
(gnus-1): Add threaded optional argument.
(gnus-instantiate-server-buffer):
Make a new nntp-server-buffer for each thread.
(gnus-get-unread-articles-pass-preceding):
Tack preceding return value to ARGS before applying F.
(gnus-thread-body):
Let-close gnus global variables, create private nntp-server-buffer,
run the threaded function, and kill the nntp-server-buffer.
(gnus-run-thread): Make the thread.  Populate with serially dependent
sequence of functions.
(gnus-mutex-get-unread-articles):
Getting unread articles is a criticial section.
(gnus-get-unread-articles):
Reorder for threading.
(gnus-read-active-for-groups): Reprosecute tabs versus spaces.
(gnus-read-active-file-1): Elide a logical redundancy.
* lisp/gnus/gnus-sum.el (gnus-summary-display-article):
Replace if-null with when.
* lisp/gnus/gnus-util.el (gnus-push-end):
Define a convenience macro.
* lisp/gnus/nnheader.el
(nnheader-init-server-buffer, nnheader-prep-server-buffer):
Refactor "setting the table" in `nnheader-init-server-buffer`.
* lisp/gnus/nnimap.el (nnimap-make-process-buffer):
Apply due diligence if user kills nnimap process buffer.
* lisp/gnus/nntp.el (nntp-open-connection):
Apply due diligence if user kills nntp process buffer.
* lisp/mh-e/mh-compat.el (defun):
Reword an ancient and very confusing sentence.
* src/fns.c (Frequire):
Reword an ancient and very confusing sentence.
---
 etc/gnus/news-server.ast |   2 +-
 lisp/gnus/gnus-demon.el  |   3 +-
 lisp/gnus/gnus-group.el  |  14 +-
 lisp/gnus/gnus-start.el  | 289 ++++++++++++++++++++++++++++-----------
 lisp/gnus/gnus-sum.el    |   3 +-
 lisp/gnus/gnus-util.el   |   3 +
 lisp/gnus/nnheader.el    |  15 +-
 lisp/gnus/nnimap.el      |  13 ++
 lisp/gnus/nntp.el        |  13 ++
 lisp/mh-e/mh-compat.el   |   3 +-
 src/fns.c                |   3 +-
 11 files changed, 257 insertions(+), 104 deletions(-)

diff --git a/etc/gnus/news-server.ast b/etc/gnus/news-server.ast
index df0bab4519..555ac47cd9 100644
--- a/etc/gnus/news-server.ast
+++ b/etc/gnus/news-server.ast
@@ -20,7 +20,7 @@ Port number: @variable{port}
 
 @node User name and password
 @type interstitial
-@next 
+@next
 (if (assistant-password-required-p)
     "Enter user name and password"
   "Want user name and password?")
diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el
index 7ec471afc7..b4b9b62a4f 100644
--- a/lisp/gnus/gnus-demon.el
+++ b/lisp/gnus/gnus-demon.el
@@ -252,7 +252,8 @@ gnus-demon-scan-news
        (save-window-excursion
          (when (gnus-alive-p)
            (with-current-buffer gnus-group-buffer
-             (gnus-group-get-new-news))))
+             (gnus-group-get-new-news nil nil
+                                       gnus-threaded-get-unread-articles))))
       (set-window-configuration win))))
 
 (defun gnus-demon-add-scan-timestamps ()
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 742f8f4be5..19090c68ff 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -4014,13 +4014,15 @@ gnus-activate-all-groups
        (gnus-activate-foreign-newsgroups level))
     (gnus-group-get-new-news)))
 
-(defun gnus-group-get-new-news (&optional arg one-level)
+(defun gnus-group-get-new-news (&optional arg one-level background)
   "Get newly arrived articles.
 If ARG is a number, it specifies which levels you are interested in
 re-scanning.  If ARG is non-nil and not a number, this will force
 \"hard\" re-reading of the active files from all servers.
 If ONE-LEVEL is not nil, then re-scan only the specified level,
-otherwise all levels below ARG will be scanned too."
+otherwise all levels below ARG will be scanned too.
+If BACKGROUND then run `gnus-get-unread-articles' in a separate thread.
+"
   (interactive "P")
   (require 'nnmail)
   (let ((gnus-inhibit-demon t)
@@ -4034,17 +4036,13 @@ gnus-group-get-new-news
     (unless gnus-slave
       (gnus-master-read-slave-newsrc))
 
-    (gnus-get-unread-articles (gnus-group-default-level arg t)
-                             nil one-level)
+    (gnus-get-unread-articles arg nil one-level background)
 
     ;; If the user wants it, we scan for new groups.
     (when (eq gnus-check-new-newsgroups 'always)
       (gnus-find-new-newsgroups))
 
-    (gnus-check-reasonable-setup)
-    (gnus-run-hooks 'gnus-after-getting-new-news-hook)
-    (gnus-group-list-groups (and (numberp arg)
-                                (max (car gnus-group-list-mode) arg)))))
+    (gnus-check-reasonable-setup)))
 
 (defun gnus-group-get-new-news-this-group (&optional n dont-scan)
   "Check for newly arrived news in the current group (and the N-1 next groups).
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index e142c438ee..4553fa2d78 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -36,6 +36,7 @@
 (autoload 'gnus-agent-save-local "gnus-agent")
 (autoload 'gnus-agent-possibly-alter-active "gnus-agent")
 (declare-function gnus-group-decoded-name "gnus-group" (string))
+(declare-function gnus-group-default-level "gnus-group")
 
 (eval-when-compile (require 'cl-lib))
 
@@ -377,6 +378,17 @@ gnus-options-not-subscribe
   :type '(choice regexp
                 (const :tag "none" nil)))
 
+(defcustom gnus-threaded-get-unread-articles nil
+  "Instantiate parallel threads for `gnus-get-unread-articles' which 
encapsulates
+most of the network retrieval when `gnus-group-get-new-news' is run."
+  :group 'gnus-start
+  :type 'boolean
+  :set (lambda (symbol value)
+         (set-default symbol value)
+         (when value (unless (featurep 'threads)
+                       (set-default symbol nil)
+                       (gnus-message 5 "Threads unsupported")))))
+
 (defcustom gnus-modtime-botch nil
   "Non-nil means .newsrc should be deleted prior to save.
 Its use is due to the bogus appearance that .newsrc was modified on
@@ -755,7 +767,8 @@ gnus-1
        (gnus-group-get-new-news
         (and (numberp arg)
              (> arg 0)
-             (max (car gnus-group-list-mode) arg))))
+             (max (car gnus-group-list-mode) arg))
+         nil gnus-threaded-get-unread-articles))
 
     (gnus-clear-system)
     (gnus-splash)
@@ -1580,9 +1593,82 @@ gnus-get-unread-articles-in-group
        (setcar (gnus-group-entry (gnus-info-group info)) num))
       num)))
 
-;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
-;; and compute how many unread articles there are in each group.
-(defun gnus-get-unread-articles (&optional level dont-connect one-level)
+(defun gnus-instantiate-server-buffer (name)
+  (let ((buffer (generate-new-buffer (format " *gnus-thread %s*" name))))
+    (nnheader-prep-server-buffer buffer)
+    buffer))
+
+(defmacro gnus-get-unread-articles-pass-preceding (f args)
+  "Tack preceding return value to ARGS before applying F."
+  `(apply ,f (nconc ,args (list (and (boundp 'gnus-run-thread--subresult)
+                                     gnus-run-thread--subresult)))))
+
+(defvar gnus-newsgroup-marked)
+(defvar gnus-newsgroup-spam-marked)
+(defvar gnus-article-current)
+(defvar gnus-current-score-file)
+(defvar gnus-newsgroup-charset)
+(defun gnus-thread-body (thread-name mtx working fns)
+  (with-mutex mtx
+    (nnheader-message 9 "gnus-thread-body: start %s" thread-name)
+    (let (gnus-run-thread--subresult
+          current-fn
+          (nntp-server-buffer working)
+          (gnus-newsgroup-name gnus-newsgroup-name)
+          (gnus-newsgroup-marked gnus-newsgroup-marked)
+          (gnus-newsgroup-spam-marked gnus-newsgroup-spam-marked)
+          (gnus-newsgroup-unreads gnus-newsgroup-unreads)
+          (gnus-current-headers gnus-current-headers)
+          (gnus-newsgroup-data gnus-newsgroup-data)
+          (gnus-summary-buffer gnus-summary-buffer)
+          (gnus-article-buffer gnus-article-buffer)
+          (gnus-original-article-buffer gnus-original-article-buffer)
+          (gnus-article-current gnus-article-current)
+          (gnus-reffed-article-number gnus-reffed-article-number)
+          (gnus-current-score-file gnus-current-score-file)
+          (gnus-newsgroup-charset gnus-newsgroup-charset))
+      (condition-case err
+          (dolist (fn fns)
+            (setq current-fn fn)
+            (setq gnus-run-thread--subresult (funcall fn)))
+        (error (nnheader-message
+                4 "gnus-thread-body: '%s' in %S"
+                (error-message-string err) current-fn))))
+    (kill-buffer working)
+    (nnheader-message 9 "gnus-thread-body: finish %s" thread-name)))
+
+(defun gnus-run-thread (mtx thread-group &rest fns)
+  "MTX, if non-nil, is the mutex for the new thread.
+THREAD-GROUP is string useful for naming working buffer and threads.
+All FNS must finish before MTX is released."
+  (when fns
+    (let ((thread-name
+           (concat thread-group "-"
+                   (let* ((max-len 160)
+                          (full-name (pp-to-string (car fns)))
+                          (short-name (cl-subseq
+                                       full-name 0
+                                       (min max-len
+                                            (length full-name)))))
+                     (if (> (length full-name) (length short-name))
+                         (concat short-name "...")
+                       short-name)))))
+      (make-thread (apply-partially
+                    #'gnus-thread-body
+                    thread-name mtx
+                    (gnus-instantiate-server-buffer thread-group)
+                    fns)
+                   thread-name))))
+
+(defvar gnus-mutex-get-unread-articles (make-mutex 
"gnus-mutex-get-unread-articles")
+  "Updating or displaying state of unread articles are critical sections.")
+
+(cl-defun gnus-get-unread-articles (&optional requested-level dont-connect
+                                              one-level background
+                                    &aux (level (gnus-group-default-level
+                                                 requested-level t)))
+  "Go through `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
+  and compute how many unread articles there are in each group."
   (setq gnus-server-method-cache nil)
   (require 'gnus-agent)
   (let* ((newsrc (cdr gnus-newsrc-alist))
@@ -1636,14 +1722,14 @@ gnus-get-unread-articles
                'primary)
               (t
                'foreign)))
-       (push (setq method-group-list (list method method-type nil nil))
+       (push (setq method-group-list (list method method-type nil))
              type-cache))
       ;; Only add groups that need updating.
       (if (or (and foreign-level (null (numberp foreign-level)))
-          (funcall (if one-level #'= #'<=) (gnus-info-level info)
-                   (if (eq (cadr method-group-list) 'foreign)
-                       foreign-level
-                     alevel)))
+             (funcall (if one-level #'= #'<=) (gnus-info-level info)
+                      (if (eq (cadr method-group-list) 'foreign)
+                          foreign-level
+                        alevel)))
          (setcar (nthcdr 2 method-group-list)
                  (cons info (nth 2 method-group-list)))
        ;; The group is inactive, so we nix out the number of unread articles.
@@ -1664,9 +1750,9 @@ gnus-get-unread-articles
                     (gnus-method-rank (cadr c2) (car c2))))))
     ;; Go through the list of servers and possibly extend methods that
     ;; aren't equal (and that need extension; i.e., they are async).
-    (let ((methods nil))
+    (let (methods)
       (dolist (elem type-cache)
-       (cl-destructuring-bind (method method-type infos dummy) elem
+       (cl-destructuring-bind (method method-type infos) elem
          (let ((gnus-opened-servers methods))
            (when (and (gnus-similar-server-opened method)
                       (gnus-check-backend-function
@@ -1687,68 +1773,107 @@ gnus-get-unread-articles
          (with-current-buffer nntp-server-buffer
            (gnus-read-active-file-1 method nil)))))
 
-    ;; Clear out all the early methods.
-    (dolist (elem type-cache)
-      (cl-destructuring-bind (method method-type infos dummy) elem
-       (when (and method
-                  infos
-                  (gnus-check-backend-function
-                   'retrieve-group-data-early (car method))
-                  (not (gnus-method-denied-p method)))
-         (when (ignore-errors (gnus-get-function method 'open-server))
-           (unless (gnus-server-opened method)
-             (gnus-open-server method))
-           (when (gnus-server-opened method)
-             ;; Just mark this server as "cleared".
-             (gnus-retrieve-group-data-early method nil))))))
-
-    ;; Start early async retrieval of data.
-    (let ((done-methods nil)
-         sanity-spec)
-      (dolist (elem type-cache)
-       (cl-destructuring-bind (method method-type infos dummy) elem
-         (setq sanity-spec (list (car method) (cadr method)))
-         (when (and method infos
-                    (not (gnus-method-denied-p method)))
-           ;; If the open-server method doesn't exist, then the method
-           ;; itself doesn't exist, so we ignore it.
-           (if (not (ignore-errors (gnus-get-function method 'open-server)))
-               (setq type-cache (delq elem type-cache))
-             (unless (gnus-server-opened method)
-               (gnus-open-server method))
-             (when (and
-                    ;; This is a sanity check, so that we never
-                    ;; attempt to start two async requests to the
-                    ;; same server, because that will fail.  This
-                    ;; should never happen, since the methods should
-                    ;; be unique at this point, but apparently it
-                    ;; does happen in the wild with some setups.
-                    (not (member sanity-spec done-methods))
-                    (gnus-server-opened method)
-                    (gnus-check-backend-function
-                     'retrieve-group-data-early (car method)))
-               (push sanity-spec done-methods)
-               (when (gnus-check-backend-function 'request-scan (car method))
-                 (gnus-request-scan nil method))
-               ;; Store the token we get back from -early so that we
-               ;; can pass it to -finish later.
-               (setcar (nthcdr 3 elem)
-                       (gnus-retrieve-group-data-early method infos))))))))
-
-    ;; Do the rest of the retrieval.
-    (dolist (elem type-cache)
-      (cl-destructuring-bind (method method-type infos early-data) elem
-       (when (and method infos
-                  (not (gnus-method-denied-p method)))
-         (let ((updatep (gnus-check-backend-function
-                         'request-update-info (car method))))
-           ;; See if any of the groups from this method require updating.
-           (gnus-read-active-for-groups method infos early-data)
-           (dolist (info infos)
-             (inline (gnus-get-unread-articles-in-group
-                      info (gnus-active (gnus-info-group info))
-                      updatep)))))))
-    (gnus-message 6 "Checking new news...done")))
+    ;; Must be able to `gnus-open-server'
+    (setq type-cache (seq-filter
+                      (lambda (elem)
+                        (cl-destructuring-bind (method _type _infos) elem
+                          (ignore-errors (gnus-get-function method 
'open-server))))
+                      type-cache))
+
+    (let (methods
+          (coda (apply-partially
+                 (lambda (level*)
+                   (nnheader-message 9 "gnus-get-unread-articles: all done")
+                   (gnus-group-list-groups level*)
+                   (gnus-run-hooks 'gnus-after-getting-new-news-hook)
+                   (gnus-group-list-groups))
+                 (and (numberp level)
+                      (max (car gnus-group-list-mode) level)))))
+      (mapc (lambda (elem)
+              (cl-destructuring-bind
+                (method _type infos
+                 &aux
+                 (backend (car method))
+                 (already-p
+                  (cl-some (apply-partially
+                            #'gnus-methods-equal-p method)
+                           methods))
+                 (denied-p (gnus-method-denied-p method))
+                 (scan-p (gnus-check-backend-function 'request-scan backend))
+                 (early-p (gnus-check-backend-function
+                           'retrieve-group-data-early backend))
+                 (update-p (gnus-check-backend-function
+                            'request-update-info backend))
+                 commands early-data)
+                  elem
+                (when (and method infos (not denied-p) (not already-p))
+                  (push method methods)
+                  (gnus-push-end (apply-partially
+                                  #'gnus-open-server method)
+                                 commands)
+                  (when early-p
+                    ;; Just mark this server as "cleared".
+                    (gnus-push-end (apply-partially
+                                    #'gnus-retrieve-group-data-early method 
nil)
+                                   commands)
+
+                    ;; This is a sanity check, so that we never
+                    ;; attempt to start two async requests to the
+                    ;; same server, because that will fail.  This
+                    ;; should never happen, since the methods should
+                    ;; be unique at this point, but apparently it
+                    ;; does happen in the wild with some setups.
+                    (when scan-p
+                      (gnus-push-end (apply-partially #'gnus-request-scan nil 
method)
+                                     commands))
+
+                    ;; Store the token we get back from -early so that we
+                    ;; can pass it to -finish later.
+                    (gnus-push-end (apply-partially
+                                    #'gnus-retrieve-group-data-early
+                                    method infos)
+                                   commands))
+                  (gnus-push-end (apply-partially
+                                  (lambda (f &rest args)
+                                    (gnus-get-unread-articles-pass-preceding f 
args))
+                                  #'gnus-read-active-for-groups method infos)
+                                 commands)
+                  (gnus-push-end (apply-partially
+                                  (lambda (infos* update-p*)
+                                    (mapc (lambda (info)
+                                            (gnus-get-unread-articles-in-group
+                                             info
+                                             (gnus-active (gnus-info-group 
info))
+                                             update-p*))
+                                          infos*)
+                                    (gnus-message 6 "Checking new 
news...done"))
+                                  infos update-p)
+                                 commands)
+                  (if background
+                      (let ((thread-group "gnus-unread-articles"))
+                        (add-function
+                         :before-while coda
+                         (apply-partially
+                          (lambda (thread-group* &rest _args)
+                            "Proceed with before-while if I'm the last one."
+                            (<= (cl-count thread-group*
+                                          (all-threads)
+                                          :test (lambda (s thr)
+                                                  (cl-search s (thread-name 
thr))))
+                                1))
+                          thread-group))
+                        (gnus-push-end coda commands)
+                        (apply #'gnus-run-thread
+                               gnus-mutex-get-unread-articles
+                               thread-group
+                               commands))
+                    (let (gnus-run-thread--subresult)
+                      (mapc (lambda (fn)
+                              (setq gnus-run-thread--subresult (funcall fn)))
+                            commands))))))
+            type-cache)
+      (unless background
+        (funcall coda)))))
 
 (defun gnus-method-rank (type method)
   (cond
@@ -1780,7 +1905,7 @@ gnus-read-active-for-groups
        early-data
        (gnus-check-backend-function 'finish-retrieve-group-infos (car method))
        (or (not (gnus-agent-method-p method))
-          (gnus-online method)))
+           (gnus-online method)))
       (gnus-finish-retrieve-group-infos method infos early-data)
       ;; We may have altered the data now, so mark the dribble buffer
       ;; as dirty so that it gets saved.
@@ -1789,12 +1914,12 @@ gnus-read-active-for-groups
      ;; Most backends have -retrieve-groups.
      ((gnus-check-backend-function 'retrieve-groups (car method))
       (when (gnus-check-backend-function 'request-scan (car method))
-       (gnus-request-scan nil method))
+        (gnus-request-scan nil method))
       (let (groups)
-       (gnus-read-active-file-2
-        (dolist (info infos (nreverse groups))
-          (push (gnus-group-real-name (gnus-info-group info)) groups))
-        method)))
+        (gnus-read-active-file-2
+         (dolist (info infos (nreverse groups))
+           (push (gnus-group-real-name (gnus-info-group info)) groups))
+         method)))
      ;; Virtually all backends have -request-list.
      ((gnus-check-backend-function 'request-list (car method))
       (gnus-read-active-file-1 method nil))
@@ -1802,7 +1927,7 @@ gnus-read-active-for-groups
      ;; by one.
      (t
       (dolist (info infos)
-       (gnus-activate-group (gnus-info-group info) nil nil method t))))))
+        (gnus-activate-group (gnus-info-group info) nil nil method t))))))
 
 (defun gnus-make-hashtable-from-newsrc-alist ()
   "Create a hash table from `gnus-newsrc-alist'.
@@ -2042,9 +2167,7 @@ gnus-read-active-file-1
     (gnus-message 5 "%s" mesg)
     (when (gnus-check-server method)
       ;; Request that the backend scan its incoming messages.
-      (when (and (or (and gnus-agent
-                         (gnus-online method))
-                    (not gnus-agent))
+      (when (and (or (not gnus-agent) (gnus-online method))
                 (gnus-check-backend-function 'request-scan (car method)))
        (gnus-request-scan nil method))
       (cond
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index f21bc7584e..6f12ae6c13 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -7764,8 +7764,7 @@ gnus-summary-display-article
     (setq gnus-article-charset gnus-newsgroup-charset)
     (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets)
     (mm-enable-multibyte))
-  (if (null article)
-      nil
+  (when article
     (prog1
        (funcall (or gnus-summary-display-article-function
                      #'gnus-article-prepare)
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 3cf364fff8..48b0739dd1 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -106,6 +106,9 @@ gnus-eval-in-buffer-window
 (put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
 (put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body))
 
+(defmacro gnus-push-end (elt place)
+  `(push ,elt (if (consp ,place) (cdr (last ,place)) ,place)))
+
 (defsubst gnus-goto-char (point)
   (and point (goto-char point)))
 
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 28c4cebb2d..d5d76e80ea 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -502,11 +502,10 @@ nnheader-file-coding-system
   "Coding system used in file backends of Gnus.")
 (defvar nnheader-callback-function nil)
 
-(defun nnheader-init-server-buffer ()
-  "Initialize the Gnus-backend communication buffer."
-  (unless (gnus-buffer-live-p nntp-server-buffer)
-    (setq nntp-server-buffer (get-buffer-create " *nntpd*")))
-  (with-current-buffer nntp-server-buffer
+(defsubst nnheader-prep-server-buffer (buffer)
+  "Refactor \"setting the table\" of BUFFER for `nnheader-init-server-buffer' 
and
+`gnus-instantiate-server-buffer'."
+  (with-current-buffer buffer
     (erase-buffer)
     (mm-enable-multibyte)
     (kill-all-local-variables)
@@ -514,6 +513,12 @@ nnheader-init-server-buffer
     (set (make-local-variable 'nntp-process-response) nil)
     t))
 
+(defun nnheader-init-server-buffer ()
+  "Initialize the Gnus-backend communication buffer."
+  (unless (gnus-buffer-live-p nntp-server-buffer)
+    (setq nntp-server-buffer (get-buffer-create " *nntpd*")))
+  (nnheader-prep-server-buffer nntp-server-buffer))
+
 ;;; Various functions the backends use.
 
 (defun nnheader-file-error (file)
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 1ec5522831..64f7cb46d6 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -371,6 +371,19 @@ nnimap-make-process-buffer
                      :initial-resync 0))
     (push (list buffer (current-buffer)) nnimap-connection-alist)
     (push (current-buffer) nnimap-process-buffers)
+    (with-current-buffer buffer
+      (add-hook 'kill-buffer-hook
+                (apply-partially
+                 (lambda (buffer)
+                   (when-let ((pbuffer
+                               (car (alist-get buffer 
nnimap-connection-alist))))
+                     (setq nnimap-process-buffers
+                           (delq pbuffer nnimap-process-buffers))
+                     (kill-buffer pbuffer) ;; should HUP its process
+                     (setq nnimap-connection-alist
+                           (assq-delete-all buffer nnimap-connection-alist))))
+                 buffer)
+                nil t))
     (current-buffer)))
 
 (defvar auth-source-creation-prompts)
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 3ddd53e46c..044e032134 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -1301,6 +1301,19 @@ nntp-open-connection
          (prog1
              (caar (push (list process buffer nil) nntp-connection-alist))
            (push process nntp-connection-list)
+            (with-current-buffer buffer
+              (add-hook 'kill-buffer-hook
+                        (apply-partially
+                         (lambda (buffer)
+                           (when-let ((process
+                                       (car (nntp-find-connection-entry 
buffer))))
+                             (setq nntp-connection-list
+                                   (delq process nntp-connection-list))
+                             (setq nntp-connection-alist
+                                   (assq-delete-all process 
nntp-connection-alist))
+                             (ignore-errors (delete-process process))))
+                         buffer)
+                        nil t))
            (with-current-buffer pbuffer
              (nntp-read-server-type)
              (erase-buffer)
diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el
index 7c5bd3a987..43669cc1af 100644
--- a/lisp/mh-e/mh-compat.el
+++ b/lisp/mh-e/mh-compat.el
@@ -47,8 +47,7 @@
 (mh-do-in-xemacs
   (defun mh-require (feature &optional filename noerror)
     "If feature FEATURE is not loaded, load it from FILENAME.
-If FEATURE is not a member of the list `features', then the feature
-is not loaded; so load the file FILENAME.
+Loaded features are recorded in the list variable `features'.
 If FILENAME is omitted, the printname of FEATURE is used as the file name.
 If the optional third argument NOERROR is non-nil,
 then return nil if the file is not found instead of signaling an error.
diff --git a/src/fns.c b/src/fns.c
index cbb6879223..7d4ed7cab6 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -2917,8 +2917,7 @@ require_unwind (Lisp_Object old_value)
 
 DEFUN ("require", Frequire, Srequire, 1, 3, 0,
        doc: /* If feature FEATURE is not loaded, load it from FILENAME.
-If FEATURE is not a member of the list `features', then the feature is
-not loaded; so load the file FILENAME.
+Loaded features are recorded in the list variable `features'.
 
 If FILENAME is omitted, the printname of FEATURE is used as the file
 name, and `load' will try to load this name appended with the suffix
-- 
2.23.0






reply via email to

[Prev in Thread] Current Thread [Next in Thread]