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

classic Classic list List threaded Threaded
17 messages Options
Reply | Threaded
Open this post in threaded view
|

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

dick.r.chiang
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 | Threaded
Open this post in threaded view
|

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

Eric Abrahamsen-2
[hidden email] writes:

> 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

I'm looking forward to testing this out this weekend!

Just a quick NB, which you should feel free to ignore: you'll probably
get much better uptake on these tickets if you include with them a
head-to-toe prose report on what they accomplish and why (in detail).
Emacs has a lot of bug reports, and a small number of bug hunters, and a
multi-hundred-line patch without so much as a "howdy-do" on it is ripe
to be ignored. Just something to consider.



Reply | Threaded
Open this post in threaded view
|

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

Robert Pluim
In reply to this post by dick.r.chiang
>>>>> On Fri, 08 Nov 2019 19:31:17 -0800, Eric Abrahamsen <[hidden email]> said:

    Eric> [hidden email] writes:

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

    Eric> I'm looking forward to testing this out this weekend!

    Eric> Just a quick NB, which you should feel free to ignore: you'll probably
    Eric> get much better uptake on these tickets if you include with them a
    Eric> head-to-toe prose report on what they accomplish and why (in detail).
    Eric> Emacs has a lot of bug reports, and a small number of bug hunters, and a
    Eric> multi-hundred-line patch without so much as a "howdy-do" on it is ripe
    Eric> to be ignored. Just something to consider.

That, plus the patch has spurious whitspace changes, and things like
the below, which makes it all harder to read.

>>>>> On Fri, 08 Nov 2019 09:56:41 -0500, [hidden email] said:
    dick> diff --git a/src/fns.c b/src/fns.c
    dick> index cbb6879223..7d4ed7cab6 100644
    dick> --- a/src/fns.c
    dick> +++ b/src/fns.c
    dick> @@ -2917,8 +2917,7 @@ require_unwind (Lisp_Object old_value)
 
    dick>  DEFUN ("require", Frequire, Srequire, 1, 3, 0,
    dick>         doc: /* If feature FEATURE is not loaded, load it from FILENAME.
    dick> -If FEATURE is not a member of the list `features', then the feature is
    dick> -not loaded; so load the file FILENAME.
    dick> +Loaded features are recorded in the list variable `features'.
 
    dick>  If FILENAME is omitted, the printname of FEATURE is used as the file
    dick>  name, and `load' will try to load this name appended with the suffix
    dick> --
    dick> 2.23.0



Reply | Threaded
Open this post in threaded view
|

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

Lars Ingebrigtsen
In reply to this post by Eric Abrahamsen-2
Eric Abrahamsen <[hidden email]> writes:

> [hidden email] writes:
>
>> 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
>
> I'm looking forward to testing this out this weekend!

I haven't tested it, but it sounds like a great feature.

> Just a quick NB, which you should feel free to ignore: you'll probably
> get much better uptake on these tickets if you include with them a
> head-to-toe prose report on what they accomplish and why (in detail).
> Emacs has a lot of bug reports, and a small number of bug hunters, and a
> multi-hundred-line patch without so much as a "howdy-do" on it is ripe
> to be ignored. Just something to consider.

No, please don't ignore.  :-)

It'd be helpful if you wrote something about how errors during `g' are
reported and stuff and how stable this is, because my impression of the
Emacs thread support is that it is (so far) got some stability
problems.  

--
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no



Reply | Threaded
Open this post in threaded view
|

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

Eric Abrahamsen-2
Lars Ingebrigtsen <[hidden email]> writes:

> Eric Abrahamsen <[hidden email]> writes:
>
>> [hidden email] writes:
>>
>>> 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
>>
>> I'm looking forward to testing this out this weekend!

I finally got to road-testing this, and so far haven't been able to
break it.

> It'd be helpful if you wrote something about how errors during `g' are
> reported and stuff and how stable this is, because my impression of the
> Emacs thread support is that it is (so far) got some stability
> problems.  

I haven't tried to make it raise an error, but I did set
`nntp-connection-timeout' very low, and try to trigger an error that
way. Nothing bad happened -- I will take a look at the code and see how
timeouts are handled.

So far so good!



Reply | Threaded
Open this post in threaded view
|

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

Lars Ingebrigtsen
Eric Abrahamsen <[hidden email]> writes:

> I haven't tried to make it raise an error, but I did set
> `nntp-connection-timeout' very low, and try to trigger an error that
> way. Nothing bad happened -- I will take a look at the code and see how
> timeouts are handled.

Try putting an (error) in `nntp-open-server' or something.  :-)

> So far so good!

Sounds good.

--
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no



Reply | Threaded
Open this post in threaded view
|

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

Eric Abrahamsen-2
In reply to this post by dick.r.chiang

On 11/18/19 09:54 AM, Lars Ingebrigtsen wrote:
> Eric Abrahamsen <[hidden email]> writes:
>
>> I haven't tried to make it raise an error, but I did set
>> `nntp-connection-timeout' very low, and try to trigger an error that
>> way. Nothing bad happened -- I will take a look at the code and see how
>> timeouts are handled.
>
> Try putting an (error) in `nntp-open-server' or something.  :-)

Oh, sure. I stuck errors in `nntp-open-server' and
`nntp-finish-retrieve-group-infos', and worked that both with a
nntp-connection-timeout and without, and wasn't able to drive it
completely off the rails -- unfortunately I did get two odd errors which
I was later unable to reproduce: one about selecting a deleted buffer,
which I think came out of `nntp-open-server', and another that looked
like "gnus-thread-group: " and then a chunk of bytecode. I don't know
how I got those, though!

The only other error I'm seeing now is if you start Gnus at a specified
level (ie "M-4 M-x gnus"), it will error out in
`gnus-get-unread-articles', line 1791, because it's expecting "(car
gnus-group-list-mode)" to be a number, but it hasn't been set yet.

In general, it would be great to have more code comments, particularly
in `gnus-get-unread-articles'. I'm afraid that we're going to end up
with more code that only one person really understands, touching on an
area of elisp (threading) that we're all kind of expecting to be
unstable.

That's all I've got for now.



Reply | Threaded
Open this post in threaded view
|

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

dick.r.chiang
I am very grateful for your interest and testing!

> selecting a deleted buffer

I get this quite a bit.  It occurs when `gnus-summary-buffer` in the main
thread gets usurped by a background thread.  I am either allowing this
important variable to get reassigned before the dynamic-let in `gnus-thread-body`
or I am not understanding dynamic-let in the presence of threads.
Incidentally, it's very difficult to point to lines of code I'm talking
about without git{hub,lab}.

> line 1791, because it's expecting "(car gnus-group-list-mode)" to be a
> number, but it hasn't been set yet.

I'll look into this, and add a test for `nntp-open-server`.

I am happy to let this marinate to get people thinking about Gnus's future.  There are many historical artifacts (like blocking `gnus-group-get-new-news`
and left-field variables like `gnus-secondary-select-methods`) that prevent
Gnus from becoming a viable MUA for more people.

Some other fellow recently posted about an ephemeral group branch which he
somehow got others to test for him in-parallel.  I don't know how he did that
outside the debbugs system.




Reply | Threaded
Open this post in threaded view
|

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

Eric Abrahamsen-2

On 11/18/19 17:22 PM, [hidden email] wrote:
> I am very grateful for your interest and testing!

My pleasure, of course -- I think this is an important direction to be
going in.

>> selecting a deleted buffer
>
> I get this quite a bit.  It occurs when `gnus-summary-buffer` in the main
> thread gets usurped by a background thread.  I am either allowing this
> important variable to get reassigned before the dynamic-let in `gnus-thread-body`
> or I am not understanding dynamic-let in the presence of threads.
> Incidentally, it's very difficult to point to lines of code I'm talking
> about without git{hub,lab}.

We could consider turning on `lexical-binding' in gnus-start.el, and
just see what happens :)

Regarding code line numbers, etc, I just do it manually -- I'm looking
at the code to begin with, and it's trivial to check what line I'm on.

>> line 1791, because it's expecting "(car gnus-group-list-mode)" to be a
>> number, but it hasn't been set yet.
>
> I'll look into this, and add a test for `nntp-open-server`.
>
> I am happy to let this marinate to get people thinking about Gnus's
> future. There are many historical artifacts (like blocking
> `gnus-group-get-new-news`
> and left-field variables like `gnus-secondary-select-methods`) that prevent
> Gnus from becoming a viable MUA for more people.

Well they definitely prevent bug-hunters and feature-implementers from
making much progress. Stuff like `gnus-group-list-mode' drives me nuts:
an undocumented variable that might totally change Gnus' behavior. But
unpicking this complexity is slow work.

> Some other fellow recently posted about an ephemeral group branch which he
> somehow got others to test for him in-parallel.  I don't know how he did that
> outside the debbugs system.

I make liberal use of git worktrees. I made a local branch to apply your
patch, then checked it out into a separate directory with "git worktree
add" and built Emacs there. Then I run that Emacs. For Gnus stuff I have
a package called gnus-mock that provides a working Gnus environment with
dummy data. I point gnus-mock at the worktree directory, and it starts
up a clean Emacs with the Gnus data in place. I do most of my testing
there.

On the Emacs side it's projectile and magit: projectile indexes the
worktree as a separate project. If you send me a line number from your
branch to look at, I do "C-c p p" -> helm-projectile-switch-project
which opens up magit for the project, then "C-c p f" ->
helm-projectile-find-file, then the usual "M-g g" -> goto-line. Not too
inconvenient.

If you have access to the Emacs repos and are collaborating with others
who do, too, then it can make sense to push a "feature/foo" branch to
the repos, and share it. I've done testing that way.

What I'd like is a Gnus summary minor mode I could enable in, say,
"emacs.bugs", which turns commit hashes into hyperlinks and provides
commands for "apply the attached patch to some worktree". I think other
people have done that, I've just never gotten around to it.

Eric



Reply | Threaded
Open this post in threaded view
|

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

Robert Pluim
>>>>> On Mon, 18 Nov 2019 15:18:10 -0800, Eric Abrahamsen <[hidden email]> said:

    Eric> What I'd like is a Gnus summary minor mode I could enable in, say,
    Eric> "emacs.bugs", which turns commit hashes into hyperlinks and provides
    Eric> commands for "apply the attached patch to some worktree". I think other
    Eric> people have done that, I've just never gotten around to it.

You mean like 'debbugs-gnu' and 'debbugs-gnu-bugs' from the debbugs-gnu
package? That has commands to do exactly that.

Robert



Reply | Threaded
Open this post in threaded view
|

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

Eric Abrahamsen-2

On 11/19/19 11:18 AM, Robert Pluim wrote:
>>>>>> On Mon, 18 Nov 2019 15:18:10 -0800, Eric Abrahamsen <[hidden email]> said:
>
>     Eric> What I'd like is a Gnus summary minor mode I could enable in, say,
>     Eric> "emacs.bugs", which turns commit hashes into hyperlinks and provides
>     Eric> commands for "apply the attached patch to some worktree". I think other
>     Eric> people have done that, I've just never gotten around to it.
>
> You mean like 'debbugs-gnu' and 'debbugs-gnu-bugs' from the debbugs-gnu
> package? That has commands to do exactly that.

Ha, I guess that's true, I've just never gotten accustomed to using
debbugs-gnu. I wish I could make a persistent debbugs view just showing
the few bugs I'm looking at at any given time (never very many), which
is easy to do in a Gnus group by ticking articles.



Reply | Threaded
Open this post in threaded view
|

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

Lars Ingebrigtsen
Eric Abrahamsen <[hidden email]> writes:

> Ha, I guess that's true, I've just never gotten accustomed to using
> debbugs-gnu. I wish I could make a persistent debbugs view just showing
> the few bugs I'm looking at at any given time (never very many), which
> is easy to do in a Gnus group by ticking articles.

That wouldn't be very difficult to add to debbugs-gnu, actually.  It
already has the concept of "marked" bugs, so there could be a command
like, say, `debbugs-gnu-show-marked' that just shows that list of bugs.

--
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no



Reply | Threaded
Open this post in threaded view
|

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

Michael Albinus
Lars Ingebrigtsen <[hidden email]> writes:

> That wouldn't be very difficult to add to debbugs-gnu, actually.  It
> already has the concept of "marked" bugs, so there could be a command
> like, say, `debbugs-gnu-show-marked' that just shows that list of bugs.

Patches welcome :-)

I'm not so fluid in writing gnus patches, so don't count on me.

Best regards, Michael.



Reply | Threaded
Open this post in threaded view
|

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

Robert Pluim
>>>>> On Wed, 20 Nov 2019 12:55:45 +0100, Michael Albinus <[hidden email]> said:

    Michael> Lars Ingebrigtsen <[hidden email]> writes:
    >> That wouldn't be very difficult to add to debbugs-gnu, actually.  It
    >> already has the concept of "marked" bugs, so there could be a command
    >> like, say, `debbugs-gnu-show-marked' that just shows that list of bugs.

    Michael> Patches welcome :-)

    Michael> I'm not so fluid in writing gnus patches, so don't count on me.

Doesnʼt this already exist?

    M-x debbugs-gnu
    Hit 't' on the bugs that youʼre interested in
    quit debbugs
    M-x debbugs-gnu
    Erase the default severities, say 'tagged', then hit RET at the next prompt
    Hey presto, debbugs-gnu with only the bugs you hit 't' on earlier.

If you want to add a bug to that list:

    M-x debbugs-gnu-bug
    type the bug number, RET
    Hit 't'

Now the next time you run debbugs-gnu as above that bug will appear as
well.

Robert



Reply | Threaded
Open this post in threaded view
|

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

Michael Albinus
Robert Pluim <[hidden email]> writes:

> Doesnʼt this already exist?
>
>     M-x debbugs-gnu
>     Hit 't' on the bugs that youʼre interested in
>     quit debbugs
>     M-x debbugs-gnu
>     Erase the default severities, say 'tagged', then hit RET at the next prompt
>     Hey presto, debbugs-gnu with only the bugs you hit 't' on earlier.
>
> If you want to add a bug to that list:
>
>     M-x debbugs-gnu-bug
>     type the bug number, RET
>     Hit 't'
>
> Now the next time you run debbugs-gnu as above that bug will appear as
> well.

Sure (and I use it every single day). But I understood the request as
"Pls give me one gnus summary buffer containing all messages of bugs I
have tagged locally". This doesn't exist yet.

> Robert

Best regards, Michael.



Reply | Threaded
Open this post in threaded view
|

bug#38136: https://github.com/dickmao/gnus

dick.r.chiang
In reply to this post by Robert Pluim
RP> That, plus the patch has spurious whitspace changes, and things like the
RP> below, which makes it all harder to read.

I've a mind, of course, to bring non-blocking goodness to the main branch, but
the volume of changes (more than 200 commits and counting at
github.com/dickmao/gnus) requires a social effort that may never reach critical mass.

The original patch wishfully believed dynamic-letting globals like
`gnus-summary-buffer` would do an end-run around thread-safety.  But "leakage"
occurs far too often as manifested by "Selected deleted buffer" errors.



Reply | Threaded
Open this post in threaded view
|

bug#38136: https://github.com/dickmao/gnus

Eric Abrahamsen-2
[hidden email] writes:

> RP> That, plus the patch has spurious whitspace changes, and things like the
> RP> below, which makes it all harder to read.
>
> I've a mind, of course, to bring non-blocking goodness to the main branch, but
> the volume of changes (more than 200 commits and counting at
> github.com/dickmao/gnus) requires a social effort that may never reach critical mass.

Don't give up hope! But I definitely recommend starting the social
effort part of things before you invest enormous amounts of time in code
(too late, I know). This is a collaborative effort, and people have
*very* strong opinions about how their Gnus behaves, and you're better
off floating ideas sooner rather than later -- for example, any one of
us could have told you that requiring users to set `gnus-select-methods'
via customization (and not `setq') was probably a non-starter. Which
could have saved you some time!

> The original patch wishfully believed dynamic-letting globals like
> `gnus-summary-buffer` would do an end-run around thread-safety.  But "leakage"
> occurs far too often as manifested by "Selected deleted buffer" errors.

Every time I've embarked on grand refactorings of Gnus I've run up
against problems like this -- every part of Gnus is tied so tightly to
every other part, it's very hard to unpick. So I've started working
backwards from the big goals. Do we want threaded server updates?
`nntp-server-buffer' is the problem. So each server should probably have
its own "work buffer". The easiest way to make that happen is if servers
are structs. And on down from there, trying to work down to a root
problem that, when solved, will reduce complexity instead of increasing
it, and boost modularity rather than causing tighter code integration.

Then I still screw it up in the end, but hey, I think it's the right
approach.

I think a lot of our problems will be made more tractable by getting rid
of code that assumes a "current" thing. The "current" server. The
"current" group. The "current" summary buffer. Pass arguments, don't
check dynamic variables. Maybe that would be a better place to start.

That patch that could end up enabling the big refactors later might not
look like much at first glance.