From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED.blaine.gmane.org!not-for-mail From: dick.r.chiang@gmail.com Newsgroups: gmane.emacs.bugs Subject: bug#38136: [PATCH] Make gnus-group-get-new-news a non blocking thread Date: Fri, 08 Nov 2019 09:56:41 -0500 Message-ID: <87imnu1knq.fsf@dick> Mime-Version: 1.0 Content-Type: text/x-diff Injection-Info: blaine.gmane.org; posting-host="blaine.gmane.org:195.159.176.226"; logging-data="223609"; mail-complaints-to="usenet@blaine.gmane.org" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) To: 38136@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Fri Nov 08 15:57:19 2019 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([209.51.188.17]) by blaine.gmane.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.89) (envelope-from ) id 1iT5hP-000w3M-8e for geb-bug-gnu-emacs@m.gmane.org; Fri, 08 Nov 2019 15:57:19 +0100 Original-Received: from localhost ([::1]:55798 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iT5hN-0001Vi-VI for geb-bug-gnu-emacs@m.gmane.org; Fri, 08 Nov 2019 09:57:17 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:45139) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iT5hF-0001Un-8d for bug-gnu-emacs@gnu.org; Fri, 08 Nov 2019 09:57:12 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1iT5hC-0000Gh-8r for bug-gnu-emacs@gnu.org; Fri, 08 Nov 2019 09:57:09 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]:38613) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1iT5hC-0000GY-3c for bug-gnu-emacs@gnu.org; Fri, 08 Nov 2019 09:57:06 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1iT5hB-0004HV-3E for bug-gnu-emacs@gnu.org; Fri, 08 Nov 2019 09:57:05 -0500 X-Loop: help-debbugs@gnu.org Resent-From: dick.r.chiang@gmail.com Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 08 Nov 2019 14:57:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 38136 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-gnu-emacs Original-Received: via spool by submit@debbugs.gnu.org id=B.157322501816447 (code B ref -1); Fri, 08 Nov 2019 14:57:04 +0000 Original-Received: (at submit) by debbugs.gnu.org; 8 Nov 2019 14:56:58 +0000 Original-Received: from localhost ([127.0.0.1]:47434 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iT5h3-0004HD-5W for submit@debbugs.gnu.org; Fri, 08 Nov 2019 09:56:58 -0500 Original-Received: from lists.gnu.org ([209.51.188.17]:43653) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1iT5gy-0004H7-7Z for submit@debbugs.gnu.org; Fri, 08 Nov 2019 09:56:53 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:45087) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iT5gu-0001Pd-TK for bug-gnu-emacs@gnu.org; Fri, 08 Nov 2019 09:56:51 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1iT5gs-00005p-0V for bug-gnu-emacs@gnu.org; Fri, 08 Nov 2019 09:56:48 -0500 Original-Received: from mail-qk1-x72e.google.com ([2607:f8b0:4864:20::72e]:43067) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1iT5gr-00005X-PV for bug-gnu-emacs@gnu.org; Fri, 08 Nov 2019 09:56:45 -0500 Original-Received: by mail-qk1-x72e.google.com with SMTP id z23so5456406qkj.10 for ; Fri, 08 Nov 2019 06:56:45 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:subject:date:message-id:user-agent:mime-version :content-disposition:content-description; bh=y3nMsOZdJriUbjvlsitm6rqHawmQdgjQ1YRb43Sgg7k=; b=r99c9mG+ofTzMKEdV7D/YwiLatou5H2QLjc+OarWrO+grr28UgitFGaWxoZpclKgnN svpH5+/BWCr1SXHw+LVsK1UISX+xo49AdaaTsqP4PswqddE1vO882yiRfNEA2XMFjNCE j0FVHZBoF9Izx212QeVpCwytmooUnLg+2NjmEOYk60zAl2tURYpxhqCMLALXuE3Bk2Es 4b3iubj5dOrYwa9iYP/FDJAdk8KUQsuMHh/zMvH3+174RrI+rnBZYJpVfRWXpej2huAn upYlqZl7XXe9ek0mNdw1A4Glrq8muZNIRGjIiUftk/3OK1ylmd0NMhVhlFFcNNs0gTnE D+4A== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:subject:date:message-id:user-agent :mime-version:content-disposition:content-description; bh=y3nMsOZdJriUbjvlsitm6rqHawmQdgjQ1YRb43Sgg7k=; b=iv1x8AX0gChdKvgk78gNNh8KKqKl8CXNVGZmxbkK2MbYQ1PbEkDySIdxLGPbs6V6RI o0th4vjdeBAXPozw3k5U8otmnQeZZpGRiIFMYyPvJSO0uDfk7JLxSnKUAf6xr/QDiqd4 zcN9F5L9AJBI0gLzIb5j93hSJhF5pfgFFSVw5ay/VbcktsgBuZgL/WP6PE56qmLMw7O/ PqfH18jaq6SmWQmg2t1b/DUd7UaybY6V5DfyBS2n/zfTzYr5sIU9YvilGee+2UiuvTAL mML1iubY2TjeXH72LF/x4WXNNUmLaHZrQXQDe+dp//JwJzLNOlZ2q4lWKc2TsDfoDMFx WcrA== X-Gm-Message-State: APjAAAV2pJYAjZ8JcynD3ChmGEqJWovzTfmKSWDfHG8K1uiHdFYmWgLo XruJeSWl+jZyNz45z0SICeSyPiwd X-Google-Smtp-Source: APXvYqyuWQcSB1Xb3wWYqz6LHlNCDYo8j5Mn3+1TsgPW7JT4gSLGBhy8g46Hoogh3YuPKTRhqVS9kQ== X-Received: by 2002:a05:620a:208a:: with SMTP id e10mr8704883qka.221.1573225004381; Fri, 08 Nov 2019 06:56:44 -0800 (PST) Original-Received: from localhost (pool-100-33-98-8.nycmny.fios.verizon.net. [100.33.98.8]) by smtp.gmail.com with ESMTPSA id n49sm3361264qtk.94.2019.11.08.06.56.42 (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Fri, 08 Nov 2019 06:56:42 -0800 (PST) Content-Disposition: inline; filename=0001-Make-gnus-group-get-new-news-a-non-blocking-thread.patch Content-Description: patch X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:171224 Archived-At: >From 834327d458c54bb0e1f25c6259ee640df0ba8b0e Mon Sep 17 00:00:00 2001 From: dickmao 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