From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: dick.r.chiang@gmail.com Newsgroups: gmane.emacs.bugs Subject: bug#49065: 28.0.50; Major Changes to Gnus Date: Wed, 16 Jun 2021 13:57:12 -0400 Message-ID: <87fsxhwv47.fsf@dick> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="6110"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.14 (Gnus v5.14pre) Emacs/28.0.50 (gnu/linux) To: 49065@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Wed Jun 16 19:58:15 2021 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1ltZnp-0001Du-Sp for geb-bug-gnu-emacs@m.gmane-mx.org; Wed, 16 Jun 2021 19:58:14 +0200 Original-Received: from localhost ([::1]:48790 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ltZno-0002Ie-Tf for geb-bug-gnu-emacs@m.gmane-mx.org; Wed, 16 Jun 2021 13:58:12 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:59910) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ltZne-0002IT-FZ for bug-gnu-emacs@gnu.org; Wed, 16 Jun 2021 13:58:03 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:41764) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1ltZne-0006rB-83 for bug-gnu-emacs@gnu.org; Wed, 16 Jun 2021 13:58:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ltZne-0006K0-8S for bug-gnu-emacs@gnu.org; Wed, 16 Jun 2021 13:58:02 -0400 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: Wed, 16 Jun 2021 17:58:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 49065 X-GNU-PR-Package: emacs X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.162386624724255 (code B ref -1); Wed, 16 Jun 2021 17:58:02 +0000 Original-Received: (at submit) by debbugs.gnu.org; 16 Jun 2021 17:57:27 +0000 Original-Received: from localhost ([127.0.0.1]:53311 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ltZn5-0006J9-EY for submit@debbugs.gnu.org; Wed, 16 Jun 2021 13:57:27 -0400 Original-Received: from lists.gnu.org ([209.51.188.17]:35632) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ltZn3-0006J1-Mt for submit@debbugs.gnu.org; Wed, 16 Jun 2021 13:57:25 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:59828) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ltZn3-0001oL-7m for bug-gnu-emacs@gnu.org; Wed, 16 Jun 2021 13:57:25 -0400 Original-Received: from mail-qk1-x730.google.com ([2607:f8b0:4864:20::730]:46698) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1ltZmu-0006JD-E0 for bug-gnu-emacs@gnu.org; Wed, 16 Jun 2021 13:57:24 -0400 Original-Received: by mail-qk1-x730.google.com with SMTP id f70so256097qke.13 for ; Wed, 16 Jun 2021 10:57:16 -0700 (PDT) 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; bh=J0tfNNGoRZjezLmH2PNQt4syarETizRANuwwGrPSMCY=; b=gAzbuSnSAGCs1j2vI3qlTUQ+GQTi3iBtDwAIznqpeO0sU8Y1E5LOGVQNiI+A3J1a2E uTOqKBOasTeppEc3fEnsFekkskmTLh0MOQFcXONnGpyOQ6kl5U/zGizGq/BedNBTp0a9 wPgktWvWIt5TrQ7IlwwolZ+DeurrtOAMkkuWMUMR3FY0VPc+aLTJjB798lDU0Qv9Cm6Y FYxyH+v2FmcxLT87dfS3a5Kq14pmWFJewk6iu69xms0qIKM1Hu2yUWKaid9ba+/k1dra PaWihgQFLhA3OaPWYm2lVHN1V1IToEhgSi9oIojGdAMf4B3/NDenlF3ssp0YtQv9wYIf hVyw== 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; bh=J0tfNNGoRZjezLmH2PNQt4syarETizRANuwwGrPSMCY=; b=gsAvW+cbZmMSjsSBR7WUuUYN7LNaDyp0TygrNJV/BDMEQtaA+6+vCGASEYfH2CMCUp JMCcCZ2o20JQP3VrDRj3/Mofc/hsNCJAVpVDBUOWy/yxMaZZE8p6SBex9Wt2G9J+kBrw DS9uluuOs9TLVdfD8l+CnYw2Rq0pEl/3FvD9S/INEI6SQ+22JZoQGnK263chDyrPKiKZ x/SngRAGXi5sspJy2PvafP6abRmMZNYHrT7QfTUuXR/JLq99ZQrd7a0aq30NzgiCIx99 PwxYZMJ/s4M5zTkOI5w2j+CUzJVZ3Br3plZmX7vcl/3lO/pcKMKdM8aKKzx5aq6Dgw6o NpBQ== X-Gm-Message-State: AOAM532e5CHiEx5iSthwe7HcbE6NOn6I9qmXIxUW9JgEicq5MUFmEpV2 1PuvvLSjlxNxzkwHCEFsjctcSs8LS/I= X-Google-Smtp-Source: ABdhPJxy7yaGGaIQDaj4O5iwMrF2iWjdg50i78SaxXFa20gtxSMU1Os5uD6TiAPjT6bf9vHoIuhZIg== X-Received: by 2002:a05:620a:22c9:: with SMTP id o9mr1298015qki.398.1623866235113; Wed, 16 Jun 2021 10:57:15 -0700 (PDT) Original-Received: from localhost (pool-71-190-212-171.nycmny.fios.verizon.net. [71.190.212.171]) by smtp.gmail.com with ESMTPSA id e3sm1639211qts.34.2021.06.16.10.57.13 for (version=TLS1_2 cipher=ECDHE-ECDSA-CHACHA20-POLY1305 bits=256/256); Wed, 16 Jun 2021 10:57:13 -0700 (PDT) Received-SPF: pass client-ip=2607:f8b0:4864:20::730; envelope-from=dick.r.chiang@gmail.com; helo=mail-qk1-x730.google.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list 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-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:208643 Archived-At: --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: attachment; filename=0001-Major-changes-to-Gnus.patch Content-Transfer-Encoding: quoted-printable >From 54243028a84a4c1b915d45fea7540638b1c26c95 Mon Sep 17 00:00:00 2001 From: dickmao Date: Wed, 16 Jun 2021 13:50:40 -0400 Subject: [PATCH] Major changes to Gnus Obsolesce gnus-secondary-select-methods for gnus-select-methods. Rationalize newsrc logic. Rationalize nnimap. Obviate `gnus-set-global-variables`, `gnus-summary-local-variables`. Toggle `gnus-background-get-unread-articles` parallel fetch thread. * doc/emacs/misc.texi (Gnus Startup): Declutter. * doc/misc/auth.texi (Multiple GMail accounts with Gnus): Declutter. * doc/misc/gnus.texi (Finding the News): Declutter. (Startup Files): Declutter. (Startup Variables): Declutter. (Foreign Groups): Declutter. (More Threading): Declutter. (Little Disk Space): Declutter. * etc/gnus/news-server.ast (User name and password): Whitespace. * lisp/gnus/gnus-agent.el (gnus): Declutter. (gnus-cache): Declutter. (nnvirtual): Declutter. (gnus-sum): Declutter. (gnus-score): Declutter. (gnus-srvr): Declutter. (gnus-util): Declutter. (require): Declutter. (gnus-start): Declutter. (gnus-all-score-files): Declutter. (gnus-server-set-status): Declutter. (gnus-server-named-server): Declutter. (gnus-inews-do-gcc): Declutter. (gnus-inews-group-method): Declutter. (gnus-cache-coding-system): Declutter. (gnus-agent-read-agentview): Declutter. * lisp/gnus/gnus-art.el (require): Declutter. (seq): Declutter. (gnus-article-wash-types): Buffer-localize. (gnus-article-image-alist): Buffer-localize. (gnus-original-group-and-article): Buffer-localize. (gnus-article-mime-handle-alist): Buffer-localize. (gnus-article-current-summary): Buffer-localize. (gnus-article-edit-mode): Declutter. (gnus-article-mode): Declutter. (gnus-article-setup-buffer-ensure): Refactor. (gnus-article-setup-buffer): Refactor. (gnus-article-prepare): gnus-summary-assume-in-summary, not set-buffer. (gnus-article-prepare-display): Replace nonsense hook. (gnus-article-show-summary): Delete gnus-article-set-globals. (gnus-article-followup-with-original): Whitespace. (gnus-request-article-this-buffer): Rationalize. (gnus-flush-original-article-buffer): Consolidate state. (gnus-article-set-globals): Delete gnus-article-set-globals. (gnus-article-encrypt-body): Delete gnus-set-global-variables. * lisp/gnus/gnus-async.el (require): Declutter. * lisp/gnus/gnus-cache.el (gnus): Declutter. (gnus-cache-removable-articles): Buffer-localize. (gnus-cache-read-active): gnus-with-temp-buffer, not gnus-set-work-buffer. * lisp/gnus/gnus-demon.el (require): Declutter. * lisp/gnus/gnus-draft.el (gnus): Declutter. (message): Declutter. (gnus-cache): Declutter. * lisp/gnus/gnus-fun.el (gnus-util): Declutter. * lisp/gnus/gnus-group.el (mm-url): Declutter. (subr-x): Declutter. (require): Declutter. (gnus-group-mode): Elide gnus-update-format-specifications bogus argument. (gnus-update-group-mark-positions): gnus-with-temp-buffer, not gnus-set-work-buffer. (gnus-group-list-groups): Elide gnus-update-format-specifications bogus argument. (gnus-group-insert-group-line): Declutter. (gnus-group-update-eval-form): Declutter. (gnus-group-first-unread-group): Declutter. (gnus-group-list-active): Declutter. (gnus-group-quit): Delete gnus-current-startup-file. (gnus-group-set-info): Declutter. * lisp/gnus/gnus-icalendar.el (require): Declutter. * lisp/gnus/gnus-int.el (gnus-agent-unfetch-articles): Declutter. (gnus-summary-select-article): Declutter. (gnus-summary-insert-subject): Declutter. (gnus-summary-setup-buffer): Declutter. (gnus-summary-read-group-1): Declutter. (gnus-server-opened): Declutter. (gnus-start-news-server): Obsolesce gnus-secondary-select-methods. (gnus-get-function): Declutter. (gnus-request-group): Declutter. (gnus-close-group): Declutter. * lisp/gnus/gnus-kill.el (gnus-apply-kill-file-internal): prog1 for clarity. * lisp/gnus/gnus-logic.el (require): Declutter. (gnus-util): Declutter. * lisp/gnus/gnus-mlspl.el (gnus-group-split-setup): Rationalize newsrc logi= c. * lisp/gnus/gnus-msg.el (require): Declutter. (gnus): Declutter. (gnus-util): Declutter. (cl-extra): Declutter. (gnus-setup-message): Declutter. (gnus-inews-add-send-actions): Buffer-localize. (gnus-group-post-news): gnus-article-copy is better as a variable. (gnus-copy-article-buffer): Use with-current-buffer instead of set-buffer. (gnus-msg-preserve-variables): Buffer-local variables need to propagate. (gnus-msg-inherit-variables): Buffer-local variables need to propagate. (gnus-post-news): Buffer-local variables need to propagate. (gnus-post-method): Obsolesce gnus-secondary-select-methods. (gnus-summary-reply): Whitespace. * lisp/gnus/gnus-notifications.el (gnus-util): Declutter. * lisp/gnus/gnus-picon.el (require): Declutter. * lisp/gnus/gnus-registry.el (gnus-util): Declutter. (subr-x): Declutter. (gnus-registry-initialize): Rationalize newsrc logic. (gnus-registry-unload-hook): Rationalize newsrc logic. * lisp/gnus/gnus-salt.el (require): Declutter. (gnus-pick-mode): Elide gnus-update-format-specifications bogus argument. (gnus-tree-mode): gnus-with-temp-buffer, not gnus-set-work-buffer. * lisp/gnus/gnus-score.el (gnus-score-alist): Buffer-localize. (gnus-score-save): Declutter. (gnus-score-headers): Whitespace. (gnus-sort-score-files): Declutter. * lisp/gnus/gnus-search.el (gnus-util): Declutter. (require): Declutter. (gnus-search-run-search): nnimap-process-buffer, not nnimap-buffer. * lisp/gnus/gnus-spec.el (require): Declutter. (gnus-newsrc-file-version): Buffer-localize. (gnus-summary-mark-positions): Buffer-localize. (gnus-update-format-specifications): Elide bogus argument. (gnus-parse-format): Spaces, not tabs. (gnus-parse-complex-format): gnus-with-temp-buffer, not gnus-set-work-buffe= r. (gnus-parse-simple-format): gnus-with-temp-buffer, not gnus-set-work-buffer. * lisp/gnus/gnus-srvr.el (require): Declutter. (gnus-browse-foreign-server): Obsolesce gnus-secondary-select-methods. * lisp/gnus/gnus-start.el (gnus-util): Declutter. (nnmail): Declutter. (gnus-group-decoded-name): Declutter. (gnus-agent-save-active): Declutter. (gnus-agentize): Declutter. (require): Declutter. (gnus-group-default-level): Declutter. (gnus-inhibit-demon): Declutter. (gnus-startup-file): Rationalize newsrc logic. (gnus-thread-group): Prefix for gnus fetch thread group. (gnus-backup-startup-file): Rationalize newsrc logic. (gnus-max-seconds-hold-mutex): Self-explanatory. (gnus-save-startup-file-via-temp-buffer): Rationalize newsrc logic. (gnus-mutex-get-unread-articles): Self-explanatory. (gnus-dot-newsrc): What used to be gnus-startup-file. (gnus-newsrc-file): What used to be gnus-newsrc-el-file. (gnus-check-new-newsgroups): Obsolesce gnus-secondary-select-methods. (gnus-read-newsrc-file): Rationalize newsrc logic. (gnus-save-newsrc-file): Rationalize newsrc logic. (gnus-save-dot-newsrc): Rationalize newsrc logic. (gnus-background-get-unread-articles): Enable backgrounding fetch. (gnus-read-newsrc-el-hook): Rationalize newsrc logic. (gnus-read-newsrc-hook): Rationalize newsrc logic. (gnus-save-newsrc-hook): Rationalize newsrc logic. (gnus-save-quick-newsrc-hook): Rationalize newsrc logic. (gnus-save-standard-newsrc-hook): Rationalize newsrc logic. (gnus-current-startup-file): Rationalize newsrc logic. (gnus-subscribe-hierarchically): Rationalize newsrc logic. (gnus-clear-system): Use when instead of and for conditionals. (gnus-1): Whitespace. (gnus-dribble-file-name): Rationalize newsrc logic. (gnus-dribble-read-file): Rationalize newsrc logic. (gnus-setup-news): Call out a bogus argument. (gnus-ask-server-for-new-groups): Obsolesce gnus-secondary-select-methods. (gnus-activate-group): Whitespace. (gnus-get-unread-articles-in-group): Declutter. (gnus-scope-globals): Buffer-localize. (gnus-thread-body): Enable backgrounding fetch. (gnus-thread-group-running-p): Enable backgrounding fetch. (gnus-run-thread): Enable backgrounding fetch. (gnus-chain-arg): Enable backgrounding fetch. (gnus-time-out-thread): Enable backgrounding fetch. (gnus-get-unread-articles): Enable backgrounding fetch. (gnus-method-rank): This became superfluous over the decades. (gnus-read-active-for-groups): Spaces, not tabs. (gnus-read-active-file): Obsolesce gnus-secondary-select-methods. (gnus-read-active-file-1): Declutter. (gnus-clean-old-newsrc): Rationalize newsrc logic. (gnus-read-newsrc-el-file): Rationalize newsrc logic. (gnus-make-newsrc-file): Rationalize newsrc logic. (gnus-newsrc-to-gnus-format): Declutter. (gnus-newsrc-parse-options): gnus-with-temp-buffer, not gnus-set-work-buffe= r. (defalias): Declutter. (gnus-gnus-to-quick-newsrc-format): Rationalize newsrc logic. (gnus-gnus-to-newsrc-format): Rationalize newsrc logic. (gnus-child-save-newsrc): Rationalize newsrc logic. (gnus-parent-read-child-newsrc): Rationalize newsrc logic. (gnus-read-all-descriptions-files): Obsolesce gnus-secondary-select-methods. * lisp/gnus/gnus-sum.el (gnus-util): Declutter. (require): Declutter. (subr-x): Declutter. (gnus-agent-get-undownloaded-list): Declutter. (gnus-summary-mark-below): Buffer-localize. (gnus-summary-expunge-below): Buffer-localize. (gnus-thread-expunge-below): Buffer-localize. (gnus-orphan-score): Buffer-localize. (gnus-article-mime-handles): Buffer-localize. (gnus-article-decoded-p): Buffer-localize. (gnus-article-charset): Buffer-localize. (gnus-scores-exclude-files): Buffer-localize. (gnus-page-broken): Buffer-localize. (gnus-original-article): Delete. (gnus-newsgroup-process-stack): Buffer-localize. (gnus-sort-gathered-threads-function): Declutter. (gnus-newsgroup-selected-overlay): Buffer-localize. (gnus-newsgroup-adaptive-score-file): Buffer-localize. (gnus-current-score-file): Buffer-localize. (gnus-newsgroup-display): Buffer-localize. (gnus-newsgroup-dependencies): Buffer-localize. (gnus-newsgroup-adaptive): Buffer-localize. (gnus-summary-highlight-line-function): Buffer-localize. (gnus-newsgroup-begin): Buffer-localize. (gnus-newsgroup-end): Buffer-localize. (gnus-newsgroup-last-rmail): Buffer-localize. (gnus-newsgroup-last-mail): Buffer-localize. (gnus-newsgroup-last-folder): Buffer-localize. (gnus-newsgroup-last-file): Buffer-localize. (gnus-newsgroup-last-directory): Buffer-localize. (gnus-newsgroup-auto-expire): Buffer-localize. (gnus-newsgroup-active): Buffer-localize. (gnus-newsgroup-highest): Buffer-localize. (gnus-newsgroup-data): Buffer-localize. (gnus-newsgroup-data-reverse): Buffer-localize. (gnus-newsgroup-limit): Buffer-localize. (gnus-newsgroup-limits): Buffer-localize. (gnus-summary-use-undownloaded-faces): Buffer-localize. (gnus-newsgroup-unreads): Buffer-localize. (gnus-newsgroup-unselected): Buffer-localize. (gnus-newsgroup-reads): Buffer-localize. (gnus-newsgroup-expunged-tally): Buffer-localize. (gnus-newsgroup-marked): Buffer-localize. (gnus-newsgroup-spam-marked): Buffer-localize. (gnus-newsgroup-killed): Buffer-localize. (gnus-newsgroup-cached): Buffer-localize. (gnus-newsgroup-saved): Buffer-localize. (gnus-newsgroup-kill-headers): Buffer-localize. (gnus-newsgroup-replied): Buffer-localize. (gnus-newsgroup-forwarded): Buffer-localize. (gnus-newsgroup-expirable): Buffer-localize. (gnus-newsgroup-processable): Buffer-localize. (gnus-newsgroup-downloadable): Buffer-localize. (gnus-newsgroup-unfetched): Buffer-localize. (gnus-newsgroup-undownloaded): Buffer-localize. (gnus-newsgroup-unsendable): Buffer-localize. (gnus-newsgroup-bookmarks): Buffer-localize. (gnus-newsgroup-dormant): Buffer-localize. (gnus-newsgroup-unseen): Buffer-localize. (gnus-newsgroup-seen): Buffer-localize. (gnus-newsgroup-unexist): Buffer-localize. (gnus-newsgroup-articles): Buffer-localize. (gnus-newsgroup-scored): Buffer-localize. (gnus-newsgroup-headers): Buffer-localize. (gnus-newsgroup-threads): Buffer-localize. (gnus-newsgroup-prepared): Buffer-localize. (gnus-newsgroup-ancient): Buffer-localize. (gnus-newsgroup-sparse): Buffer-localize. (gnus-newsgroup-selection): Buffer-localize. (gnus-current-article): Buffer-localize. (gnus-article-current): Buffer-localize. (gnus-current-headers): Buffer-localize. (gnus-have-all-headers): Buffer-localize. (gnus-last-article): Buffer-localize. (gnus-newsgroup-history): Buffer-localize. (gnus-newsgroup-charset): Buffer-localize. (gnus-summary-local-variables): Delete. (gnus-newsgroup-variables): Delete. (gnus-simplify-subject-fuzzy): gnus-with-temp-buffer, not gnus-set-work-buffer. (gnus-summary-mode-group): Delete. (gnus-summary-mode): Delete gnus-summary-make-local-variables. (gnus-summary-make-local-variables): Delete. (gnus-summary-setup-buffer): Buffer-localize. (gnus-set-global-variables): Delete. (gnus--dummy-data-list): Rectify ancient type error. (gnus-update-summary-mark-positions): gnus-summary-assume-in-summary, not set-buffer. (gnus-summary-insert-line): Describe the error. (gnus-summary-read-group-1): Declutter. (gnus-summary-prepare): Consolidate sorting of message threads. (gnus-gather-threads-by-references): Declutter. (gnus-sort-gathered-threads): Consolidate sorting of message threads. (gnus-summary-assume-in-summary): gnus-summary-assume-in-summary, not set-buffer. (gnus-summary-update-article): gnus-summary-assume-in-summary, not set-buffer. (gnus-select-newsgroup): Whitespace. (gnus-summary-display-make-predicate): Declutter. (gnus-killed-articles): Declutter. (gnus-set-mode-line): Declutter. (gnus-get-newsgroup-headers-xover): Buffer-localize. (gnus-summary-exit): Delete gnus-set-global-variables. (gnus-handle-ephemeral-exit): Delete gnus-set-global-variables. (gnus-summary-display-article): Delete gnus-set-global-variables. (gnus-summary-select-article): gnus-summary-assume-in-summary, not set-buffer. (gnus-summary-force-verify-and-decrypt): Spaces, not tabs. (gnus-summary-next-article): gnus-summary-assume-in-summary, not set-buffer. (gnus-summary-next-page): Delete gnus-set-global-variables. (gnus-summary-enter-digest-group): Delete gnus-set-global-variables. (gnus-summary-edit-article): Delete gnus-set-global-variables. (gnus-summary-catchup): Whitespace. (gnus-summary-catchup-and-exit): Spaces, not tabs. (gnus-summary-sort): Consolidate sorting of message threads. (gnus-offer-save-summaries): Only do for visible buffers. * lisp/gnus/gnus-topic.el (require): Declutter. (gnus-util): Declutter. (subr-x): Declutter. (gnus-group-prepare-topics): Elide gnus-update-format-specifications bogus argument. * lisp/gnus/gnus-undo.el (gnus-util): Declutter. * lisp/gnus/gnus-util.el (require): Declutter. (cl-seq): Declutter. (gnus-push-end): Push at the end. (gnus-parent-id): Declutter. (gnus-buffer-live-p): Clarify. (gnus-work-buffer): gnus-with-temp-buffer, not gnus-set-work-buffer. (gnus-delete-duplicates): Delete. (gnus-assign-former-global): Buffer-localize. (gnus-with-temp-buffer): gnus-with-temp-buffer, not gnus-set-work-buffer. * lisp/gnus/gnus-uu.el (require): Declutter. * lisp/gnus/gnus-win.el (gnus-util): Declutter. (seq): Declutter. (gnus-configure-frame): Increase thread safety. (gnus-configure--frame): Increase thread safety. (gnus-configure-windows): Declutter. * lisp/gnus/gnus.el (require): Declutter. (gnus-util): Declutter. (seq): Declutter. (subr-x): Declutter. (gnus-version-number): Bump version. (nnheader): Declutter. (gnus-secondary-select-methods): Obsolesce gnus-secondary-select-methods. (gnus-select-methods): Obsolesce gnus-secondary-select-methods. (gnus-select-method): Obsolesce gnus-secondary-select-methods. (gnus-redefine-select-method-widget): Obsolesce gnus-secondary-select-methods. (gnus-original-article-buffer): Buffer-localize. (gnus-newsgroup-name): Buffer-localize. (gnus-summary-buffer): Buffer-localize. (gnus-article-buffer): Buffer-localize. (gnus-reffed-article-number): Buffer-localize. (gnus-continuum-version): Bump version. (gnus-summary-buffer-name): Enable backgrounding fetch. (gnus-secondary-method-p): Declutter. (gnus-server-extend-method): Declutter. (gnus-find-method-for-group): Declutter. (gnus-read-method): Obsolesce gnus-secondary-select-methods. (gnus): Declutter. * lisp/gnus/legacy-gnus-agent.el (gnus-util): Declutter. * lisp/gnus/message.el (gnus-msg-inherit-variables): Declutter. (message-pop-to-buffer): Whitespace. (message-followup): Buffer-local variables need to propagate. * lisp/gnus/nnfolder.el (gnus-util): Declutter. * lisp/gnus/nnheader.el (require): Declutter. (nnheader-init-server-buffer): Refactor. (nnheader-prep-server-buffer): Refactor. * lisp/gnus/nnimap.el (require): Declutter. (gnus-util): Declutter. (cl-seq): Declutter. (x-server-version): Declutter. (nnimap-with-context): Prefer this to set-buffer. (nnimap-for-process-buffers): Facilitate iteration over nnimap buffers. (nnimap-connection-alist): Rationalize nnimap. (nnimap-process-buffers): Rationalize nnimap. (nnimap--process-buffer-fmt): Rationalize nnimap. (nnimap-assert-context): Rationalize nnimap. (nnimap-process-buffer-key): Rationalize nnimap. (nnimap-group-to-imap): Rationalize nnimap. (nnimap-buffer): Rationalize nnimap. (nnimap-process-buffer): Rationalize nnimap. (nnimap-retrieve-headers): Rationalize nnimap. (nnimap-open-server): Rationalize nnimap. (nnimap-make-process-buffer): Rationalize nnimap. (nnimap-keepalive): Rationalize nnimap. (nnimap-open-connection): Rationalize nnimap. (nnimap-open-connection-1): Rationalize nnimap. (nnimap-close-server): Rationalize nnimap. (nnimap-server-opened): Rationalize nnimap. (nnimap-request-article): Rationalize nnimap. (nnimap-request-head): Rationalize nnimap. (nnimap-request-articles): Rationalize nnimap. (nnimap-request-group): Rationalize nnimap. (nnimap-request-group-scan): Rationalize nnimap. (nnimap-request-create-group): Rationalize nnimap. (nnimap-request-delete-group): Rationalize nnimap. (nnimap-request-rename-group): Rationalize nnimap. (nnimap-request-expunge-group): Rationalize nnimap. (nnimap-get-flags): Rationalize nnimap. (nnimap-close-group): Rationalize nnimap. (nnimap-request-move-article): Rationalize nnimap. (nnimap-process-expiry-targets): Rationalize nnimap. (nnimap-find-expired-articles): Rationalize nnimap. (nnimap-find-article-by-message-id): Rationalize nnimap. (nnimap-delete-article): Rationalize nnimap. (nnimap-request-update-group-status): Rationalize nnimap. (nnimap-request-set-mark): Rationalize nnimap. (nnimap-request-accept-article): Rationalize nnimap. (nnimap-request-list): Rationalize nnimap. (nnimap-request-newgroups): Rationalize nnimap. (nnimap-retrieve-group-data-early): Rationalize nnimap. (nnimap-finish-retrieve-group-infos): Rationalize nnimap. (nnimap-find-process-buffer): Rationalize nnimap. (nnimap-get-process-buffer): Rationalize nnimap. (nnimap-request-thread): Rationalize nnimap. (nnimap-change-group): Rationalize nnimap. (nnimap-find-connection): Rationalize nnimap. (nnimap-wait-for-response): Rationalize nnimap. (nnimap-split-incoming-mail): Rationalize nnimap. * lisp/gnus/nnmail.el (gnus-util): Declutter. (nnmail-cache-primary-mail-backend): Obsolesce gnus-secondary-select-method= s. * lisp/gnus/nnmaildir.el (gnus-util): Declutter. * lisp/gnus/nntp.el (gnus): Declutter. (nntp-retrieval-in-progress): Delete. (nntp-kill-buffer): Declutter. (nntp-find-connection): Make this defun for easier debugging. (nntp-find-connection-buffer): Declutter. (nntp-send-command-and-decode): Declutter. (nntp-retrieve-group-data-early): Declutter. (nntp-finish-retrieve-group-infos): Delete nntp-retrieval-in-progress. (nntp-retrieve-groups): Delete nntp-retrieval-in-progress. (nntp-make-process-buffer): Delete nntp-retrieval-in-progress. (nntp-open-connection): Ensure nntp buffers clean up when killed. * lisp/gnus/nnvirtual.el (gnus): Declutter. (gnus-util): Declutter. * lisp/gnus/nnweb.el (require): Declutter. (gnus-util): Declutter. * lisp/obsolete/nnir.el (nnimap-buffer): Rationalize nnimap. (nnimap-process-buffer): Rationalize nnimap. (nnir-run-imap): Rationalize nnimap. * lisp/org/ol-gnus.el (gnus-util): Declutter. * test/src/process-tests.el (process-test-stopped-pipe): Add test. * test/src/thread-tests.el (eieio): Add test. (ring): Add test. (threads-test-channel): Add test. (threads-test-channel-send): Add test. (threads-test-channel-recv): Add test. (threads-signal-early): Add test. (threads-test-bug33073): Add test. (threads-test-bug36609-signal): Add test. (threads-test-glib-lock): Add test. (threads-test-promiscuous-process): Add test. --- doc/emacs/misc.texi | 3 +- doc/misc/auth.texi | 10 +- doc/misc/gnus.texi | 102 +- etc/gnus/news-server.ast | 2 +- lisp/gnus/gnus-agent.el | 18 +- lisp/gnus/gnus-art.el | 418 ++++--- lisp/gnus/gnus-async.el | 2 - lisp/gnus/gnus-cache.el | 8 +- lisp/gnus/gnus-demon.el | 2 - lisp/gnus/gnus-draft.el | 3 +- lisp/gnus/gnus-fun.el | 1 - lisp/gnus/gnus-group.el | 151 +-- lisp/gnus/gnus-icalendar.el | 2 - lisp/gnus/gnus-int.el | 145 +-- lisp/gnus/gnus-kill.el | 96 +- lisp/gnus/gnus-logic.el | 3 - lisp/gnus/gnus-mlspl.el | 2 +- lisp/gnus/gnus-msg.el | 385 ++++--- lisp/gnus/gnus-notifications.el | 1 - lisp/gnus/gnus-picon.el | 2 - lisp/gnus/gnus-registry.el | 8 +- lisp/gnus/gnus-salt.el | 7 +- lisp/gnus/gnus-score.el | 36 +- lisp/gnus/gnus-search.el | 7 +- lisp/gnus/gnus-spec.el | 79 +- lisp/gnus/gnus-srvr.el | 10 +- lisp/gnus/gnus-start.el | 1171 +++++++++---------- lisp/gnus/gnus-sum.el | 1206 ++++++++------------ lisp/gnus/gnus-topic.el | 8 +- lisp/gnus/gnus-undo.el | 1 - lisp/gnus/gnus-util.el | 55 +- lisp/gnus/gnus-uu.el | 2 - lisp/gnus/gnus-win.el | 61 +- lisp/gnus/gnus.el | 166 +-- lisp/gnus/legacy-gnus-agent.el | 1 - lisp/gnus/message.el | 8 +- lisp/gnus/nnfolder.el | 1 - lisp/gnus/nnheader.el | 22 +- lisp/gnus/nnimap.el | 564 ++++----- lisp/gnus/nnmail.el | 3 +- lisp/gnus/nnmaildir.el | 1 - lisp/gnus/nnrss.el | 1 - lisp/gnus/nntp.el | 85 +- lisp/gnus/nnvirtual.el | 2 - lisp/gnus/nnweb.el | 3 - lisp/obsolete/nnir.el | 6 +- lisp/org/ol-gnus.el | 1 - test/lisp/gnus/gnus-test-select-methods.el | 103 ++ test/lisp/gnus/gnus-tests.el | 92 +- test/src/process-tests.el | 9 + test/src/thread-tests.el | 118 +- 51 files changed, 2572 insertions(+), 2621 deletions(-) create mode 100644 test/lisp/gnus/gnus-test-select-methods.el diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 027133cc3a..83b0828351 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -97,8 +97,7 @@ Gnus Startup If your system does not have a default news server, or if you wish to use Gnus for reading email, then before invoking @kbd{M-x gnus} you need to tell Gnus where to get news and/or mail. To do this, -customize the variables @code{gnus-select-method} and/or -@code{gnus-secondary-select-methods}. +customize the variable @code{gnus-select-methods}. @iftex See the Gnus manual for details. @end iftex diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 034004d1df..ba6a527752 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -280,14 +280,14 @@ Multiple GMail accounts with Gnus @chapter Multiple GMail accounts with Gnus =20 For multiple GMail accounts with Gnus, you have to make two nnimap -entries in your @code{gnus-secondary-select-methods} with distinct +entries in your @code{gnus-select-methods} with distinct names: =20 @example -(setq gnus-secondary-select-methods '((nnimap "gmail" - (nnimap-address "imap.gmail.com")) - (nnimap "gmail2" - (nnimap-address "imap.gmail.com")= ))) +(setq gnus-select-methods '((nnimap "gmail" + (nnimap-address "imap.gmail.com")) + (nnimap "gmail2" + (nnimap-address "imap.gmail.com")))) @end example =20 Your netrc entries will then be: diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index b63947c044..a59c9bcc1b 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -1139,13 +1139,13 @@ Finding the News you want to get your daily dosage of news from, you'd say: =20 @lisp -(setq gnus-select-method '(nntp "news.somewhere.edu")) +(setq gnus-select-method '((nntp "news.somewhere.edu"))) @end lisp =20 If you want to read directly from the local spool, say: =20 @lisp -(setq gnus-select-method '(nnspool "")) +(setq gnus-select-method '((nnspool ""))) @end lisp =20 If you can use a local spool, you probably should, as it will almost @@ -1492,41 +1492,13 @@ Startup Files @section Startup Files @cindex startup files @cindex .newsrc -@cindex .newsrc.el @cindex .newsrc.eld =20 -Most common Unix news readers use a shared startup file called -@file{.newsrc}. This file contains all the information about what -groups are subscribed, and which articles in these groups have been -read. +The @file{.newsrc.eld} contains s-exprs persisting Gnus's state. +Avoid deleting it. =20 -Things got a bit more complicated with @sc{gnus}. In addition to -keeping the @file{.newsrc} file updated, it also used a file called -@file{.newsrc.el} for storing all the information that didn't fit into -the @file{.newsrc} file. (Actually, it also duplicated everything in -the @file{.newsrc} file.) @sc{gnus} would read whichever one of these -files was the most recently saved, which enabled people to swap between -@sc{gnus} and other newsreaders. - -That was kinda silly, so Gnus went one better: In addition to the -@file{.newsrc} and @file{.newsrc.el} files, Gnus also has a file called -@file{.newsrc.eld}. It will read whichever of these files that are most -recent, but it will never write a @file{.newsrc.el} file. You should -never delete the @file{.newsrc.eld} file---it contains much information -not stored in the @file{.newsrc} file. - -@vindex gnus-save-newsrc-file -@vindex gnus-read-newsrc-file -You can turn off writing the @file{.newsrc} file by setting -@code{gnus-save-newsrc-file} to @code{nil}, which means you can delete -the file and save some space, as well as exiting from Gnus faster. -However, this will make it impossible to use other newsreaders than -Gnus. But hey, who would want to, right? Similarly, setting -@code{gnus-read-newsrc-file} to @code{nil} makes Gnus ignore the -@file{.newsrc} file and any @file{.newsrc-SERVER} files, which can be -convenient if you use a different news reader occasionally, and you -want to read a different subset of the available groups with that -news reader. +The @file{.newsrc} is the standard Usenet rcfile, which Gnus will generally +ignore unless the @file{.newsrc.eld} did not assign a @code{gnus-newsrc-al= ist}. =20 @vindex gnus-save-killed-list If @code{gnus-save-killed-list} (default @code{t}) is @code{nil}, Gnus @@ -1541,34 +1513,8 @@ Startup Files saving. This can be useful in certain obscure situations that involve several servers where not all servers support @code{ask-server}. =20 -@vindex gnus-startup-file -@vindex gnus-backup-startup-file -@vindex version-control -The @code{gnus-startup-file} variable says where the startup files are. -The default value is @file{~/.newsrc}, with the Gnus (El Dingo) startup -file being whatever that one is, with a @samp{.eld} appended. -If you want to keep multiple numbered backups of this file, set -@code{gnus-backup-startup-file}. It respects the same values as the -@code{version-control} variable. - @vindex gnus-save-newsrc-hook -@vindex gnus-save-quick-newsrc-hook -@vindex gnus-save-standard-newsrc-hook -@code{gnus-save-newsrc-hook} is called before saving any of the newsrc -files, while @code{gnus-save-quick-newsrc-hook} is called just before -saving the @file{.newsrc.eld} file, and -@code{gnus-save-standard-newsrc-hook} is called just before saving the -@file{.newsrc} file. The latter two are commonly used to turn version -control on or off. Version control is on by default when saving the -startup files. If you want to turn backup creation off, say something lik= e: - -@lisp -(defun turn-off-backup () - (set (make-local-variable 'backup-inhibited) t)) - -(add-hook 'gnus-save-quick-newsrc-hook 'turn-off-backup) -(add-hook 'gnus-save-standard-newsrc-hook 'turn-off-backup) -@end lisp +@code{gnus-save-newsrc-hook} is called before saving the @file{.newsrc.eld= }. =20 @vindex gnus-init-file @vindex gnus-site-init-file @@ -1687,6 +1633,11 @@ Startup Variables =20 @table @code =20 +@item gnus-save-dot-newsrc +If changed to @code{nil} from its default value @code{t}, Gnus will +stop saving @file{.newsrc}, meaning other newsreaders cannot pick +up from where Gnus left off. + @item gnus-before-startup-hook @vindex gnus-before-startup-hook A hook called as the first thing when Gnus is started. @@ -2646,9 +2597,8 @@ Foreign Groups groups under point---@code{gnus-subscribe-newsgroup-method} is not consulted. =20 -Changes from the group editing commands are stored in -@file{~/.newsrc.eld} (@code{gnus-startup-file}). An alternative is the -variable @code{gnus-parameters}, @xref{Group Parameters}. +Changes from the group editing commands are stored in @file{~/.newsrc.eld}. +An alternative is the variable @code{gnus-parameters}, @xref{Group Paramet= ers}. =20 @table @kbd =20 @@ -7323,18 +7273,6 @@ More Threading This is a number that says how much each sub-thread should be indented. The default is 4. =20 -@item gnus-sort-gathered-threads-function -@vindex gnus-sort-gathered-threads-function -Sometimes, particularly with mailing lists, the order in which mails -arrive locally is not necessarily the same as the order in which they -arrived on the mailing list. Consequently, when sorting sub-threads -using the default @code{gnus-thread-sort-by-number}, responses can end -up appearing before the article to which they are responding to. -Setting this variable to an alternate value -(e.g., @code{gnus-thread-sort-by-date}), in a group's parameters or in an -appropriate hook (e.g., @code{gnus-summary-generate-hook}) can produce a -more logical sub-thread ordering in such instances. - @end table =20 =20 @@ -29693,18 +29631,6 @@ Little Disk Space =20 @table @code =20 -@item gnus-save-newsrc-file -If this is @code{nil}, Gnus will never save @file{.newsrc}---it will -only save @file{.newsrc.eld}. This means that you will not be able to -use any other newsreaders than Gnus. This variable is @code{t} by -default. - -@item gnus-read-newsrc-file -If this is @code{nil}, Gnus will never read @file{.newsrc}---it will -only read @file{.newsrc.eld}. This means that you will not be able to -use any other newsreaders than Gnus. This variable is @code{t} by -default. - @item gnus-save-killed-list If this is @code{nil}, Gnus will not save the list of dead groups. You should also set @code{gnus-check-new-newsgroups} to @code{ask-server} 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} =20 @node User name and password @type interstitial -@next=20 +@next (if (assistant-password-required-p) "Enter user name and password" "Want user name and password?") diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index cbe3505cd1..2b15ec15dc 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -22,19 +22,19 @@ =20 ;;; Code: =20 -(require 'gnus) -(require 'gnus-cache) (require 'nnmail) -(require 'nnvirtual) -(require 'gnus-sum) -(require 'gnus-score) -(require 'gnus-srvr) -(require 'gnus-util) (require 'timer) -(eval-when-compile (require 'cl-lib)) +(require 'gnus-start) +(require 'gnus-sum) =20 +(autoload 'gnus-all-score-files "gnus-score") (autoload 'gnus-server-update-server "gnus-srvr") +(autoload 'gnus-server-set-status "gnus-srvr") +(autoload 'gnus-server-named-server "gnus-srvr") +(autoload 'gnus-inews-do-gcc "gnus-msg") +(autoload 'gnus-inews-group-method "gnus-msg") (autoload 'gnus-agent-customize-category "gnus-cus") +(defvar gnus-cache-coding-system) =20 (defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/") "Where the Gnus agent will store its files." @@ -2063,7 +2063,7 @@ gnus-agent-read-agentview (let (state sequence uncomp) (while alist (setq state (caar alist) - sequence (inline (gnus-uncompress-range (cdar alist))) + sequence (gnus-uncompress-range (cdar alist)) alist (cdr alist)) (while sequence (push (cons (pop sequence) state) uncomp))) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index f2ec9462c5..011bc0902e 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -24,7 +24,6 @@ =20 ;;; Code: =20 -(eval-when-compile (require 'cl-lib)) (defvar tool-bar-map) (defvar w3m-minor-mode-map) =20 @@ -41,7 +40,6 @@ w3m-minor-mode-map (require 'mm-uu) (require 'message) (require 'mouse) -(require 'seq) =20 (autoload 'gnus-msg-mail "gnus-msg" nil t) (autoload 'gnus-button-mailto "gnus-msg") @@ -1643,9 +1641,10 @@ gnus-english-month-names "September" "October" "November" "December")) =20 (defvar article-goto-body-goes-to-point-min-p nil) -(defvar gnus-article-wash-types nil) +(defvar-local gnus-article-wash-types nil) (defvar gnus-article-emphasis-alist nil) -(defvar gnus-article-image-alist nil) +(defvar-local gnus-original-group-and-article nil) +(defvar-local gnus-article-image-alist nil) =20 (defvar gnus-article-mime-handle-alist-1 nil) (defvar gnus-treatment-function-alist @@ -1695,9 +1694,9 @@ gnus-treatment-function-alist (gnus-treat-highlight-citation gnus-article-highlight-citation) (gnus-treat-body-boundary gnus-article-treat-body-boundary))) =20 -(defvar gnus-article-mime-handle-alist nil) +(defvar-local gnus-article-mime-handle-alist nil) (defvar article-lapsed-timer nil) -(defvar gnus-article-current-summary nil) +(defvar-local gnus-article-current-summary nil) =20 (defvar gnus-article-mode-syntax-table (let ((table (copy-syntax-table text-mode-syntax-table))) @@ -1719,8 +1718,6 @@ gnus-number-of-articles-to-be-saved =20 (defvar gnus-inhibit-hiding nil) =20 -(defvar gnus-article-edit-mode nil) - ;;; Macros for dealing with the article buffer. =20 (defmacro gnus-with-article-headers (&rest forms) @@ -4494,74 +4491,72 @@ gnus-article-mode (setq-local nobreak-char-display nil) ;; Enable `gnus-article-remove-images' to delete images shr.el renders. (setq-local shr-put-image-function #'gnus-shr-put-image) + (setq show-trailing-whitespace nil) (unless gnus-article-show-cursor (setq cursor-in-non-selected-windows nil)) (gnus-set-default-directory) (buffer-disable-undo) - (setq show-trailing-whitespace nil) (mm-enable-multibyte)) =20 +(defun gnus-article-setup-buffer-ensure (summary-buffer + newsgroup-name + article-buffer-name + original-article-buffer-name) + "Refactor." + (gnus-summary-assume-in-summary + (with-current-buffer (gnus-get-buffer-create original-article-buffer-n= ame) + (mm-enable-multibyte) + (setq major-mode 'gnus-original-article-mode)) + + (with-current-buffer (gnus-get-buffer-create article-buffer-name) + (dolist (buffer `(,(current-buffer) ,summary-buffer)) + (gnus-assign-former-global 'gnus-article-buffer + article-buffer-name + buffer) + (gnus-assign-former-global 'gnus-original-article-buffer + original-article-buffer-name + buffer) + (gnus-assign-former-global 'gnus-newsgroup-name + newsgroup-name + buffer) + (gnus-assign-former-global 'gnus-summary-buffer + summary-buffer + buffer)) + (gnus-article-stop-animations) + (mm-destroy-parts gnus-article-mime-handles) + (setq gnus-article-mime-handles nil + gnus-article-mime-handle-alist nil) + (unless (derived-mode-p 'gnus-article-mode) + (gnus-article-mode)) + (setq truncate-lines gnus-article-truncate-lines) + (gnus-summary-set-local-parameters newsgroup-name) + (when article-lapsed-timer + (gnus-stop-date-timer)) + (when gnus-article-update-date-headers + (gnus-start-date-timer gnus-article-update-date-headers)) + (current-buffer)))) + (defun gnus-article-setup-buffer () "Initialize the article buffer." - (let* ((name (if gnus-single-article-buffer "*Article*" - (concat "*Article " gnus-newsgroup-name "*"))) - (original - (progn (string-match "\\*Article" name) - (concat " *Original Article" - (substring name (match-end 0)))))) - (setq gnus-article-buffer name) - (setq gnus-original-article-buffer original) - (setq gnus-article-mime-handle-alist nil) - (with-current-buffer gnus-summary-buffer - ;; This might be a variable local to the summary buffer. - (unless gnus-single-article-buffer - (setq gnus-article-buffer name) - (setq gnus-original-article-buffer original) - (gnus-set-global-variables))) + (gnus-summary-assume-in-summary (gnus-article-setup-highlight-words) - ;; Init original article buffer. - (with-current-buffer (gnus-get-buffer-create gnus-original-article-buf= fer) - (mm-enable-multibyte) - (setq major-mode 'gnus-original-article-mode) - (make-local-variable 'gnus-original-article)) - (if (and (get-buffer name) - (with-current-buffer name - (if gnus-article-edit-mode - (if (y-or-n-p "Article mode edit in progress; discard? ") - (progn - (set-buffer-modified-p nil) - (gnus-kill-buffer name) - (message "") - nil) - (error "Action aborted")) - t))) - (let ((summary gnus-summary-buffer)) - (with-current-buffer name - (setq-local gnus-article-edit-mode nil) - (gnus-article-stop-animations) - (when gnus-article-mime-handles - (mm-destroy-parts gnus-article-mime-handles) - (setq gnus-article-mime-handles nil)) - ;; Set it to nil in article-buffer! - (setq gnus-article-mime-handle-alist nil) - (buffer-disable-undo) - (setq buffer-read-only t) - (unless (derived-mode-p 'gnus-article-mode) - (gnus-article-mode)) - (setq-local gnus-summary-buffer summary) - (setq truncate-lines gnus-article-truncate-lines) - (current-buffer))) - (let ((summary gnus-summary-buffer)) - (with-current-buffer (gnus-get-buffer-create name) - (gnus-article-mode) - (setq truncate-lines gnus-article-truncate-lines) - (setq-local gnus-summary-buffer summary) - (gnus-summary-set-local-parameters gnus-newsgroup-name) - (when article-lapsed-timer - (gnus-stop-date-timer)) - (when gnus-article-update-date-headers - (gnus-start-date-timer gnus-article-update-date-headers)) - (current-buffer)))))) + (let* ((summary gnus-summary-buffer) + (group gnus-newsgroup-name) + (name (if gnus-single-article-buffer "*Article*" + (concat "*Article " group "*"))) + (original (progn (string-match "\\*Article" name) + (concat " *Original Article" + (substring name (match-end 0)))))) + (when-let ((existing-buffer (get-buffer name))) + (with-current-buffer existing-buffer + (when (eq major-mode 'gnus-article-edit-mode) + (if (y-or-n-p "Article mode edit in progress; discard? ") + (progn + (set-buffer-modified-p nil) + (gnus-kill-buffer existing-buffer) + (message "")) + (error "Action aborted"))))) + (gnus-article-setup-buffer-ensure summary group name original)))) =20 (defun gnus-article-stop-animations () (cancel-function-timers 'image-animate-timeout)) @@ -4593,113 +4588,116 @@ gnus-article-prepare ARTICLE should either be an article number or a Message-ID. If ARTICLE is an id, HEADER should be the article headers. If ALL-HEADERS is non-nil, no headers are hidden." - (save-excursion ;FIXME: Shouldn't that be save-current-bu= ffer? - ;; Make sure we start in a summary buffer. - (unless (derived-mode-p 'gnus-summary-mode) - (set-buffer gnus-summary-buffer)) - (setq gnus-summary-buffer (current-buffer)) - (let* ((summary-buffer (current-buffer)) - (gnus-tmp-internal-hook gnus-article-internal-prepare-hook) - (group gnus-newsgroup-name) - result) - (save-excursion - (gnus-article-setup-buffer) - (set-buffer gnus-article-buffer) - ;; Deactivate active regions. - (when transient-mark-mode - (setq mark-active nil)) - (if (not (setq result (let ((inhibit-read-only t)) - (gnus-request-article-this-buffer - article group)))) - ;; There is no such article. - (save-excursion - (when (and (numberp article) - (not (memq article gnus-newsgroup-sparse))) - (setq gnus-article-current - (cons gnus-newsgroup-name article)) - (set-buffer gnus-summary-buffer) - (setq gnus-current-article article) - (if (and (memq article gnus-newsgroup-undownloaded) - (not (gnus-online (gnus-find-method-for-group - gnus-newsgroup-name)))) - (progn - (gnus-summary-set-agent-mark article) - (message "Message marked for downloading")) - (gnus-summary-mark-article article gnus-canceled-mark) - (unless (memq article gnus-newsgroup-sparse) - (gnus-error 1 "No such article (may have expired or been canceled)")= )))) - (if (or (eq result 'pseudo) - (eq result 'nneething)) - (progn - (with-current-buffer summary-buffer - (push article gnus-newsgroup-history) - (setq gnus-last-article gnus-current-article - gnus-current-article 0 - gnus-current-headers nil - gnus-article-current nil) - (if (eq result 'nneething) - (gnus-configure-windows 'summary) - (gnus-configure-windows 'article)) - (gnus-set-global-variables)) - (let ((gnus-article-mime-handle-alist-1 - gnus-article-mime-handle-alist)) - (gnus-set-mode-line 'article))) - ;; The result from the `request' was an actual article - - ;; or at least some text that is now displayed in the - ;; article buffer. - (when (and (numberp article) - (not (eq article gnus-current-article))) - ;; Seems like a new article has been selected. - ;; `gnus-current-article' must be an article number. - (with-current-buffer summary-buffer - (push article gnus-newsgroup-history) - (setq gnus-last-article gnus-current-article - gnus-current-article article - gnus-current-headers - (gnus-summary-article-header gnus-current-article) - gnus-article-current - (cons gnus-newsgroup-name gnus-current-article)) - (unless (mail-header-p gnus-current-headers) - (setq gnus-current-headers nil)) - (gnus-summary-goto-subject gnus-current-article) - (when (gnus-summary-show-thread) - ;; If the summary buffer really was folded, the - ;; previous goto may not actually have gone to - ;; the right article, but the thread root instead. - ;; So we go again. - (gnus-summary-goto-subject gnus-current-article)) - (gnus-run-hooks 'gnus-mark-article-hook) - (gnus-set-mode-line 'summary) - (when (gnus-visual-p 'article-highlight 'highlight) - (gnus-run-hooks 'gnus-visual-mark-article-hook)) - ;; Set the global newsgroup variables here. - (gnus-set-global-variables) - (setq gnus-have-all-headers - (or all-headers gnus-show-all-headers)))) - (save-excursion - (gnus-configure-windows 'article)) - (when (or (numberp article) - (stringp article)) - (gnus-article-prepare-display) - ;; Do page break. - (goto-char (point-min)) - (when gnus-break-pages - (gnus-narrow-to-page))) - (let ((gnus-article-mime-handle-alist-1 - gnus-article-mime-handle-alist)) - (gnus-set-mode-line 'article)) - (article-goto-body) - (unless (bobp) - (forward-line -1)) - (set-window-point (get-buffer-window (current-buffer)) (point)) - (gnus-configure-windows 'article) - ;; Make sure the article begins with the top of the header. - (let ((window (get-buffer-window gnus-article-buffer))) - (when window - (with-current-buffer (window-buffer window) - (set-window-point window (point-min))))) - (gnus-run-hooks 'gnus-article-prepare-hook) - t)))))) + (gnus-summary-assume-in-summary + (gnus-article-setup-buffer) + (let ((group gnus-newsgroup-name) + (summary (current-buffer)) + result) + (with-current-buffer gnus-article-buffer + ;; Deactivate active regions. + (when transient-mark-mode + (setq mark-active nil)) + (cond ((not (setq result (let ((inhibit-read-only t)) + (gnus-request-article-this-buffer + article group)))) + (with-current-buffer summary + (when (and (numberp article) + (not (memq article gnus-newsgroup-sparse))) + (setq gnus-article-current + (cons gnus-newsgroup-name article)) + (setq gnus-current-article article) + (if (and (memq article gnus-newsgroup-undownloaded) + (not (gnus-online (gnus-find-method-for-group + gnus-newsgroup-name)))) + (progn + (gnus-summary-set-agent-mark article) + (message "Message marked for downloading")) + (gnus-summary-mark-article article gnus-canceled-mark) + (unless (memq article gnus-newsgroup-sparse) + (gnus-error + 1 + "No such article (may have expired or been cancele= d)")))))) + ((or (eq result 'pseudo) (eq result 'nneething)) + (with-current-buffer summary + (push article gnus-newsgroup-history) + (setq gnus-last-article gnus-current-article + gnus-current-article 0 + gnus-current-headers nil + gnus-article-current nil) + (if (eq result 'nneething) + (gnus-configure-windows 'summary) + (gnus-configure-windows 'article))) + (let ((gnus-article-mime-handle-alist-1 + gnus-article-mime-handle-alist)) + (gnus-set-mode-line 'article))) + ;; The result from the `request' was an actual article - + ;; or at least some text that is now displayed in the + ;; article buffer. + (t + (with-current-buffer summary + (when (and (numberp article) + (not (eq article gnus-current-article))) + ;; Seems like a new article has been selected. + ;; `gnus-current-article' must be an article number. + (push article gnus-newsgroup-history) + ;; TODO: a more elegant way to replicate former globals + (dolist (buffer `(,(get-buffer gnus-article-buffer) + ,(get-buffer summary))) + (gnus-assign-former-global + 'gnus-last-article + gnus-current-article + buffer) + (gnus-assign-former-global + 'gnus-current-article + article + buffer) + (gnus-assign-former-global + 'gnus-current-headers + (gnus-summary-article-header article) + buffer) + (gnus-assign-former-global + 'gnus-article-current + (cons gnus-newsgroup-name article) + buffer)) + (unless (mail-header-p gnus-current-headers) + (setq gnus-current-headers nil)) + (gnus-summary-goto-subject gnus-current-article) + (when (gnus-summary-show-thread) + ;; If the summary buffer really was folded, the + ;; previous goto may not actually have gone to + ;; the right article, but the thread root instead. + ;; So we go again. + (gnus-summary-goto-subject gnus-current-article)) + (gnus-run-hooks 'gnus-mark-article-hook) + (gnus-set-mode-line 'summary) + (when (gnus-visual-p 'article-highlight 'highlight) + (gnus-run-hooks 'gnus-visual-mark-article-hook)) + (setq gnus-have-all-headers + (or all-headers gnus-show-all-headers)))) + (save-excursion + (gnus-configure-windows 'article)) + (when (or (numberp article) + (stringp article)) + (gnus-article-prepare-display) + ;; Do page break. + (goto-char (point-min)) + (when gnus-break-pages + (gnus-narrow-to-page))) + (let ((gnus-article-mime-handle-alist-1 + gnus-article-mime-handle-alist)) + (gnus-set-mode-line 'article)) + (article-goto-body) + (unless (bobp) + (forward-line -1)) + (set-window-point (get-buffer-window (current-buffer)) (poi= nt)) + (gnus-configure-windows 'article) + ;; Make sure the article begins with the top of the header. + (let ((window (get-buffer-window gnus-article-buffer))) + (when window + (with-current-buffer (window-buffer window) + (set-window-point window (point-min))))) + (gnus-run-hooks 'gnus-article-prepare-hook) + t)))))) =20 ;;;###autoload (defun gnus-article-prepare-display () @@ -4714,7 +4712,7 @@ gnus-article-prepare-display (setq buffer-read-only nil gnus-article-wash-types nil gnus-article-image-alist nil) - (gnus-run-hooks 'gnus-tmp-internal-hook) + (gnus-run-hooks 'gnus-article-internal-prepare-hook) (when gnus-display-mime-function (funcall gnus-display-mime-function)) ;; Add attachment buttons to the header. @@ -6683,7 +6681,6 @@ gnus-article-show-summary (interactive nil gnus-article-mode) (if (not (gnus-buffer-live-p gnus-summary-buffer)) (error "There is no summary buffer for this article buffer") - (gnus-article-set-globals) (gnus-configure-windows 'article) (gnus-summary-goto-subject gnus-current-article) (gnus-summary-position-point))) @@ -6960,16 +6957,16 @@ gnus-article-followup-with-original (interactive nil gnus-article-mode) (let ((article (cdr gnus-article-current)) contents) - (if (not (and transient-mark-mode mark-active)) - (with-current-buffer gnus-summary-buffer - (gnus-summary-followup (list (list article)))) - (setq contents (buffer-substring (point) (mark t))) - ;; Deactivate active regions. - (when transient-mark-mode - (setq mark-active nil)) - (with-current-buffer gnus-summary-buffer - (gnus-summary-followup - (list (list article contents))))))) + (if (not (and transient-mark-mode mark-active)) + (with-current-buffer gnus-summary-buffer + (gnus-summary-followup (list (list article)))) + (setq contents (buffer-substring (point) (mark t))) + ;; Deactivate active regions. + (when transient-mark-mode + (setq mark-active nil)) + (with-current-buffer gnus-summary-buffer + (gnus-summary-followup + (list (list article contents))))))) =20 (defun gnus-article-hide (&optional arg force) "Hide all the gruft in the current article. @@ -7059,8 +7056,10 @@ gnus-request-article-this-buffer ((and (get-buffer gnus-original-article-buffer) (numberp article) (with-current-buffer gnus-original-article-buffer - (and (equal (car gnus-original-article) group) - (eq (cdr gnus-original-article) article)))) + (when (consp gnus-original-group-and-article) + (cl-destructuring-bind (ogroup . oarticle) + gnus-original-group-and-article + (and (equal ogroup group) (eq oarticle article)))))) (insert-buffer-substring gnus-original-article-buffer) 'article) ;; Check the backlog. @@ -7131,24 +7130,23 @@ gnus-request-article-this-buffer ;; Take the article from the original article buffer ;; and place it in the buffer it's supposed to be in. (when (and (get-buffer gnus-article-buffer) - (equal (buffer-name (current-buffer)) - (buffer-name (get-buffer gnus-article-buffer)))) - (save-excursion - (if (get-buffer gnus-original-article-buffer) - (set-buffer gnus-original-article-buffer) - (set-buffer (gnus-get-buffer-create gnus-original-article-buffer)) - (buffer-disable-undo) - (setq major-mode 'gnus-original-article-mode) - (setq buffer-read-only t)) - (let ((inhibit-read-only t)) - (erase-buffer) - (insert-buffer-substring gnus-article-buffer)) - (setq gnus-original-article (cons group article))) - - ;; Decode charsets. - (run-hooks 'gnus-article-decode-hook) - ;; Mark article as decoded or not. - (setq gnus-article-decoded-p gnus-article-decode-hook)) + (equal (buffer-name (current-buffer)) + (buffer-name (get-buffer gnus-article-buffer)))) + (unless (get-buffer gnus-original-article-buffer) + (with-current-buffer (gnus-get-buffer-create gnus-original-artic= le-buffer) + (buffer-disable-undo) + (setq major-mode 'gnus-original-article-mode) + (setq buffer-read-only t))) + (let ((article-buffer gnus-article-buffer)) + (with-current-buffer (get-buffer gnus-original-article-buffer) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert-buffer-substring article-buffer)) + (setq gnus-original-group-and-article (cons group article)))) + ;; Decode charsets. + (run-hooks 'gnus-article-decode-hook) + ;; Mark article as decoded or not. + (setq gnus-article-decoded-p gnus-article-decode-hook)) =20 ;; Update sparse articles. (when (and do-update-line @@ -7261,7 +7259,6 @@ gnus-article-edit-mode (make-local-variable 'gnus-prev-winconf) (setq-local font-lock-defaults '(message-font-lock-keywords t)) (setq-local mail-header-separator "") - (setq-local gnus-article-edit-mode t) (mml-mode) (setq buffer-read-only nil) (buffer-enable-undo) @@ -7335,7 +7332,7 @@ gnus-article-edit-done (defun gnus-flush-original-article-buffer () (when (get-buffer gnus-original-article-buffer) (with-current-buffer gnus-original-article-buffer - (setq gnus-original-article nil)))) + (setq gnus-original-group-and-article nil)))) =20 (defun gnus-article-edit-exit () "Exit the article editing without updating." @@ -8134,10 +8131,6 @@ gnus-article-copy-string =20 ;;; Internal functions: =20 -(defun gnus-article-set-globals () - (with-current-buffer gnus-summary-buffer - (gnus-set-global-variables))) - (defun gnus-signature-toggle (end) (gnus-with-article-buffer (let ((inhibit-point-motion-hooks t)) @@ -8628,7 +8621,6 @@ gnus-article-encrypt-body (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) (summary-buffer gnus-summary-buffer) references point) - (gnus-set-global-variables) (when (gnus-group-read-only-p) (error "The current newsgroup does not support article encrypt")) (gnus-summary-show-article t) diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el index fefd02c7bf..239e5f67bd 100644 --- a/lisp/gnus/gnus-async.el +++ b/lisp/gnus/gnus-async.el @@ -24,8 +24,6 @@ =20 ;;; Code: =20 -(eval-when-compile (require 'cl-lib)) - (require 'gnus) (require 'gnus-sum) (require 'nntp) diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index 34dba54c11..33fcfd8931 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -24,9 +24,6 @@ =20 ;;; Code: =20 -(eval-when-compile (require 'cl-lib)) - -(require 'gnus) (require 'gnus-sum) =20 (declare-function gnus-agent-load-alist "gnus-agent" (group)) @@ -81,7 +78,7 @@ gnus-cache-coding-system =20 ;;; Internal variables. =20 -(defvar gnus-cache-removable-articles nil) +(defvar-local gnus-cache-removable-articles nil) (defvar gnus-cache-buffer nil) (defvar gnus-cache-active-hashtb nil) (defvar gnus-cache-active-altered nil) @@ -630,8 +627,7 @@ gnus-cache-read-active ;; There is no active file, so we generate one. (gnus-cache-generate-active) ;; We simply read the active file. - (save-excursion - (gnus-set-work-buffer) + (gnus-with-temp-buffer (nnheader-insert-file-contents gnus-cache-active-file) (gnus-active-to-gnus-format nil (setq gnus-cache-active-hashtb diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el index e99247c0ca..bcc70654b0 100644 --- a/lisp/gnus/gnus-demon.el +++ b/lisp/gnus/gnus-demon.el @@ -24,8 +24,6 @@ =20 ;;; Code: =20 -(eval-when-compile (require 'cl-lib)) - (require 'gnus) (require 'gnus-int) (require 'nnheader) diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el index 9a0f21359f..6d2c2fd57a 100644 --- a/lisp/gnus/gnus-draft.el +++ b/lisp/gnus/gnus-draft.el @@ -24,12 +24,11 @@ =20 ;;; Code: =20 -(require 'gnus) (require 'gnus-sum) -(require 'message) (require 'gnus-msg) (require 'nndraft) (require 'gnus-agent) +(require 'gnus-cache) =20 ;;; Draft minor mode =20 diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index 8bca4ffe38..923aa1ec38 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -25,7 +25,6 @@ ;;; Code: =20 (require 'mm-util) -(require 'gnus-util) (require 'gnus) =20 (defvar gnus-face-properties-alist) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index c8b95d9185..bedbf19ea2 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -35,10 +35,10 @@ (require 'gnus-undo) (require 'gmm-utils) (require 'time-date) +(require 'mm-url) +(require 'subr-x) =20 (eval-when-compile - (require 'mm-url) - (require 'subr-x) (with-suppressed-warnings ((lexical features)) (dlet ((features (cons 'gnus-group features))) (require 'gnus-sum)))) @@ -1136,7 +1136,7 @@ gnus-group-mode (setq truncate-lines t) (setq show-trailing-whitespace nil) (gnus-set-default-directory) - (gnus-update-format-specifications nil 'group 'group-mode) + (gnus-update-format-specifications 'group 'group-mode) (gnus-update-group-mark-positions) (when gnus-use-undo (gnus-undo-mode 1)) @@ -1144,19 +1144,17 @@ gnus-group-mode (gnus-child-mode))) =20 (defun gnus-update-group-mark-positions () - (save-excursion - (let ((gnus-process-mark ?\200) - (gnus-group-update-hook nil) - (gnus-group-marked '("dummy.group")) - (gnus-active-hashtb (gnus-make-hashtable 10))) - (gnus-set-active "dummy.group" '(0 . 0)) - (gnus-set-work-buffer) - (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil) - (goto-char (point-min)) + (let ((gnus-process-mark ?\200) + (gnus-group-update-hook nil) + (gnus-group-marked '("dummy.group")) + (gnus-active-hashtb (gnus-make-hashtable 10))) + (gnus-set-active "dummy.group" '(0 . 0)) + (gnus-with-temp-buffer + (save-excursion + (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)) (setq gnus-group-mark-positions - (list (cons 'process (and (search-forward - (string gnus-process-mark) nil t) - (- (point) (point-min) 1)))))))) + (list (cons 'process (when (search-forward (string gnus-process-mark)= nil t) + (- (point) (point-min) 1)))))))) =20 (defun gnus-mouse-pick-group (e) "Enter the group under the mouse pointer." @@ -1248,27 +1246,19 @@ gnus-group-list-groups unread (cdr gnus-group-list-mode))) (setq level (gnus-group-default-level level)) (gnus-group-setup-buffer) - (gnus-update-format-specifications nil 'group 'group-mode) - (let ((case-fold-search nil) - (props (text-properties-at (point-at-bol))) - (empty (=3D (point-min) (point-max))) + (gnus-update-format-specifications 'group 'group-mode) + (let ((props (text-properties-at (point-at-bol))) (group (gnus-group-group-name)) - number) - (set-buffer gnus-group-buffer) - (setq number (funcall gnus-group-prepare-function level unread lowest)) + (number (funcall gnus-group-prepare-function level unread lowest)) + case-fold-search) (when (or (and (numberp number) (zerop number)) (zerop (buffer-size))) - ;; No groups in the buffer. (gnus-message 5 "%s" gnus-no-groups-message)) - ;; We have some groups displayed. - (goto-char (point-max)) (when (or (not gnus-group-goto-next-group-function) (not (funcall gnus-group-goto-next-group-function group props))) (cond - (empty - (goto-char (point-min))) ((not group) ;; Go to the first group with unread articles. (gnus-group-search-forward t)) @@ -1277,8 +1267,7 @@ gnus-group-list-groups ;; has disappeared in the new listing, try to find the next ;; one. If no next one can be found, just leave point at the ;; first newsgroup in the buffer. - (when (not (gnus-text-property-search - 'gnus-group group nil 'goto)) + (unless (gnus-text-property-search 'gnus-group group nil 'goto) (let ((groups (cdr-safe (member group gnus-group-list)))) (while (and groups (not (gnus-text-property-search @@ -1287,7 +1276,8 @@ gnus-group-list-groups (unless groups (goto-char (point-max)) (forward-line -1))))))) - ;; Adjust cursor point. + (when (eobp) + (goto-char (point-min))) (gnus-group-position-point))) =20 (defun gnus-group-list-level (level &optional all) @@ -1590,7 +1580,7 @@ gnus-group-insert-group-line (setq end (point)) (gnus-group--setup-tool-bar-update beg end) (forward-line -1) - (when (inline (gnus-visual-p 'group-highlight 'highlight)) + (when (gnus-visual-p 'group-highlight 'highlight) (gnus-group-highlight-line gnus-tmp-group beg end)) (gnus-run-hooks 'gnus-group-update-hook) (forward-line))) @@ -1615,8 +1605,7 @@ gnus-group-update-eval-form (let* ((entry (gnus-group-entry group)) (active (gnus-active group)) (info (nth 1 entry)) - (method (inline (gnus-server-get-method - group (gnus-info-method info)))) + (method (gnus-server-get-method group (gnus-info-method info))) (marked (gnus-info-marks info)) (env (list @@ -2725,17 +2714,13 @@ gnus-group-best-unread-group (defun gnus-group-first-unread-group () "Go to the first group with unread articles." (interactive nil gnus-group-mode) - (prog1 - (let ((opoint (point)) - unread) - (goto-char (point-min)) - (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active. - (and (numberp unread) ; Not a topic. - (not (zerop unread))) ; Has unread articles. - (zerop (gnus-group-next-unread-group 1))) ; Next unread group. - (point) ; Success. - (goto-char opoint) - nil)) ; Not success. + (let ((opoint (point))) + (goto-char (save-excursion + (goto-char (point-min)) + (let ((unread (gnus-group-group-unread))) + (cond ((and (numberp unread) (not (zerop unread))) + (point)) + (t opoint))))) (gnus-group-position-point))) =20 (defun gnus-group-enter-server-mode () @@ -4137,7 +4122,7 @@ gnus-group-list-active "\n")) (list 'gnus-group group 'gnus-unread t - 'gnus-level (inline (gnus-group-level group))))) + 'gnus-level (gnus-group-level group)))) (goto-char (point-min)))) =20 (defun gnus-activate-all-groups (level) @@ -4167,17 +4152,13 @@ gnus-group-get-new-news (unless gnus-child (gnus-parent-read-child-newsrc)) =20 - (gnus-get-unread-articles (gnus-group-default-level arg t) - nil one-level) + (gnus-get-unread-articles arg nil one-level) =20 ;; If the user wants it, we scan for new groups. (when (eq gnus-check-new-newsgroups 'always) (gnus-find-new-newsgroups)) =20 - (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))) =20 (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 gro= ups). @@ -4493,10 +4474,9 @@ gnus-group-quit (zerop (buffer-size)) (not (gnus-server-opened gnus-select-method)) gnus-expert-user - (not gnus-current-startup-file) (gnus-yes-or-no-p (format "Quit reading news without saving %s? " - (file-name-nondirectory gnus-current-startup-file)))) + (file-name-nondirectory gnus-newsrc-file)))) (gnus-run-hooks 'gnus-exit-gnus-hook) (gnus-configure-windows 'group t) (when (and (gnus-buffer-live-p gnus-dribble-buffer) @@ -4551,8 +4531,7 @@ gnus-group-set-info (let* ((entry (gnus-group-entry (or method-only-group (gnus-info-group info)))) (part-info info) - (info (if method-only-group (nth 1 entry) info)) - method) + (info (if method-only-group (nth 1 entry) info))) (when method-only-group (unless entry (error "Trying to change non-existent group %s" method-only-group)) @@ -4569,45 +4548,35 @@ gnus-group-set-info (unless entry ;; This is a new group, so we just create it. (with-current-buffer gnus-group-buffer - (setq method (gnus-info-method info)) - (when (gnus-server-equal method "native") - (setq method nil)) - (with-current-buffer gnus-group-buffer - (if method - ;; It's a foreign group... + (let ((method (gnus-info-method info))) + (with-current-buffer gnus-group-buffer + (if (gnus-server-equal method "native") + (gnus-group-make-group (gnus-info-group info)) (gnus-group-make-group (gnus-group-real-name (gnus-info-group info)) - (if (stringp method) method + (if (stringp method) + method (prin1-to-string (car method))) - (and (consp method) - (nth 1 (gnus-info-method info))) - nil) - ;; It's a native group. - (gnus-group-make-group (gnus-info-group info) nil nil nil))) - (gnus-message 6 "Note: New group created") - (setq entry - (gnus-group-entry (gnus-group-prefixed-name - (gnus-group-real-name (gnus-info-group info)) - (or (gnus-info-method info) gnus-select-method)))))) - ;; Whether it was a new group or not, we now have the entry, so we - ;; can do the update. - (if entry - (progn - (setcar (nthcdr 1 entry) info) - (when (and (not (eq (car entry) t)) - (gnus-active (gnus-info-group info))) - (setcar entry (length - (gnus-list-of-unread-articles (car info))))) - ;; The above `setcar' will only affect the hashtable, not - ;; the alist: update the alist separately, but only if - ;; it's been initialized. - (when gnus-newsrc-alist - (push info (cdr (setq gnus-newsrc-alist - (remove (assoc-string - (gnus-info-group info) - gnus-newsrc-alist) - gnus-newsrc-alist)))))) - (error "No such group: %s" (gnus-info-group info)))))) + (when (consp method) + (nth 1 (gnus-info-method info)))))) + (setq entry + (gnus-group-entry (gnus-group-prefixed-name + (gnus-group-real-name (gnus-info-group info)) + (or method gnus-select-method)))) + (gnus-message 6 "Note: New group created")))) + (setcar (nthcdr 1 entry) info) + (when (and (not (eq (car entry) t)) + (gnus-active (gnus-info-group info))) + (setcar entry (length + (gnus-list-of-unread-articles (car info))))) + ;; How `gnus-newsrc-hashtb' and `gnus-newsrc-alist' are + ;; dutifully kept in-sync is anyone's guess... + (when gnus-newsrc-alist + (push info (cdr (setq gnus-newsrc-alist + (remove (assoc-string + (gnus-info-group info) + gnus-newsrc-alist) + gnus-newsrc-alist)))))))) =20 ;; Ad-hoc function for inserting data from a different newsrc.eld ;; file. Use with caution, if at all. diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index 1b2743c148..855cc630a0 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -42,8 +42,6 @@ (require 'gnus-sum) (require 'gnus-art) =20 -(eval-when-compile (require 'cl-lib)) - (defun gnus-icalendar-find-if (pred seq) (catch 'found (while seq diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index 01053797b3..e71be0518f 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -33,6 +33,11 @@ (autoload 'gnus-agent-regenerate-group "gnus-agent") (autoload 'gnus-agent-read-servers-validate-native "gnus-agent") (autoload 'gnus-agent-possibly-synchronize-flags-server "gnus-agent") +(autoload 'gnus-agent-unfetch-articles "gnus-agent") +(autoload 'gnus-summary-select-article "gnus-sum") +(autoload 'gnus-summary-insert-subject "gnus-sum") +(autoload 'gnus-summary-setup-buffer "gnus-sum") +(autoload 'gnus-summary-read-group-1 "gnus-sum") =20 (defcustom gnus-open-server-hook nil "Hook called just before opening connection to the news server." @@ -84,7 +89,7 @@ gnus-server-opened (if (stringp command-method) (gnus-server-to-method command-method) command-method))) - (funcall (inline (gnus-get-function gnus-command-method 'server-open= ed)) + (funcall (gnus-get-function gnus-command-method 'server-opened) (nth 1 gnus-command-method))))) =20 (defun gnus-status-message (command-method) @@ -105,73 +110,69 @@ gnus-status-message (defun gnus-start-news-server (&optional confirm) "Open a method for getting news. If CONFIRM is non-nil, the user will be asked for an NNTP server." - (let (how) - (if gnus-current-select-method - ;; Stream is already opened. - nil - ;; Open NNTP server. - (when confirm - ;; Read server name with completion. - (setq gnus-nntp-server - (gnus-completing-read "NNTP server" - (cons gnus-nntp-server - (if (boundp 'gnus-secondary-servers) - gnus-secondary-servers)) - nil gnus-nntp-server))) - - (when (and gnus-nntp-server - (stringp gnus-nntp-server) - (not (string=3D gnus-nntp-server ""))) - (setq gnus-select-method - (cond ((or (string=3D gnus-nntp-server "") - (string=3D gnus-nntp-server "::")) - (list 'nnspool (system-name))) - ((string-match "^:" gnus-nntp-server) - (list 'nnmh gnus-nntp-server - (list 'nnmh-directory - (file-name-as-directory - (expand-file-name - (substring gnus-nntp-server 1) "~/"))) - (list 'nnmh-get-new-mail nil))) - (t - (list 'nntp gnus-nntp-server))))) - - (setq how (car gnus-select-method)) - (cond - ((eq how 'nnspool) - (require 'nnspool) - (gnus-message 5 "Looking up local news spool...")) - ((eq how 'nnmh) - (require 'nnmh) - (gnus-message 5 "Looking up mh spool...")) - (t - (require 'nntp))) - (setq gnus-current-select-method gnus-select-method) - (gnus-run-hooks 'gnus-open-server-hook) + (unless gnus-current-select-method + (when confirm + ;; Read server name with completion. + (setq gnus-nntp-server + (gnus-completing-read "NNTP server" + (cons gnus-nntp-server + (if (boundp 'gnus-secondary-server= s) + gnus-secondary-servers)) + nil gnus-nntp-server))) + (when (and (stringp gnus-nntp-server) + (not (zerop (length gnus-nntp-server)))) + ;; this will also assign the obsolete variable `gnus-select-method' + (custom-set-variables + `(gnus-select-methods + (quote (,(cond ((string=3D gnus-nntp-server "::") + (list 'nnspool (system-name))) + ((string-match "^:" gnus-nntp-server) + (list 'nnmh gnus-nntp-server + (list 'nnmh-directory + (file-name-as-directory + (expand-file-name + (substring gnus-nntp-server 1) "~/"= ))) + (list 'nnmh-get-new-mail nil))) + (t + (list 'nntp gnus-nntp-server)))))))) + (setq gnus-current-select-method gnus-select-method) + (cl-case (car gnus-select-method) + ('nnspool + (require 'nnspool) + (gnus-message 5 "Looking up local news spool...")) + ('nnmh + (require 'nnmh) + (gnus-message 5 "Looking up mh spool...")) + (t + (require 'nntp))) + (gnus-run-hooks 'gnus-open-server-hook) + + ;; Partially validate agent covered methods now that the + ;; gnus-select-method is known. + + (if gnus-agent + ;; NOTE: This is here for one purpose only. By validating + ;; the current select method, it converts the old 5.10.3, + ;; and earlier, format to the current format. That enables + ;; the agent code within gnus-open-server to function + ;; correctly. + (gnus-agent-read-servers-validate-native gnus-select-method)) =20 - ;; Partially validate agent covered methods now that the - ;; gnus-select-method is known. - - (if gnus-agent - ;; NOTE: This is here for one purpose only. By validating - ;; the current select method, it converts the old 5.10.3, - ;; and earlier, format to the current format. That enables - ;; the agent code within gnus-open-server to function - ;; correctly. - (gnus-agent-read-servers-validate-native gnus-select-method)) - - (or - ;; gnus-open-server-hook might have opened it - (gnus-server-opened gnus-select-method) - (gnus-open-server gnus-select-method) - gnus-batch-mode - (gnus-y-or-n-p - (format-message - "%s (%s) open error: `%s'. Continue? " - (car gnus-select-method) (cadr gnus-select-method) - (gnus-status-message gnus-select-method))) - (gnus-error 1 "Couldn't open server on %s" - (nth 1 gnus-select-method)))))) + (or + ;; gnus-open-server-hook might have opened it + (gnus-server-opened gnus-select-method) + (gnus-open-server gnus-select-method) + gnus-batch-mode + (gnus-y-or-n-p + (format-message + "%s (%s) open error%s. Continue? " + (car gnus-select-method) (cadr gnus-select-method) + (if-let ((status (gnus-status-message gnus-select-method)) + (status* (not (zerop (length status))))) + (format ": `%s'" status) + ""))) + (gnus-error 1 "Couldn't open server on %s" + (nth 1 gnus-select-method))))) =20 (defun gnus-check-group (group) "Try to make sure that the server where GROUP exists is alive." @@ -219,7 +220,7 @@ gnus-get-function (setq method (gnus-server-to-method method))) ;; Check cache of constructed names. (let* ((method-sym (if gnus-agent - (inline (gnus-agent-get-function method)) + (gnus-agent-get-function method) (car method))) (method-fns (get method-sym 'gnus-method-functions)) (func (let ((method-fnlist-elt (assq function method-fns))) @@ -488,11 +489,11 @@ gnus-request-compact (defun gnus-request-group (group &optional dont-check command-method info) "Request GROUP. If DONT-CHECK, no information is required." (let ((gnus-command-method - (or command-method (inline (gnus-find-method-for-group group))))) + (or command-method (gnus-find-method-for-group group)))) (when (stringp gnus-command-method) (setq gnus-command-method - (inline (gnus-server-to-method gnus-command-method)))) - (funcall (inline (gnus-get-function gnus-command-method 'request-group= )) + (gnus-server-to-method gnus-command-method))) + (funcall (gnus-get-function gnus-command-method 'request-group) (gnus-group-real-name group) (nth 1 gnus-command-method) dont-check info))) @@ -515,7 +516,7 @@ gnus-request-group-scan =20 (defun gnus-close-group (group) "Request the GROUP be closed." - (let ((gnus-command-method (inline (gnus-find-method-for-group group)))) + (let ((gnus-command-method (gnus-find-method-for-group group))) (funcall (gnus-get-function gnus-command-method 'close-group) (gnus-group-real-name group) (nth 1 gnus-command-method)))) =20 diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el index f73627a648..4a480dde66 100644 --- a/lisp/gnus/gnus-kill.el +++ b/lisp/gnus/gnus-kill.el @@ -333,60 +333,48 @@ gnus-apply-kill-file-unless-scored (defun gnus-apply-kill-file-internal () "Apply a kill file to the current newsgroup. Returns the number of articles marked as read." - (let* ((kill-files (list (gnus-newsgroup-kill-file nil) - (gnus-newsgroup-kill-file gnus-newsgroup-name))) - (unreads (length gnus-newsgroup-unreads)) - (gnus-summary-inhibit-highlight t) - ) ;; beg - (setq gnus-newsgroup-kill-headers nil) - ;; If there are any previously scored articles, we remove these - ;; from the `gnus-newsgroup-headers' list that the score functions - ;; will see. This is probably pretty wasteful when it comes to - ;; conses, but is, I think, faster than having to assq in every - ;; single score function. - (let ((files kill-files)) - (while files - (if (file-exists-p (car files)) - (let ((headers gnus-newsgroup-headers)) - (if gnus-kill-killed - (setq gnus-newsgroup-kill-headers - (mapcar #'mail-header-number headers)) - (while headers - (unless (gnus-member-of-range - (mail-header-number (car headers)) - gnus-newsgroup-killed) - (push (mail-header-number (car headers)) - gnus-newsgroup-kill-headers)) - (setq headers (cdr headers)))) - (setq files nil)) - (setq files (cdr files))))) - (if (not gnus-newsgroup-kill-headers) - () - (save-window-excursion - (save-excursion - (while kill-files - (if (not (file-exists-p (car kill-files))) - () - (gnus-message 6 "Processing kill file %s..." (car kill-files)) - (find-file (car kill-files)) - (goto-char (point-min)) - - (if (consp (ignore-errors (read (current-buffer)))) - (gnus-kill-parse-gnus-kill-file) - (gnus-kill-parse-rn-kill-file)) - - (gnus-message - 6 "Processing kill file %s...done" (car kill-files))) - (setq kill-files (cdr kill-files))))) - - (gnus-set-mode-line 'summary) - - (if nil ;; beg - (let ((nunreads (- unreads (length gnus-newsgroup-unreads)))) - (or (eq nunreads 0) - (gnus-message 6 "Marked %d articles as read" nunreads)) - nunreads) - 0)))) + (prog1 0 + (let ((kill-files (list (gnus-newsgroup-kill-file nil) + (gnus-newsgroup-kill-file gnus-newsgroup-name))) + (gnus-summary-inhibit-highlight t)) + (setq gnus-newsgroup-kill-headers nil) + ;; If there are any previously scored articles, we remove these + ;; from the `gnus-newsgroup-headers' list that the score functions + ;; will see. This is probably pretty wasteful when it comes to + ;; conses, but is, I think, faster than having to assq in every + ;; single score function. + (let ((files kill-files)) + (while files + (if (file-exists-p (car files)) + (let ((headers gnus-newsgroup-headers)) + (if gnus-kill-killed + (setq gnus-newsgroup-kill-headers + (mapcar #'mail-header-number headers)) + (while headers + (unless (gnus-member-of-range + (mail-header-number (car headers)) + gnus-newsgroup-killed) + (push (mail-header-number (car headers)) + gnus-newsgroup-kill-headers)) + (setq headers (cdr headers)))) + (setq files nil)) + (setq files (cdr files))))) + (unless gnus-newsgroup-kill-headers + (save-window-excursion + (save-excursion + (dolist (file kill-files) + (unless (file-exists-p file) + (gnus-message 6 "Processing kill file %s..." file) + (when-let ((buf (find-file-noselect file))) + (unwind-protect + (with-current-buffer buf + (if (consp (ignore-errors (read (current-buffer)))) + (gnus-kill-parse-gnus-kill-file) + (gnus-kill-parse-rn-kill-file)) + (gnus-message 6 "Processing kill file %s...done" file)) + (let (kill-buffer-query-functions) + (kill-buffer buf)))))))) + (gnus-set-mode-line 'summary))))) =20 ;; Parse a Gnus killfile. (defun gnus-kill-parse-gnus-kill-file () diff --git a/lisp/gnus/gnus-logic.el b/lisp/gnus/gnus-logic.el index cdfdc9b731..261cabfb04 100644 --- a/lisp/gnus/gnus-logic.el +++ b/lisp/gnus/gnus-logic.el @@ -24,11 +24,8 @@ =20 ;;; Code: =20 -(eval-when-compile (require 'cl-lib)) - (require 'gnus) (require 'gnus-score) -(require 'gnus-util) =20 ;;; Internal variables. =20 diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el index d42f097125..34840b1906 100644 --- a/lisp/gnus/gnus-mlspl.el +++ b/lisp/gnus/gnus-mlspl.el @@ -70,7 +70,7 @@ gnus-group-split-setup ;; Split updating requires `gnus-newsrc-hashtb' to be ;; initialized; the read newsrc hook is the only hook that comes ;; after initialization, but before checking for new news. - 'gnus-read-newsrc-el-hook) + 'gnus-read-newsrc-hook) #'gnus-group-split-update)) =20 ;;;###autoload diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index bac987e2f0..87c775a44a 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -25,12 +25,9 @@ =20 ;;; Code: =20 -(eval-when-compile (require 'cl-lib)) - -(require 'gnus) (require 'message) (require 'gnus-art) -(require 'gnus-util) +(require 'cl-extra) =20 (defcustom gnus-post-method 'current "Preferred method for posting USENET news. @@ -398,90 +395,83 @@ gnus-inews-make-draft (defvar gnus-article-reply nil) (defmacro gnus-setup-message (config &rest forms) (declare (indent 1) (debug t)) - (let ((winconf (make-symbol "gnus-setup-message-winconf")) - (winconf-name (make-symbol "gnus-setup-message-winconf-name")) - (buffer (make-symbol "gnus-setup-message-buffer")) - (article (make-symbol "gnus-setup-message-article")) - (oarticle (make-symbol "gnus-setup-message-oarticle")) - (yanked (make-symbol "gnus-setup-yanked-articles")) - (group (make-symbol "gnus-setup-message-group"))) - `(let ((,winconf (current-window-configuration)) - (,winconf-name gnus-current-window-configuration) - (,buffer (buffer-name (current-buffer))) - (,article (when gnus-article-reply - (or (nnselect-article-number - (or (car-safe gnus-article-reply) - gnus-article-reply)) - gnus-article-reply))) - (,oarticle gnus-article-reply) - (,yanked gnus-article-yanked-articles) - (,group (if gnus-article-reply - (or (nnselect-article-group - (or (car-safe gnus-article-reply) - gnus-article-reply)) - gnus-newsgroup-name) - gnus-newsgroup-name)) - (message-header-setup-hook - (copy-sequence message-header-setup-hook)) - (mbl mml-buffer-list) - (message-mode-hook (copy-sequence message-mode-hook))) - (setq mml-buffer-list nil) - (add-hook 'message-header-setup-hook (lambda () - (gnus-inews-insert-gcc ,group))) - ;; message-newsreader and message-mailer were formerly set in - ;; gnus-inews-add-send-actions, but this is too late when - ;; message-generate-headers-first is used. --ansel - (add-hook 'message-mode-hook - (lambda nil - (setq message-newsreader - (setq message-mailer (gnus-extended-version))))) - ;; #### FIXME: for a reason that I did not manage to identify yet, - ;; the variable `gnus-newsgroup-name' does not honor a dynamically - ;; scoped or setq'ed value from a caller like `C-u gnus-summary-mai= l'. - ;; After evaluation of @forms below, it gets the value we actually = want - ;; to override, and the posting styles are used. For that reason, I= 've - ;; added an optional argument to `gnus-configure-posting-styles' to - ;; make sure that the correct value for the group name is used. -- = drv - (add-hook 'message-mode-hook - (if (memq ,config '(reply-yank reply)) - (lambda () - (gnus-configure-posting-styles ,group)) + `(let ((setup-winconf (current-window-configuration)) + (setup-winconf-name gnus-current-window-configuration) + (setup-buffer (buffer-name (current-buffer))) + (setup-article (when gnus-article-reply + (or (nnselect-article-number + (or (car-safe gnus-article-reply) + gnus-article-reply)) + gnus-article-reply))) + (setup-oarticle gnus-article-reply) + (setup-yanked gnus-article-yanked-articles) + (setup-group (if gnus-article-reply + (or (nnselect-article-group + (or (car-safe gnus-article-reply) + gnus-article-reply)) + gnus-newsgroup-name) + gnus-newsgroup-name)) + (message-header-setup-hook + (copy-sequence message-header-setup-hook)) + (mbl mml-buffer-list) + (message-mode-hook (copy-sequence message-mode-hook))) + (setq mml-buffer-list nil) + (add-hook 'message-header-setup-hook (lambda () + (gnus-inews-insert-gcc setup-group))) + ;; message-newsreader and message-mailer were formerly set in + ;; gnus-inews-add-send-actions, but this is too late when + ;; message-generate-headers-first is used. --ansel + (add-hook 'message-mode-hook + (lambda nil + (setq message-newsreader + (setq message-mailer (gnus-extended-version))))) + ;; #### FIXME: for a reason that I did not manage to identify yet, + ;; the variable `gnus-newsgroup-name' does not honor a dynamically + ;; scoped or setq'ed value from a caller like `C-u gnus-summary-mail'. + ;; After evaluation of @forms below, it gets the value we actually wa= nt + ;; to override, and the posting styles are used. For that reason, I've + ;; added an optional argument to `gnus-configure-posting-styles' to + ;; make sure that the correct value for the group name is used. -- drv + (add-hook 'message-mode-hook + (if (memq ,config '(reply-yank reply)) (lambda () - ;; There may be an old " *gnus article copy*" buffer. - (let (gnus-article-copy) - (gnus-configure-posting-styles ,group))))) - (gnus-alist-pull ',(intern gnus-draft-meta-information-header) - message-required-headers) - (when (and ,group - (not (string=3D ,group ""))) - (push (cons - (intern gnus-draft-meta-information-header) - (gnus-inews-make-draft (or ,yanked ,article))) - message-required-headers)) - (unwind-protect - (progn - ,@forms) - (gnus-inews-add-send-actions ,winconf ,buffer ,oarticle ,config - ,yanked ,winconf-name) - (setq gnus-message-buffer (current-buffer)) - (setq-local gnus-message-group-art (cons ,group ,article)) - ;; Enable highlighting of different citation levels - (when gnus-message-highlight-citation - (gnus-message-citation-mode 1)) - (gnus-run-hooks 'gnus-message-setup-hook) - (if (eq major-mode 'message-mode) - (let ((mbl1 mml-buffer-list)) - (setq mml-buffer-list mbl) ;; Global value - (setq-local mml-buffer-list mbl1) ;; Local value - (add-hook 'change-major-mode-hook #'mml-destroy-buffers nil= t) - (add-hook 'kill-buffer-hook #'mml-destroy-buffers t t)) - (mml-destroy-buffers) - (setq mml-buffer-list mbl))) - (message-hide-headers) - (gnus-add-buffer) - (gnus-configure-windows ,config t) - (run-hooks 'post-command-hook) - (set-buffer-modified-p nil)))) + (gnus-configure-posting-styles setup-group)) + (lambda () + ;; There may be an old " *gnus article copy*" buffer. + (let (gnus-article-copy) + (gnus-configure-posting-styles setup-group))))) + (gnus-alist-pull ',(intern gnus-draft-meta-information-header) + message-required-headers) + (when (and setup-group + (not (string=3D setup-group ""))) + (push (cons + (intern gnus-draft-meta-information-header) + (gnus-inews-make-draft (or setup-yanked setup-article))) + message-required-headers)) + (unwind-protect + (progn + ,@forms) + (gnus-inews-add-send-actions setup-winconf setup-buffer setup-oarti= cle ,config + setup-yanked setup-winconf-name) + (setq gnus-message-buffer (current-buffer)) + (setq-local gnus-message-group-art (cons setup-group setup-article)) + ;; Enable highlighting of different citation levels + (when gnus-message-highlight-citation + (gnus-message-citation-mode 1)) + (gnus-run-hooks 'gnus-message-setup-hook) + (if (eq major-mode 'message-mode) + (let ((mbl1 mml-buffer-list)) + (setq mml-buffer-list mbl) ;; Global value + (setq-local mml-buffer-list mbl1) ;; Local value + (add-hook 'change-major-mode-hook #'mml-destroy-buffers nil t) + (add-hook 'kill-buffer-hook #'mml-destroy-buffers t t)) + (mml-destroy-buffers) + (setq mml-buffer-list mbl))) + (message-hide-headers) + (gnus-add-buffer) + (gnus-configure-windows ,config t) + (run-hooks 'post-command-hook) + (set-buffer-modified-p nil))) =20 (defun gnus-inews-make-draft-meta-information (group articles) (when (numberp articles) @@ -577,8 +567,8 @@ gnus-inews-add-send-actions (when gnus-agent (add-hook 'message-header-hook #'gnus-agent-possibly-save-gcc nil t)) (setq message-post-method - (let ((gn gnus-newsgroup-name)) - (lambda (&optional arg) (gnus-post-method arg gn)))) + `(lambda (&optional arg) + (gnus-post-method arg ,(buffer-local-value 'gnus-newsgroup-name= (get-buffer buffer))))) (message-add-action `(progn (setq gnus-current-window-configuration ',winconf-name) @@ -661,7 +651,7 @@ gnus-group-post-news (or (gnus-group-group-name) "")) "")) ;; make sure last viewed article doesn't affect posting styles: - (gnus-article-copy)) + gnus-article-copy) (gnus-post-news 'post gnus-newsgroup-name nil nil nil nil (string=3D gnus-newsgroup-name "")))) =20 @@ -869,58 +859,85 @@ gnus-copy-article-buffer (mm-enable-multibyte)) (let ((article-buffer (or article-buffer gnus-article-buffer)) end beg) - (if (not (gnus-buffer-live-p article-buffer)) - (error "Can't find any article buffer") - (with-current-buffer article-buffer - (let ((gnus-newsgroup-charset (or gnus-article-charset - gnus-newsgroup-charset)) - (inhibit-read-only t) - (gnus-newsgroup-ignored-charsets - (or gnus-article-ignored-charsets - gnus-newsgroup-ignored-charsets))) - (save-restriction - ;; Copy over the (displayed) article buffer, delete - ;; hidden text and remove text properties. - (widen) - (copy-to-buffer gnus-article-copy (point-min) (point-max)) - (set-buffer gnus-article-copy) - (when yank-string - (message-goto-body) - (delete-region (point) (point-max)) - (insert yank-string)) - (gnus-article-delete-text-of-type 'annotation) - (gnus-article-delete-text-of-type 'multipart) - (gnus-remove-text-with-property 'gnus-prev) - (gnus-remove-text-with-property 'gnus-next) - (gnus-remove-text-with-property 'gnus-decoration) - (insert - (prog1 - (buffer-substring-no-properties (point-min) (point-max)) - (erase-buffer))) - ;; Find the original headers. - (set-buffer gnus-original-article-buffer) - (goto-char (point-min)) - (while (looking-at message-unix-mail-delimiter) - (forward-line 1)) - (let ((mail-header-separator "")) - (setq beg (point) - end (or (message-goto-body) - ;; There may be just a header. - (point-max)))) - ;; Delete the headers from the displayed articles. - (set-buffer gnus-article-copy) - (let ((mail-header-separator "")) - (delete-region (goto-char (point-min)) - (or (message-goto-body) (point-max)))) - ;; Insert the original article headers. - (insert-buffer-substring gnus-original-article-buffer beg end) - ;; Decode charsets. - (let ((gnus-article-decode-hook - (delq 'article-decode-charset - (copy-sequence gnus-article-decode-hook))) - (rfc2047-quote-decoded-words-containing-tspecials t)) - (run-hooks 'gnus-article-decode-hook))))) - gnus-article-copy))) + (unless (gnus-buffer-live-p article-buffer) + (error "Can't find any article buffer")) + (gnus-msg-inherit-variables (get-buffer article-buffer) gnus-article-c= opy) + (with-current-buffer article-buffer + (let ((gnus-newsgroup-charset (or gnus-article-charset + gnus-newsgroup-charset)) + (inhibit-read-only t) + (gnus-newsgroup-ignored-charsets + (or gnus-article-ignored-charsets + gnus-newsgroup-ignored-charsets))) + (save-restriction + ;; Copy over the (displayed) article buffer, delete + ;; hidden text and remove text properties. + (widen) + (copy-to-buffer gnus-article-copy (point-min) (point-max)) + (with-current-buffer gnus-article-copy + (when yank-string + (message-goto-body) + (delete-region (point) (point-max)) + (insert yank-string)) + (gnus-article-delete-text-of-type 'annotation) + (gnus-article-delete-text-of-type 'multipart) + (gnus-remove-text-with-property 'gnus-prev) + (gnus-remove-text-with-property 'gnus-next) + (gnus-remove-text-with-property 'gnus-decoration) + (insert + (prog1 + (buffer-substring-no-properties (point-min) (point-max)) + (erase-buffer)))) + ;; Find the original headers. + (with-current-buffer gnus-original-article-buffer + (goto-char (point-min)) + (while (looking-at message-unix-mail-delimiter) + (forward-line 1)) + (let ((mail-header-separator "")) + (setq beg (point) + end (or (message-goto-body) + ;; There may be just a header. + (point-max))))) + ;; Delete the headers from the displayed articles. + (with-current-buffer gnus-article-copy + (let ((mail-header-separator "")) + (delete-region (goto-char (point-min)) + (or (message-goto-body) (point-max)))) + ;; Insert the original article headers. + (insert-buffer-substring gnus-original-article-buffer beg end) + ;; Decode charsets. + (let ((gnus-article-decode-hook + (delq 'article-decode-charset + (copy-sequence gnus-article-decode-hook))) + (rfc2047-quote-decoded-words-containing-tspecials t)) + (run-hooks 'gnus-article-decode-hook)))))) + gnus-article-copy)) + +(defmacro gnus-msg-preserve-variables (parent-buffer &rest body) + "If BODY changes the current buffer, ensure important variables preserve= d." + (declare (indent 1)) + `(progn + ,@body + (unless (eq ,parent-buffer (current-buffer)) + (gnus-msg-inherit-variables ,parent-buffer (current-buffer))))) + +(defun gnus-msg-inherit-variables (source-buffer dest-buffer) + "Transfer formerly global variables from SOURCE-BUFFER to DEST-BUFFER." + (with-current-buffer dest-buffer + (mapc (lambda (pair) + (set (make-local-variable (car pair)) + (cdr pair))) + (cl-mapcan (lambda (variable) + (when (local-variable-if-set-p variable) + (list `(,variable . ,(buffer-local-value + variable + source-buffer))))) + '(gnus-summary-buffer + gnus-article-buffer + gnus-original-article-buffer + gnus-newsgroup-name + gnus-article-current + gnus-current-article))))) =20 (defun gnus-post-news (post &optional group header article-buffer yank _su= bject force-news) @@ -963,13 +980,15 @@ gnus-post-news (and (not (gnus-virtual-group-p pgroup)) group))) (set-buffer gnus-article-copy) (gnus-msg-treat-broken-reply-to) - (message-followup (if (or newsgroup-p force-news) - (if (save-restriction - (article-narrow-to-head) - (message-fetch-field "newsgroups")) - nil - "") - to-group))) + (let ((parent-buffer (current-buffer))) + (gnus-msg-preserve-variables parent-buffer + (message-followup (if (or newsgroup-p force-news) + (if (save-restriction + (article-narrow-to-head) + (message-fetch-field "newsgr= oups")) + nil + "") + to-group))))) ;; The is mail. (if post (progn @@ -983,7 +1002,9 @@ gnus-post-news message-send-actions))) (set-buffer gnus-article-copy) (gnus-msg-treat-broken-reply-to) - (message-wide-reply to-address))) + (let ((parent-buffer (current-buffer))) + (gnus-msg-preserve-variables parent-buffer + (message-wide-reply to-address))))) (when yank (gnus-inews-yank-articles yank)))))) =20 @@ -1027,10 +1048,9 @@ gnus-post-method (if (listp (car gnus-post-method)) gnus-post-method (list gnus-post-method))) - gnus-secondary-select-methods + gnus-select-methods (mapcar #'cdr gnus-server-alist) (mapcar #'car gnus-opened-servers) - (list gnus-select-method) (list group-method))) method-alist post-methods method) ;; Weed out all mail methods. @@ -1105,10 +1125,11 @@ gnus-summary-reply If prefix argument YANK is non-nil, the original article is yanked automatically. If WIDE, make a wide reply. -If VERY-WIDE, make a very wide reply." - (interactive (list (and current-prefix-arg - (gnus-summary-work-articles 1))) - gnus-summary-mode) +VERY-WIDE is a list of other articles to reply to." + (interactive + (list (and current-prefix-arg + (gnus-summary-work-articles 1))) + gnus-summary-mode) ;; Allow user to require confirmation before replying by mail to the ;; author of a news article (or mail message). (when (or (not (or (gnus-news-group-p gnus-newsgroup-name) @@ -1120,40 +1141,38 @@ gnus-summary-reply (funcall gnus-confirm-mail-reply-to-news gnus-newsgroup-name)) (t gnus-confirm-mail-reply-to-news))) - (if (or wide very-wide) - t ;; Ignore gnus-confirm-mail-reply-to-news for wide and very - ;; wide replies. - (y-or-n-p "Really reply by mail to article author? "))) - (let* ((article - (if (listp (car yank)) - (caar yank) - (car yank))) + (or wide very-wide + (y-or-n-p "Really reply by mail to article author? "))) + (let* ((article (if (listp (car yank)) (caar yank) (car yank))) (gnus-article-reply (or article (gnus-summary-article-number))) - (gnus-article-yanked-articles yank) - (headers "")) + (gnus-article-yanked-articles yank)) ;; Stripping headers should be specified with mail-yank-ignored-head= ers. (when yank (gnus-summary-goto-subject article)) (gnus-setup-message (if yank 'reply-yank 'reply) - (if (not very-wide) - (gnus-summary-select-article) - (dolist (article very-wide) - (gnus-summary-select-article nil nil nil article) - (with-current-buffer (gnus-copy-article-buffer) - (gnus-msg-treat-broken-reply-to) - (save-restriction - (message-narrow-to-head) - (setq headers (concat headers (buffer-string))))))) + (gnus-summary-select-article nil nil nil gnus-article-reply) (set-buffer (gnus-copy-article-buffer)) (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to) - (save-restriction - (message-narrow-to-head) - (when very-wide - (erase-buffer) - (insert headers)) - (goto-char (point-max))) - (mml-quote-region (point) (point-max)) - (message-reply nil wide) + (save-restriction + (message-narrow-to-head) + (when-let ((very-wide-headers + (save-current-buffer + (let (result) + (dolist (art very-wide result) + (gnus-summary-select-article nil nil nil art) + (with-current-buffer (gnus-copy-article-buffer) + (gnus-msg-treat-broken-reply-to) + (save-restriction + (message-narrow-to-head) + (setq result (concat (or result "") + (buffer-string)))))))= ))) + (erase-buffer) + (insert very-wide-headers)) + (goto-char (point-max))) + (let ((parent-buffer (current-buffer))) + (gnus-msg-preserve-variables parent-buffer + (mml-quote-region (point) (point-max)) + (message-reply nil wide))) (when yank (gnus-inews-yank-articles yank)) (gnus-summary-handle-replysign))))) diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications= .el index 8646904637..aeb590c28c 100644 --- a/lisp/gnus/gnus-notifications.el +++ b/lisp/gnus/gnus-notifications.el @@ -35,7 +35,6 @@ (require 'gnus-group) (require 'gnus-int) (require 'gnus-art) -(require 'gnus-util) (ignore-errors (require 'google-contacts)) ; Optional (require 'gnus-fun) diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el index fd4d3b8a76..a65521b458 100644 --- a/lisp/gnus/gnus-picon.el +++ b/lisp/gnus/gnus-picon.el @@ -37,8 +37,6 @@ ;; ;;; Code: =20 -(eval-when-compile (require 'cl-lib)) - (require 'gnus) (require 'gnus-art) =20 diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 0468d72edd..1bca887889 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -79,16 +79,14 @@ =20 ;;; Code: =20 -(eval-when-compile (require 'cl-lib)) -(eval-when-compile (require 'subr-x)) =20 (require 'gnus) (require 'gnus-int) (require 'gnus-sum) (require 'gnus-art) -(require 'gnus-util) (require 'nnmail) (require 'registry) +(require 'subr-x) =20 (defvar gnus-adaptive-word-syntax-table) =20 @@ -1187,7 +1185,7 @@ gnus-registry-initialize (gnus-registry-install-shortcuts) (if (gnus-alive-p) (gnus-registry-load) - (add-hook 'gnus-read-newsrc-el-hook #'gnus-registry-load))) + (add-hook 'gnus-read-newsrc-hook #'gnus-registry-load))) =20 (defun gnus-registry-install-hooks () "Install the registry hooks." @@ -1209,7 +1207,7 @@ gnus-registry-unload-hook (remove-hook 'nnmail-spool-hook #'gnus-registry-spool-action) =20 (remove-hook 'gnus-save-newsrc-hook #'gnus-registry-save) - (remove-hook 'gnus-read-newsrc-el-hook #'gnus-registry-load) + (remove-hook 'gnus-read-newsrc-hook #'gnus-registry-load) =20 (remove-hook 'gnus-summary-prepare-hook #'gnus-registry-register-message= -ids) (setq gnus-registry-enabled nil)) diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index 5b746a8efa..6fb1282a1e 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -24,8 +24,6 @@ =20 ;;; Code: =20 -(eval-when-compile (require 'cl-lib)) - (require 'gnus) (require 'gnus-sum) (require 'gnus-win) @@ -110,7 +108,7 @@ gnus-pick-mode ;; Change line format. (setq gnus-summary-line-format gnus-summary-pick-line-format) (setq gnus-summary-line-format-spec nil) - (gnus-update-format-specifications nil 'summary) + (gnus-update-format-specifications 'summary) (gnus-update-summary-mark-positions) ;; FIXME: a buffer-local minor mode adding globally to a hook?? (add-hook 'gnus-message-setup-hook #'gnus-pick-setup-message) @@ -457,8 +455,7 @@ gnus-tree-mode (buffer-disable-undo) (setq buffer-read-only t) (setq truncate-lines t) - (save-current-buffer - (gnus-set-work-buffer) + (gnus-with-temp-buffer (gnus-tree-node-insert (make-mail-header "") nil) (setq gnus-tree-node-length (1- (point))))) =20 diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index f40da9e9c4..3e71bb56c4 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -460,7 +460,7 @@ gnus-adaptive-word-score-alist (defvar gnus-score-trace nil) (defvar gnus-score-edit-buffer nil) =20 -(defvar gnus-score-alist nil +(defvar-local gnus-score-alist nil "Alist containing score information. The keys can be symbols or strings. The following symbols are defined. =20 @@ -1444,24 +1444,21 @@ gnus-score-save ;; Save all score information. (let ((cache gnus-score-cache) entry score file) - (save-excursion + (with-temp-buffer (setq gnus-score-alist nil) - (nnheader-set-temp-buffer " *Gnus Scores*") (while cache - (current-buffer) (setq entry (pop cache) file (nnheader-translate-file-chars (car entry) t) score (cdr entry)) - (if (or (not (equal (gnus-score-get 'touched score) '(t))) - (gnus-score-get 'read-only score) - (and (file-exists-p file) - (not (file-writable-p file)))) - () + (when (and (equal (gnus-score-get 'touched score) '(t)) + (not (gnus-score-get 'read-only score)) + (or (not (file-exists-p file)) + (file-writable-p file))) (setq score (setcdr entry (assq-delete-all 'touched score))) (erase-buffer) (let (emacs-lisp-mode-hook) (if (and (not gnus-adaptive-pretty-print) - (string-match + (string-match-p (concat (regexp-quote gnus-adaptive-file-suffix) "$") file)) ;; This is an adaptive score file, so we do not run it through @@ -1482,10 +1479,9 @@ gnus-score-save (gnus-write-buffer file)) (when gnus-score-after-write-file-function (funcall gnus-score-after-write-file-function file))))) - (and gnus-score-uncacheable-files - (string-match gnus-score-uncacheable-files file) - (gnus-score-remove-from-cache file))) - (kill-buffer (current-buffer))))) + (when (and gnus-score-uncacheable-files + (string-match-p gnus-score-uncacheable-files file)) + (gnus-score-remove-from-cache file)))))) =20 (defun gnus-score-load-files (score-files) "Load all score files in SCORE-FILES." @@ -1524,8 +1520,7 @@ gnus-score-headers (while news (setq scores news news nil) - (when (and gnus-summary-default-score - scores) + (when (and gnus-summary-default-score scores) (let* ((entries gnus-header-index) (now (time-to-days nil)) (expire (and gnus-score-expiry-days @@ -1544,8 +1539,7 @@ gnus-score-headers (cons (cons header (or gnus-summary-default-score 0)) gnus-scores-articles)))) =20 - (with-current-buffer (gnus-get-buffer-create "*Headers*") - (buffer-disable-undo) + (with-temp-buffer (when (gnus-buffer-live-p gnus-summary-buffer) (message-clone-locals gnus-summary-buffer)) =20 @@ -1589,9 +1583,7 @@ gnus-score-headers (when (gnus-buffer-live-p gnus-summary-buffer) (let ((scored gnus-newsgroup-scored)) (with-current-buffer gnus-summary-buffer - (setq gnus-newsgroup-scored scored)))) - ;; Remove the buffer. - (gnus-kill-buffer (current-buffer))) + (setq gnus-newsgroup-scored scored))))) =20 ;; Add articles to `gnus-newsgroup-scored'. (while gnus-scores-articles @@ -2916,7 +2908,7 @@ gnus-sort-score-files (let ((alist (mapcar (lambda (file) - (cons (inline (gnus-score-file-rank file)) file)) + (cons (gnus-score-file-rank file) file)) files))) (mapcar #'cdr (sort alist #'car-less-than-car))))) =20 diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index fc9f8684f6..91f2decaf8 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -81,9 +81,8 @@ (require 'gnus-group) (require 'gnus-sum) (require 'message) -(require 'gnus-util) (require 'eieio) -(eval-when-compile (require 'cl-lib)) + (autoload 'eieio-build-class-alist "eieio-opt") (autoload 'nnmaildir-base-name-to-article-number "nnmaildir") =20 @@ -1024,7 +1023,7 @@ gnus-search-run-search ;; We should only be doing this once, in ;; `nnimap-open-connection', but it's too frustrating to try to ;; get to the server from the process buffer. - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (setf (slot-value engine 'literal-plus) (when (nnimap-capability "LITERAL+") t)) ;; MULTISEARCH not yet implemented. @@ -1062,7 +1061,7 @@ gnus-search-run-search (or (null single-search) (null artlist))) (when (nnimap-change-group (gnus-group-short-name group) server) - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (message "Searching %s..." group) (let ((result (gnus-search-imap-search-command engine q-string))) diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el index cb60108ea9..ec7c7e7406 100644 --- a/lisp/gnus/gnus-spec.el +++ b/lisp/gnus/gnus-spec.el @@ -24,14 +24,12 @@ =20 ;;; Code: =20 -(eval-when-compile (require 'cl-lib)) -(defvar gnus-newsrc-file-version) - (require 'gnus) =20 ;;; Internal variables. =20 -(defvar gnus-summary-mark-positions nil) +(defvar gnus-newsrc-file-version) +(defvar-local gnus-summary-mark-positions nil) (defvar gnus-group-mark-positions nil) (defvar gnus-group-indentation "") =20 @@ -129,13 +127,12 @@ gnus-update-format (lisp-interaction-mode) (insert (gnus-pp-to-string spec)))) =20 -(defun gnus-update-format-specifications (&optional force &rest types) +(defun gnus-update-format-specifications (&rest types) "Update all (necessary) format specifications. Return a list of updated types." ;; Make the indentation array. ;; See whether all the stored info needs to be flushed. - (when (or force - (not gnus-newsrc-file-version) + (when (or (not gnus-newsrc-file-version) (not (equal (gnus-continuum-version) (gnus-continuum-version gnus-newsrc-file-version))) (not (equal emacs-version @@ -374,56 +371,55 @@ gnus-parse-format (if (string-match "\\`\\(.*\\)%[0-9]?[{(=C2=AB]\\(.*\\)%[0-9]?[=C2=BB})]\\(.*\n?\\)\\'\\|%= [-0-9]*=3D\\|%[-0-9]*\\*" format) - (gnus-parse-complex-format format spec-alist) + (gnus-parse-complex-format format spec-alist) ;; This is a simple format. (gnus-parse-simple-format format spec-alist insert)))) =20 (defun gnus-parse-complex-format (format spec-alist) - (let ((cursor-spec nil)) - (save-excursion - (gnus-set-work-buffer) - (insert format) - (goto-char (point-min)) - (while (re-search-forward "\"" nil t) - (replace-match "\\\"" nil t)) - (goto-char (point-min)) - (insert "(\"") - ;; Convert all font specs into font spec lists. - (while (re-search-forward "%\\([0-9]+\\)?\\([=C2=AB=C2=BB{}()]\\)" n= il t) - (let ((number (if (match-beginning 1) - (match-string 1) "0")) - (delim (aref (match-string 2) 0))) - (if (or (=3D delim ?\() - (=3D delim ?\{) - (=3D delim 171)) ; =C2=AB - (replace-match (concat "\"(" - (cond ((=3D delim ?\() "mouse") - ((=3D delim ?\{) "face") - (t "balloon")) - " " number " \"") - t t) - (replace-match "\")\"")))) - (goto-char (point-max)) - (insert "\")") - ;; Convert point position commands. - (goto-char (point-min)) + (gnus-with-temp-buffer + (insert format) + (goto-char (point-min)) + (while (re-search-forward "\"" nil t) + (replace-match "\\\"" nil t)) + (goto-char (point-min)) + (insert "(\"") + ;; Convert all font specs into font spec lists. + (while (re-search-forward "%\\([0-9]+\\)?\\([=C2=AB=C2=BB{}()]\\)" nil= t) + (let ((number (if (match-beginning 1) + (match-string 1) "0")) + (delim (aref (match-string 2) 0))) + (if (or (=3D delim ?\() + (=3D delim ?\{) + (=3D delim 171)) ; =C2=AB + (replace-match (concat "\"(" + (cond ((=3D delim ?\() "mouse") + ((=3D delim ?\{) "face") + (t "balloon")) + " " number " \"") + t t) + (replace-match "\")\"")))) + (goto-char (point-max)) + (insert "\")") + ;; Convert point position commands. + (goto-char (point-min)) + (let (cursor-spec) (let ((case-fold-search nil)) - (while (re-search-forward "%\\([-0-9]+\\)?\\*" nil t) + (while (re-search-forward "%\\([-0-9]+\\)?\\*" nil t) (replace-match "\"(point)\"" t t) (setq cursor-spec t))) ;; Convert TAB commands. (goto-char (point-min)) (while (re-search-forward "%\\([-0-9]+\\)=3D" nil t) - (replace-match (format "\"(tab %s)\"" (match-string 1)) t t)) + (replace-match (format "\"(tab %s)\"" (match-string 1)) t t)) ;; Convert the buffer into the spec. (goto-char (point-min)) (let ((form (read (current-buffer)))) - (if cursor-spec + (if cursor-spec `(let (gnus-position) ,@(gnus-complex-form-to-spec form spec-alist) (if gnus-position (put-text-property gnus-position (1+ gnus-position) - 'gnus-position t))) + 'gnus-position t))) `(progn ,@(gnus-complex-form-to-spec form spec-alist))))))) =20 @@ -452,8 +448,7 @@ gnus-parse-simple-format spec flist fstring elem result dontinsert user-defined type value pad-width spec-beg cut-width ignore-value tilde-form tilde elem-type extended-spec) - (save-excursion - (gnus-set-work-buffer) + (gnus-with-temp-buffer (insert format) (goto-char (point-min)) (while (re-search-forward "%" nil t) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index f66f8427ea..6dfd8d9050 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -24,8 +24,6 @@ =20 ;;; Code: =20 -(eval-when-compile (require 'cl-lib)) - (require 'gnus) (require 'gnus-start) (require 'gnus-spec) @@ -754,8 +752,8 @@ gnus-browse-foreign-server (setq gnus-browse-current-method (gnus-server-to-method server)) (setq gnus-browse-return-buffer return-buffer) (let* ((method gnus-browse-current-method) - (orig-select-method gnus-select-method) - (gnus-select-method method) + (orig-select-methods gnus-select-methods) + (gnus-select-methods (list method)) groups group) (gnus-message 5 "Connecting to %s..." (nth 1 method)) (cond @@ -822,7 +820,7 @@ gnus-browse-foreign-server (lambda (l1 l2) (string< (car l1) (car l2))))) (if gnus-server-browse-in-group-buffer - (let* ((gnus-select-method orig-select-method) + (let* ((gnus-select-methods orig-select-methods) (gnus-group-listed-groups (mapcar (lambda (group) (let ((name @@ -846,7 +844,7 @@ gnus-browse-foreign-server "Gnus: %%b {%s:%s}" (car method) (cadr method)))) (let ((buffer-read-only nil) name - (prefix (let ((gnus-select-method orig-select-method)) + (prefix (let ((gnus-select-methods orig-select-methods)) (gnus-group-prefixed-name "" method)))) (while (setq group (pop groups)) (add-text-properties diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 44e97d5484..a3360769fb 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -29,47 +29,49 @@ (require 'gnus-int) (require 'gnus-spec) (require 'gnus-range) -(require 'gnus-util) (require 'gnus-cloud) (require 'gnus-dbus) +(require 'nnmail) + (autoload 'message-make-date "message") (autoload 'gnus-agent-read-servers-validate "gnus-agent") (autoload 'gnus-agent-save-local "gnus-agent") (autoload 'gnus-agent-possibly-alter-active "gnus-agent") -(declare-function gnus-group-decoded-name "gnus-group" (string)) +(autoload 'gnus-agent-save-active "gnus-agent") +(autoload 'gnus-agentize "gnus-agent" nil t) =20 -(eval-when-compile (require 'cl-lib)) +(declare-function gnus-group-decoded-name "gnus-group" (string)) +(declare-function gnus-group-default-level "gnus-group") =20 (defvar gnus-agent-covered-methods) (defvar gnus-agent-file-loading-local) (defvar gnus-agent-file-loading-cache) (defvar gnus-topic-alist) +(defvar gnus-inhibit-demon) =20 -(defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc= ") - "Your `.newsrc' file. -`.newsrc-SERVER' will be used instead if that exists." - :group 'gnus-start - :type 'file) +(defconst gnus-thread-group "gnus-get-unread-articles" + "Identifying prefix for fetching threads.") =20 -(defcustom gnus-backup-startup-file 'never - "Control use of version numbers for backups of `gnus-startup-file'. -This variable takes the same values as the `version-control' -variable." - :version "22.1" +(defcustom gnus-max-seconds-hold-mutex 75 + "Timeout in seconds before relinquishing `gnus-mutex-get-unread-articles= '." :group 'gnus-start - :type '(choice (const :tag "Never" never) - (const :tag "If existing" nil) - (other :tag "Always" t))) - -(defcustom gnus-save-startup-file-via-temp-buffer t - "Whether to write the startup file contents to a buffer then save -the buffer or write directly to the file. The buffer is faster -because all of the contents are written at once. The direct write -uses considerably less memory." - :version "22.1" + :type 'integer) + +(defvar gnus-mutex-get-unread-articles (make-mutex gnus-thread-group) + "Updating or displaying state of unread articles are critical sections.") + +(defconst gnus-dot-newsrc (nnheader-concat gnus-home-directory ".newsrc") + "Traditional Usenet .newsrc file. Its time is long past.") + +(defcustom gnus-newsrc-file (nnheader-concat gnus-home-directory ".newsrc.= eld") + "So-called El Dingo state file. Do not change this." :group 'gnus-start - :type '(choice (const :tag "Write via buffer" t) - (const :tag "Write directly to file" nil))) + :type 'file) + +(make-obsolete-variable 'gnus-startup-file 'gnus-newsrc-file "28.1") + +(make-obsolete-variable 'gnus-backup-startup-file nil "28.1") +(make-obsolete-variable 'gnus-save-startup-file-via-temp-buffer nil "28.1") =20 (defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus") "Your Gnus Emacs Lisp startup file name. @@ -109,7 +111,7 @@ gnus-check-new-newsgroups or killed. =20 When any of the following are true, `gnus-find-new-newsgroups' will instead -ask the servers (primary, secondary, and archive servers) to list new +ask the servers (including the archive server) to list new groups since the last time it checked: 1. This variable is `ask-server'. 2. This variable is a list of select methods (see below). @@ -121,8 +123,7 @@ gnus-check-new-newsgroups longer necessary, so you could safely set `gnus-save-killed-list' to nil. =20 This variable can be a list of select methods which Gnus will query with -the `ask-server' method in addition to the primary, secondary, and archive -servers. +the `ask-server' method in addition to the archive server. =20 E.g.: (setq gnus-check-new-newsgroups @@ -217,24 +218,15 @@ gnus-activate-foreign-newsgroups :type '(choice integer (const :tag "none" nil))) =20 -(defcustom gnus-read-newsrc-file t - "Non-nil means that Gnus will read the `.newsrc' file. -Gnus always reads its own startup file, which is called -\".newsrc.eld\". The file called \".newsrc\" is in a format that can -be readily understood by other newsreaders. If you don't plan on -using other newsreaders, set this variable to nil to save some time on -entry." - :version "21.1" - :group 'gnus-newsrc - :type 'boolean) +(make-obsolete-variable 'gnus-read-newsrc-file nil "28.1") + +(make-obsolete-variable 'gnus-save-newsrc-file 'gnus-save-dot-newsrc "28.1= ") =20 +(defvaralias 'gnus-save-dot-newsrc 'gnus-save-newsrc-file) (defcustom gnus-save-newsrc-file t - "Non-nil means that Gnus will save the `.newsrc' file. -Gnus always saves its own startup file, which is called -\".newsrc.eld\". The file called \".newsrc\" is in a format that can -be readily understood by other newsreaders. If you don't plan on -using other newsreaders, set this variable to nil to save some time on -exit." + "Save a Usenet .newsrc for nntp groups. +Note the .newsrc is primarily for the benefit of other newsreaders. +Gnus uses .newsrc.eld, not .newsrc." :group 'gnus-newsrc :type 'boolean) =20 @@ -378,6 +370,17 @@ gnus-options-not-subscribe :type '(choice regexp (const :tag "none" nil))) =20 +(defcustom gnus-background-get-unread-articles nil + "Instantiate background thread for `gnus-get-unread-articles' which +covers 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 @@ -439,27 +442,20 @@ gnus-after-getting-new-news-hook :group 'gnus-group-new :type 'hook) =20 -(defcustom gnus-read-newsrc-el-hook nil - "A hook called after reading the newsrc.eld? file." +(defcustom gnus-read-newsrc-hook nil + "A hook called after reading the newsrc.eld file." :group 'gnus-newsrc :type 'hook) =20 -(defcustom gnus-save-newsrc-hook nil - "A hook called before saving any of the newsrc files." - :group 'gnus-newsrc - :type 'hook) +(make-obsolete-variable 'gnus-read-newsrc-el-hook 'gnus-read-newsrc-hook "= 28.1") =20 -(defcustom gnus-save-quick-newsrc-hook nil - "A hook called just before saving the quick newsrc file. -Can be used to turn version control on or off." +(defcustom gnus-save-newsrc-hook nil + "A hook called before saving the newsrc.eld file." :group 'gnus-newsrc :type 'hook) =20 -(defcustom gnus-save-standard-newsrc-hook nil - "A hook called just before saving the standard newsrc file. -Can be used to turn version control on or off." - :group 'gnus-newsrc - :type 'hook) +(make-obsolete-variable 'gnus-save-quick-newsrc-hook nil "28.1") +(make-obsolete-variable 'gnus-save-standard-newsrc-hook nil "28.1") =20 (defcustom gnus-group-mode-hook nil "Hook for Gnus group mode." @@ -491,14 +487,17 @@ gnus-newsrc-options-n (defvar gnus-newsrc-last-checked-date nil "Date Gnus last asked server for new newsgroups.") =20 -(defvar gnus-current-startup-file nil - "Startup file for the current host.") - ;; Byte-compiler warning. (defvar gnus-group-line-format) =20 ;; Suggested by Brian Edmonds . (defvar gnus-init-inhibit nil) + +(defvar gnus-thread-start nil + "(lisp-time . thread) when background thread got mutex. +The macro `with-timeout' within thread body is verboten since handlerlist = is not +thread-safe in eval.c.") + (defun gnus-read-init-file (&optional inhibit-next) ;; Don't load .gnus if the -q option was used. (when init-file-user @@ -594,7 +593,7 @@ gnus-subscribe-alphabetically (defun gnus-subscribe-hierarchically (newgroup) "Subscribe new NEWGROUP and insert it in hierarchical newsgroup order." ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams) - (with-current-buffer (nnheader-find-file-noselect gnus-current-startup-f= ile) + (with-current-buffer (nnheader-find-file-noselect gnus-dot-newsrc) (prog1 (let ((groupkey newgroup) before) (while (and (not before) groupkey) @@ -710,9 +709,8 @@ gnus-clear-system gnus-ephemeral-servers nil) (gnus-shutdown 'gnus) ;; Kill the startup file. - (and gnus-current-startup-file - (get-file-buffer gnus-current-startup-file) - (kill-buffer (get-file-buffer gnus-current-startup-file))) + (when-let ((buffer (get-file-buffer gnus-newsrc-file))) + (kill-buffer buffer)) ;; Clear the dribble buffer. (gnus-dribble-clear) ;; Kill global KILL file buffer. @@ -755,7 +753,6 @@ gnus-1 (and (numberp arg) (> arg 0) (max (car gnus-group-list-mode) arg)))) - (gnus-clear-system) (gnus-splash) (gnus-run-hooks 'gnus-before-startup-hook) @@ -769,8 +766,8 @@ gnus-1 (add-to-list 'gnus-predefined-server-alist (cons "native" gnus-select-method))) =20 - (if gnus-agent - (gnus-agentize)) + (when gnus-agent + (gnus-agentize)) =20 (let ((level (and (numberp arg) (> arg 0) arg)) did-connect) @@ -784,9 +781,6 @@ gnus-1 ;; Couldn't connect to the server, so bail out. (gnus-group-quit) (gnus-run-hooks 'gnus-startup-hook) - ;; Find the current startup file name. - (setq gnus-current-startup-file - (gnus-make-newsrc-file gnus-startup-file)) =20 ;; Read the dribble file. (when (or gnus-child gnus-use-dribble-file) @@ -801,7 +795,7 @@ gnus-1 (gnus-dbus-register-sleep-signal)) (gnus-start-draft-setup) ;; Generate the group buffer. - (gnus-group-list-groups level) + (gnus-group-list-groups level) (gnus-group-first-unread-group) (gnus-configure-windows 'group) (gnus-group-set-mode-line) @@ -820,7 +814,6 @@ gnus-start-draft-setup (gnus-group-set-parameter "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode))))) =20 - ;;; ;;; Dribble file ;;; @@ -833,8 +826,8 @@ gnus-dribble-file-name (concat (if gnus-dribble-directory (concat (file-name-as-directory gnus-dribble-directory) - (file-name-nondirectory gnus-current-startup-file)) - gnus-current-startup-file) + (file-name-nondirectory gnus-newsrc-file)) + gnus-newsrc-file) "-dribble")) =20 (defun gnus-dribble-enter (string &optional regexp) @@ -882,32 +875,25 @@ gnus-dribble-read-file (buffer-disable-undo) (bury-buffer (current-buffer)) (set-buffer-modified-p nil) - (let ((auto (make-auto-save-file-name)) - (gnus-dribble-ignore t) - (purpose nil) - modes) - (when (or (file-exists-p auto) (file-exists-p dribble-file)) - ;; Load whichever file is newest -- the auto save file - ;; or the "real" file. - (if (file-newer-than-file-p auto dribble-file) - (nnheader-insert-file-contents auto) - (nnheader-insert-file-contents dribble-file)) + (let* ((gnus-dribble-ignore t) + (auto (make-auto-save-file-name)) + (state (if (file-newer-than-file-p auto dribble-file) + auto + dribble-file)) + modes) + (when (file-exists-p state) + (nnheader-insert-file-contents state) (unless (zerop (buffer-size)) (set-buffer-modified-p t)) ;; Set the file modes to reflect the .newsrc file modes. (save-buffer) - (when (and (setq modes (file-modes gnus-current-startup-file)) + (when (and (setq modes (file-modes gnus-newsrc-file)) (file-exists-p dribble-file)) (gnus-set-file-modes dribble-file modes)) (goto-char (point-min)) - (when (search-forward "Gnus was exited on purpose" nil t) - (setq purpose t)) ;; Possibly eval the file later. (when (or gnus-always-read-dribble-file - (gnus-y-or-n-p - (if purpose - "Gnus exited on purpose without saving; read auto-save file anyway? " - "Gnus auto-save file exists. Do you want to read it? "))) + (gnus-y-or-n-p (format "Read unsaved state %s? " state))) (setq gnus-dribble-eval-file t))))))) =20 (defun gnus-dribble-eval-file () @@ -941,27 +927,23 @@ gnus-dribble-clear (set-buffer-modified-p nil) (setq buffer-saved-size (buffer-size))))) =20 - ;;; ;;; Active & Newsrc File Handling ;;; =20 -(defun gnus-setup-news (&optional rawfile level dont-connect) +(defun gnus-setup-news (&optional _force level dont-connect) "Setup news information. -If RAWFILE is non-nil, the .newsrc file will also be read. If LEVEL is non-nil, the news will be set up at level LEVEL." - (require 'nnmail) - (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)= ))) + (let ((init (or (not gnus-newsrc-alist) (not gnus-active-hashtb))) ;; Binding this variable will inhibit multiple fetchings ;; of the same mail source. (nnmail-fetched-sources (list t))) - (when init ;; Clear some variables to re-initialize news information. (setq gnus-newsrc-alist nil gnus-active-hashtb nil) ;; Read the newsrc file and create `gnus-newsrc-hashtb'. - (gnus-read-newsrc-file rawfile)) + (gnus-read-newsrc-file)) =20 ;; Make sure the archive server is available to all and sundry. (let ((method (or (and (stringp gnus-message-archive-method) @@ -1163,21 +1145,18 @@ gnus-matches-options-n (defun gnus-ask-server-for-new-groups () (let* ((new-date (message-make-date)) (date (or gnus-newsrc-last-checked-date new-date)) - (methods (cons gnus-select-method - (nconc - (when (gnus-archive-server-wanted-p) - (list "archive")) - (append - (and (consp gnus-check-new-newsgroups) - gnus-check-new-newsgroups) - gnus-secondary-select-methods)))) + (methods (nconc + (when (gnus-archive-server-wanted-p) + (list "archive")) + (append + (and (consp gnus-check-new-newsgroups) + gnus-check-new-newsgroups) + gnus-select-methods))) (groups 0) new-newsgroups got-new method hashtb ;; group gnus-override-subscribe-method) (unless gnus-killed-hashtb (gnus-make-hashtable-from-killed)) - ;; Go through both primary and secondary select methods and - ;; request new newsgroups. (while (setq method (gnus-server-get-method nil (pop methods))) (setq new-newsgroups nil gnus-override-subscribe-method method) @@ -1424,81 +1403,56 @@ gnus-cache-active-hashtb (when (> (cdr cache-active) (cdr active)) (setcdr active (cdr cache-active)))))))) =20 -(defun gnus-activate-group (group &optional scan dont-check method - dont-sub-check) +(defun gnus-activate-group (group + &optional scan dont-check method dont-sub-chec= k) "Check whether a group has been activated or not. If SCAN, request a scan of that group as well. If METHOD, use that select method instead of determining the method based on the group name. If DONT-CHECK, don't check whether the group actually exists. If DONT-SUB-CHECK or DONT-CHECK, don't let the backend check whether the group actually exists." - (let ((method (or method (inline (gnus-find-method-for-group group)))) - active) - (and (inline (gnus-check-server method)) - ;; We escape all bugs and quit here to make it possible to - ;; continue if a group is so out-there that it reports bugs - ;; and stuff. - (progn - (and scan - (gnus-check-backend-function 'request-scan (car method)) - (gnus-request-scan group method)) - t) - (if (or debug-on-error debug-on-quit) - (inline (gnus-request-group group (or dont-sub-check dont-check) - method - (gnus-get-info group))) - (condition-case nil - (inline (gnus-request-group group (or dont-sub-check dont-check) - method - (gnus-get-info group))) - (quit - (if debug-on-quit - (debug "Quit") - (message "Quit activating %s" group)) - nil))) - (unless dont-check - (setq active (gnus-parse-active)) - ;; If there are no articles in the group, the GROUP - ;; command may have responded with the `(0 . 0)'. We - ;; ignore this if we already have an active entry - ;; for the group. - (if (and (zerop (or (car active) 0)) - (zerop (or (cdr active) 0)) - (gnus-active group)) - (gnus-active group) - - ;; If a cache is present, we may have to alter the active inf= o. - (when gnus-use-cache - (inline (gnus-cache-possibly-alter-active - group active))) - - ;; If the agent is enabled, we may have to alter the active i= nfo. - (when gnus-agent - (gnus-agent-possibly-alter-active group active)) - - (gnus-set-active group active) - ;; Return the new active info. - active))))) + (setq method (or method (gnus-find-method-for-group group))) + (when (gnus-check-server method) + (when scan + (gnus-check-backend-function 'request-scan (car method)) + (gnus-request-scan group method)) + (when (and (gnus-request-group group + (or dont-sub-check dont-check) + method + (gnus-get-info group)) + (not dont-check)) + (let ((new-active (gnus-parse-active)) + (old-active (gnus-active group))) + ;; If new active is `(0 . 0)`, then return existing active. + (if (and old-active + (cl-every (lambda (e) (or (not (integerp e)) + (zerop e))) + `(,(car new-active) ,(cdr new-active)))) + old-active + (when gnus-use-cache + (gnus-cache-possibly-alter-active group new-active)) + (when gnus-agent + (gnus-agent-possibly-alter-active group new-active)) + (gnus-set-active group new-active) + new-active))))) =20 (defun gnus-get-unread-articles-in-group (info active &optional update) (when (and info active) ;; Allow the backend to update the info in the group. (when (and update (gnus-request-update-info - info (inline (gnus-find-method-for-group - (gnus-info-group info))))) + info (gnus-find-method-for-group (gnus-info-group info)))) (gnus-activate-group (gnus-info-group info) nil t)) =20 - (let* ((range (gnus-info-read info)) - (num 0)) + (let ((range (gnus-info-read info)) + (num 0)) =20 ;; These checks are present in gnus-activate-group but skipped ;; due to setting dont-check in the preceding call. =20 ;; If a cache is present, we may have to alter the active info. (when (and gnus-use-cache info) - (inline (gnus-cache-possibly-alter-active - (gnus-info-group info) active))) + (gnus-cache-possibly-alter-active (gnus-info-group info) active)) =20 ;; If the agent is enabled, we may have to alter the active info. (when (and gnus-agent info) @@ -1575,197 +1529,300 @@ gnus-get-unread-articles-in-group (setcar (gnus-group-entry (gnus-info-group info)) num)) num))) =20 -;; 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) +(defmacro gnus-scope-globals (&rest forms) + "Sandbox globals for thread safety." + (declare (indent 0)) + (let ((variables (quote (gnus-newsgroup-name + gnus-newsgroup-marked + gnus-newsgroup-spam-marked + gnus-newsgroup-unreads + gnus-current-headers + gnus-newsgroup-data + gnus-summary-buffer + gnus-article-buffer + gnus-original-article-buffer + gnus-article-current + gnus-current-article + gnus-reffed-article-number + gnus-current-score-file + gnus-newsgroup-charset)))) + `(progn + ,(cons 'inline (mapcar (lambda (v) (list 'defvar v)) variables)) + (let ,(mapcar (apply-partially #'make-list 2) variables) + ,@forms)))) + +(defun gnus-thread-body (thread-name mtx fns) + "Errors need to be trapped for a clean exit. +Else we get unblocked but permanently yielded threads." + (let ((working (get-buffer-create (format " *%s*" thread-name))) + (inhibit-debugger t) + debug-on-quit + debug-on-error) + ;; once context switch occurs handlerlist in eval.c(throw) is lost + (unwind-protect + (condition-case err + (with-mutex mtx + (setq gnus-thread-start (cons (current-time) (current-thread= ))) + (with-current-buffer working + (gnus-message-with-timestamp "gnus-thread-body: start %s <= %s>" + thread-name (buffer-name)) + ;; buffer-locals not thread-safe (avoid them) + (let (gnus-run-thread--subresult + current-fn + (gnus-inhibit-demon t) + (nntp-server-buffer (current-buffer))) + (condition-case err + (dolist (fn fns) + (setq current-fn fn) + (setq gnus-run-thread--subresult + (funcall fn gnus-run-thread--subresult)) + (thread-yield)) + (error + (ignore-errors (mutex-unlock mtx)) + ;; feed current-fn to outer condition-case + (error "dolist: '%s' in %s" + (error-message-string err) current-fn)))))) + (error (gnus-message-with-timestamp + "gnus-thread-body: error %s '%s'" + thread-name (error-message-string err)))) + (let (kill-buffer-query-functions) + (kill-buffer working)) + (setq gnus-thread-start nil) + (ignore-errors (mutex-unlock mtx)) + (gnus-message-with-timestamp "gnus-thread-body: finish %s" thread-na= me)))) + +(defun gnus-thread-group-running-p (thread-group) + (when-let ((thr (cl-some (lambda (thr) + (when (cl-search thread-group (thread-name th= r)) + thr)) + (all-threads)))) + (if (thread-live-p thr) + thr + (prog1 nil + (thread-signal thr 'error nil))))) + +(defun gnus-run-thread (label 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 "-" label))) + (make-thread + (apply-partially #'gnus-thread-body thread-name mtx fns) + thread-name)))) + +(defun gnus-chain-arg (tack-p f &rest args) + (lambda (prev) + (apply f (append args (when tack-p (list prev)))))) + +(defun gnus-time-out-thread () + (interactive) + (when gnus-thread-start + (cl-destructuring-bind (started . thread) + gnus-thread-start + (when (time-less-p + (time-add started gnus-max-seconds-hold-mutex) + nil) + (setq gnus-thread-start nil) + (if (thread-live-p thread) + (progn + (gnus-message-with-timestamp + "gnus-time-out-thread: signal quit %s" (thread-name thread)) + (thread-signal thread 'quit nil)) + (gnus-message-with-timestamp + "gnus-time-out-thread: race on dead %s" (thread-name thread))))= ))) + +(cl-defun gnus-get-unread-articles (&optional + requested-level + dont-connect + one-level + &aux + (level (gnus-group-default-level reque= sted-level t))) + "Workhorse of `gnus-group-get-new-news'." (setq gnus-server-method-cache nil) - (require 'gnus-agent) (defvar gnus-agent-article-local-times) - (let* ((newsrc (cdr gnus-newsrc-alist)) - (alevel (or level gnus-activate-level (1+ gnus-level-subscribed))) - (foreign-level - (or - level - (min - (cond ((and gnus-activate-foreign-newsgroups - (not (numberp gnus-activate-foreign-newsgroups))) - (1+ gnus-level-subscribed)) - ((numberp gnus-activate-foreign-newsgroups) - gnus-activate-foreign-newsgroups) - (t 0)) - alevel))) - (methods-cache nil) - (type-cache nil) - (gnus-agent-article-local-times 0) - (archive-method (gnus-server-to-method "archive")) - info group active method cmethod - method-type method-group-list entry) - (gnus-message 6 "Checking new news...") - - (while newsrc - (setq active (gnus-active (setq group (gnus-info-group - (setq info (pop newsrc)))))) - ;; First go through all the groups, see what select methods they - ;; belong to, and then collect them into lists per unique select - ;; method. - (if (not (setq method (gnus-info-method info))) - (setq method gnus-select-method) - ;; There may be several similar methods. Possibly extend the - ;; method. - (if (setq cmethod (assoc method methods-cache)) - (setq method (cdr cmethod)) - (setq cmethod (if (stringp method) - (gnus-server-to-method method) - (inline (gnus-find-method-for-group - (gnus-info-group info) info)))) - (push (cons method cmethod) methods-cache) - (setq method cmethod))) - (setq method-group-list (assoc method type-cache)) - (unless method-group-list - (setq method-type - (cond - ((or (gnus-secondary-method-p method) - (and (gnus-archive-server-wanted-p) - (gnus-methods-equal-p archive-method method))) - 'secondary) - ((inline (gnus-server-equal gnus-select-method method)) - 'primary) - (t - 'foreign))) - (push (setq method-group-list (list method method-type nil nil)) - type-cache)) - ;; Only add groups that need updating. - (if (or (and foreign-level (null (numberp foreign-level))) - (funcall (if one-level #'=3D #'<=3D) (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. - ;; It leads `(gnus-group-unread group)' to return t. See also - ;; `gnus-group-prepare-flat'. - (unless active - (when (setq entry (gnus-group-entry group)) - (setcar entry t))))) - - ;; Sort the methods based so that the primary and secondary - ;; methods come first. This is done for legacy reasons to try to - ;; ensure that side-effect behavior doesn't change from previous - ;; Gnus versions. - (setq type-cache - (sort (nreverse type-cache) - (lambda (c1 c2) - (< (gnus-method-rank (cadr c1) (car c1)) - (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)) - (dolist (elem type-cache) - (cl-destructuring-bind (method _method-type infos _dummy) elem - (let ((gnus-opened-servers methods)) - (when (and (gnus-similar-server-opened method) - (gnus-check-backend-function - 'retrieve-group-data-early (car method))) - (setq method (gnus-server-extend-method - (gnus-info-group (car infos)) - method)) - (setcar elem method)) - (push (list method 'ok) methods))))) - - ;; If we have primary/secondary select methods, but no groups from - ;; them, we still want to issue a retrieval request from them. - (unless dont-connect - (dolist (method (cons gnus-select-method - gnus-secondary-select-methods)) - (when (and (not (assoc method type-cache)) - (gnus-check-backend-function 'request-list (car method))) - (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"))) - -(defun gnus-method-rank (type method) - (cond - ;; Get info for virtual groups last. - ((eq (car method) 'nnvirtual) - 200) - ((eq type 'primary) - 1) - ;; Compute the rank of the secondary methods based on where they - ;; are in the secondary select list. - ((eq type 'secondary) - (let ((i 2)) - (cl-block nil - (cl-dolist (smethod gnus-secondary-select-methods) - (when (equal method smethod) - (cl-return i)) - (cl-incf i)) - i))) - ;; Just say that all foreign groups have the same rank. - (t - 100))) + (cl-assert (eq (current-thread) main-thread)) + (when gnus-background-get-unread-articles + (unless (cl-find-if (lambda (timer) + (eq (timer--function timer) + #'gnus-time-out-thread)) + timer-list) + (run-at-time + nil + (/ gnus-max-seconds-hold-mutex 2) + #'gnus-time-out-thread))) + (if-let ((pending (gnus-thread-group-running-p gnus-thread-group))) + (gnus-message 3 "gnus-get-unread-articles: %s still running" pending) + (let* ((newsrc (cdr gnus-newsrc-alist)) + (alevel (or level gnus-activate-level (1+ gnus-level-subscribed))) + (foreign-level + (or + level + (min + (cond ((and gnus-activate-foreign-newsgroups + (not (numberp gnus-activate-foreign-newsgroups))) + (1+ gnus-level-subscribed)) + ((numberp gnus-activate-foreign-newsgroups) + gnus-activate-foreign-newsgroups) + (t 0)) + alevel))) + (gnus-agent-article-local-times 0) + (archive-method (gnus-server-to-method "archive")) + infos-by-method) + (gnus-message 6 "Checking new news...") + (while newsrc + (when-let ((info (pop newsrc)) + (group (gnus-info-group info)) + (method (gnus-find-method-for-group group info)) + (backend (car method))) + (if (or (and foreign-level (not (numberp foreign-level))) + (funcall (if one-level #'=3D #'<=3D) + (gnus-info-level info) + (if (or (gnus-server-equal gnus-select-method method) + (gnus-secondary-method-p method) + (and (gnus-archive-server-wanted-p) + (gnus-methods-equal-p archive-method method))) + alevel + foreign-level))) + (push info (alist-get method infos-by-method nil nil #'equal= )) + ;; The group is inactive, so we nix out the number of unread articles. + ;; It leads `(gnus-group-unread group)' to return t. See also + ;; `gnus-group-prepare-flat'. + (unless (gnus-active group) + (when-let ((entry (gnus-group-entry group))) + (setcar entry t)))))) + + ;; "Extend" means changing "nnimap" to "nnimap+subaccount" + (let (methods) + (dolist (elem infos-by-method) + (cl-destructuring-bind (method &rest infos) elem + (let ((gnus-opened-servers methods)) + (when (and (gnus-similar-server-opened method) + (gnus-check-backend-function + 'retrieve-group-data-early (car method))) + (setq method (gnus-server-extend-method + (gnus-info-group (car infos)) + method)) + (setcar elem method)) + (push (list method 'ok) methods))))) + + ;; For methods with no groups to update, we still request-list if su= pported. + (unless dont-connect + (dolist (method gnus-select-methods) + (when (and (not (assoc method infos-by-method)) + (gnus-check-backend-function 'request-list (car method))) + (with-current-buffer nntp-server-buffer + (gnus-read-active-file-1 method nil))))) + + ;; Must be able to `gnus-open-server' + (setq infos-by-method + (cl-remove-if-not + (lambda (elem) + (cl-destructuring-bind (method &rest infos) elem + (and (ignore-errors (gnus-get-function method 'open-serve= r)) + (memq (car method) (mapcar #'car gnus-select-methods= ))))) + infos-by-method)) + + (let (methods + (coda (apply-partially + (lambda (level*) + (gnus-message-with-timestamp "gnus-get-unread-article= s: all done") + (when-let ((timer (cl-find-if (lambda (timer) + (eq (timer--function = timer) + #'gnus-time-out-t= hread)) + timer-list))) + (cancel-timer timer)) + (gnus-group-list-groups level*) + (gnus-run-hooks 'gnus-after-getting-new-news-hook) + (gnus-group-list-groups) + (redisplay t)) + (and (numberp level) + (max (or (and (numberp (car gnus-group-list-mode)) + (car gnus-group-list-mode)) + (gnus-group-default-level)) + level))))) + (mapc (lambda (elem) + (cl-destructuring-bind + (method &rest 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) + elem + (when (and method infos (not denied-p) (not already-p)) + (push method methods) + (gnus-push-end (gnus-chain-arg + nil + #'gnus-open-server + method) + commands) + (when early-p + (when scan-p + (gnus-push-end (gnus-chain-arg nil #'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 (gnus-chain-arg + nil + #'gnus-retrieve-group-data-early + method infos) + commands)) + (gnus-push-end (gnus-chain-arg + t + #'gnus-read-active-for-groups + method infos) + commands) + (gnus-push-end (gnus-chain-arg + nil + (lambda (infos* update-p*) + (mapc (lambda (info) + (gnus-get-unread-articles-in= -group + info + (gnus-active (gnus-info-gro= up info)) + update-p*) + (gnus-group-update-group (gn= us-info-group info) t)) + infos*) + (gnus-message 6 "Checking new news..= .done")) + infos update-p) + commands) + (if gnus-background-get-unread-articles + (progn + (add-function + :before-while (var coda) + (apply-partially + (lambda (thread-group* &rest _args) + "Proceed with CODA if I'm the last one." + (<=3D (cl-count thread-group* + (all-threads) + :test (lambda (s thr) + (cl-search s (thread-n= ame thr)))) + 1)) + gnus-thread-group)) + (gnus-push-end (gnus-chain-arg nil coda) command= s) + (apply #'gnus-run-thread + (mapconcat (apply-partially #'format "%s") + (cl-subseq method 0 (min (leng= th method) 2)) + "-") + gnus-mutex-get-unread-articles + gnus-thread-group + commands)) + (let (gnus-run-thread--subresult) + (mapc (lambda (fn) + (setq gnus-run-thread--subresult + (funcall fn gnus-run-thread--subresu= lt))) + commands)))))) + infos-by-method) + (unless gnus-background-get-unread-articles + (funcall coda)))))) =20 (defun gnus-read-active-for-groups (method infos early-data) (with-current-buffer nntp-server-buffer @@ -1776,7 +1833,7 @@ gnus-read-active-for-groups early-data (gnus-check-backend-function 'finish-retrieve-group-infos (car meth= od)) (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. @@ -1785,12 +1842,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)) @@ -1798,7 +1855,7 @@ gnus-read-active-for-groups ;; by one. (t (dolist (info infos) - (gnus-activate-group (gnus-info-group info) t nil method t)))))) + (gnus-activate-group (gnus-info-group info) t nil method t)))))) =20 (defun gnus-make-hashtable-from-newsrc-alist () "Create a hash table from `gnus-newsrc-alist'. @@ -1998,10 +2055,12 @@ gnus-read-active-file (if (and (not not-native) (gnus-check-server gnus-select-method)) ;; The native server is available. - (cons gnus-select-method gnus-secondary-select-methods) + gnus-select-methods ;; The native server is down, so we just do the ;; secondary ones. - gnus-secondary-select-methods) + (cl-remove-if + (lambda (method) (gnus-method-equal method gnus-select-metho= d)) + gnus-select-methods)) ;; Also read from the archive server. (when (gnus-archive-server-wanted-p) (list "archive"))))) @@ -2036,9 +2095,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 @@ -2215,50 +2272,35 @@ gnus-groups-to-gnus-format (error (remhash group hashtb))) (forward-line 1)))))) =20 -(defun gnus-read-newsrc-file (&optional force) - "Read startup file. -If FORCE is non-nil, the .newsrc file is read." - ;; Reset variables that might be defined in the .newsrc.eld file. - (let ((variables (remove 'gnus-format-specs gnus-variable-list))) - (while variables - (set (car variables) nil) - (setq variables (cdr variables)))) - (let* ((newsrc-file gnus-current-startup-file) - (quick-file (concat newsrc-file ".el"))) - (save-excursion - ;; We always load the .newsrc.eld file. If always contains - ;; much information that can not be gotten from the .newsrc - ;; file (ticked articles, killed groups, foreign methods, etc.) - (gnus-read-newsrc-el-file quick-file) - - (when (and gnus-read-newsrc-file - (file-exists-p gnus-current-startup-file) - (or force - (and (file-newer-than-file-p newsrc-file quick-file) - (file-newer-than-file-p newsrc-file - (concat quick-file "d"))) - (not gnus-newsrc-alist))) - ;; We read the .newsrc file. Note that if there if a - ;; .newsrc.eld file exists, it has already been read, and - ;; the `gnus-newsrc-hashtb' has been created. While reading - ;; the .newsrc file, Gnus will only use the information it - ;; can find there for changing the data already read - - ;; i. e., reading the .newsrc file will not trash the data - ;; already read (except for read articles). - (gnus-message 5 "Reading %s..." newsrc-file) - (with-current-buffer (nnheader-find-file-noselect newsrc-file) - (buffer-disable-undo) - (gnus-newsrc-to-gnus-format) - (kill-buffer (current-buffer)) - (gnus-message 5 "Reading %s...done" newsrc-file))) - - ;; Convert old to new. - (gnus-convert-old-newsrc) - (gnus-clean-old-newsrc)))) - -(defun gnus-clean-old-newsrc (&optional _force) - ;; Currently no cleanups. - ) +(defun gnus-read-newsrc-file (&optional _force) + (dolist (var (remove 'gnus-format-specs gnus-variable-list)) + (set var nil)) + (when (file-exists-p gnus-newsrc-file) + (gnus-message 5 "Reading %s..." gnus-newsrc-file) + (gnus-load gnus-newsrc-file)) + (when (and (file-exists-p gnus-dot-newsrc) (not gnus-newsrc-alist)) + (gnus-message 5 "Reading %s..." gnus-dot-newsrc) + (let ((buffer (nnheader-find-file-noselect gnus-dot-newsrc))) + (unwind-protect + (with-current-buffer buffer + (gnus-newsrc-to-gnus-format) + (gnus-message 5 "Reading %s...done" gnus-dot-newsrc)) + (kill-buffer buffer)))) + (gnus-make-hashtable-from-newsrc-alist) + (setq gnus-topic-alist + (mapcar + (lambda (elt) + (cl-destructuring-bind (topic . groups) + elt + (cons topic + (mapcar (lambda (group) + (if (string-match-p "[^[:ascii:]]" group) + (gnus-group-decoded-name group) + group)) + groups)))) + gnus-topic-alist)) + (gnus-run-hooks 'gnus-read-newsrc-hook) + (gnus-convert-old-newsrc)) =20 (defun gnus-convert-old-newsrc () "Convert old newsrc formats into the current format, if needed." @@ -2383,43 +2425,6 @@ gnus-killed-assoc (defvar gnus-marked-assoc) (defvar gnus-newsrc-assoc) =20 -(defun gnus-read-newsrc-el-file (file) - (let ((ding-file (concat file "d"))) - (when (file-exists-p ding-file) - ;; We always, always read the .eld file. - (gnus-message 5 "Reading %s..." ding-file) - (let (gnus-newsrc-assoc) - (gnus-load ding-file) - ;; Older versions of `gnus-format-specs' are no longer valid - ;; in Oort Gnus 0.01. - (let ((version - (and gnus-newsrc-file-version - (gnus-continuum-version gnus-newsrc-file-version)))) - (when (or (not version) - (< version 5.090009)) - (setq gnus-format-specs gnus-default-format-specs))) - (when gnus-newsrc-assoc - (setq gnus-newsrc-alist gnus-newsrc-assoc)))) - (gnus-make-hashtable-from-newsrc-alist) - (when gnus-topic-alist - (setq gnus-topic-alist - (mapcar - (lambda (elt) - (cons (car elt) - (mapcar (lambda (g) - (if (string-match-p "[^[:ascii:]]" g) - (gnus-group-decoded-name g) - g)) - (cdr elt)))) - gnus-topic-alist))) - (when (file-newer-than-file-p file ding-file) - ;; Old format quick file - (gnus-message 5 "Reading %s..." file) - ;; The .el file is newer than the .eld file, so we read that one - ;; as well. - (gnus-read-old-newsrc-el-file file))) - (gnus-run-hooks 'gnus-read-newsrc-el-hook)) - ;; Parse the old-style quick startup file (defun gnus-read-old-newsrc-el-file (file) (let (newsrc killed marked group m info) @@ -2475,19 +2480,9 @@ gnus-read-old-newsrc-el-file (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)) (gnus-make-hashtable-from-newsrc-alist))) =20 -(defun gnus-make-newsrc-file (file) - "Make server dependent file name by catenating FILE and server host name= ." - (let* ((file (expand-file-name file nil)) - (real-file (concat file "-" (nth 1 gnus-select-method)))) - (if (or (file-exists-p real-file) - (file-exists-p (concat real-file ".el")) - (file-exists-p (concat real-file ".eld"))) - real-file - file))) - (defun gnus-newsrc-to-gnus-format () - (setq gnus-newsrc-options "") - (setq gnus-newsrc-options-n nil) + (setq gnus-newsrc-options "" + gnus-newsrc-options-n nil) =20 (unless gnus-active-hashtb (setq gnus-active-hashtb (gnus-make-hashtable 4000))) @@ -2675,58 +2670,57 @@ gnus-newsrc-to-gnus-format ;; groups will be ignored. Note that "options -n !all rec.all" is very ;; different from "options -n rec.all !all". (defun gnus-newsrc-parse-options (options) - (let (out eol) - (save-excursion - (gnus-set-work-buffer) - (insert (regexp-quote options)) - ;; First we treat all continuation lines. - (goto-char (point-min)) - (while (re-search-forward "\n[ \t]+" nil t) - (replace-match " " t t)) - ;; Then we transform all "all"s into ".+"s. - (goto-char (point-min)) - (while (re-search-forward "\\ball\\b" nil t) - (replace-match ".+" t t)) - (goto-char (point-min)) - ;; We remove all other options than the "-n" ones. - (while (re-search-forward "[ \t]-[^n][^-]*" nil t) - (replace-match " ") - (forward-char -1)) - (goto-char (point-min)) + (gnus-with-temp-buffer + (insert (regexp-quote options)) + ;; First we treat all continuation lines. + (goto-char (point-min)) + (while (re-search-forward "\n[ \t]+" nil t) + (replace-match " " t t)) + ;; Then we transform all "all"s into ".+"s. + (goto-char (point-min)) + (while (re-search-forward "\\ball\\b" nil t) + (replace-match ".+" t t)) + (goto-char (point-min)) + ;; We remove all other options than the "-n" ones. + (while (re-search-forward "[ \t]-[^n][^-]*" nil t) + (replace-match " ") + (forward-char -1)) + (goto-char (point-min)) =20 - ;; We are only interested in "options -n" lines - we - ;; ignore the other option lines. - (while (re-search-forward "[ \t]-n" nil t) - (setq eol - (or (save-excursion - (and (re-search-forward "[ \t]-n" (point-at-eol) t) - (- (point) 2))) - (point-at-eol))) - ;; Search for all "words"... - (while (re-search-forward "[^ \t,\n]+" eol t) - (if (eq (char-after (match-beginning 0)) ?!) - ;; If the word begins with a bang (!), this is a "not" - ;; spec. We put this spec (minus the bang) and the - ;; symbol `ignore' into the list. - (push (cons (concat - "^" (buffer-substring - (1+ (match-beginning 0)) - (match-end 0)) - "\\($\\|\\.\\)") - 'ignore) - out) - ;; There was no bang, so this is a "yes" spec. - (push (cons (concat "^" (match-string 0) "\\($\\|\\.\\)") - 'subscribe) - out)))) - - (setq gnus-newsrc-options-n out)))) - -(eval-and-compile - (defalias 'gnus-long-file-names - (if (fboundp 'msdos-long-file-names) - 'msdos-long-file-names - (lambda () t)))) + ;; We are only interested in "options -n" lines - we + ;; ignore the other option lines. + (setq gnus-newsrc-options-n + (let (out) + (while (re-search-forward "[ \t]-n" nil t) + ;; Search for all "words"... + (while (re-search-forward + "[^ \t,\n]+" + (or (save-excursion + (and (re-search-forward "[ \t]-n" (point-at-eol) t) + (- (point) 2))) + (point-at-eol)) + t) + (if (eq (char-after (match-beginning 0)) ?!) + ;; If the word begins with a bang (!), this is a "not" + ;; spec. We put this spec (minus the bang) and the + ;; symbol `ignore' into the list. + (push (cons (concat + "^" (buffer-substring + (1+ (match-beginning 0)) + (match-end 0)) + "\\($\\|\\.\\)") + 'ignore) + out) + ;; There was no bang, so this is a "yes" spec. + (push (cons (concat "^" (match-string 0) "\\($\\|\\.\\)") + 'subscribe) + out)))) + out))) + (eval-and-compile + (defalias 'gnus-long-file-names + (if (fboundp 'msdos-long-file-names) + 'msdos-long-file-names + (lambda () t))))) =20 (defvar gnus-save-newsrc-file-last-timestamp nil) (defun gnus-save-newsrc-file (&optional force) @@ -2734,12 +2728,10 @@ gnus-save-newsrc-file Use the group string names in `gnus-group-list' to pull info values from `gnus-newsrc-hashtb', and write a new value of `gnus-newsrc-alist'." - (when (and (or gnus-newsrc-alist gnus-killed-list) - gnus-current-startup-file) + (when (or gnus-newsrc-alist gnus-killed-list) ;; Save agent range limits for the currently active method. (when gnus-agent (gnus-agent-save-local force)) - (save-excursion (if (and (or gnus-use-dribble-file gnus-child) (not force) @@ -2750,97 +2742,33 @@ gnus-save-newsrc-file (gnus-run-hooks 'gnus-save-newsrc-hook) (if gnus-child (gnus-child-save-newsrc) - ;; Save .newsrc only if the select method is an NNTP method. - ;; The .newsrc file is for interoperability with other - ;; newsreaders, so saving non-NNTP groups there doesn't make - ;; much sense. - (when (and gnus-save-newsrc-file - (eq (car (gnus-server-to-method gnus-select-method)) - 'nntp)) - (gnus-message 8 "Saving %s..." gnus-current-startup-file) - (gnus-gnus-to-newsrc-format) - (gnus-message 8 "Saving %s...done" gnus-current-startup-file)) - - ;; Save .newsrc.eld. - (set-buffer (gnus-get-buffer-create " *Gnus-newsrc*")) - (setq-local version-control gnus-backup-startup-file) - (setq buffer-file-name - (concat gnus-current-startup-file ".eld")) - (setq default-directory (file-name-directory buffer-file-name)) - (buffer-disable-undo) - (erase-buffer) - (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) - - ;; Check timestamp of `gnus-current-startup-file'.eld against - ;; `gnus-save-newsrc-file-last-timestamp'. - (if (let* ((checkfile (concat gnus-current-startup-file ".eld")) - (mtime (file-attribute-modification-time - (file-attributes checkfile)))) - (and gnus-save-newsrc-file-last-timestamp - (time-less-p gnus-save-newsrc-file-last-timestamp - mtime) + ;; save .newsrc + (when gnus-save-dot-newsrc + (gnus-gnus-to-newsrc-format)) + ;; save .newsrc.eld + (gnus-message 5 "Saving %s..." gnus-newsrc-file) + ;; Starting two gnusae inevitably yields this annoying question + ;; of whether to save over each other. + (let ((mtime (file-attribute-modification-time + (file-attributes gnus-newsrc-file)))) + (if (and gnus-save-newsrc-file-last-timestamp + (time-less-p gnus-save-newsrc-file-last-timestamp mti= me) (not (y-or-n-p (format "%s was updated externally after %s, save?" - checkfile + gnus-newsrc-file (format-time-string - "%c" - gnus-save-newsrc-file-last-timestamp)))))) - (gnus-message - 4 "Didn't save %s: updated externally" - (concat gnus-current-startup-file ".eld")) - (if gnus-save-startup-file-via-temp-buffer - (let ((coding-system-for-write gnus-ding-file-coding-system) + "%c" + gnus-save-newsrc-file-last-timestamp))))) + (gnus-message 4 "Not saving %s" gnus-newsrc-file) + (with-temp-file gnus-newsrc-file + (let ((coding-system-for-write gnus-ding-file-coding-syste= m) (standard-output (current-buffer))) - (gnus-gnus-to-quick-newsrc-format) - (gnus-run-hooks 'gnus-save-quick-newsrc-hook) - (save-buffer) - (setq gnus-save-newsrc-file-last-timestamp - (file-attribute-modification-time - (file-attributes buffer-file-name)))) - (let ((coding-system-for-write gnus-ding-file-coding-system) - (version-control gnus-backup-startup-file) - (startup-file (concat gnus-current-startup-file ".eld"= )) - (working-dir (file-name-directory gnus-current-startup= -file)) - working-file - (i -1)) - ;; Generate the name of a non-existent file. - (while (progn (setq working-file - (format - (if (and (eq system-type 'ms-dos) - (not (gnus-long-file-names))) - "%s#%d.tm#" ; MSDOS limits files to 8+3 - "%s#tmp#%d") - working-dir (setq i (1+ i)))) - (file-exists-p working-file))) - - (unwind-protect - (with-file-modes (file-modes startup-file) - (gnus-with-output-to-file working-file - (gnus-gnus-to-quick-newsrc-format) - (gnus-run-hooks 'gnus-save-quick-newsrc-hook)) - - ;; These bindings will mislead the current buffer - ;; into thinking that it is visiting the startup - ;; file. - (let ((buffer-backed-up nil) - (buffer-file-name startup-file) - (file-precious-flag t)) - ;; Backup the current version of the startup file. - (backup-buffer) - - ;; Replace the existing startup file with the temp file. - (rename-file working-file startup-file t) - (setq gnus-save-newsrc-file-last-timestamp - (file-attribute-modification-time - (file-attributes startup-file))))) - (condition-case nil - (delete-file working-file) - (file-error nil))))) - - (gnus-kill-buffer (current-buffer)) - (gnus-message - 5 "Saving %s.eld...done" gnus-current-startup-file))) + (gnus-gnus-to-quick-newsrc-format))) + (setq gnus-save-newsrc-file-last-timestamp + (file-attribute-modification-time + (file-attributes gnus-newsrc-file))) + (gnus-message 5 "Saving %s...done" gnus-newsrc-file)))) (gnus-dribble-delete-file) (gnus-group-set-mode-line))))) =20 @@ -2894,7 +2822,7 @@ gnus-gnus-to-quick-newsrc-format ;; compatible with older versions of Gnus. At some point, ;; if/when a new version of Gnus is released, stop doing ;; this and move the corresponding decode in - ;; `gnus-read-newsrc-el-file' into a conversion routine. + ;; `gnus-read-newsrc-file' into a conversion routine. (gnus-newsrc-alist (mapcar (lambda (info) (cons (encode-coding-string (car info) 'utf-8-emacs) @@ -2931,13 +2859,15 @@ gnus-strip-killed-list (nreverse olist))) =20 (defun gnus-gnus-to-newsrc-format (&optional foreign-ok) + "Save NNTP state into the Usenet .newsrc file. +We save a .newsrc file for the benefit of other newsreaders, although +Gnus itself doesn't consult it in most cases." (interactive (list (gnus-y-or-n-p "write foreign groups too? "))) - ;; Generate and save the .newsrc file. - (with-current-buffer (create-file-buffer gnus-current-startup-file) + (with-current-buffer (create-file-buffer gnus-dot-newsrc) (let ((standard-output (current-buffer)) (groups (delete "dummy.group" (copy-sequence gnus-group-list))) info ranges range method) - (setq buffer-file-name gnus-current-startup-file) + (setq buffer-file-name gnus-dot-newsrc) (setq default-directory (file-name-directory buffer-file-name)) (buffer-disable-undo) (erase-buffer) @@ -2949,8 +2879,9 @@ gnus-gnus-to-newsrc-format (setq info (nth 1 (gnus-group-entry g-name))) ;; Maybe don't write foreign groups to .newsrc. (when (or (null (setq method (gnus-info-method info))) - (equal method "native") - (inline (gnus-server-equal method gnus-select-method)) + (and (stringp method) + (or (equal "native" method) + (eq 'nntp (car (gnus-server-to-method method)))= )) foreign-ok) (insert g-name (if (> (gnus-info-level info) gnus-level-subscribed) @@ -2981,14 +2912,11 @@ gnus-gnus-to-newsrc-format ;; delete the silly thing entirely first. but this fails to provide ;; such niceties as .newsrc~ creation. (if gnus-modtime-botch - (delete-file gnus-startup-file) + (delete-file gnus-dot-newsrc) (clear-visited-file-modtime)) - (gnus-run-hooks 'gnus-save-standard-newsrc-hook) (let ((coding-system-for-write 'raw-text)) (save-buffer)) (kill-buffer (current-buffer))))) - - ;;; ;;; Child functions. ;;; @@ -3007,22 +2935,17 @@ 'gnus-slave-mode-hook =20 (defun gnus-child-save-newsrc () (with-current-buffer gnus-dribble-buffer - (with-file-modes (or (ignore-errors - (file-modes - (concat gnus-current-startup-file ".eld"))) + (with-file-modes (or (ignore-errors (file-modes gnus-newsrc-file)) (default-file-modes)) - (let ((child-name - (make-temp-file (concat gnus-current-startup-file "-child-")))) - (let ((coding-system-for-write gnus-ding-file-coding-system)) - (gnus-write-buffer child-name)))))) + (let ((child-name (make-temp-file (concat gnus-newsrc-file "-child-"= ))) + (coding-system-for-write gnus-ding-file-coding-system)) + (gnus-write-buffer child-name))))) =20 (defun gnus-parent-read-child-newsrc () (let ((child-files - (directory-files - (file-name-directory gnus-current-startup-file) + (directory-files (file-name-directory gnus-newsrc-file) t (concat - "^" (regexp-quote - (file-name-nondirectory gnus-current-startup-file)) + "^" (regexp-quote (file-name-nondirectory gnus-newsrc-file)) ;; When the obsolete variables like ;; `gnus-slave-mode-hook' etc are removed, the "slave" ;; bit of this regexp should also be removed. @@ -3059,17 +2982,15 @@ gnus-parent-read-child-newsrc (gnus-dribble-touch) (gnus-message 7 "Reading child newsrcs...done")))) =20 - ;;; ;;; Group description. ;;; =20 (defun gnus-read-all-descriptions-files () - (let ((methods (cons gnus-select-method - (nconc - (when (gnus-archive-server-wanted-p) - (list "archive")) - gnus-secondary-select-methods)))) + (let ((methods (nconc + (when (gnus-archive-server-wanted-p) + (list "archive")) + gnus-select-methods))) (while methods (gnus-read-descriptions-file (car methods)) (setq methods (cdr methods))) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index bcd76dda29..5dc8b46323 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -64,14 +64,12 @@ gnus-use-article-prefetch (require 'gnus-range) (require 'gnus-int) (require 'gnus-undo) -(require 'gnus-util) (require 'gmm-utils) (require 'mm-decode) (require 'shr) (require 'url) (require 'nnoo) -(eval-when-compile - (require 'subr-x)) +(require 'subr-x) =20 (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil '(gnus-summary-mode)) @@ -80,6 +78,7 @@ gnus-use-article-prefetch (autoload 'nnselect-article-rsv "nnselect" nil nil) (autoload 'nnselect-article-group "nnselect" nil nil) (autoload 'gnus-nnselect-group-p "nnselect" nil nil) +(autoload 'gnus-agent-get-undownloaded-list "gnus-agent") =20 (defcustom gnus-kill-summary-on-exit t "If non-nil, kill the summary buffer when you exit from it. @@ -827,6 +826,7 @@ gnus-summary-mark-below score file." :group 'gnus-score-default :type 'integer) +(make-variable-buffer-local 'gnus-summary-mark-below) =20 (defun gnus-widget-reversible-match (_widget value) "Ignoring WIDGET, convert VALUE to internal form. @@ -982,6 +982,7 @@ gnus-summary-expunge-below :group 'gnus-score-default :type '(choice (const :tag "off" nil) integer)) +(make-variable-buffer-local 'gnus-summary-expunge-below) =20 (defcustom gnus-thread-expunge-below nil "All threads that have a total score less than this variable will be exp= unged. @@ -993,6 +994,7 @@ gnus-thread-expunge-below :group 'gnus-score-default :type '(choice (const :tag "off" nil) integer)) +(make-variable-buffer-local 'gnus-thread-expunge-below) =20 (defcustom gnus-summary-menu-hook nil "Hook run after the creation of the summary mode menu." @@ -1321,6 +1323,7 @@ gnus-orphan-score :group 'gnus-score-default :type '(choice (const nil) integer)) +(make-variable-buffer-local 'gnus-orphan-score) =20 (defcustom gnus-summary-save-parts-default-mime "image/.*" "A regexp to match MIME parts when saving multiple parts of a @@ -1378,37 +1381,35 @@ gnus-article-emulate-mime ;;; Internal variables =20 (defvar gnus-summary-display-cache nil) -(defvar gnus-article-mime-handles nil) -(defvar gnus-article-decoded-p nil) -(defvar gnus-article-charset nil) +(defvar-local gnus-article-mime-handles nil) +(defvar-local gnus-article-decoded-p nil) +(defvar-local gnus-article-charset nil) (defvar gnus-article-ignored-charsets nil) -(defvar gnus-scores-exclude-files nil) -(defvar gnus-page-broken nil) - -(defvar gnus-original-article nil) +(defvar-local gnus-scores-exclude-files nil) (defvar gnus-article-internal-prepare-hook nil) -(defvar gnus-newsgroup-process-stack nil) +(defvar-local gnus-page-broken nil) + +(defvar-local gnus-newsgroup-process-stack nil) =20 (defvar gnus-thread-indent-array nil) (defvar gnus-thread-indent-array-level gnus-thread-indent-level) -(defvar gnus-sort-gathered-threads-function #'gnus-thread-sort-by-number - "Function to sort articles within a thread after it has been gathered to= gether.") +(make-obsolete-variable 'gnus-sort-gathered-threads-function nil "28.1") =20 (defvar gnus-summary-save-parts-type-history nil) (defvar gnus-summary-save-parts-last-directory mm-default-directory) =20 ;; Avoid highlighting in kill files. (defvar gnus-summary-inhibit-highlight nil) -(defvar gnus-newsgroup-selected-overlay nil) +(defvar-local gnus-newsgroup-selected-overlay nil) (defvar gnus-inhibit-limiting nil) -(defvar gnus-newsgroup-adaptive-score-file nil) -(defvar gnus-current-score-file nil) +(defvar-local gnus-newsgroup-adaptive-score-file nil) +(defvar-local gnus-current-score-file nil) (defvar gnus-current-move-group nil) (defvar gnus-current-copy-group nil) (defvar gnus-current-crosspost-group nil) -(defvar gnus-newsgroup-display nil) +(defvar-local gnus-newsgroup-display nil) =20 -(defvar gnus-newsgroup-dependencies nil +(defvar-local gnus-newsgroup-dependencies (gnus-make-hashtable) "A hash table holding dependencies between messages.") ;; Dependencies are held in a tree structure: a list with the root ;; message as car, and each immediate child a sublist (perhaps @@ -1417,9 +1418,9 @@ gnus-newsgroup-dependencies ;; dependency table using the message's Message-ID as the key. The ;; root key is the string "none". =20 -(defvar gnus-newsgroup-adaptive nil) +(defvar-local gnus-newsgroup-adaptive gnus-use-adaptive-scoring) (defvar gnus-summary-display-article-function nil) -(defvar gnus-summary-highlight-line-function nil +(defvar-local gnus-summary-highlight-line-function nil "Function called after highlighting a summary line.") =20 (defvar gnus-summary-line-format-alist @@ -1519,208 +1520,126 @@ gnus-last-shell-command =20 (defvar gnus-newsgroup-agentized nil "Locally bound in each summary buffer to indicate if server has been age= ntized.") -(defvar gnus-newsgroup-begin nil) -(defvar gnus-newsgroup-end nil) -(defvar gnus-newsgroup-last-rmail nil) -(defvar gnus-newsgroup-last-mail nil) -(defvar gnus-newsgroup-last-folder nil) -(defvar gnus-newsgroup-last-file nil) -(defvar gnus-newsgroup-last-directory nil) -(defvar gnus-newsgroup-auto-expire nil) -(defvar gnus-newsgroup-active nil) -(defvar gnus-newsgroup-highest nil) - -(defvar gnus-newsgroup-data nil) -(defvar gnus-newsgroup-data-reverse nil) -(defvar gnus-newsgroup-limit nil) -(defvar gnus-newsgroup-limits nil) -(defvar gnus-summary-use-undownloaded-faces nil) - -(defvar gnus-newsgroup-unreads nil +(defvar-local gnus-newsgroup-begin nil) +(defvar-local gnus-newsgroup-end nil) +(defvar-local gnus-newsgroup-last-rmail nil) +(defvar-local gnus-newsgroup-last-mail nil) +(defvar-local gnus-newsgroup-last-folder nil) +(defvar-local gnus-newsgroup-last-file nil) +(defvar-local gnus-newsgroup-last-directory nil) +(defvar-local gnus-newsgroup-auto-expire nil) +(defvar-local gnus-newsgroup-active nil) +(defvar-local gnus-newsgroup-highest nil) + +(defvar-local gnus-newsgroup-data nil) +(defvar-local gnus-newsgroup-data-reverse nil) +(defvar-local gnus-newsgroup-limit nil) +(defvar-local gnus-newsgroup-limits nil) +(defvar-local gnus-summary-use-undownloaded-faces nil) + +(defvar-local gnus-newsgroup-unreads nil "Sorted list of unread articles in the current newsgroup.") =20 -(defvar gnus-newsgroup-unselected nil +(defvar-local gnus-newsgroup-unselected nil "Sorted list of unselected unread articles in the current newsgroup.") =20 -(defvar gnus-newsgroup-reads nil +(defvar-local gnus-newsgroup-reads nil "Alist of read articles and article marks in the current newsgroup.") =20 -(defvar gnus-newsgroup-expunged-tally nil) +(defvar-local gnus-newsgroup-expunged-tally 0) =20 -(defvar gnus-newsgroup-marked nil +(defvar-local gnus-newsgroup-marked nil "Sorted list of ticked articles in current newsgroup (a subset of unread= art).") =20 -(defvar gnus-newsgroup-spam-marked nil +(defvar-local gnus-newsgroup-spam-marked nil "List of ranges of articles that have been marked as spam.") =20 -(defvar gnus-newsgroup-killed nil +(defvar-local gnus-newsgroup-killed nil "List of ranges of articles that have been through the scoring process.") =20 -(defvar gnus-newsgroup-cached nil +(defvar-local gnus-newsgroup-cached nil "Sorted list of articles that come from the article cache.") =20 -(defvar gnus-newsgroup-saved nil +(defvar-local gnus-newsgroup-saved nil "List of articles that have been saved.") =20 -(defvar gnus-newsgroup-kill-headers nil) +(defvar-local gnus-newsgroup-kill-headers nil) =20 -(defvar gnus-newsgroup-replied nil +(defvar-local gnus-newsgroup-replied nil "List of articles that have been replied to in the current newsgroup.") =20 -(defvar gnus-newsgroup-forwarded nil +(defvar-local gnus-newsgroup-forwarded nil "List of articles that have been forwarded in the current newsgroup.") =20 -(defvar gnus-newsgroup-expirable nil +(defvar-local gnus-newsgroup-expirable nil "Sorted list of articles in the current newsgroup that can be expired.") =20 -(defvar gnus-newsgroup-processable nil +(defvar-local gnus-newsgroup-processable nil "List of articles in the current newsgroup that can be processed.") =20 -(defvar gnus-newsgroup-downloadable nil +(defvar-local gnus-newsgroup-downloadable nil "Sorted list of articles in the current newsgroup that can be processed.= ") =20 -(defvar gnus-newsgroup-unfetched nil +(defvar-local gnus-newsgroup-unfetched nil "Sorted list of articles in the current newsgroup whose headers have not been fetched into the agent. =20 This list will always be a subset of gnus-newsgroup-undownloaded.") =20 -(defvar gnus-newsgroup-undownloaded nil +(defvar-local gnus-newsgroup-undownloaded nil "List of articles in the current newsgroup that haven't been downloaded.= ") =20 -(defvar gnus-newsgroup-unsendable nil +(defvar-local gnus-newsgroup-unsendable nil "List of articles in the current newsgroup that won't be sent.") =20 -(defvar gnus-newsgroup-bookmarks nil +(defvar-local gnus-newsgroup-bookmarks nil "List of articles in the current newsgroup that have bookmarks.") =20 -(defvar gnus-newsgroup-dormant nil +(defvar-local gnus-newsgroup-dormant nil "Sorted list of dormant articles in the current newsgroup.") =20 -(defvar gnus-newsgroup-unseen nil +(defvar-local gnus-newsgroup-unseen nil "List of unseen articles in the current newsgroup.") =20 -(defvar gnus-newsgroup-seen nil +(defvar-local gnus-newsgroup-seen nil "Range of seen articles in the current newsgroup.") =20 -(defvar gnus-newsgroup-unexist nil +(defvar-local gnus-newsgroup-unexist nil "Range of unexisting articles in the current newsgroup.") =20 -(defvar gnus-newsgroup-articles nil +(defvar-local gnus-newsgroup-articles nil "List of articles in the current newsgroup.") =20 -(defvar gnus-newsgroup-scored nil +(defvar-local gnus-newsgroup-scored nil "List of scored articles in the current newsgroup.") =20 -(defvar gnus-newsgroup-headers nil +(defvar-local gnus-newsgroup-headers nil "List of article headers in the current newsgroup.") =20 -(defvar gnus-newsgroup-threads nil) +(defvar-local gnus-newsgroup-threads nil) =20 -(defvar gnus-newsgroup-prepared nil +(defvar-local gnus-newsgroup-prepared nil "Whether the current group has been prepared properly.") =20 -(defvar gnus-newsgroup-ancient nil +(defvar-local gnus-newsgroup-ancient nil "List of `gnus-fetch-old-headers' articles in the current newsgroup.") =20 -(defvar gnus-newsgroup-sparse nil) +(defvar-local gnus-newsgroup-sparse nil) =20 -(defvar gnus-newsgroup-selection nil) - -(defvar gnus-current-article nil) -(defvar gnus-article-current nil) -(defvar gnus-current-headers nil) -(defvar gnus-have-all-headers nil) -(defvar gnus-last-article nil) -(defvar gnus-newsgroup-history nil) -(defvar gnus-newsgroup-charset nil) +(defvar-local gnus-newsgroup-selection nil) +(defvar-local gnus-current-article nil) +(defvar-local gnus-article-current nil) +(defvar-local gnus-current-headers nil) +(defvar-local gnus-have-all-headers nil) +(defvar-local gnus-last-article nil) +(defvar-local gnus-newsgroup-history nil) +(defvar-local gnus-newsgroup-charset nil) (defvar gnus-newsgroup-ephemeral-charset nil) (defvar gnus-newsgroup-ephemeral-ignored-charsets nil) - (defvar gnus-article-before-search nil) =20 -(defvar gnus-summary-local-variables - '(gnus-newsgroup-name - - ;; Marks lists - gnus-newsgroup-unreads - gnus-newsgroup-unselected - gnus-newsgroup-marked - gnus-newsgroup-spam-marked - gnus-newsgroup-reads - gnus-newsgroup-saved - gnus-newsgroup-replied - gnus-newsgroup-forwarded - gnus-newsgroup-expirable - gnus-newsgroup-killed - gnus-newsgroup-unseen - gnus-newsgroup-seen - gnus-newsgroup-unexist - gnus-newsgroup-cached - gnus-newsgroup-downloadable - gnus-newsgroup-undownloaded - gnus-newsgroup-unsendable - - gnus-newsgroup-selection - - gnus-newsgroup-begin gnus-newsgroup-end - gnus-newsgroup-last-rmail gnus-newsgroup-last-mail - gnus-newsgroup-last-folder gnus-newsgroup-last-file - gnus-newsgroup-last-directory - gnus-newsgroup-auto-expire - gnus-newsgroup-processable - gnus-newsgroup-unfetched - gnus-newsgroup-articles - gnus-newsgroup-bookmarks gnus-newsgroup-dormant - gnus-newsgroup-headers gnus-newsgroup-threads - gnus-newsgroup-prepared gnus-summary-highlight-line-function - gnus-current-article gnus-current-headers gnus-have-all-headers - gnus-last-article gnus-article-internal-prepare-hook - (gnus-summary-article-delete-hook . global) - (gnus-summary-article-move-hook . global) - gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay - gnus-newsgroup-scored gnus-newsgroup-kill-headers - gnus-thread-expunge-below - gnus-score-alist gnus-current-score-file - (gnus-summary-expunge-below . global) - (gnus-summary-mark-below . global) - (gnus-orphan-score . global) - gnus-newsgroup-active gnus-scores-exclude-files - gnus-newsgroup-highest - gnus-newsgroup-history gnus-newsgroup-ancient - gnus-newsgroup-sparse gnus-newsgroup-process-stack - (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring) - gnus-newsgroup-adaptive-score-file (gnus-reffed-article-number . -1) - (gnus-newsgroup-expunged-tally . 0) - gnus-cache-removable-articles - gnus-newsgroup-data gnus-newsgroup-data-reverse - gnus-newsgroup-limit gnus-newsgroup-limits - gnus-newsgroup-charset gnus-newsgroup-display - gnus-summary-use-undownloaded-faces) - "Variables that are buffer-local to the summary buffers.") - -(defvar gnus-newsgroup-variables nil - "A list of variables that have separate values in different newsgroups. -A list of newsgroup (summary buffer) local variables, or cons of -variables and their default expressions to be evalled (when the default -values are not nil), that should be made global while the summary buffer -is active. - -Note: The default expressions will be evaluated (using function `eval') -before assignment to the local variable rather than just assigned to it. -If the default expression is the symbol `global', that symbol will not -be evaluated but the global value of the local variable will be used -instead. - -These variables can be used to set variables in the group parameters -while still allowing them to affect operations done in other buffers. -For example: - -\(setq gnus-newsgroup-variables - \\=3D'(message-use-followup-to - (gnus-visible-headers . - \"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\"))) -") +(make-obsolete-variable 'gnus-summary-local-variables nil "28.1") +(make-obsolete-variable 'gnus-newsgroup-variables nil "28.1") =20 (eval-when-compile ;; Bind features so that require will believe that gnus-sum has @@ -1850,17 +1769,15 @@ gnus-simplify-buffer-fuzzy (defun gnus-simplify-subject-fuzzy (subject) "Simplify a subject string fuzzily. See `gnus-simplify-buffer-fuzzy' for details." - (save-excursion - (let ((regexp gnus-simplify-subject-fuzzy-regexp)) - (gnus-set-work-buffer) - (let ((case-fold-search t)) - ;; Remove uninteresting prefixes. - (when (and gnus-simplify-ignored-prefixes - (string-match gnus-simplify-ignored-prefixes subject)) - (setq subject (substring subject (match-end 0)))) - (insert subject) - (inline (gnus-simplify-buffer-fuzzy regexp)) - (buffer-string))))) + (gnus-with-temp-buffer + (let ((case-fold-search t)) + ;; Remove uninteresting prefixes. + (when (and gnus-simplify-ignored-prefixes + (string-match gnus-simplify-ignored-prefixes subject)) + (setq subject (substring subject (match-end 0)))) + (insert subject) + (gnus-simplify-buffer-fuzzy gnus-simplify-subject-fuzzy-regexp) + (buffer-string)))) =20 (defsubst gnus-simplify-subject-fully (subject) "Simplify a subject string according to `gnus-summary-gather-subject-lim= it'." @@ -3119,11 +3036,6 @@ bookmark-make-record-function (defvar bidi-paragraph-direction) =20 -(defvar gnus-summary-mode-group nil - "Variable for communication with `gnus-summary-mode'. -Allows the `gnus-newsgroup-name' local variable to be set before -the summary mode hooks are run.") - (define-derived-mode gnus-summary-mode gnus-mode "Summary" "Major mode for reading articles. \\ @@ -3143,10 +3055,6 @@ gnus-summary-mode =20 \\{gnus-summary-mode-map}" :interactive nil - (let ((gnus-summary-local-variables gnus-newsgroup-variables)) - (gnus-summary-make-local-variables)) - (gnus-summary-make-local-variables) - (setq gnus-newsgroup-name gnus-summary-mode-group) (when (gnus-visual-p 'summary-menu 'menu) (gnus-summary-make-menu-bar) (gnus-summary-make-tool-bar)) @@ -3163,27 +3071,11 @@ gnus-summary-mode (make-local-variable 'gnus-summary-line-format-spec) (make-local-variable 'gnus-summary-dummy-line-format) (make-local-variable 'gnus-summary-dummy-line-format-spec) - (make-local-variable 'gnus-summary-mark-positions) - (make-local-variable 'gnus-article-buffer) - (make-local-variable 'gnus-article-current) - (make-local-variable 'gnus-original-article-buffer) - (add-hook 'pre-command-hook #'gnus-set-global-variables nil t) (mm-enable-multibyte) (setq-local bookmark-make-record-function - #'gnus-summary-bookmark-make-record)) - -(defun gnus-summary-make-local-variables () - "Make all the local summary buffer variables." - (dolist (local gnus-summary-local-variables) - (if (consp local) - (let ((global (if (eq (cdr local) 'global) - ;; Copy the global value of the variable. - (symbol-value (car local)) - ;; Use the value from the list. - (eval (cdr local) t)))) - (set (make-local-variable (car local)) global)) - ;; Simple nil-valued local variable. - (set (make-local-variable local) nil)))) + #'gnus-summary-bookmark-make-record) + (setq gnus-summary-buffer (current-buffer)) + (set-default 'gnus-summary-buffer gnus-summary-buffer)) =20 ;; Summary data functions. =20 @@ -3527,76 +3419,25 @@ gnus-summary-setup-buffer This function does all setup work that relies on the specific value of GROUP, and puts the buffer in `gnus-summary-mode'. =20 -Returns non-nil if the setup was successful." - (let ((buffer (gnus-summary-buffer-name group)) - (dead-name (concat "*Dead Summary " group "*"))) - ;; If a dead summary buffer exists, we kill it. - (gnus-kill-buffer dead-name) - (if (get-buffer buffer) - (progn - (set-buffer buffer) - (setq gnus-summary-buffer (current-buffer)) - (not gnus-newsgroup-prepared)) - (set-buffer (gnus-get-buffer-create buffer)) - (setq gnus-summary-buffer (current-buffer)) - (let ((gnus-summary-mode-group group)) - (gnus-summary-mode)) - (when (gnus-group-quit-config group) - (setq-local gnus-single-article-buffer nil)) - (turn-on-gnus-mailing-list-mode) - ;; These functions don't currently depend on GROUP, but might in - ;; the future. - (gnus-update-format-specifications nil 'summary 'summary-mode 'summa= ry-dummy) - (gnus-update-summary-mark-positions) - ;; Set any local variables in the group parameters. - (gnus-summary-set-local-parameters gnus-newsgroup-name) - t))) - -(defun gnus-set-global-variables () - "Set the global equivalents of the buffer-local variables. -They are set to the latest values they had. These reflect the summary -buffer that was in action when the last article was fetched." - (when (derived-mode-p 'gnus-summary-mode) - (setq gnus-summary-buffer (current-buffer)) - (let ((name gnus-newsgroup-name) - (marked gnus-newsgroup-marked) - (spam gnus-newsgroup-spam-marked) - (unread gnus-newsgroup-unreads) - (headers gnus-current-headers) - (data gnus-newsgroup-data) - (summary gnus-summary-buffer) - (article-buffer gnus-article-buffer) - (original gnus-original-article-buffer) - (gac gnus-article-current) - (reffed gnus-reffed-article-number) - (score-file gnus-current-score-file) - (default-charset gnus-newsgroup-charset) - vlist) - (dolist (local gnus-newsgroup-variables) - (push (eval (if (consp local) (car local) - local) - t) - vlist)) - (setq vlist (nreverse vlist)) - (with-temp-buffer - (setq gnus-newsgroup-name name - gnus-newsgroup-marked marked - gnus-newsgroup-spam-marked spam - gnus-newsgroup-unreads unread - gnus-current-headers headers - gnus-newsgroup-data data - gnus-article-current gac - gnus-summary-buffer summary - gnus-article-buffer article-buffer - gnus-original-article-buffer original - gnus-reffed-article-number reffed - gnus-current-score-file score-file - gnus-newsgroup-charset default-charset) - (dolist (local gnus-newsgroup-variables) - (set (if (consp local) - (car local) - local) - (pop vlist))))))) +Return non-nil if caller must prepare the summary buffer." + (gnus-kill-buffer (concat "*Dead Summary " group "*")) ;; kill deadened = summaries + (let ((name (gnus-summary-buffer-name group))) + (if (gnus-buffer-live-p name) + (with-current-buffer name + (not gnus-newsgroup-prepared)) + (with-current-buffer (gnus-get-buffer-create name) + (gnus-summary-mode) + (setq gnus-newsgroup-name group) + (when (gnus-group-quit-config gnus-newsgroup-name) + (set (make-local-variable 'gnus-single-article-buffer) nil)) + (turn-on-gnus-mailing-list-mode) + ;; These functions don't currently depend on GROUP, but might in + ;; the future. + (gnus-update-format-specifications 'summary 'summary-mode 'summary= -dummy) + (gnus-update-summary-mark-positions) + ;; Set any local variables in the group parameters. + (gnus-summary-set-local-parameters gnus-newsgroup-name) + t)))) =20 (defun gnus-summary-article-unread-p (article) "Say whether ARTICLE is unread or not." @@ -3619,7 +3460,7 @@ gnus--dummy-mail-header (make-full-mail-header 0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 ""= nil)) =20 (defconst gnus--dummy-data-list - (list (gnus-data-make 0 nil nil gnus--dummy-mail-header nil))) + (list (gnus-data-make 0 nil 0 gnus--dummy-mail-header nil))) =20 (defun gnus-make-thread-indent-array (&optional n) (when (or n @@ -3635,63 +3476,57 @@ gnus-make-thread-indent-array =20 (defun gnus-update-summary-mark-positions () "Compute where the summary marks are to go." - (save-excursion - (when (gnus-buffer-live-p gnus-summary-buffer) - (set-buffer gnus-summary-buffer)) - (let ((spec gnus-summary-line-format-spec) - pos) - (save-excursion - (gnus-set-work-buffer) - (let ((gnus-tmp-unread ?Z) - (gnus-replied-mark ?Z) - (gnus-score-below-mark ?Z) - (gnus-score-over-mark ?Z) - (gnus-undownloaded-mark ?Z) - (gnus-summary-line-format-spec spec) - ;; Make sure `gnus-data-find' finds a dummy element - ;; so we don't call gnus-data- accessors on nil. - (gnus-newsgroup-data gnus--dummy-data-list) - (gnus-newsgroup-downloadable '(0)) - (gnus-visual nil) - case-fold-search ignores) - ;; Here, all marks are bound to Z. - (gnus-summary-insert-line gnus--dummy-mail-header - 0 nil t gnus-tmp-unread t nil "" nil 1) - (goto-char (point-min)) - ;; Memorize the positions of the same characters as dummy marks. - (while (re-search-forward "[A-D]" nil t) - (push (point) ignores)) - (erase-buffer) - ;; We use A-D as dummy marks in order to know column positions - ;; where marks should be inserted. - (setq gnus-tmp-unread ?A - gnus-replied-mark ?B - gnus-score-below-mark ?C - gnus-score-over-mark ?C - gnus-undownloaded-mark ?D) - (gnus-summary-insert-line gnus--dummy-mail-header - 0 nil t gnus-tmp-unread t nil "" nil 1) - ;; Ignore characters which aren't dummy marks. - (dolist (p ignores) - (delete-region (goto-char (1- p)) p) - (insert ?Z)) - (goto-char (point-min)) - (setq pos (list (cons 'unread - (and (search-forward "A" nil t) - (- (point) (point-min) 1))))) - (goto-char (point-min)) - (push (cons 'replied (and (search-forward "B" nil t) - (- (point) (point-min) 1))) - pos) - (goto-char (point-min)) - (push (cons 'score (and (search-forward "C" nil t) - (- (point) (point-min) 1))) - pos) - (goto-char (point-min)) - (push (cons 'download (and (search-forward "D" nil t) - (- (point) (point-min) 1))) - pos))) - (setq gnus-summary-mark-positions pos)))) + (with-current-buffer gnus-summary-buffer + (setq gnus-summary-mark-positions + (gnus-with-temp-buffer + (let ((gnus-tmp-unread ?Z) + (gnus-replied-mark ?Z) + (gnus-score-below-mark ?Z) + (gnus-score-over-mark ?Z) + (gnus-undownloaded-mark ?Z) + ;; Make sure `gnus-data-find' finds a dummy element + ;; so we don't call gnus-data- accessors on nil. + (gnus-newsgroup-data gnus--dummy-data-list) + (gnus-newsgroup-downloadable '(0)) + pos case-fold-search ignores gnus-visual) + ;; Here, all marks are bound to Z. + (gnus-summary-insert-line gnus--dummy-mail-header + 0 nil t gnus-tmp-unread t nil "" n= il 1) + (goto-char (point-min)) + ;; Memorize the positions of the same characters as dummy ma= rks. + (while (re-search-forward "[A-D]" nil t) + (push (point) ignores)) + (erase-buffer) + ;; We use A-D as dummy marks in order to know column positio= ns + ;; where marks should be inserted. + (setq gnus-tmp-unread ?A + gnus-replied-mark ?B + gnus-score-below-mark ?C + gnus-score-over-mark ?C + gnus-undownloaded-mark ?D) + (gnus-summary-insert-line gnus--dummy-mail-header + 0 nil t gnus-tmp-unread t nil "" n= il 1) + ;; Ignore characters which aren't dummy marks. + (dolist (p ignores) + (delete-region (goto-char (1- p)) p) + (insert ?Z)) + (goto-char (point-min)) + (setq pos (list (cons 'unread + (and (search-forward "A" nil t) + (- (point) (point-min) 1))))) + (goto-char (point-min)) + (push (cons 'replied (and (search-forward "B" nil t) + (- (point) (point-min) 1))) + pos) + (goto-char (point-min)) + (push (cons 'score (and (search-forward "C" nil t) + (- (point) (point-min) 1))) + pos) + (goto-char (point-min)) + (push (cons 'download (and (search-forward "D" nil t) + (- (point) (point-min) 1))) + pos) + pos))))) =20 (defun gnus-summary-insert-dummy-line (subject number) "Insert a dummy root in the summary buffer." @@ -3841,12 +3676,13 @@ gnus-summary-insert-line (setq gnus-tmp-lines (if (=3D gnus-tmp-lines -1) "?" (number-to-string gnus-tmp-lines))) - (condition-case () + (condition-case err (put-text-property (point) (progn (eval gnus-summary-line-format-spec t) (point)) 'gnus-number gnus-tmp-number) - (error (gnus-message 5 "Error updating the summary line"))) + (error (gnus-message 3 "Error updating the summary line: %s" + (error-message-string err)))) (when (gnus-visual-p 'summary-highlight 'highlight) (forward-line -1) (gnus-summary-highlight-line) @@ -4030,168 +3866,156 @@ gnus-summary-read-group (defun gnus-summary-read-group-1 (group show-all no-article kill-buffer no-display &optional select-articles) - "Display articles and threads in a Summary buffer for GROUP." - ;; This function calls `gnus-summary-setup-buffer' to create the - ;; buffer, put it in `gnus-summary-mode', and set local variables; - ;; `gnus-select-newsgroup' to update the group's active and marks - ;; from the server; and `gnus-summary-prepare' to actually insert - ;; lines for articles. The rest of the function is mostly concerned - ;; with limiting and positioning and windowing and other visual - ;; effects. - - ;; Killed foreign groups can't be entered. - ;; (when (and (not (gnus-group-native-p group)) - ;; (not (gethash group gnus-newsrc-hashtb))) - ;; (error "Dead non-native groups can't be entered")) + "Display articles and threads in a Summary buffer for GROUP. + +Calls `gnus-summary-setup-buffer' to create the +buffer, put it in `gnus-summary-mode', and set local variables; +`gnus-select-newsgroup' to update the group's active and marks +from the server; and `gnus-summary-prepare' to actually insert +lines for articles. The rest of the function is mostly concerned +with limiting and positioning and windowing and other visual +effects." (gnus-message 7 "Retrieving newsgroup: %s..." group) - (let* ((new-group (gnus-summary-setup-buffer group)) - (quit-config (gnus-group-quit-config group)) - (did-select (and new-group (gnus-select-newsgroup - group show-all select-articles)))) - (cond - ;; This summary buffer exists already, so we just select it. - ((not new-group) - (gnus-set-global-variables) - (when kill-buffer - (gnus-kill-or-deaden-summary kill-buffer)) - (gnus-configure-windows 'summary 'force) - (gnus-set-mode-line 'summary) - (gnus-summary-position-point) - (message "") - t) - ;; We couldn't select this group. - ((null did-select) - (when (and (derived-mode-p 'gnus-summary-mode) - (not (equal (current-buffer) kill-buffer))) - (kill-buffer (current-buffer)) - (if (not quit-config) - (progn - ;; Update the info -- marks might need to be removed, - ;; for instance. - (gnus-summary-update-info) - (set-buffer gnus-group-buffer) - (gnus-group-jump-to-group group) - (gnus-group-next-unread-group 1)) - (gnus-handle-ephemeral-exit quit-config))) - (if (null (gnus-list-of-unread-articles group)) - (gnus-message 3 "Group %s contains no messages" group) - (gnus-message 3 "Can't select group")) - nil) - ;; The user did a `C-g' while prompting for number of articles, - ;; so we exit this group. - ((eq did-select 'quit) - (and (derived-mode-p 'gnus-summary-mode) - (not (equal (current-buffer) kill-buffer)) - (kill-buffer (current-buffer))) - (when kill-buffer - (gnus-kill-or-deaden-summary kill-buffer)) - (if (not quit-config) - (progn - (set-buffer gnus-group-buffer) - (gnus-group-jump-to-group group) - (gnus-configure-windows 'group 'force)) - (gnus-handle-ephemeral-exit quit-config)) - ;; Finally signal the quit. - (signal 'quit nil)) - ;; The group was successfully selected. - (t - (gnus-set-global-variables) - (when (boundp 'spam-install-hooks) - (spam-initialize)) - ;; Save the active value in effect when the group was entered. - (setq gnus-newsgroup-active - (copy-tree - (gnus-active gnus-newsgroup-name))) - (setq gnus-newsgroup-highest (cdr gnus-newsgroup-active)) - ;; You can change the summary buffer in some way with this hook. - (gnus-run-hooks 'gnus-select-group-hook) - (when (memq 'summary (gnus-update-format-specifications - nil 'summary 'summary-mode 'summary-dummy)) - ;; The format specification for the summary line was updated, - ;; so we need to update the mark positions as well. - (gnus-update-summary-mark-positions)) - ;; Do score processing. - (when gnus-use-scoring - (gnus-possibly-score-headers)) - ;; Check whether to fill in the gaps in the threads. - (when gnus-build-sparse-threads - (gnus-build-sparse-threads)) - ;; Find the initial limit. - (if show-all - (let ((gnus-newsgroup-dormant nil)) - (gnus-summary-initial-limit show-all)) - (gnus-summary-initial-limit show-all)) - ;; Generate the summary buffer. - (unless no-display - (gnus-summary-prepare)) - (when gnus-use-trees - (gnus-tree-open) ;Autoloaded from gnus-salt. - (declare-function gnus-tree-highlight-article "gnus-salt" (article= face)) - (setq gnus-summary-highlight-line-function - #'gnus-tree-highlight-article)) - ;; If the summary buffer is empty, but there are some low-scored - ;; articles or some excluded dormants, we include these in the - ;; buffer. - (when (and (zerop (buffer-size)) - (not no-display)) - (cond (gnus-newsgroup-dormant - (gnus-summary-limit-include-dormant)) - ((and gnus-newsgroup-scored show-all) - (gnus-summary-limit-include-expunged t)))) - ;; Function `gnus-apply-kill-file' must be called in this hook. - (gnus-run-hooks 'gnus-apply-kill-hook) - (if (and (zerop (buffer-size)) - (not no-display)) - (progn - ;; This newsgroup is empty. - (gnus-summary-catchup-and-exit nil t) - (gnus-message 6 "No unread news") - (when kill-buffer - (gnus-kill-or-deaden-summary kill-buffer)) - ;; Return nil from this function. - nil) - ;; Hide conversation thread subtrees. We cannot do this in - ;; gnus-summary-prepare-hook since kill processing may not - ;; work with hidden articles. - (gnus-summary-maybe-hide-threads) - (gnus-configure-windows 'summary) - (when kill-buffer - (gnus-kill-or-deaden-summary kill-buffer)) - (gnus-summary-auto-select-subject) - ;; Don't mark any articles as selected if we haven't done that. - (when no-article - (setq overlay-arrow-position nil)) - ;; Show first unread article if requested. - (if (and (not no-article) - (not no-display) - gnus-newsgroup-unreads - gnus-auto-select-first) - (progn - (let ((art (gnus-summary-article-number))) - (when (and art - gnus-plugged - (not (memq art gnus-newsgroup-undownloaded)) - (not (memq art gnus-newsgroup-downloadable))) - (gnus-summary-goto-article art)))) - ;; Don't select any articles. - (gnus-summary-position-point) - (gnus-configure-windows 'summary 'force) - (gnus-set-mode-line 'summary)) - (when (and gnus-auto-center-group - (get-buffer-window gnus-group-buffer t)) - ;; Gotta use windows, because recenter does weird stuff if - ;; the current buffer ain't the displayed window. - (let ((owin (selected-window))) - (select-window (get-buffer-window gnus-group-buffer t)) - (when (gnus-group-goto-group group) - (recenter)) - (select-window owin))) - ;; Mark this buffer as "prepared". - (setq gnus-newsgroup-prepared t) - (gnus-run-hooks 'gnus-summary-prepared-hook) - (unless (gnus-ephemeral-group-p group) - (gnus-group-update-group group nil t)) - t))))) + (unwind-protect + (if-let ((prepare-p (gnus-summary-setup-buffer group))) + (with-current-buffer (gnus-summary-buffer-name group) + (cl-case (gnus-select-newsgroup group show-all select-articles) + ('quit + ;; The user did a `C-g' while prompting for number of artic= les, + ;; so we exit this group. + (and (derived-mode-p 'gnus-summary-mode) + (not (equal (current-buffer) kill-buffer)) + (kill-buffer (current-buffer))) + (when kill-buffer + (gnus-kill-or-deaden-summary kill-buffer)) + (if-let ((quit-config (gnus-group-quit-config group))) + (gnus-handle-ephemeral-exit quit-config) + (set-buffer gnus-group-buffer) + (gnus-group-jump-to-group group) + (gnus-configure-windows 'group 'force)) + ;; Finally signal the quit. + (signal 'quit nil)) + (nil + (when (and (derived-mode-p 'gnus-summary-mode) + (not (equal (current-buffer) kill-buffer))) + (kill-buffer (current-buffer)) + (if-let ((quit-config (gnus-group-quit-config group))) + (gnus-handle-ephemeral-exit quit-config) + (gnus-summary-update-info) ;; marks might need to be re= moved + (set-buffer gnus-group-buffer) + (gnus-group-jump-to-group group) + (gnus-group-next-unread-group 1))) + (if (null (gnus-list-of-unread-articles group)) + (gnus-message 3 "Group %s contains no messages" group) + (gnus-message 3 "Can't select group")) + nil) + (otherwise + ;; The group was successfully selected. + (when (boundp 'spam-install-hooks) + (spam-initialize)) + ;; Save the active value in effect when the group was enter= ed. + (setq gnus-newsgroup-active + (copy-tree + (gnus-active gnus-newsgroup-name))) + (setq gnus-newsgroup-highest (cdr gnus-newsgroup-active)) + ;; You can change the summary buffer in some way with this = hook. + (gnus-run-hooks 'gnus-select-group-hook) + (when (memq 'summary (gnus-update-format-specifications + 'summary 'summary-mode 'summary-dummy= )) + ;; The format specification for the summary line was upda= ted, + ;; so we need to update the mark positions as well. + (gnus-update-summary-mark-positions)) + ;; Do score processing. + (when gnus-use-scoring + (gnus-possibly-score-headers)) + ;; Check whether to fill in the gaps in the threads. + (when gnus-build-sparse-threads + (gnus-build-sparse-threads)) + ;; Find the initial limit. + (if show-all + (let ((gnus-newsgroup-dormant nil)) + (gnus-summary-initial-limit show-all)) + (gnus-summary-initial-limit show-all)) + ;; Generate the summary buffer. + (unless no-display + (gnus-summary-prepare)) + (when gnus-use-trees + (gnus-tree-open) ;Autoloaded from gnus-salt. + (declare-function gnus-tree-highlight-article "gnus-salt"= (article face)) + (setq gnus-summary-highlight-line-function + #'gnus-tree-highlight-article)) + ;; If the summary buffer is empty, but there are some low-s= cored + ;; articles or some excluded dormants, we include these in = the + ;; buffer. + (when (and (zerop (buffer-size)) + (not no-display)) + (cond (gnus-newsgroup-dormant + (gnus-summary-limit-include-dormant)) + ((and gnus-newsgroup-scored show-all) + (gnus-summary-limit-include-expunged t)))) + ;; Function `gnus-apply-kill-file' must be called in this h= ook. + (gnus-run-hooks 'gnus-apply-kill-hook) + (if (and (zerop (buffer-size)) + (not no-display)) + (progn + ;; This newsgroup is empty. + (gnus-summary-catchup-and-exit nil t) + (gnus-message 6 "No unread news") + (when kill-buffer + (gnus-kill-or-deaden-summary kill-buffer)) + ;; Return nil from this function. + nil) + ;; Hide conversation thread subtrees. We cannot do this = in + ;; `gnus-summary-prepared-hook' since kill processing may= not + ;; work with hidden articles. + (gnus-summary-maybe-hide-threads) + (when kill-buffer + (gnus-kill-or-deaden-summary kill-buffer)) + (gnus-summary-auto-select-subject) + ;; Don't mark any articles as selected if we haven't done= that. + (when no-article + (setq overlay-arrow-position nil)) + ;; Show first unread article if requested. + (if (and (not no-article) + (not no-display) + gnus-newsgroup-unreads + gnus-auto-select-first) + (progn + (let ((art (gnus-summary-article-number))) + (when (and art + gnus-plugged + (not (memq art gnus-newsgroup-undownlo= aded)) + (not (memq art gnus-newsgroup-download= able))) + (gnus-summary-goto-article art)))) + ;; Don't select any articles. + (gnus-summary-position-point) + (gnus-set-mode-line 'summary) + (save-excursion + (gnus-configure-windows 'summary 'force))) + (when (and gnus-auto-center-group + (get-buffer-window gnus-group-buffer t)) + ;; Gotta use windows, because recenter does weird stuff= if + ;; the current buffer ain't the displayed window. + (let ((owin (selected-window))) + (select-window (get-buffer-window gnus-group-buffer t= )) + (when (gnus-group-goto-group group) + (recenter)) + (select-window owin))) + ;; Mark this buffer as "prepared". + (setq gnus-newsgroup-prepared t) + (gnus-run-hooks 'gnus-summary-prepared-hook) + (unless (gnus-ephemeral-group-p group) + (gnus-group-update-group group nil t)) + t)))) + (with-current-buffer (gnus-summary-buffer-name group) + ;; Summary buffer already prepared, so we just select it. + (when kill-buffer + (gnus-kill-or-deaden-summary kill-buffer)) + (gnus-set-mode-line 'summary) + (gnus-summary-position-point) + (gnus-configure-windows 'summary 'force) + t)) + (gnus-message 7 "Retrieving newsgroup: %s...done" group))) =20 (defun gnus-summary-auto-select-subject () "Select the subject line on initial group entry." @@ -4225,10 +4049,9 @@ gnus-summary-prepare (when gnus-newsgroup-headers (gnus-summary-prepare-threads (if gnus-show-threads - (gnus-sort-gathered-threads - (funcall gnus-summary-thread-gathering-function - (gnus-sort-threads - (gnus-cut-threads (gnus-make-threads))))) + (gnus-sort-threads + (funcall gnus-summary-thread-gathering-function + (gnus-cut-threads (gnus-make-threads)))) ;; Unthreaded display. (gnus-sort-articles gnus-newsgroup-headers)))) (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data)) @@ -4317,7 +4140,7 @@ gnus-gather-threads-by-references (while threads (when (setq references (mail-header-references (caar threads))) (setq id (mail-header-id (caar threads)) - ids (inline (gnus-split-references references)) + ids (gnus-split-references references) entered nil) (while (setq ref (pop ids)) (setq ids (delete ref ids)) @@ -4346,16 +4169,6 @@ gnus-gather-threads-by-references (setq threads (cdr threads))) result)) =20 -(defun gnus-sort-gathered-threads (threads) - "Sort subthreads inside each gathered thread by `gnus-sort-gathered-thre= ads-function'." - (let ((result threads)) - (while threads - (when (stringp (caar threads)) - (setcdr (car threads) - (sort (cdar threads) gnus-sort-gathered-threads-function))) - (setq threads (cdr threads))) - result)) - (defun gnus-thread-loop-p (root thread) "Say whether ROOT is in THREAD." (let ((stack (list thread)) @@ -4698,33 +4511,42 @@ gnus-summary-update-article-line (cdr datal) (- (gnus-data-pos data) (gnus-data-pos (cadr datal)) inserted))= ))))) =20 +(defmacro gnus-summary-assume-in-summary (&rest body) + "If we are not in an summary buffer, go there, and execute BODY. Restor= e." + (declare (indent 0) (debug t)) + `(save-current-buffer + (when (or (derived-mode-p 'gnus-summary-mode) + (when (gnus-buffer-live-p gnus-summary-buffer) + (set-buffer gnus-summary-buffer))) + ,@body))) + (defun gnus-summary-update-article (article &optional iheader) "Update ARTICLE in the summary buffer." - (set-buffer gnus-summary-buffer) - (let* ((header (gnus-summary-article-header article)) - (id (mail-header-id header)) - (data (gnus-data-find article)) - (thread (gnus-id-to-thread id)) - (references (mail-header-references header)) - (parent - (gnus-id-to-thread - (or (gnus-parent-id - (when (and references - (not (equal "" references))) - references)) - "none"))) - (inhibit-read-only t) - (old (car thread))) - (when thread - (unless iheader - (setcar thread nil) - (when parent - (delq thread parent))) - (if (gnus-summary-insert-subject id header) - ;; Set the (possibly) new article number in the data structure. - (setf (gnus-data-number data) (gnus-id-to-article id)) - (setcar thread old) - nil)))) + (gnus-summary-assume-in-summary + (let* ((header (gnus-summary-article-header article)) + (id (mail-header-id header)) + (data (gnus-data-find article)) + (thread (gnus-id-to-thread id)) + (references (mail-header-references header)) + (parent + (gnus-id-to-thread + (or (gnus-parent-id + (when (and references + (not (equal "" references))) + references)) + "none"))) + (inhibit-read-only t) + (old (car thread))) + (when thread + (unless iheader + (setcar thread nil) + (when parent + (delq thread parent))) + (if (gnus-summary-insert-subject id header) + ;; Set the (possibly) new article number in the data structure. + (setf (gnus-data-number data) (gnus-id-to-article id)) + (setcar thread old) + nil))))) =20 (defun gnus-rebuild-thread (id &optional line) "Rebuild the thread containing ID. @@ -5694,7 +5516,6 @@ gnus-select-newsgroup gnus-summary-ignore-duplicates)) (info (nth 1 entry)) articles fetched-articles cached) - (unless (gnus-check-server (setq-local gnus-current-select-method (gnus-find-method-for-group group))) @@ -5707,12 +5528,10 @@ gnus-select-newsgroup (gnus-kill-buffer (current-buffer))) (error "Couldn't activate group %s: %s" group (gnus-status-message group)))) - (unless (gnus-request-group group t nil info) (when (derived-mode-p 'gnus-summary-mode) (gnus-kill-buffer (current-buffer))) (error "Couldn't request group %s: %s" group (gnus-status-message gr= oup))) - (when (and gnus-agent (gnus-active group)) (gnus-agent-possibly-alter-active group (gnus-active group) info) @@ -5721,11 +5540,9 @@ gnus-select-newsgroup (gnus-agent-find-parameter group 'agent-enable-undownloaded-faces))) - (setq gnus-newsgroup-name group gnus-newsgroup-unselected nil gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) - (let ((display (gnus-group-find-parameter group 'display))) (setq gnus-newsgroup-display (cond @@ -5758,21 +5575,17 @@ gnus-select-newsgroup nil)))) =20 (gnus-summary-setup-default-charset) - ;; Kludge to avoid having cached articles nixed out in virtual groups. (when (gnus-virtual-group-p group) (setq cached gnus-newsgroup-cached)) - (setq gnus-newsgroup-unreads (gnus-sorted-ndifference (gnus-sorted-ndifference gnus-newsgroup-unreads gnus-newsgroup-marked) gnus-newsgroup-dormant)) - (setq gnus-newsgroup-processable nil) =20 (gnus-update-read-articles group gnus-newsgroup-unreads t) - ;; Adjust and set lists of article marks. (when info (gnus-adjust-marked-articles info)) @@ -5790,11 +5603,7 @@ gnus-select-newsgroup ;; Init the dependencies hash table. (setq gnus-newsgroup-dependencies (gnus-make-hashtable (length articles))) - (if (gnus-buffer-live-p gnus-group-buffer) - (gnus-set-global-variables) - (set-default 'gnus-newsgroup-name gnus-newsgroup-name)) ;; Retrieve the headers and read them in. - (setq gnus-newsgroup-headers (gnus-fetch-headers articles)) =20 ;; Kludge to avoid having cached articles nixed out in virtual group= s. @@ -5835,9 +5644,11 @@ gnus-select-newsgroup (and (gnus-group-auto-expirable-p group) (not (gnus-group-read-only-p group)))) ;; Set up the article buffer now, if necessary. - (unless (and gnus-single-article-buffer - (equal gnus-article-buffer "*Article*")) - (gnus-article-setup-buffer)) + (let ((single-article-p (and gnus-single-article-buffer + (equal gnus-article-buffer "*Article*")= ))) + (when (and (not single-article-p) + (gnus-buffer-live-p gnus-summary-buffer)))) + (gnus-article-setup-buffer) ;; First and last article in this newsgroup. (when gnus-newsgroup-headers (setq gnus-newsgroup-begin @@ -5859,7 +5670,6 @@ gnus-compute-unseen-list (declare-function gnus-get-predicate "gnus-agent" (predicate)) =20 (defun gnus-summary-display-make-predicate (display) - (require 'gnus-agent) (when (=3D (length display) 1) (setq display (car display))) (unless gnus-summary-display-cache @@ -6032,7 +5842,7 @@ gnus-articles-to-read (defun gnus-killed-articles (killed articles) (let (out) (while articles - (when (inline (gnus-member-of-range (car articles) killed)) + (when (gnus-member-of-range (car articles) killed) (push (car articles) out)) (setq articles (cdr articles))) out)) @@ -6223,8 +6033,8 @@ gnus-update-marks =20 (defun gnus-set-mode-line (where) "Set the mode line of the article or summary buffers. -If WHERE is `summary', the summary mode line format will be used." - ;; Is this mode line one we keep updated? +If WHERE is `summary', the summary mode line format will be used. +" (when (and (memq where gnus-updated-mode-lines) (symbol-value (intern (format "gnus-%s-mode-line-format-spec" where)))) @@ -6471,7 +6281,7 @@ gnus-get-newsgroup-headers-xover `nntp-retrieve-headers')." ;; Get the Xref when the users reads the articles since most/some ;; NNTP servers do not include Xrefs when using XOVER. - (setq gnus-article-internal-prepare-hook (list #'gnus-article-get-xrefs)) + (add-hook 'gnus-article-internal-prepare-hook 'gnus-article-get-xrefs ni= l t) (let ((mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) (cur nntp-server-buffer) @@ -7193,7 +7003,6 @@ gnus-summary-exit "Exit reading current newsgroup, and then return to group selection mode. `gnus-exit-group-hook' is called with no arguments if that value is non-ni= l." (interactive nil gnus-summary-mode) - (gnus-set-global-variables) (when (gnus-buffer-live-p gnus-article-buffer) (with-current-buffer gnus-article-buffer (mm-destroy-parts gnus-article-mime-handles) @@ -7254,8 +7063,7 @@ gnus-summary-exit (gnus-article-stop-animations) (unless leave-hidden (gnus-configure-windows 'group 'force)) - (if temporary - nil ;Nothing to do. + (unless temporary (set-buffer buf) (if (not gnus-kill-summary-on-exit) (progn @@ -7357,17 +7165,14 @@ gnus-handle-ephemeral-exit (unless (eq (cdr quit-config) 'group) (setq gnus-current-select-method (gnus-find-method-for-group gnus-newsgroup-name))) - (cond ((derived-mode-p 'gnus-summary-mode) - (gnus-set-global-variables)) - ((derived-mode-p 'gnus-article-mode) - (save-current-buffer - ;; The `gnus-summary-buffer' variable may point - ;; to the old summary buffer when using a single - ;; article buffer. - (unless (gnus-buffer-live-p gnus-summary-buffer) - (set-buffer gnus-group-buffer)) - (set-buffer gnus-summary-buffer) - (gnus-set-global-variables)))) + (when (derived-mode-p 'gnus-article-mode) + (save-current-buffer + ;; The `gnus-summary-buffer' variable may point + ;; to the old summary buffer when using a single + ;; article buffer. + (unless (gnus-buffer-live-p gnus-summary-buffer) + (set-buffer gnus-group-buffer)) + (set-buffer gnus-summary-buffer))) (if (or (eq (cdr quit-config) 'article) (eq (cdr quit-config) 'pick)) (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode)) @@ -7670,38 +7475,47 @@ gnus-summary-expand-window =20 (defun gnus-summary-display-article (article &optional all-header) "Display ARTICLE in article buffer." - (unless (and (gnus-buffer-live-p gnus-article-buffer) - (with-current-buffer gnus-article-buffer - (derived-mode-p 'gnus-article-mode))) - (gnus-article-setup-buffer)) - (gnus-set-global-variables) - (with-current-buffer gnus-article-buffer - ;; The buffer may be non-empty and even narrowed, so go back to - ;; a sane state. - (widen) - ;; We're going to erase the buffer anyway so do it now: it can save us= from - ;; uselessly performing multibyte-conversion of the current content. - (let ((inhibit-read-only t)) (erase-buffer)) - (setq gnus-article-charset gnus-newsgroup-charset) - (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets) - (mm-enable-multibyte)) - (if (null article) - nil - (prog1 - (funcall (or gnus-summary-display-article-function - #'gnus-article-prepare) - article all-header) - (gnus-run-hooks 'gnus-select-article-hook) - (when (and gnus-current-article - (not (zerop gnus-current-article))) - (gnus-summary-goto-subject gnus-current-article)) - (gnus-summary-recenter) - (when (and gnus-use-trees gnus-show-threads) - (gnus-possibly-generate-tree article) - (gnus-highlight-selected-tree article)) - ;; Successfully display article. - (gnus-article-set-window-start - (cdr (assq article gnus-newsgroup-bookmarks)))))) + (gnus-summary-assume-in-summary + (cl-block nil + (let ((result + (cond ((not article) + (gnus-message 3 "Article cannot be displayed") + (cl-return)) + (gnus-summary-display-article-function + (unless (and (gnus-buffer-live-p gnus-article-buffer) + (with-current-buffer gnus-article-buffer + (derived-mode-p 'gnus-article-mode))) + (gnus-article-setup-buffer)) + (with-current-buffer gnus-article-buffer + ;; The buffer may be non-empty and even narrowed, + ;; so go back to a sane state. + (widen) + ;; We're going to erase the buffer anyway so do it n= ow: + ;; it can save us from uselessly performing + ;; multibyte-conversion of the current content. + (let ((inhibit-read-only t)) (erase-buffer)) + (setq gnus-article-charset gnus-newsgroup-charset) + (setq gnus-article-ignored-charsets + gnus-newsgroup-ignored-charsets) + (mm-enable-multibyte)) + (funcall gnus-summary-display-article-function + article all-header)) + (t (gnus-article-prepare article all-header))))) + (gnus-run-hooks 'gnus-select-article-hook) + (when (and gnus-current-article + (not (zerop gnus-current-article))) + (gnus-summary-goto-subject gnus-current-article)) + (gnus-summary-recenter) + (when (and gnus-use-trees gnus-show-threads) + (gnus-possibly-generate-tree article) + (gnus-highlight-selected-tree article)) + (with-current-buffer gnus-article-buffer + (unless gnus-article-decoded-p + (mm-disable-multibyte))) + ;; Successfully display article. + (gnus-article-set-window-start + (cdr (assq article gnus-newsgroup-bookmarks))) + result)))) =20 (defun gnus-summary-select-article (&optional all-headers force pseudo art= icle) "Select the current article. @@ -7709,50 +7523,40 @@ gnus-summary-select-article non-nil, the article will be re-fetched even if it already present in the article buffer. If PSEUDO is non-nil, pseudo-articles will also be displayed." - ;; Make sure we are in the summary buffer to work around bbdb bug. - (unless (derived-mode-p 'gnus-summary-mode) - (set-buffer gnus-summary-buffer)) - (let ((article (or article (gnus-summary-article-number))) - (all-headers (and all-headers t)) ; Must be t or nil. - gnus-summary-display-article-function) - (and (not pseudo) - (gnus-summary-article-pseudo-p article) - (error "This is a pseudo-article")) - (with-current-buffer gnus-summary-buffer + (gnus-summary-assume-in-summary + (let ((article (or article (gnus-summary-article-number))) + (all-headers (and all-headers t)) ; Must be t or nil. + gnus-summary-display-article-function) + (and (not pseudo) + (gnus-summary-article-pseudo-p article) + (error "This is a pseudo-article")) (if (or (and gnus-single-article-buffer - (or (null gnus-current-article) - (null gnus-article-current) - (null (get-buffer gnus-article-buffer)) - (not (eq article (cdr gnus-article-current))) - (not (equal (car gnus-article-current) - gnus-newsgroup-name)) - (not (get-buffer gnus-original-article-buffer)))) - (and (not gnus-single-article-buffer) - (or (null gnus-current-article) - (not (get-buffer gnus-original-article-buffer)) - (not (eq gnus-current-article article)))) - force) - ;; The requested article is different from the current article. - (progn - (gnus-summary-display-article article all-headers) - (when (gnus-buffer-live-p gnus-article-buffer) - (with-current-buffer gnus-article-buffer - (if (not gnus-article-decoded-p) ;; a local variable - (mm-disable-multibyte)))) - (gnus-article-set-window-start - (cdr (assq article gnus-newsgroup-bookmarks))) - article) - 'old)))) + (or (null gnus-current-article) + (null gnus-article-current) + (null (get-buffer gnus-article-buffer)) + (not (eq article (cdr gnus-article-current))) + (not (equal (car gnus-article-current) + gnus-newsgroup-name)) + (not (get-buffer gnus-original-article-buffer)))) + (and (not gnus-single-article-buffer) + (or (null gnus-current-article) + (not (get-buffer gnus-original-article-buffer)) + (not (eq gnus-current-article article)))) + force) + ;; The requested article is different from the current article. + (prog1 article + (gnus-summary-display-article article all-headers)) + 'old)))) =20 (defun gnus-summary-force-verify-and-decrypt () "Display buttons for signed/encrypted parts and verify/decrypt them." (interactive nil gnus-summary-mode) (let ((mm-verify-option 'known) - (mm-decrypt-option 'known) - (gnus-article-emulate-mime t) - (gnus-buttonized-mime-types (append (list "multipart/signed" - "multipart/encrypted") - gnus-buttonized-mime-types))) + (mm-decrypt-option 'known) + (gnus-article-emulate-mime t) + (gnus-buttonized-mime-types (append (list "multipart/signed" + "multipart/encrypted") + gnus-buttonized-mime-types))) (gnus-summary-select-article nil 'force))) =20 (defun gnus-summary-next-article (&optional unread subject backward push) @@ -7762,68 +7566,67 @@ gnus-summary-next-article If BACKWARD, the previous article is selected instead of the next." (interactive "P" gnus-summary-mode) ;; Make sure we are in the summary buffer. - (unless (derived-mode-p 'gnus-summary-mode) - (set-buffer gnus-summary-buffer)) - (cond - ;; Is there such an article? - ((and (gnus-summary-search-forward unread subject backward) - (or (gnus-summary-display-article (gnus-summary-article-number)) - (eq (gnus-summary-article-mark) gnus-canceled-mark))) - (gnus-summary-position-point)) - ;; If not, we try the first unread, if that is wanted. - ((and subject - gnus-auto-select-same - (gnus-summary-first-unread-article)) - (gnus-summary-position-point) - (gnus-message 6 "Wrapped")) - ;; Try to get next/previous article not displayed in this group. - ((and gnus-auto-extend-newsgroup - (not unread) (not subject)) - (gnus-summary-goto-article - (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end)) - nil (count-lines (point-min) (point)))) - ;; Go to next/previous group. - (t - (unless (gnus-ephemeral-group-p gnus-newsgroup-name) - (gnus-summary-jump-to-group gnus-newsgroup-name)) - (let ((cmd last-command-event) - (point - (with-current-buffer gnus-group-buffer - (point))) - (current-summary (current-buffer)) - (group - (if (eq gnus-keep-same-level 'best) - (gnus-summary-best-group gnus-newsgroup-name) - (gnus-summary-search-group backward gnus-keep-same-level)))) - ;; Select next unread newsgroup automagically. - (cond - ((or (not gnus-auto-select-next) - (not cmd)) - (unless (eq gnus-auto-select-next 'quietly) - (gnus-message 6 "No more%s articles" (if unread " unread" "")))) - ((or (eq gnus-auto-select-next 'quietly) - (and (eq gnus-auto-select-next 'slightly-quietly) - push) - (and (eq gnus-auto-select-next 'almost-quietly) - (gnus-summary-last-article-p))) - ;; Select quietly. - (if (gnus-ephemeral-group-p gnus-newsgroup-name) - (gnus-summary-exit) - (unless (eq gnus-auto-select-next 'quietly) - (gnus-message 6 "No more%s articles (%s)..." - (if unread " unread" "") - (if group (concat "selecting " group) - "exiting"))) - (gnus-summary-next-group nil group backward))) - (t - (when (numberp last-input-event) - ;; Somehow or other, we may now have selected a different - ;; window. Make point go back to the summary buffer. - (when (eq current-summary (current-buffer)) - ;; FIXME: This burps when get-buffer-window returns nil. - (select-window (get-buffer-window current-summary 0))) - (gnus-summary-walk-group-buffer - gnus-newsgroup-name cmd unread backward point)))))))) + (gnus-summary-assume-in-summary + (cond + ;; Is there such an article? + ((and (gnus-summary-search-forward unread subject backward) + (or (gnus-summary-display-article (gnus-summary-article-number)) + (eq (gnus-summary-article-mark) gnus-canceled-mark))) + (gnus-summary-position-point)) + ;; If not, we try the first unread, if that is wanted. + ((and subject + gnus-auto-select-same + (gnus-summary-first-unread-article)) + (gnus-summary-position-point) + (gnus-message 6 "Wrapped")) + ;; Try to get next/previous article not displayed in this group. + ((and gnus-auto-extend-newsgroup + (not unread) (not subject)) + (gnus-summary-goto-article + (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end)) + nil (count-lines (point-min) (point)))) + ;; Go to next/previous group. + (t + (unless (gnus-ephemeral-group-p gnus-newsgroup-name) + (gnus-summary-jump-to-group gnus-newsgroup-name)) + (let ((cmd last-command-event) + (point + (with-current-buffer gnus-group-buffer + (point))) + (current-summary (current-buffer)) + (group + (if (eq gnus-keep-same-level 'best) + (gnus-summary-best-group gnus-newsgroup-name) + (gnus-summary-search-group backward gnus-keep-same-level)))) + ;; Select next unread newsgroup automagically. + (cond + ((or (not gnus-auto-select-next) + (not cmd)) + (unless (eq gnus-auto-select-next 'quietly) + (gnus-message 6 "No more%s articles" (if unread " unread" ""))= )) + ((or (eq gnus-auto-select-next 'quietly) + (and (eq gnus-auto-select-next 'slightly-quietly) + push) + (and (eq gnus-auto-select-next 'almost-quietly) + (gnus-summary-last-article-p))) + ;; Select quietly. + (if (gnus-ephemeral-group-p gnus-newsgroup-name) + (gnus-summary-exit) + (unless (eq gnus-auto-select-next 'quietly) + (gnus-message 6 "No more%s articles (%s)..." + (if unread " unread" "") + (if group (concat "selecting " group) + "exiting"))) + (gnus-summary-next-group nil group backward))) + (t + (when (numberp last-input-event) + ;; Somehow or other, we may now have selected a different + ;; window. Make point go back to the summary buffer. + (when (eq current-summary (current-buffer)) + ;; FIXME: This burps when get-buffer-window returns nil. + (select-window (get-buffer-window current-summary 0))) + (gnus-summary-walk-group-buffer + gnus-newsgroup-name cmd unread backward point))))))))) =20 (defun gnus-summary-walk-group-buffer (_from-group cmd unread backward sta= rt) (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1)) @@ -7909,7 +7712,6 @@ gnus-summary-next-page =20 Also see the variable `gnus-article-skip-boring'." (interactive "P" gnus-summary-mode) - (gnus-set-global-variables) (let ((article (gnus-summary-article-number)) (article-window (get-buffer-window gnus-article-buffer t)) endp) @@ -9333,7 +9135,6 @@ gnus-summary-enter-digest-group params) ;; Couldn't select this doc group. (switch-to-buffer buf) - (gnus-set-global-variables) (gnus-configure-windows 'summary) (gnus-message 3 "Article couldn't be entered?")) (kill-buffer dig))))) @@ -10681,7 +10482,6 @@ gnus-summary-edit-article (with-current-buffer gnus-summary-buffer (let ((mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)) - (gnus-set-global-variables) (when (and (not force) (gnus-group-read-only-p)) (error "The current newsgroup does not support article editing")) @@ -11591,6 +11391,7 @@ gnus-summary-catchup gnus-catchup-mark) (while (gnus-summary-find-next (not all)) (gnus-summary-mark-article-as-read gnus-catchup-mark))) + (when (gnus-summary-first-subject (not all)) (while (and (if to-here (< (point) to-here) t) @@ -11639,8 +11440,8 @@ gnus-summary-catchup-and-exit (when (gnus-summary-catchup all quietly nil 'fast) ;; Select next newsgroup or exit. (if (and (not (gnus-group-quit-config gnus-newsgroup-name)) - (eq gnus-auto-select-next 'quietly)) - (gnus-summary-next-group nil) + (eq gnus-auto-select-next 'quietly)) + (gnus-summary-next-group nil) (gnus-summary-exit)))) =20 (defun gnus-summary-catchup-all-and-exit (&optional quietly) @@ -12143,8 +11944,6 @@ gnus-summary-sort thread (lambda (t1 t2) (funcall thread t2 t1)))) - (gnus-sort-gathered-threads-function - gnus-thread-sort-functions) (gnus-article-sort-functions (if (not reverse) article @@ -12881,6 +12680,7 @@ gnus-offer-save-summaries (dolist (buffer (buffer-list)) (when (and (setq buffer (buffer-name buffer)) (string-match "Summary" buffer) + (/=3D (aref buffer 0) ? ) (with-current-buffer buffer ;; We check that this is, indeed, a summary buffer. (and (derived-mode-p 'gnus-summary-mode) diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index b974dff372..6ba2668e9d 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -25,14 +25,10 @@ =20 ;;; Code: =20 -(eval-when-compile (require 'cl-lib)) - (require 'gnus) (require 'gnus-group) (require 'gnus-start) -(require 'gnus-util) -(eval-when-compile - (require 'subr-x)) +(require 'subr-x) =20 (defgroup gnus-topic nil "Group topics." @@ -428,7 +424,7 @@ gnus-group-prepare-topics (and gnus-group-listed-groups (copy-sequence gnus-group-listed-groups)))) =20 - (gnus-update-format-specifications nil 'topic) + (gnus-update-format-specifications 'topic) =20 (when (or (not gnus-topic-alist) (not gnus-topology-checked-p)) diff --git a/lisp/gnus/gnus-undo.el b/lisp/gnus/gnus-undo.el index 64ed2bbad6..c7ba39ed24 100644 --- a/lisp/gnus/gnus-undo.el +++ b/lisp/gnus/gnus-undo.el @@ -43,7 +43,6 @@ =20 ;;; Code: =20 -(require 'gnus-util) (require 'gnus) =20 (defgroup gnus-undo nil diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index be0284515d..d738614584 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -32,11 +32,10 @@ =20 ;;; Code: =20 -(eval-when-compile (require 'cl-lib)) - (require 'seq) (require 'time-date) (require 'text-property-search) +(require 'cl-seq) =20 (defcustom gnus-completing-read-function 'gnus-emacs-completing-read "Function use to do completing read." @@ -104,6 +103,9 @@ gnus-eval-in-buffer-window ,@forms) (select-window ,tempvar))))) =20 +(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))) =20 @@ -547,7 +549,7 @@ gnus-parent-id (when (and references (not (zerop (length references)))) (if n - (let ((ids (inline (gnus-split-references references)))) + (let ((ids (gnus-split-references references))) (while (nthcdr n ids) (setq ids (cdr ids))) (car ids)) @@ -555,10 +557,12 @@ gnus-parent-id (when (string-match "\\(<[^<]+>\\)[ \t]*\\'" references) (match-string 1 references)))))) =20 -(defsubst gnus-buffer-live-p (buffer) +(defsubst gnus-buffer-live-p (buffer-or-name) "If BUFFER names a live buffer, return its object; else nil." - (and buffer (buffer-live-p (setq buffer (get-buffer buffer))) - buffer)) + (when-let* ((buffer-or-name buffer-or-name) + (buffer (get-buffer buffer-or-name))) + (when (buffer-live-p buffer) + buffer))) =20 (define-obsolete-function-alias 'gnus-buffer-exists-p 'gnus-buffer-live-p "27.1") @@ -602,21 +606,7 @@ gnus-copy-file (setq to (read-file-name "Copy file to: " default-directory))) (copy-file file to)) =20 -(defvar gnus-work-buffer " *gnus work*") - (declare-function gnus-get-buffer-create "gnus" (name)) -;; gnus.el requires mm-util. -(declare-function mm-enable-multibyte "mm-util") - -(defun gnus-set-work-buffer () - "Put point in the empty Gnus work buffer." - (if (get-buffer gnus-work-buffer) - (progn - (set-buffer gnus-work-buffer) - (erase-buffer)) - (set-buffer (gnus-get-buffer-create gnus-work-buffer)) - (kill-all-local-variables) - (mm-enable-multibyte))) =20 (defmacro gnus-group-real-name (group) "Find the real name of a foreign newsgroup." @@ -749,14 +739,7 @@ gnus-delete-file (when (file-exists-p file) (delete-file file))) =20 -(defun gnus-delete-duplicates (list) - "Remove duplicate entries from LIST." - (let ((result nil)) - (while list - (unless (member (car list) result) - (push (car list) result)) - (pop list)) - (nreverse result))) +(defalias 'gnus-delete-duplicates #'delete-dups) =20 (defun gnus-delete-directory (directory) "Delete files in DIRECTORY. Subdirectories remain. @@ -1209,6 +1192,10 @@ gnus-string-equal (or (string-equal x y) (string-equal (downcase x) (downcase y))))) =20 +(defmacro gnus-assign-former-global (var val buffer) + "Will rename this." + `(setf (buffer-local-value ,var ,buffer) ,val)) + (defcustom gnus-use-byte-compile t "If non-nil, byte-compile crucial run-time code." :type 'boolean @@ -1676,6 +1663,18 @@ gnus-kill-all-overlays (while overlays (delete-overlay (pop overlays))))) =20 +(defmacro gnus-with-temp-buffer (&rest forms) + "Formerly gnus-set-work-buffer. Relay buffer-locals to temp buffer." + (declare (indent defun)) + `(let ((gnus-vars (cl-remove-if-not + (lambda (entry) + (zerop (or (cl-search "gnus-" (symbol-name (car ent= ry))) + -1))) + (buffer-local-variables)))) + (with-temp-buffer + (mapc (lambda (v) (set (make-local-variable (car v)) (cdr v))) gnus= -vars) + ,@forms))) + (provide 'gnus-util) =20 ;;; gnus-util.el ends here diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index ceb2ebcdcb..4a2f957241 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -26,8 +26,6 @@ =20 ;;; Code: =20 -(eval-when-compile (require 'cl-lib)) - (require 'gnus) (require 'gnus-art) (require 'message) diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el index 8ac4e39fa5..7a799c1de6 100644 --- a/lisp/gnus/gnus-win.el +++ b/lisp/gnus/gnus-win.el @@ -24,11 +24,9 @@ =20 ;;; Code: =20 -(eval-when-compile (require 'cl-lib)) - (require 'gnus) -(require 'gnus-util) -(require 'seq) + +(declare-function gnus-group-name-at-point "gnus-group") =20 (defgroup gnus-windows nil "Window configuration." @@ -237,7 +235,28 @@ gnus-window-to-buffer-helper nil))) =20 (defun gnus-configure-frame (split &optional window) - "Split WINDOW according to SPLIT." + "TODO: rewrite `gnus-win.el' to be less opinionated. + +It's not ideal to maintain hardcoded maps like `gnus-window-to-buffer' +and `gnus-buffer-configuration'." + (gnus-configure--frame + (progn + (when-let* ((what (cdr (assq (car split) gnus-window-to-buffer))) + (buf (gnus-window-to-buffer-helper what)) + (dead-buf (and (bufferp buf) (not (buffer-live-p buf))))) + (if-let* ((live-buf (gnus-buffer-live-p gnus-group-buffer)) + (group (with-current-buffer live-buf + (gnus-group-name-at-point)))) + (setcar split + (gnus-summary-buffer-name group)) + (error "No group at point"))) + split) + window)) + +(defun gnus-configure--frame (split &optional window) + "Split WINDOW according to SPLIT. + +Formerly `gnus-configure-frame'. Wasn't thread-safe." (let* ((current-window (or (get-buffer-window (current-buffer)) (selected-window))) (window (or window current-window))) @@ -263,7 +282,7 @@ gnus-configure-frame ;; This is a buffer to be selected. ((not (memq type '(frame horizontal vertical))) (let ((buffer (cond ((stringp type) type) - (t (cdr (assq type gnus-window-to-buffer)))))) + (t (cdr (assq type gnus-window-to-buffer)))))) (unless buffer (error "Invalid buffer type: %s" type)) (let ((buf (gnus-get-buffer-create @@ -374,9 +393,7 @@ gnus-frame-split-p =20 (defun gnus-configure-windows (setting &optional force) (cond - ((null setting) - ;; Do nothing. - ) + ((null setting)) ((window-configuration-p setting) (set-window-configuration setting)) (t @@ -403,14 +420,14 @@ gnus-configure-windows (unless (gnus-buffer-live-p nntp-server-buffer) (nnheader-init-server-buffer)) =20 - ;; Remove all 'window-atom parameters, as we're going to blast - ;; and recreate the window layout. - (when (window-parameter nil 'window-atom) - (let ((root (window-atom-root))) - (walk-window-subtree - (lambda (win) - (set-window-parameter win 'window-atom nil)) - root t))) + ;; Remove all 'window-atom parameters, as we're going to blast + ;; and recreate the window layout. + (when (window-parameter nil 'window-atom) + (let ((root (window-atom-root))) + (walk-window-subtree + (lambda (win) + (set-window-parameter win 'window-atom nil)) + root t))) =20 ;; Either remove all windows or just remove all Gnus windows. (let ((frame (selected-frame))) @@ -434,11 +451,11 @@ gnus-configure-windows (gnus-configure-frame split) (run-hooks 'gnus-configure-windows-hook) =20 - ;; If we're using atomic windows, and the current frame has - ;; multiple windows, make them atomic. - (when (and gnus-use-atomic-windows - (window-parent (selected-window))) - (window-make-atom (window-parent (selected-window)))) + ;; If we're using atomic windows, and the current frame has + ;; multiple windows, make them atomic. + (when (and gnus-use-atomic-windows + (window-parent (selected-window))) + (window-make-atom (window-parent (selected-window)))) =20 (when gnus-window-frame-focus (select-frame-set-input-focus diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 7dde799a5b..ac252a043b 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -6,7 +6,7 @@ ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen ;; Keywords: news, mail -;; Version: 5.13 +;; Version: 5.14pre =20 ;; This file is part of GNU Emacs. =20 @@ -29,12 +29,11 @@ =20 (run-hooks 'gnus-load-hook) =20 -(eval-when-compile (require 'cl-lib) - (require 'subr-x)) +(require 'gnus-util) (require 'wid-edit) (require 'mm-util) (require 'nnheader) -(require 'seq) +(require 'subr-x) =20 ;; These are defined afterwards with gnus-define-group-parameter (defvar gnus-ham-process-destinations) @@ -296,7 +295,7 @@ gnus-dbus "D-Bus integration for Gnus." :group 'gnus) =20 -(defconst gnus-version-number "5.13" +(defconst gnus-version-number "5.14pre" "Version number for this version of Gnus.") =20 (defconst gnus-version (format "Gnus v%s" gnus-version-number) @@ -850,9 +849,6 @@ gnus-splash-svg-color-symbols =20 ;;; Do the rest. =20 -(require 'gnus-util) -(require 'nnheader) - (defcustom gnus-parameters nil "Alist of group parameters. =20 @@ -1024,35 +1020,29 @@ gnus-getenv-nntpserver ;; starting or even loading Gnus. ;;;###autoload(custom-autoload 'gnus-select-method "gnus") =20 +(defvar gnus-secondary-select-methods) +(defvar gnus-select-methods) (defcustom gnus-select-method - (list 'nntp (or (gnus-getenv-nntpserver) - (when (and gnus-default-nntp-server - (not (string=3D gnus-default-nntp-server ""))) - gnus-default-nntp-server) - "news")) - "Default method for selecting a newsgroup. -This variable should be a list, where the first element is how the -news is to be fetched, the second is the address. - -For instance, if you want to get your news via \"flab.flab.edu\" using -NNTP, you could say: - -\(setq gnus-select-method \\=3D'(nntp \"flab.flab.edu\")) - -If you want to use your local spool, say: - -\(setq gnus-select-method (list \\=3D'nnspool (system-name))) - -If you use this variable, you must set `gnus-nntp-server' to nil. - -There is a lot more to know about select methods and virtual servers - -see the manual for details." - ;; Emacs has set-after since 22.1. - ;set-after '(gnus-default-nntp-server) + (if-let ((nntp (or (gnus-getenv-nntpserver) + (unless (zerop (length gnus-default-nntp-server)) + gnus-default-nntp-server)))) + `(nntp ,nntp) + '(nnnil "")) + "This variable is deprecated in favor of `gnus-select-methods'." :group 'gnus-server :group 'gnus-start :initialize 'custom-initialize-default + :set (lambda (symbol value) + (set-default symbol value) + (setq gnus-select-methods (cons value gnus-secondary-select-metho= ds))) :type 'gnus-select-method) +(make-obsolete-variable 'gnus-select-method 'gnus-select-methods "28.1" 's= et) +(add-variable-watcher + 'gnus-select-method + (lambda (symbol newval operation _where) + (pcase operation + ((or 'set 'let 'unlet) + (custom-set-variables `(,symbol (quote ,newval))))))) =20 (defcustom gnus-message-archive-method "archive" "Method used for archiving messages you've sent. @@ -1119,16 +1109,67 @@ gnus-secondary-servers (make-obsolete-variable 'gnus-secondary-servers 'gnus-select-method "24.1") =20 (defcustom gnus-secondary-select-methods nil - "A list of secondary methods that will be used for reading news. -This is a list where each element is a complete select method (see -`gnus-select-method'). - -If, for instance, you want to read your mail with the nnml back end, -you could set this variable: - -\(setq gnus-secondary-select-methods \\=3D'((nnml \"\")))" + "This variable is deprecated in favor of `gnus-select-methods'." :group 'gnus-server + :set (lambda (symbol value) + (set-default symbol value) + (setq gnus-select-methods (cons gnus-select-method value))) + :type '(repeat gnus-select-method)) +(make-obsolete-variable 'gnus-secondary-select-methods 'gnus-select-method= s "28.1" 'set) +(add-variable-watcher + 'gnus-secondary-select-methods + (lambda (symbol newval operation _where) + (pcase operation + ((or 'set 'let 'unlet) + (custom-set-variables `(,symbol (quote ,newval))))))) + +(defcustom gnus-select-methods (cons gnus-select-method gnus-secondary-sel= ect-methods) + "((BACKEND1 SERVER1) (BACKEND2 SERVER2) ... ) where BACKEND is a symbol,= e.g., +nntp, and SERVER is a string, e.g., \"news.gmane.io\". + +For example, these settings specify gmane over nntp, and a home +dovecot imap server. + +Method: nntp +Server: \"news.gmane.io\" + +Method: nnimap +Server: \"dovecot\" +Options: +Variable: nnimap-address + Value: \"localhost\" +Variable: nnimap-stream + Value: network +Variable: nnimap-server-port + Value: 143 +Variable: nnimap-inbox + Value: \"INBOX\" + +Or equivalently, + +\(custom-set-variables \\=3D`(gnus-select-methods + \\=3D'((nntp \"news.gmane.io\") + (nnimap \"dovecot\" + (nnimap-address \"localhost\") + (nnimap-stream network) + (nnimap-server-port 143) + (nnimap-inbox \"INBOX\"))))) +" + :group 'gnus-server + :initialize 'custom-initialize-default + :set (lambda (symbol value) + (unless (listp (car value)) + (setq value (list value))) + (set-default symbol value) + (setq gnus-select-method (car value)) + (setq gnus-secondary-select-methods (cdr value))) :type '(repeat gnus-select-method)) +(add-variable-watcher + 'gnus-select-methods + (lambda (symbol newval operation _where) + (pcase operation + ((or 'set 'let 'unlet) + (custom-set-variables `(,symbol (quote ,newval))))))) =20 (defcustom gnus-local-domain nil "Local domain name without a host name. @@ -1396,7 +1437,7 @@ gnus-redefine-select-method-widget (intern (car entry)))) gnus-valid-select-methods) (symbol :tag "other")) - (string :tag "Address") + (string :tag "Server") (repeat :tag "Options" :inline t (list :format "%v" @@ -2309,8 +2350,8 @@ gnus-agent-method-p-cache (defvar gnus-agent-target-move-group-header "X-Gnus-Agent-Move-To") (defvar gnus-draft-meta-information-header "X-Draft-From") (defvar gnus-group-get-parameter-function #'gnus-group-get-parameter) -(defvar gnus-original-article-buffer " *Original Article*") -(defvar gnus-newsgroup-name nil) +(defvar-local gnus-original-article-buffer " *Original Article*") +(defvar-local gnus-newsgroup-name nil) (defvar gnus-ephemeral-servers nil) (defvar gnus-server-method-cache nil) (defvar gnus-extended-servers nil) @@ -2422,8 +2463,8 @@ gnus-info-nodes (gnus-tree-mode "(gnus)Tree Display")) "Alist of major modes and related Info nodes.") =20 -(defvar gnus-summary-buffer "*Summary*") -(defvar gnus-article-buffer "*Article*") +(defvar-local gnus-summary-buffer nil) +(defvar-local gnus-article-buffer "*Article*") (defvar gnus-server-buffer "*Server*") =20 (defvar gnus-child nil @@ -2487,7 +2528,7 @@ gnus-moderated-hashtb ;; Save window configuration. (defvar gnus-prev-winconf nil) =20 -(defvar gnus-reffed-article-number nil) +(defvar-local gnus-reffed-article-number -1) =20 (defvar gnus-dead-summary nil) =20 @@ -2956,7 +2997,7 @@ gnus-continuum-version "Return VERSION as a floating point number." (unless version (setq version gnus-version)) - (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version) + (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)\\S-*$" vers= ion) (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version)) (let ((alpha (and (match-beginning 1) (match-string 1 version))) (number (match-string 2 version)) @@ -3454,9 +3495,13 @@ gnus-group-prefixed-p "Return the prefix of the current group name." (< 0 (length (gnus-group-real-prefix group)))) =20 -(defun gnus-summary-buffer-name (group) +(defun gnus-summary-buffer-name (group &optional canonical) "Return the summary buffer name of GROUP." - (concat "*Summary " group "*")) + (let ((name (concat "*Summary " group "*")) + (main-thread-p (eq (current-thread) main-thread))) + (if (or canonical main-thread-p) + name + (format " %s %s" (thread-name (current-thread)) name)))) =20 (defun gnus-group-method (group) "Return the server or method used for selecting GROUP. @@ -3490,10 +3535,10 @@ gnus-native-method-p (defsubst gnus-secondary-method-p (method) "Return whether METHOD is a secondary select method." (let ((methods gnus-secondary-select-methods) - (gmethod (inline (gnus-server-get-method nil method)))) + (gmethod (gnus-server-get-method nil method))) (while (and methods (not (gnus-method-equal - (inline (gnus-server-get-method nil (car methods))) + (gnus-server-get-method nil (car methods)) gmethod))) (setq methods (cdr methods))) methods)) @@ -3870,7 +3915,7 @@ gnus-server-extend-method ;; "hello", and the select method is ("hello" (my-var "something")) ;; in the group "alt.alt", this will result in a new virtual server ;; called "hello+alt.alt". - (if (or (not (inline (gnus-similar-server-opened method))) + (if (or (not (gnus-similar-server-opened method)) (not (cddr method))) method (let ((address-slot @@ -3942,12 +3987,11 @@ gnus-find-method-for-group gnus-select-method (setq method (cond ((stringp method) - (inline (gnus-server-to-method method))) + (gnus-server-to-method method)) ((stringp (cadr method)) (or - (inline - (gnus-same-method-different-name method)) - (inline (gnus-server-extend-method group method)))) + (gnus-same-method-different-name method) + (gnus-server-extend-method group method))) (t method))) (cond ((equal (cadr method) "") @@ -4026,7 +4070,7 @@ gnus-read-method ((assoc method gnus-valid-select-methods) (let ((address (if (memq 'prompt-address (assoc method gnus-valid-select-methods)) - (read-string "Address: ") + (read-string "Server: ") ""))) (or (cadr (assoc (format "%s:%s" method address) open-servers)) (list (intern method) address)))) @@ -4160,14 +4204,6 @@ gnus startup level. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use." (interactive "P") - ;; When using the development version of Gnus, load the gnus-load - ;; file. - (unless (string-match "^Gnus" gnus-version) - (load "gnus-load" nil t)) - (unless (or (byte-code-function-p (symbol-function 'gnus)) - (subr-native-elisp-p (symbol-function 'gnus))) - (message "You should compile Gnus") - (sit-for 2)) (let ((gnus-action-message-log (list nil))) (gnus-1 arg dont-connect child) (gnus-final-warning))) diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el index 4f800891b2..bc62349c2c 100644 --- a/lisp/gnus/legacy-gnus-agent.el +++ b/lisp/gnus/legacy-gnus-agent.el @@ -26,7 +26,6 @@ =20 ;;; Code: (require 'gnus-start) -(require 'gnus-util) (require 'gnus-range) (require 'gnus-agent) =20 diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 02db38725a..db996e8192 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -5119,6 +5119,7 @@ message-insert-canlock (autoload 'nnheader-get-report "nnheader") =20 (declare-function gnus-setup-posting-charset "gnus-msg" (group)) +(declare-function gnus-msg-inherit-variables "gnus-msg" (source-buffer des= t-buffer)) =20 (defun message-send-news (&optional arg) (require 'gnus-msg) @@ -6649,8 +6650,7 @@ message-pop-to-buffer "Message already being composed; erase? ") (message nil)))) (error "Message being composed"))) - (funcall (or switch-function 'pop-to-buffer-same-window) - name) + (funcall (or switch-function 'pop-to-buffer-same-window) name) (set-buffer name)) (erase-buffer) (message-mode))) @@ -7299,7 +7299,9 @@ message-followup (setq subject (concat "Re: " (message-simplify-subject subject))) (widen)) =20 - (message-pop-to-buffer (message-buffer-name "followup" from newsgroups= )) + (let ((before-pop (current-buffer))) + (message-pop-to-buffer (message-buffer-name "followup" from newsgrou= ps)) + (gnus-msg-inherit-variables before-pop (current-buffer))) =20 (setq message-reply-headers (make-full-mail-header diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index 2de5b83a7b..53a7be4cd7 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -33,7 +33,6 @@ (require 'nnmail) (require 'nnoo) (require 'gnus) -(require 'gnus-util) (require 'gnus-range) =20 ;; FIXME not explicitly used in this file. diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 708887cb9c..43a86ba8e1 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -26,20 +26,13 @@ =20 ;;; Code: =20 -(eval-when-compile (require 'cl-lib)) - (defvar gnus-decode-encoded-word-function) (defvar gnus-decode-encoded-address-function) (defvar gnus-alter-header-function) - (defvar nnmail-extra-headers) (defvar gnus-newsgroup-name) (defvar jka-compr-compression-info-list) =20 -;; Requiring `gnus-util' at compile time creates a circular -;; dependency between nnheader.el and gnus-util.el. -;;(eval-when-compile (require 'gnus-util)) - (require 'mail-utils) (require 'mm-util) (require 'gnus-util) @@ -559,11 +552,10 @@ nnheader-callback-function =20 (autoload 'gnus-get-buffer-create "gnus") =20 -(defun nnheader-init-server-buffer () - "Initialize the Gnus-backend communication buffer." - (unless (gnus-buffer-live-p nntp-server-buffer) - (setq nntp-server-buffer (gnus-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-buff= er' and +`gnus-thread-body'." + (with-current-buffer buffer (erase-buffer) (mm-enable-multibyte) (kill-all-local-variables) @@ -571,6 +563,12 @@ nnheader-init-server-buffer (setq-local nntp-process-response nil) t)) =20 +(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. =20 (defun nnheader-file-error (file) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 3e2a202a6c..fe0b79870b 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -26,21 +26,37 @@ =20 ;;; Code: =20 -(eval-when-compile - (require 'cl-lib) - (require 'subr-x)) - (require 'nnheader) -(require 'gnus-util) (require 'gnus) (require 'nnoo) (require 'netrc) (require 'utf7) (require 'nnmail) +(require 'cl-seq) =20 (autoload 'auth-source-forget+ "auth-source") (autoload 'auth-source-search "auth-source") =20 +(declare-function x-server-version "xfns.c" (&optional terminal)) + +(defmacro nnimap-with-context (buffer &rest body) + (declare (indent defun)) + `(with-current-buffer ,buffer ,@body)) + +(defmacro nnimap-for-process-buffers (b &rest body) + (declare (indent defun)) + `(cl-flet ((match + (buf) + (let* ((regex* (mapconcat + #'identity + (mapcar #'regexp-quote + (split-string nnimap--process-buffer= -fmt "%s")) + ".*")) + (regex (format "^%s$" regex*))) + (string-match-p regex (buffer-name buf))))) + (dolist (,b (seq-filter #'match (gnus-buffers))) + ,@body))) + (nnoo-declare nnimap) =20 (defvoo nnimap-address nil @@ -123,8 +139,6 @@ nnimap-streaming Switching this off will make nnimap slower, but it helps with some servers.") =20 -(defvoo nnimap-connection-alist nil) - (defvoo nnimap-current-infos nil) =20 (defvoo nnimap-namespace nil) @@ -174,7 +188,6 @@ nnimap-process (defvar nnimap-status-string "") =20 (defvar nnimap-keepalive-timer nil) -(defvar nnimap-process-buffers nil) =20 (cl-defstruct nnimap group process commands capabilities select-result newlinep server @@ -199,10 +212,29 @@ nnimap-quirks =20 (defvar nnimap-inhibit-logging nil) =20 +(defconst nnimap--process-buffer-fmt " *nnimap %s*") + +(defun nnimap-assert-context (&optional dont-assert) + (let ((result (cl-every (lambda (v) (and (boundp v) v)) + '(nnimap-address nnimap-server-port)))) + (prog1 result + (unless dont-assert + (cl-assert result))))) + +(defsubst nnimap-process-buffer-key () + (nnimap-assert-context) + (format nnimap--process-buffer-fmt + (mapconcat (apply-partially #'format "%s") + (list + (nnoo-current-server 'nnimap) + nnimap-address + nnimap-server-port) + " "))) + (defun nnimap-group-to-imap (group) "Convert Gnus group name to IMAP mailbox name." - (let* ((inbox (if nnimap-namespace - (substring nnimap-namespace 0 -1) nil))) + (let ((inbox (when nnimap-namespace + (substring nnimap-namespace 0 -1)))) (utf7-encode (cond ((or (not inbox) (string-equal group inbox)) @@ -210,10 +242,13 @@ nnimap-group-to-imap ((string-prefix-p "#" group) (substring group 1)) (t - (concat nnimap-namespace group))) t))) + (concat nnimap-namespace group))) + t))) =20 -(defun nnimap-buffer () - (nnimap-find-process-buffer nntp-server-buffer)) +(defalias 'nnimap-buffer #'nnimap-process-buffer) +(defun nnimap-process-buffer () + + (nnimap-get-process-buffer (nnimap-process-buffer-key))) =20 (defun nnimap-header-parameters () (let (params) @@ -233,10 +268,10 @@ nnimap-header-parameters (format "%s" (nreverse params)))) =20 (deffoo nnimap-retrieve-headers (articles &optional group server _fetch-ol= d) - (with-current-buffer nntp-server-buffer + (nnimap-with-context nntp-server-buffer (erase-buffer) (when (nnimap-change-group group server) - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (erase-buffer) (nnimap-wait-for-response (nnimap-send-command @@ -248,8 +283,7 @@ nnimap-retrieve-headers (error "Server closed connection")) (nnimap-transform-headers) (nnheader-remove-cr-followed-by-lf)) - (insert-buffer-substring - (nnimap-find-process-buffer (current-buffer)))) + (insert-buffer-substring (nnimap-process-buffer))) 'headers)) =20 (defun nnimap-transform-headers () @@ -366,32 +400,35 @@ nnimap-article-ranges result)) (mapconcat #'identity (nreverse result) ","))))) =20 -(deffoo nnimap-open-server (server &optional defs no-reconnect) - (if (nnimap-server-opened server) - t - (unless (assq 'nnimap-address defs) - (setq defs (append defs (list (list 'nnimap-address server))))) - (nnoo-change-server 'nnimap server defs) - (if no-reconnect - (nnimap-find-connection nntp-server-buffer) - (or (nnimap-find-connection nntp-server-buffer) - (nnimap-open-connection nntp-server-buffer))))) - -(defun nnimap-make-process-buffer (buffer) - (with-current-buffer - (generate-new-buffer (format " *nnimap %s %s %s*" - nnimap-address nnimap-server-port - buffer)) - (mm-disable-multibyte) - (buffer-disable-undo) - (gnus-add-buffer) - (setq-local after-change-functions nil) ;FIXME: Why? - (setq-local nnimap-object - (make-nnimap :server (nnoo-current-server 'nnimap) - :initial-resync 0)) - (push (list buffer (current-buffer)) nnimap-connection-alist) - (push (current-buffer) nnimap-process-buffers) - (current-buffer))) +(deffoo nnimap-open-server (server &optional defs _no-reconnect) + "Context switch based on SERVER. + +If `nnoo-current-server-p' is false for SERVER, +`nnoo-change-server' replaces the current context in `nnoo-state-alist' +with DEFS. And does so for all parent classes of nnimap. + +This imagined necessity of a back-line assoc list called `nnoo-state-alist' +was of course another \"youthful indiscretion.\" He just had to augment +the key of the front-line assoc list to incorporate SERVER." + (nnoo-change-server 'nnimap server defs) + (nnimap-server-opened server)) + +(defun nnimap-make-process-buffer (server process-buffer-key) + (nnimap-assert-context) + (let ((nnimap-vars (cl-remove-if-not + (lambda (entry) + (zerop (or (cl-search "nnimap-" (symbol-name (car = entry))) + -1))) + (buffer-local-variables)))) + (with-current-buffer (get-buffer-create process-buffer-key t) + (prog1 (current-buffer) + (mm-disable-multibyte) + (buffer-disable-undo) + (gnus-add-buffer) + (cl-assert (null after-change-functions)) + (mapc (lambda (v) (set (make-local-variable (car v)) (cdr v))) nni= map-vars) + (setq-local nnimap-object (make-nnimap :server server + :initial-resync 0)))))) =20 (defvar auth-source-creation-prompts) =20 @@ -418,173 +455,172 @@ nnimap-keepalive (let ((now (current-time)) ;; Set this so we don't wait for a response. (nnimap-streaming t)) - (dolist (buffer nnimap-process-buffers) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (when (and nnimap-object - (nnimap-last-command-time nnimap-object) - (time-less-p - (cdr nnimap-keepalive-intervals) - (time-subtract - now - (nnimap-last-command-time nnimap-object)))) - (with-local-quit - (ignore-errors ;E.g. "buffer foo has no process". - (nnimap-send-command "NOOP"))))))))) - -(defun nnimap-open-connection (buffer) - ;; Be backwards-compatible -- the earlier value of nnimap-stream was - ;; `ssl' when nnimap-server-port was nil. Sort of. + (nnimap-for-process-buffers buffer + (with-current-buffer buffer + (when (and nnimap-object + (nnimap-last-command-time nnimap-object) + (time-less-p + (cdr nnimap-keepalive-intervals) + (time-subtract + now + (nnimap-last-command-time nnimap-object)))) + (with-local-quit + (ignore-errors (nnimap-send-command "NOOP")))))))) + +(defun nnimap-open-connection (process-buffer-key) + (nnimap-assert-context) (when (and nnimap-server-port (eq nnimap-stream 'undecided)) (setq nnimap-stream 'ssl)) (let ((stream (if (eq nnimap-stream 'undecided) (cl-loop for type in '(ssl network) - for stream =3D (let ((nnimap-stream type)) - (nnimap-open-connection-1 buffer)) - while (eq stream 'no-connect) - finally (return stream)) - (nnimap-open-connection-1 buffer)))) - (if (eq stream 'no-connect) - nil + for stream =3D (let ((nnimap-stream type)) + (nnimap-open-connection-1 process-buffer-key)) + while (eq stream 'no-connect) + finally (return stream)) + (nnimap-open-connection-1 process-buffer-key)))) + (unless (eq stream 'no-connect) stream))) =20 -;; This is only needed for Windows XP or earlier -(defun nnimap-map-port (port) - (declare-function x-server-version "xfns.c" (&optional terminal)) - (if (and (eq system-type 'windows-nt) - (<=3D (car (x-server-version)) 5) - (equal port "imaps")) - "993" - port)) - -(defun nnimap-open-connection-1 (buffer) - (unless (or nnimap-keepalive-timer - (null nnimap-keepalive-intervals)) - (setq nnimap-keepalive-timer (run-at-time - (car nnimap-keepalive-intervals) - (car nnimap-keepalive-intervals) - #'nnimap-keepalive))) - (with-current-buffer (nnimap-make-process-buffer buffer) +(defun nnimap-open-connection-1 (process-buffer-key) + (nnimap-assert-context) + (setq nnimap-keepalive-timer + (or nnimap-keepalive-timer + (when nnimap-keepalive-intervals + (run-at-time + (car nnimap-keepalive-intervals) + (car nnimap-keepalive-intervals) + #'nnimap-keepalive)))) + ;; Assert commit f33a5dc no longer necessary + (when (eq system-type 'windows-nt) + (cl-assert (> (car (x-server-version)) 5))) + (with-current-buffer + (nnimap-make-process-buffer + (nnoo-current-server 'nnimap) + process-buffer-key) (let* ((coding-system-for-read 'binary) (coding-system-for-write 'binary) (ports - (cond - ((memq nnimap-stream '(network plain starttls)) - (nnheader-message 7 "Opening connection to %s..." - nnimap-address) - '("imap" "143")) - ((eq nnimap-stream 'shell) - (nnheader-message 7 "Opening connection to %s via shell..." - nnimap-address) - '("imap")) - ((memq nnimap-stream '(ssl tls)) - (nnheader-message 7 "Opening connection to %s via tls..." - nnimap-address) - '("imaps" "imap" "993" "143")) - (t - (error "Unknown stream type: %s" nnimap-stream)))) - login-result credentials) - (when nnimap-server-port - (push nnimap-server-port ports)) - (let* ((stream-list - (open-network-stream - "*nnimap*" (current-buffer) nnimap-address - (nnimap-map-port (car ports)) - :type nnimap-stream - :warn-unless-encrypted t - :return-list t - :shell-command nnimap-shell-program - :capability-command "1 CAPABILITY\r\n" - :always-query-capabilities t - :end-of-command "\r\n" - :success " OK " - :starttls-function - (lambda (capabilities) - (when (string-match-p "STARTTLS" capabilities) - "1 STARTTLS\r\n")))) - (stream (car stream-list)) - (props (cdr stream-list)) - (greeting (plist-get props :greeting)) - (capabilities (plist-get props :capabilities)) - (stream-type (plist-get props :type)) - (server (nnoo-current-server 'nnimap))) - (when (and stream (not (memq (process-status stream) '(open run)))) - (setq stream nil)) - - (when (eq (process-type stream) 'network) - ;; Use TCP-keepalive so that connections that pass through a NAT - ;; router don't hang when left idle. - (set-network-process-option stream :keepalive t)) - - (setf (nnimap-process nnimap-object) stream) - (setf (nnimap-stream-type nnimap-object) stream-type) - (if (not stream) - (progn - (nnheader-report 'nnimap "Unable to contact %s:%s via %s" - nnimap-address (car ports) nnimap-stream) - 'no-connect) - (set-process-query-on-exit-flag stream nil) - (if (not (string-match-p "[*.] \\(OK\\|PREAUTH\\)" greeting)) - (nnheader-report 'nnimap "%s" greeting) - ;; Store the greeting (for debugging purposes). - (setf (nnimap-greeting nnimap-object) greeting) - (setf (nnimap-capabilities nnimap-object) - (mapcar #'upcase - (split-string capabilities))) - (unless (string-match-p "[*.] PREAUTH" greeting) - (if (not (setq credentials - (if (eq nnimap-authenticator 'anonymous) - (list "anonymous" - (message-make-address)) - ;; Look for the credentials based on - ;; the virtual server name and the address - (nnimap-credentials - (gnus-delete-duplicates - (list server nnimap-address)) - ports - nnimap-user)))) - (setq nnimap-object nil) - (let ((nnimap-inhibit-logging t)) - (setq login-result - (nnimap-login (car credentials) (cadr credentials)))) - (if (car login-result) - (progn - ;; Save the credentials if a save function exists - ;; (such a function will only be passed if a new - ;; token was created). - (when (functionp (nth 2 credentials)) - (funcall (nth 2 credentials))) - ;; See if CAPABILITY is set as part of login - ;; response. - (dolist (response (cddr (nnimap-command "CAPABILITY"))) - (when (string=3D "CAPABILITY" (upcase (car response))) - (setf (nnimap-capabilities nnimap-object) - (mapcar #'upcase (cdr response))))) - (when (and nnimap-use-namespaces - (nnimap-capability "NAMESPACE")) - (erase-buffer) - (nnimap-wait-for-response (nnimap-send-command "NA= MESPACE")) - (let ((response (nnimap-last-response-string))) - (when (string-match - "^\\*\\W+NAMESPACE\\W+((\"\\([^\"\n]+\\)\= "\\W+\"\\(.\\)\"))\\W+" - response) - (setq nnimap-namespace (match-string 1 respons= e)))))) - ;; If the login failed, then forget the credentials - ;; that are now possibly cached. - (dolist (host (list (nnoo-current-server 'nnimap) - nnimap-address)) - (dolist (port ports) - (auth-source-forget+ :host host :port port))) - (delete-process (nnimap-process nnimap-object)) - (setq nnimap-object nil)))) - (when nnimap-object - (when (nnimap-capability "QRESYNC") - (nnimap-command "ENABLE QRESYNC")) - (nnheader-message 7 "Opening connection to %s...done" - nnimap-address) - (nnimap-process nnimap-object)))))))) + `(,@(when nnimap-server-port (list nnimap-server-port)) + ,@(cl-remove-if + (apply-partially #'equal nnimap-server-port) + (cond + ((memq nnimap-stream '(network plain starttls)) + (nnheader-message 7 "Opening connection to %s..." + nnimap-address) + '("imap" 143)) + ((eq nnimap-stream 'shell) + (nnheader-message 7 "Opening connection to %s via shell..." + nnimap-address) + '("imap")) + ((memq nnimap-stream '(ssl tls)) + (nnheader-message 7 "Opening connection to %s via tls..." + nnimap-address) + '("imaps" "imap" 993 143)) + (t + (error "Unknown stream type: %s" nnimap-stream)))))) + login-result + credentials + (stream-list + (open-network-stream + (let ((muffs "[ \t\n\r*]+")) + (string-trim process-buffer-key muffs muffs)) + (current-buffer) + nnimap-address + (car ports) + :type nnimap-stream + :warn-unless-encrypted t + :return-list t + :shell-command nnimap-shell-program + :capability-command "1 CAPABILITY\r\n" + :always-query-capabilities t + :end-of-command "\r\n" + :success " OK " + :starttls-function + (lambda (capabilities) + (when (string-match-p "STARTTLS" capabilities) + "1 STARTTLS\r\n")))) + (stream (car stream-list)) + (props (cdr stream-list)) + (greeting (plist-get props :greeting)) + (capabilities (plist-get props :capabilities)) + (stream-type (plist-get props :type)) + (server (nnoo-current-server 'nnimap))) + (when (and stream (not (memq (process-status stream) '(open run)))) + (setq stream nil)) + + (when (eq (process-type stream) 'network) + ;; Use TCP-keepalive so that connections that pass through a NAT + ;; router don't hang when left idle. + (set-network-process-option stream :keepalive t)) + + (setf (nnimap-process nnimap-object) stream) + (setf (nnimap-stream-type nnimap-object) stream-type) + (if (not stream) + (prog1 'no-connect + (nnheader-report 'nnimap "Unable to contact %s:%s via %s" + nnimap-address (car ports) nnimap-stream)) + (set-process-query-on-exit-flag stream nil) + (set-process-thread stream nil) + (if (not (string-match-p "[*.] \\(OK\\|PREAUTH\\)" greeting)) + (nnheader-report 'nnimap "%s" greeting) + (setf (nnimap-greeting nnimap-object) greeting) + (setf (nnimap-capabilities nnimap-object) + (mapcar #'upcase + (split-string capabilities))) + (unless (string-match-p "[*.] PREAUTH" greeting) + (if (not (setq credentials + (if (eq nnimap-authenticator 'anonymous) + (list "anonymous" + (message-make-address)) + ;; Look for the credentials based on + ;; the virtual server name and the address + (nnimap-credentials + (gnus-delete-duplicates + (list server nnimap-address)) + ports + nnimap-user)))) + (setq nnimap-object nil) + (let ((nnimap-inhibit-logging t)) + (setq login-result + (nnimap-login (car credentials) (cadr credentials)))) + (if (car login-result) + (progn + ;; Save the credentials if a save function exists + ;; (such a function will only be passed if a new + ;; token was created). + (when (functionp (nth 2 credentials)) + (funcall (nth 2 credentials))) + ;; See if CAPABILITY is set as part of login + ;; response. + (dolist (response (cddr (nnimap-command "CAPABILITY"))) + (when (string=3D "CAPABILITY" (upcase (car response))) + (setf (nnimap-capabilities nnimap-object) + (mapcar #'upcase (cdr response))))) + (when (and nnimap-use-namespaces + (nnimap-capability "NAMESPACE")) + (erase-buffer) + (nnimap-wait-for-response (nnimap-send-command "NAME= SPACE")) + (let ((response (nnimap-last-response-string))) + (when (string-match + "^\\*\\W+NAMESPACE\\W+((\"\\([^\"\n]+\\)\"\= \W+\"\\(.\\)\"))\\W+" + response) + (setq nnimap-namespace (match-string 1 response)= ))))) + ;; If the login failed, then forget the credentials + ;; that are now possibly cached. + (dolist (host (list (nnoo-current-server 'nnimap) + nnimap-address)) + (dolist (port ports) + (auth-source-forget+ :host host :port port))) + (delete-process (nnimap-process nnimap-object)) + (setq nnimap-object nil)))) + (when nnimap-object + (when (nnimap-capability "QRESYNC") + (nnimap-command "ENABLE QRESYNC")) + (nnheader-message 7 "Opening connection to %s...done" + nnimap-address) + (nnimap-process nnimap-object))))))) =20 (autoload 'rfc2104-hash "rfc2104") =20 @@ -656,7 +692,7 @@ nnimap-find-parameter (deffoo nnimap-close-server (&optional server defs) (when (nnoo-change-server 'nnimap server defs) (ignore-errors - (delete-process (get-buffer-process (nnimap-buffer)))) + (delete-process (get-buffer-process (nnimap-process-buffer)))) (nnoo-close-server 'nnimap server) t)) =20 @@ -664,16 +700,13 @@ nnimap-request-close t) =20 (deffoo nnimap-server-opened (&optional server) - (and (nnoo-current-server-p 'nnimap server) - nntp-server-buffer - (gnus-buffer-live-p nntp-server-buffer) - (nnimap-find-connection nntp-server-buffer))) + (nnoo-current-server-p 'nnimap server)) =20 (deffoo nnimap-status-message (&optional _server) nnimap-status-string) =20 (deffoo nnimap-request-article (article &optional group server to-buffer) - (with-current-buffer nntp-server-buffer + (nnimap-with-context nntp-server-buffer (let ((result (nnimap-change-group group server)) parts structure) (when (stringp article) @@ -681,7 +714,7 @@ nnimap-request-article (when (and result article) (erase-buffer) - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (erase-buffer) (when nnimap-fetch-partial-articles (nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article) @@ -705,7 +738,7 @@ nnimap-request-article =20 (deffoo nnimap-request-head (article &optional group server to-buffer) (when (nnimap-change-group group server) - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (when (stringp article) (setq article (nnimap-find-article-by-message-id group server article))) (if (null article) @@ -721,11 +754,11 @@ nnimap-request-head (cons group article))))))) =20 (deffoo nnimap-request-articles (articles &optional group server) - (with-current-buffer nntp-server-buffer + (nnimap-with-context nntp-server-buffer (let ((result (nnimap-change-group group server))) (when result (erase-buffer) - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (erase-buffer) (when (nnimap-command (if (nnimap-ver4-p) @@ -733,7 +766,7 @@ nnimap-request-articles "UID FETCH %s RFC822.PEEK") (nnimap-article-ranges (gnus-compress-sequence articles))) (let ((buffer (current-buffer))) - (with-current-buffer nntp-server-buffer + (nnimap-with-context nntp-server-buffer (nnheader-insert-buffer-substring buffer) (nnheader-ms-strip-cr))) t)))))) @@ -873,14 +906,13 @@ nnimap-request-group (let ((result (nnimap-change-group ;; Don't SELECT the group if we're going to select it ;; later, anyway. - (if (and (not dont-check) - (assoc group nnimap-current-infos)) - nil + (when (or dont-check + (not (assoc group nnimap-current-infos))) group) server)) (info (when info (list info))) active) - (with-current-buffer nntp-server-buffer + (nnimap-with-context nntp-server-buffer (when result (when (or (not dont-check) (not (setq active @@ -902,7 +934,7 @@ nnimap-request-group (deffoo nnimap-request-group-scan (group &optional server info) (when (nnimap-change-group nil server) (let (marks high low) - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (erase-buffer) (let ((group-sequence (nnimap-send-command "SELECT %S" (nnimap-group-to-imap group))) @@ -926,7 +958,7 @@ nnimap-request-group-scan (nth 3 (car marks))) 0) low (or (nth 4 (car marks)) uidnext 1))))) - (with-current-buffer nntp-server-buffer + (nnimap-with-context nntp-server-buffer (erase-buffer) (insert (format @@ -936,17 +968,17 @@ nnimap-request-group-scan =20 (deffoo nnimap-request-create-group (group &optional server _args) (when (nnimap-change-group nil server) - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (car (nnimap-command "CREATE %S" (nnimap-group-to-imap group)))))) =20 (deffoo nnimap-request-delete-group (group &optional _force server) (when (nnimap-change-group nil server) - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (car (nnimap-command "DELETE %S" (nnimap-group-to-imap group)))))) =20 (deffoo nnimap-request-rename-group (group new-name &optional server) (when (nnimap-change-group nil server) - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (nnimap-unselect-group) (car (nnimap-command "RENAME %S %S" (nnimap-group-to-imap group) (nnimap-group-to-imap new-name)))))) @@ -960,13 +992,13 @@ nnimap-unselect-group =20 (deffoo nnimap-request-expunge-group (group &optional server) (when (nnimap-change-group group server) - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (car (nnimap-command "EXPUNGE"))))) =20 (defun nnimap-get-flags (spec) (let ((articles nil) elems end) - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (erase-buffer) (nnimap-wait-for-response (nnimap-send-command "UID FETCH %s FLAGS" spec)) @@ -984,7 +1016,7 @@ nnimap-get-flags (deffoo nnimap-close-group (_group &optional server) (when (eq nnimap-expunge 'on-exit) (nnoo-change-server 'nnimap server nil) - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (nnimap-command "EXPUNGE")))) =20 (deffoo nnimap-request-move-article (article group server accept-form @@ -1000,7 +1032,7 @@ nnimap-request-move-article ;; easy way. (let ((message-id (message-field-value "message-id"))) (if internal-move-group - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (let* ((can-move (and (nnimap-capability "MOVE") (equal (nnimap-quirk "MOVE") "MOVE"))) (command (if can-move @@ -1067,7 +1099,7 @@ nnimap-process-expiry-targets (gnus-server-to-method (format "nnimap:%s" server)))) (and (nnimap-change-group group server) - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (nnheader-message 7 "Expiring articles from %s: %s" group articles) (let ((can-move (and (nnimap-capability "MOVE") (equal (nnimap-quirk "MOVE") "MOVE")))) @@ -1112,7 +1144,7 @@ nnimap-process-expiry-targets (defun nnimap-find-expired-articles (group) (let ((cutoff (nnmail-expired-article-p group nil nil))) (when cutoff - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (let ((result (nnimap-command "UID SEARCH SENTBEFORE %s" @@ -1126,7 +1158,7 @@ nnimap-find-article-by-message-id &optional limit) "Search for message with MESSAGE-ID in GROUP from SERVER. If LIMIT, first try to limit the search to the N last articles." - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (erase-buffer) (let* ((change-group-result (nnimap-change-group group server nil t)) (number-of-article @@ -1156,7 +1188,7 @@ nnimap-find-article-by-message-id =20 (defun nnimap-delete-article (articles) "Delete ARTICLES." - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (nnimap-command "UID STORE %s +FLAGS.SILENT (\\Deleted)" (nnimap-article-ranges articles)) (cond @@ -1208,13 +1240,13 @@ nnimap-request-update-group-status '((subscribe "SUBSCRIBE") (unsubscribe "UNSUBSCRIBE"))))) (when command - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (nnimap-command "%s %S" (cadr command) (nnimap-group-to-imap group)))))= )) =20 (deffoo nnimap-request-set-mark (group actions &optional server) (when (nnimap-change-group group server) (let (sequence) - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (erase-buffer) ;; Just send all the STORE commands without waiting for ;; response. If they're successful, they're successful. @@ -1259,7 +1291,7 @@ nnimap-request-accept-article sequence message) (nnimap-add-cr) (setq message (buffer-substring-no-properties (point-min) (point-max= ))) - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (when (setq message (or (nnimap-process-quirk "OK Gimap " 'append message) message)) ;; If we have this group open read-only, then unselect it @@ -1392,14 +1424,14 @@ nnimap-get-responses =20 (deffoo nnimap-request-list (&optional server) (when (nnimap-change-group nil server) - (with-current-buffer nntp-server-buffer + (nnimap-with-context nntp-server-buffer (erase-buffer) (let ((groups - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (nnimap-get-groups))) sequences responses) (when groups - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (setf (nnimap-group nnimap-object) nil) (dolist (group groups) (setf (nnimap-examined nnimap-object) group) @@ -1438,9 +1470,9 @@ nnimap-request-list =20 (deffoo nnimap-request-newgroups (_date &optional server) (when (nnimap-change-group nil server) - (with-current-buffer nntp-server-buffer + (nnimap-with-context nntp-server-buffer (erase-buffer) - (dolist (group (with-current-buffer (nnimap-buffer) + (dolist (group (with-current-buffer (nnimap-process-buffer) (nnimap-get-groups))) (unless (assoc group nnimap-current-infos) ;; Insert dummy numbers here -- they don't matter. @@ -1448,9 +1480,8 @@ nnimap-request-newgroups t))) =20 (deffoo nnimap-retrieve-group-data-early (server infos) - (when (and (nnimap-change-group nil server) - infos) - (with-current-buffer (nnimap-buffer) + (when (nnimap-change-group nil server) + (with-current-buffer (nnimap-process-buffer) (erase-buffer) (setf (nnimap-group nnimap-object) nil) (setf (nnimap-initial-resync nnimap-object) 0) @@ -1516,10 +1547,10 @@ nnimap-finish-retrieve-group-infos (when (and sequences (nnimap-change-group nil server t) ;; Check that the process is still alive. - (get-buffer-process (nnimap-buffer)) - (memq (process-status (get-buffer-process (nnimap-buffer))) + (get-buffer-process (nnimap-process-buffer)) + (memq (process-status (get-buffer-process (nnimap-process-buffer))) '(open run))) - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) ;; Wait for the final data to trickle in. (when (nnimap-wait-for-response (if (eq (cadar sequences) 'qresync) (caar sequences) @@ -1535,7 +1566,7 @@ nnimap-finish-retrieve-group-infos (unless dont-insert ;; Finally, just return something resembling an active file in ;; the nntp buffer, so that the agent can save the info, too. - (with-current-buffer nntp-server-buffer + (nnimap-with-context nntp-server-buffer (erase-buffer) (dolist (info infos) (let* ((group (gnus-info-group info)) @@ -1870,8 +1901,20 @@ nnimap-parse-flags (setq articles nil)))) groups)) =20 -(defun nnimap-find-process-buffer (buffer) - (cadr (assoc buffer nnimap-connection-alist))) +(defun nnimap-get-process-buffer (process-buffer-key) + (cl-flet ((get + (key) + (cl-find-if (lambda (b) + (equal key (buffer-name b))) + (gnus-buffers)))) + (let ((extant (get process-buffer-key))) + (when (and extant (not (get-buffer-process extant))) + (gnus-kill-buffer extant) + (setq extant nil)) + (or extant + (progn (nnimap-open-connection process-buffer-key) + (get process-buffer-key)) + (error "Cannot connect to %s" process-buffer-key))))) =20 (deffoo nnimap-request-post (&optional _server) (setq nnimap-status-string "Read-only server") @@ -1888,7 +1931,7 @@ nnimap-request-thread (nnselect-search-thread header) (when (nnimap-change-group group server) (let* ((cmd (nnimap-make-thread-query header)) - (result (with-current-buffer (nnimap-buffer) + (result (with-current-buffer (nnimap-process-buffer) (nnimap-command "UID SEARCH %s" cmd)))) (when result (gnus-fetch-headers @@ -1915,7 +1958,7 @@ nnimap-change-group ((not group) t) (t - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (let ((result (nnimap-command "%s %S" (if read-only "EXAMINE" @@ -1926,17 +1969,18 @@ nnimap-change-group (nnimap-select-result nnimap-object) result) result))))))) =20 -(defun nnimap-find-connection (buffer) - "Find the connection delivering to BUFFER." - (let ((entry (assoc buffer nnimap-connection-alist))) - (when entry - (if (and (buffer-live-p (cadr entry)) - (get-buffer-process (cadr entry)) - (memq (process-status (get-buffer-process (cadr entry))) - '(open run))) - (get-buffer-process (cadr entry)) - (setq nnimap-connection-alist (delq entry nnimap-connection-alist)) - nil)))) +(defun nnimap-find-connection (_buffer) + "Find the connection delivering to BUFFER. +Confusingly, BUFFER will always be `nntp-server-buffer', i.e.,\" *nntpd*\", +so `nnimap-connection-alist' will usually be of length 1, and look like, +\((# #)) + +Multiplexing of different imap servers is made possible because +`nnoo-change-server' deftly swaps out this associative pair with the +current imap source (only the XXXXXX string changes). + +This is all changing." + (cl-assert nil)) =20 ;; Leave room for `open-network-stream' to issue a couple of IMAP ;; commands before nnimap starts. @@ -2012,8 +2056,8 @@ nnimap-wait-for-line (match-string 1)))) =20 (defun nnimap-wait-for-response (sequence &optional messagep) - (let ((process (get-buffer-process (current-buffer))) - openp) + (let (openp + (process (get-buffer-process (current-buffer)))) (condition-case nil (progn (goto-char (point-max)) @@ -2140,7 +2184,7 @@ nnimap-fetch-inbox t)) =20 (defun nnimap-split-incoming-mail () - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (let ((nnimap-incoming-split-list nil) (nnmail-split-methods (cond diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index bcf01cfa9e..d8c9d5005c 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -29,7 +29,6 @@ (require 'gnus) ; for macro gnus-kill-buffer, at least (require 'nnheader) (require 'message) -(require 'gnus-util) (require 'mail-source) (require 'mm-util) (require 'gnus-int) @@ -1624,7 +1623,7 @@ nnmail-cache-insert (insert id "\n")))))) =20 (defun nnmail-cache-primary-mail-backend () - (let ((be-list (cons gnus-select-method gnus-secondary-select-methods)) + (let ((be-list gnus-select-methods) (be nil) (res nil) (get-new-mail nil)) diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 4867455393..a2bc109673 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -50,7 +50,6 @@ =20 (require 'nnheader) (require 'gnus) -(require 'gnus-util) (require 'gnus-range) (require 'gnus-start) (require 'gnus-int) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index a40fa88631..4a796b1bc4 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -31,7 +31,6 @@ (require 'nnmail) (require 'message) (require 'mm-util) -(require 'gnus-util) (require 'time-date) (require 'rfc2231) (require 'mm-url) diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 1fd2ed06eb..1050779cc4 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -27,8 +27,6 @@ =20 (require 'nnheader) (require 'nnoo) -(require 'gnus-util) -(require 'gnus) (require 'gnus-group) ;; gnus-group-name-charset =20 (nnoo-declare nntp) @@ -252,7 +250,6 @@ nntp-server-list-active-group =20 ;;; Internal variables. =20 -(defvoo nntp-retrieval-in-progress nil) (defcustom nntp-record-commands nil "If non-nil, nntp will record all commands in the \"*nntp-log*\" buffer." :type 'boolean) @@ -399,9 +396,8 @@ nntp-wait-for =20 (defun nntp-kill-buffer (buffer) (when (buffer-live-p buffer) - (let ((process (get-buffer-process buffer))) - (when process - (delete-process process))) + (when-let ((process (get-buffer-process buffer))) + (delete-process process)) (kill-buffer buffer) (nnheader-init-server-buffer))) =20 @@ -410,7 +406,7 @@ nntp-erase-buffer (with-current-buffer buffer (erase-buffer))) =20 -(defsubst nntp-find-connection (buffer) +(defun nntp-find-connection (buffer) "Find the connection delivering to BUFFER." (let ((alist nntp-connection-alist) (buffer (if (stringp buffer) (get-buffer buffer) buffer)) @@ -432,9 +428,8 @@ nntp-find-connection-entry =20 (defun nntp-find-connection-buffer (buffer) "Return the process connection buffer tied to BUFFER." - (let ((process (nntp-find-connection buffer))) - (when process - (process-buffer process)))) + (when-let ((process (nntp-find-connection buffer))) + (process-buffer process))) =20 (defun nntp-retrieve-data (command address _port buffer &optional wait-for callback decode) @@ -528,8 +523,8 @@ nntp-send-command-nodelete =20 (defun nntp-send-command-and-decode (wait-for &rest strings) "Send STRINGS to server and wait until WAIT-FOR returns." - (when (not (or nnheader-callback-function - nntp-inhibit-output)) + (when (and (not nnheader-callback-function) + (not nntp-inhibit-output)) (nntp-erase-buffer nntp-server-buffer)) (let* ((command (mapconcat #'identity strings " ")) (process (nntp-find-connection nntp-server-buffer)) @@ -734,32 +729,19 @@ nntp-retrieve-headers (deffoo nntp-retrieve-group-data-early (server infos) "Retrieve group info on INFOS." (nntp-with-open-group nil server - (let ((buffer (nntp-find-connection-buffer nntp-server-buffer))) - (unless infos - (with-current-buffer buffer - (setq nntp-retrieval-in-progress nil))) - (when (and buffer - infos - (with-current-buffer buffer - (not nntp-retrieval-in-progress))) - ;; The first time this is run, this variable is `try'. So we - ;; try. - (when (eq nntp-server-list-active-group 'try) - (nntp-try-list-active - (gnus-group-real-name (gnus-info-group (car infos))))) - (with-current-buffer buffer - (erase-buffer) - ;; Mark this buffer as "in use" in case we try to issue two - ;; retrievals from the same server. This shouldn't happen, - ;; so this is mostly a sanity check. - (setq nntp-retrieval-in-progress t) - (let ((nntp-inhibit-erase t) - (command (if nntp-server-list-active-group - "LIST ACTIVE" "GROUP"))) - (dolist (info infos) - (nntp-send-command - nil command (gnus-group-real-name (gnus-info-group info))))) - (length infos)))))) + (when-let ((buffer (nntp-find-connection-buffer nntp-server-buffer))) + (when (eq nntp-server-list-active-group 'try) ;; `try' is initial va= lue + (nntp-try-list-active + (gnus-group-real-name (gnus-info-group (car infos))))) + (with-current-buffer buffer + (erase-buffer) + (let ((nntp-inhibit-erase t) + (command (if nntp-server-list-active-group + "LIST ACTIVE" "GROUP"))) + (dolist (info infos) + (nntp-send-command + nil command (gnus-group-real-name (gnus-info-group info))))) + (length infos))))) =20 (deffoo nntp-finish-retrieve-group-infos (server infos count) (nntp-with-open-group nil server @@ -769,8 +751,6 @@ nntp-finish-retrieve-group-infos (car infos))) (received 0) (last-point 1)) - (with-current-buffer buf - (setq nntp-retrieval-in-progress nil)) (when (and buf count) (with-current-buffer buf @@ -815,14 +795,7 @@ nntp-retrieve-groups "Retrieve group info on GROUPS." (nntp-with-open-group nil server - (when (and (nntp-find-connection-buffer nntp-server-buffer) - (with-current-buffer - (nntp-find-connection-buffer nntp-server-buffer) - (if (not nntp-retrieval-in-progress) - t - (message "Warning: Refusing to do retrieval from %s because a retrieva= l is already happening" - server) - nil))) + (when (nntp-find-connection-buffer nntp-server-buffer) (catch 'done (save-excursion ;; Erase nntp-server-buffer before nntp-inhibit-erase. @@ -1235,8 +1208,7 @@ nntp-make-process-buffer nntp-process-callback nil nntp-process-to-buffer nil nntp-process-start-point nil - nntp-process-decode nil - nntp-retrieval-in-progress nil) + nntp-process-decode nil) (current-buffer))) =20 (defun nntp-open-connection (buffer) @@ -1311,6 +1283,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 bu= ffer)))) + (setq nntp-connection-list + (delq process nntp-connection-list)) + (setq nntp-connection-alist + (assq-delete-all process nntp-connectio= n-alist)) + (ignore-errors (delete-process process)))) + buffer) + nil t)) (with-current-buffer pbuffer (nntp-read-server-type) (erase-buffer) diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el index 03a0ff296f..7ee21c633a 100644 --- a/lisp/gnus/nnvirtual.el +++ b/lisp/gnus/nnvirtual.el @@ -32,9 +32,7 @@ =20 (require 'nntp) (require 'nnheader) -(require 'gnus) (require 'nnoo) -(require 'gnus-util) (require 'gnus-start) (require 'gnus-sum) (require 'gnus-msg) diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index f08dc47e31..b8cfacb5d5 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -24,11 +24,8 @@ =20 ;;; Code: =20 -(eval-when-compile (require 'cl-lib)) - (require 'nnoo) (require 'message) -(require 'gnus-util) (require 'gnus) (require 'nnmail) (require 'mm-util) diff --git a/lisp/obsolete/nnir.el b/lisp/obsolete/nnir.el index 40a8ec57b9..51dd14de95 100644 --- a/lisp/obsolete/nnir.el +++ b/lisp/obsolete/nnir.el @@ -37,7 +37,7 @@ ;; The Lisp setup may involve setting a few variables and setting up the ;; search engine. You can define the variables in the server definition ;; like this : -;; (setq gnus-secondary-select-methods '( +;; (setq gnus-select-methods '( ;; (nnimap "" (nnimap-address "localhost") ;; (nnir-search-engine namazu) ;; ))) @@ -518,7 +518,7 @@ nnir-compose-result =20 (autoload 'gnus-server-get-active "gnus-int") (autoload 'nnimap-change-group "nnimap") -(declare-function nnimap-buffer "nnimap" ()) +(declare-function nnimap-process-buffer "nnimap" ()) (declare-function nnimap-command "nnimap" (&rest args)) =20 ;; imap interface @@ -547,7 +547,7 @@ nnir-run-imap (condition-case () (when (nnimap-change-group (gnus-group-short-name group) server) - (with-current-buffer (nnimap-buffer) + (with-current-buffer (nnimap-process-buffer) (message "Searching %s..." group) (let ((arts 0) (result (nnimap-command "UID SEARCH %s" diff --git a/lisp/org/ol-gnus.el b/lisp/org/ol-gnus.el index 2d51447e0c..d913e5fc02 100644 --- a/lisp/org/ol-gnus.el +++ b/lisp/org/ol-gnus.el @@ -32,7 +32,6 @@ ;;; Code: =20 (require 'gnus-sum) -(require 'gnus-util) (require 'nnheader) (or (require 'nnselect nil t) ; Emacs >=3D 28 (require 'nnir nil t)) ; Emacs < 28 diff --git a/test/lisp/gnus/gnus-test-select-methods.el b/test/lisp/gnus/gn= us-test-select-methods.el new file mode 100644 index 0000000000..6fdde070e5 --- /dev/null +++ b/test/lisp/gnus/gnus-test-select-methods.el @@ -0,0 +1,103 @@ +;;; gnus-test-select-methods.el -*- lexical-binding:t -*- + +;; Copyright (C) 2019 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(require 'gnus) +(require 'gnus-int) +(require 'gnus-start) + +(eval-when-compile + (put 'gnus-secondary-select-methods 'byte-obsolete-variable nil) + (put 'gnus-select-method 'byte-obsolete-variable nil) + (put 'gnus-nntp-server 'byte-obsolete-variable nil)) + +(ert-deftest gnus-test-select-methods-basic () + "Customizing `gnus-select-method' and `gnus-secondary-select-methods' +also modifies `gnus-select-methods'." + (let (gnus-select-method + gnus-secondary-select-methods + gnus-select-methods + (test-methods '((nnnil) (nntp "flab.flab.edu")))) + (custom-set-variables `(gnus-select-method (quote ,(car test-methods))) + `(gnus-secondary-select-methods (quote ,(cdr tes= t-methods)))) + (should (cl-every #'identity + (cl-mapcar #'gnus-methods-equal-p gnus-select-method= s test-methods))) + (should (gnus-method-equal gnus-select-method (car gnus-select-methods= ))) + (should (cl-every #'identity + (cl-mapcar #'gnus-methods-equal-p gnus-secondary-sel= ect-methods + (cdr gnus-select-methods)))))) + +(ert-deftest gnus-test-select-methods-out-of-band () + "Hamfistedly setting, not customizing, `gnus-select-method' and +`gnus-secondary-select-methods' also modifies `gnus-select-methods'." + (let (gnus-select-method + gnus-secondary-select-methods + gnus-select-methods + (test-methods '((nnnil) (nntp "flab.flab.edu")))) + (setq gnus-select-method (car test-methods) + gnus-secondary-select-methods (cdr test-methods)) + (should (cl-every #'identity + (cl-mapcar #'gnus-methods-equal-p gnus-select-method= s test-methods))) + (should (gnus-method-equal gnus-select-method (car gnus-select-methods= ))) + (should (cl-every #'identity + (cl-mapcar #'gnus-methods-equal-p gnus-secondary-sel= ect-methods + (cdr gnus-select-methods)))))) + +(ert-deftest gnus-test-select-methods-override () + "Customizing `gnus-select-methods' overrides earlier customizations +of `gnus-select-method' and `gnus-secondary-select-methods'." + (let (gnus-select-method + gnus-secondary-select-methods + gnus-select-methods + (test-methods '((nnnil) (nntp "flab.flab.edu"))) + (override-methods '((nntp "override") (nnnil)))) + (custom-set-variables `(gnus-select-method (quote ,(car test-methods))) + `(gnus-secondary-select-methods (quote ,(cdr tes= t-methods))) + `(gnus-select-methods (quote ,override-methods))) + (should (cl-every #'identity + (cl-mapcar #'gnus-methods-equal-p gnus-select-method= s override-methods))) + (should (gnus-method-equal gnus-select-method (car gnus-select-methods= ))) + (should (cl-every #'identity + (cl-mapcar #'gnus-methods-equal-p gnus-secondary-sel= ect-methods + (cdr gnus-select-methods)))))) + +(ert-deftest gnus-test-gnus-start-news-server () + "Test an archaic method of initiating gnus." + (let (gnus-current-select-method + (gnus-nntp-server "::")) + (cl-letf (((symbol-function 'gnus-y-or-n-p) #'ignore)) + (gnus-start-news-server) + (should (gnus-method-equal gnus-select-method `(nnspool ,(system-nam= e))))))) + +(ert-deftest gnus-test-gnus-read-active-file () + "Ensure unification does right by `gnus-read-active-file'." + (let (gnus-select-method + gnus-secondary-select-methods + gnus-select-methods + (test-methods '((nnnil) (nntp "flab.flab.edu")))) + (custom-set-variables `(gnus-select-methods (quote ,test-methods))) + (should (equal + (cl-remove-if (lambda (method) + (gnus-method-equal method gnus-select-method)) + gnus-select-methods) + gnus-secondary-select-methods)))) + +;;; gnus-test-select-methods.el ends here diff --git a/test/lisp/gnus/gnus-tests.el b/test/lisp/gnus/gnus-tests.el index 6602e67a34..c65c2ce880 100644 --- a/test/lisp/gnus/gnus-tests.el +++ b/test/lisp/gnus/gnus-tests.el @@ -25,9 +25,95 @@ ;; tests that are not standalone. =20 ;;; Code: -;; registry.el is required by gnus-registry.el but this way we're explicit. -(require 'registry) -(require 'gnus-registry) +;; + +(require 'cl-macs) +(require 'message) +(require 'gnus) +(require 'gnus-start) +(require 'nsm) + +(defconst gnus-tests-load-file-name (or load-file-name + (buffer-file-name))) + +(defmacro gnus-tests-let-customs (bindings &rest forms) + (declare (indent defun)) + `(let (,@(mapcar #'car bindings)) + (ignore ,@(mapcar #'car bindings)) + (funcall #'custom-set-variables + ,@(mapcar (apply-partially #'list 'quote) bindings)) + ,@forms)) + +(cl-defmacro gnus-tests-doit (&rest + body + &key + (select-methods '(default-value 'gnus-select= -methods)) + (customs) + &allow-other-keys + &aux + (body + (cl-loop until (not (keywordp (car body))) + do (setq body (nthcdr 2 body)) + finally return body))) + (declare (indent defun)) + `(let* ((parent-dir (file-name-directory gnus-tests-load-file-name)) + (default-directory (file-name-as-directory (concat parent-dir "g= nus-tests"))) + (user-emacs-directory default-directory)) + (unless (file-exists-p default-directory) + (make-directory default-directory)) + (gnus-tests-let-customs + ((gnus-verbose 8) + (gnus-save-dot-newsrc nil) + (gnus-home-directory default-directory) + (gnus-use-dribble-file nil) + (network-security-level (quote low)) + (gnus-interactive-exit (quote quiet)) + (gnus-select-methods ,select-methods) + (message-directory (concat default-directory "Mail")) + (mail-source-directory message-directory) + (mail-source-crash-box (concat default-directory ".whatev")) + (gnus-newsrc-file (nnheader-concat gnus-home-directory ".newsrc.el= d")) + (gnus-init-file (nnheader-concat gnus-home-directory ".gnus")) + (gnus-directory (nnheader-concat gnus-home-directory "News/")) + ,@customs) + (unwind-protect + (progn ,@body) + (cl-macrolet ((safe-delete + (x) + `(if (cl-search "gnus-tests/" ,x) + (delete-directory ,x t) + (error "Attempted delete of %s!" ,x)))) + (safe-delete default-directory)))))) + +(ert-deftest gnus-test-clean-room () + (gnus-tests-doit + (should (equal gnus-select-methods (default-value 'gnus-select-methods= ))) + (should-not gnus-save-dot-newsrc)) + (should gnus-save-dot-newsrc)) + +(ert-deftest gnus-test-select-methods () + (gnus-tests-doit :select-methods (quote ((nnfolder ""))) + (should (equal gnus-select-methods (quote ((nnfolder ""))))) + (should (equal gnus-select-method (quote (nnfolder "")))) + (should-not gnus-secondary-select-methods))) + +(ert-deftest gnus-test-be-nicer-to-noobs () + "Between the time Linux entered the home and the time I wrote this test, +the innocent user trying `M-x gnus` would be rebuffed with hostility." + (gnus-tests-doit + (with-current-buffer "*Messages*" + (let ((inhibit-read-only t)) + (erase-buffer))) + (let ((inhibit-message t)) + (call-interactively #'gnus)) + (with-current-buffer "*Messages*" + (save-excursion + (goto-char (point-min)) + (should-error (re-search-forward "failed")))))) + +(ert-deftest gnus-test-basic-op () + (gnus-tests-doit :select-methods (quote ((nnfolder ""))) + (call-interactively #'gnus))) =20 (provide 'gnus-tests) ;;; gnus-tests.el ends here diff --git a/test/src/process-tests.el b/test/src/process-tests.el index b64c82c87d..708473bf8a 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -111,6 +111,15 @@ process-test-stderr-buffer (goto-char (point-min)) (looking-at "hello stderr!")))))) =20 +(ert-deftest process-test-stopped-pipe () + (skip-unless (executable-find "cat")) + (with-temp-buffer + (let ((proc (make-pipe-process :name "pipe" :buffer (current-buffer) + :command '("cat") :stop t))) + (unwind-protect + (should (list-processes--refresh)) + (delete-process proc))))) + (ert-deftest process-test-stderr-filter () (skip-unless (executable-find "bash")) (with-timeout (60 (ert-fail "Test timed out")) diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index fc7bc7441b..2b0fcb5383 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -20,6 +20,8 @@ ;;; Code: =20 (require 'thread) +(require 'eieio) +(require 'ring) =20 ;; Declare the functions in case Emacs has been configured --without-threa= ds. (declare-function all-threads "thread.c" ()) @@ -42,6 +44,26 @@ (declare-function thread-yield "thread.c" ()) (defvar main-thread) =20 +(defclass threads-test-channel () + ((condition :initarg :condition :type condition-variable) + (msg-queue :initarg :msg-queue :type ring))) + +(cl-defgeneric threads-test-channel-send ((channel threads-test-channel) m= essage) + (with-slots (condition msg-queue) channel + (with-mutex (condition-mutex condition) + (while (<=3D (ring-size msg-queue) (ring-length msg-queue)) + (condition-wait condition)) + (ring-insert msg-queue message) + (condition-notify condition t)))) + +(cl-defgeneric threads-test-channel-recv ((channel threads-test-channel)) + (with-slots (condition msg-queue) channel + (with-mutex (condition-mutex condition) + (while (ring-empty-p msg-queue) + (condition-wait condition)) + (prog1 (ring-remove msg-queue) + (condition-notify condition t))))) + (ert-deftest threads-is-one () "Test for existence of a thread." (skip-unless (featurep 'threads)) @@ -318,7 +340,7 @@ threads-signal-early (make-thread (lambda () (while t (thread-yield)))))) (thread-signal thread 'error nil) - (sit-for 1) + (funcall (if noninteractive #'sit-for #'sleep-for) 1) (should-not (thread-live-p thread)) (should (equal (thread-last-error) '(error))))) =20 @@ -389,7 +411,99 @@ threads-condvar-wait (should (equal (thread-last-error) '(error "Die, die, die!"))))) =20 (ert-deftest threads-test-bug33073 () + (skip-unless (featurep 'threads)) (let ((th (make-thread 'ignore))) (should-not (equal th main-thread)))) =20 -;;; threads.el ends here +(ert-deftest threads-test-bug36609-signal () + "Would only fail under TEST_INTERACTIVE=3Dyes, and not every time. +The failure manifests only by being unable to exit the interactive emacs." + (skip-unless (featurep 'threads)) + (let* ((cv (make-condition-variable (make-mutex) "CV")) + condition + (notify (lambda () + (sleep-for 1) ;; let wait() start spinning first + (with-mutex (condition-mutex cv) + (setq condition t) + (condition-notify cv)))) + (wait (lambda () (with-mutex (condition-mutex cv) + (while (not condition) + (condition-wait cv))))) + (herring (make-thread (apply-partially #'sleep-for 1000) "unrelated= "))) + ;; herring is a non-main thread that, if the bug is still present, + ;; could assume the glib context lock when the main thread executes wa= it() + (make-thread notify "notify") + (funcall wait) + (thread-signal herring 'quit nil))) + +(ert-deftest threads-test-glib-lock () + "Would only fail under TEST_INTERACTIVE=3Dyes, and not every time. +The failure manifests only by being unable to exit the interactive emacs." + (skip-unless (featurep 'threads)) + (cl-macrolet ((run-thread + (name what) + `(make-thread + (lambda () + (sleep-for (1+ (random 3))) + (funcall ,what)) + ,name))) + (let* ((n 3) + (capacity 1) + (channel (make-instance + 'threads-test-channel + :condition (make-condition-variable (make-mutex) "cha= nnel") + :msg-queue (make-ring capacity)))) + (dotimes (i n) + (let ((send-name (format "send-%d" (1+ i))) + (recv-name (format "recv-%d" (- n i)))) + (run-thread send-name + (lambda () (threads-test-channel-send channel 42))) + (run-thread recv-name + (lambda () (threads-test-channel-recv channel)))))))) + +(ert-deftest threads-test-promiscuous-process () + "Can't we `accept-process-output' of a process started by another thread? +For whatever reason, in 2012, tromey inserted an assertion forbidding this. +We test flouting that edict here." + (skip-unless (featurep 'threads)) + (thread-last-error t) + (let* ((thread-tests-main (get-buffer-create "thread-tests-main" t)) + (buffers (list thread-tests-main)) + (start-proc (lambda (n b) + (apply #'start-process n b "cat" (split-string "/de= v/urandom")))) + (n 3)) + (funcall start-proc "threads-tests-main" (car buffers)) + (dotimes (i (1- n)) + (push (get-buffer-create (format "thread-tests-%d" i) t) buffers) + (make-thread (apply-partially start-proc + (format "thread-tests-%d" i) + (car buffers)))) + (should (cl-loop repeat 10 + when (cl-every #'processp (mapcar #'get-buffer-proces= s buffers)) + return t + do (accept-process-output nil 0.1) + finally return nil)) + (let ((procs (mapcar #'get-buffer-process buffers))) + (mapc (lambda (proc) (set-process-thread proc nil)) procs) + (dotimes (i (1- n)) + (make-thread + (lambda () + (cl-loop repeat 5 + do (accept-process-output + (nth (random (length procs)) procs) + 0.2 + nil + t))) + (format "thread-tests-%d" i))) + (should (cl-loop repeat 20 + unless (cl-some + (lambda (thr) + (cl-search "thread-tests-" (thread-name t= hr))) + (all-threads)) + return t + do (accept-process-output + (nth (random (length procs)) procs) 1.0) + finally return nil))) + (mapc (lambda (b) (kill-buffer b)) buffers)) + (should-not (thread-last-error t))) +;;; thread-tests.el ends here --=20 2.26.2 --=-=-= Content-Type: text/plain In GNU Emacs 28.0.50 (build 9, x86_64-pc-linux-gnu, GTK+ Version 3.22.30, cairo version 1.15.10) of 2021-06-16 built on dick Repository revision: 1aece73f02724f283bea73e374f6f7f2b4af3b50 Repository branch: gnus-dev-28 Windowing system distributor 'The X.Org Foundation', version 11.0.11906000 System Description: Ubuntu 18.04.4 LTS Configured using: 'configure --prefix=/home/dick/.local' Configured features: CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GSETTINGS HARFBUZZ JPEG JSON LCMS2 LIBSELINUX LIBXML2 MODULES NOTIFY INOTIFY PDUMPER PNG RSVG SECCOMP SOUND THREADS TIFF TOOLKIT_SCROLL_BARS X11 XDBE XIM XPM GTK3 ZLIB Important settings: value of $LANG: en_US.UTF-8 locale-coding-system: utf-8-unix Major mode: Magit Minor modes in effect: async-bytecomp-package-mode: t global-git-commit-mode: t magit-auto-revert-mode: t show-paren-mode: t projectile-mode: t flx-ido-mode: t override-global-mode: t shell-dirtrack-mode: t beacon-mode: t global-hl-line-mode: t winner-mode: t tooltip-mode: t mouse-wheel-mode: t file-name-shadow-mode: t global-font-lock-mode: t font-lock-mode: t blink-cursor-mode: t auto-composition-mode: t auto-encryption-mode: t auto-compression-mode: t buffer-read-only: t column-number-mode: t line-number-mode: t transient-mark-mode: t Load-path shadows: /home/dick/ESS/lisp/obsolete/ess-swv hides /home/dick/ESS/lisp/ess-swv /home/dick/ESS/lisp/obsolete/ess-rutils hides /home/dick/ESS/lisp/ess-rutils /home/dick/ESS/lisp/obsolete/ess-noweb hides /home/dick/ESS/lisp/ess-noweb /home/dick/ESS/lisp/obsolete/mouseme hides /home/dick/ESS/lisp/mouseme /home/dick/ESS/lisp/obsolete/ess-mouse hides /home/dick/ESS/lisp/ess-mouse /home/dick/ESS/lisp/obsolete/ess-noweb-mode hides /home/dick/ESS/lisp/ess-noweb-mode /home/dick/ESS/lisp/obsolete/make-regexp hides /home/dick/ESS/lisp/make-regexp /home/dick/ESS/lisp/obsolete/ess-r-a hides /home/dick/ESS/lisp/ess-r-a /home/dick/ESS/lisp/obsolete/ess-noweb-font-lock-mode hides /home/dick/ESS/lisp/ess-noweb-font-lock-mode /home/dick/gomacro-mode/gomacro-mode hides /home/dick/.emacs.d/elpa/gomacro-mode-20200326.1103/gomacro-mode /home/dick/ESS/lisp/julia-mode hides /home/dick/.emacs.d/elpa/julia-mode-20200717.1915/julia-mode /home/dick/ESS/lisp/julia-mode-latexsubs hides /home/dick/.emacs.d/elpa/julia-mode-20200717.1915/julia-mode-latexsubs /home/dick/.emacs.d/elpa/hydra-20170924.2259/lv hides /home/dick/.emacs.d/elpa/lv-20191106.1238/lv /home/dick/org-gcal.el/org-gcal hides /home/dick/.emacs.d/elpa/org-gcal-0.3/org-gcal /home/dick/.emacs.d/elpa/async-20200113.1745/async-autoloads hides /home/dick/.local/share/emacs/site-lisp/emacs-async/async-autoloads /home/dick/.emacs.d/elpa/async-20200113.1745/async-bytecomp hides /home/dick/.local/share/emacs/site-lisp/emacs-async/async-bytecomp /home/dick/.emacs.d/elpa/async-20200113.1745/smtpmail-async hides /home/dick/.local/share/emacs/site-lisp/emacs-async/smtpmail-async /home/dick/.emacs.d/elpa/async-20200113.1745/dired-async hides /home/dick/.local/share/emacs/site-lisp/emacs-async/dired-async /home/dick/.emacs.d/elpa/async-20200113.1745/async hides /home/dick/.local/share/emacs/site-lisp/emacs-async/async /home/dick/.emacs.d/elpa/async-20200113.1745/async-pkg hides /home/dick/.local/share/emacs/site-lisp/emacs-async/async-pkg /home/dick/.emacs.d/lisp/json hides /home/dick/gnus/lisp/json /home/dick/.emacs.d/elpa/transient-20210221.2251/transient hides /home/dick/gnus/lisp/transient /home/dick/.emacs.d/elpa/org-9.4.5/ob-css hides /home/dick/gnus/lisp/org/ob-css /home/dick/.emacs.d/elpa/org-9.4.5/ox-texinfo hides /home/dick/gnus/lisp/org/ox-texinfo /home/dick/.emacs.d/elpa/org-9.4.5/org-plot hides /home/dick/gnus/lisp/org/org-plot /home/dick/.emacs.d/elpa/org-9.4.5/ob-eval hides /home/dick/gnus/lisp/org/ob-eval /home/dick/.emacs.d/elpa/org-9.4.5/ob-ref hides /home/dick/gnus/lisp/org/ob-ref /home/dick/.emacs.d/elpa/org-9.4.5/org-crypt hides /home/dick/gnus/lisp/org/org-crypt /home/dick/.emacs.d/elpa/org-9.4.5/ob-tangle hides /home/dick/gnus/lisp/org/ob-tangle /home/dick/.emacs.d/elpa/org-9.4.5/ob-asymptote hides /home/dick/gnus/lisp/org/ob-asymptote /home/dick/.emacs.d/elpa/org-9.4.5/ol-w3m hides /home/dick/gnus/lisp/org/ol-w3m /home/dick/.emacs.d/elpa/org-9.4.5/ob-hledger hides /home/dick/gnus/lisp/org/ob-hledger /home/dick/.emacs.d/elpa/org-9.4.5/ob-forth hides /home/dick/gnus/lisp/org/ob-forth /home/dick/.emacs.d/elpa/org-9.4.5/org-mouse hides /home/dick/gnus/lisp/org/org-mouse /home/dick/.emacs.d/elpa/org-9.4.5/org-indent hides /home/dick/gnus/lisp/org/org-indent /home/dick/.emacs.d/elpa/org-9.4.5/org-attach-git hides /home/dick/gnus/lisp/org/org-attach-git /home/dick/.emacs.d/elpa/org-9.4.5/org-element hides /home/dick/gnus/lisp/org/org-element /home/dick/.emacs.d/elpa/org-9.4.5/ol-mhe hides /home/dick/gnus/lisp/org/ol-mhe /home/dick/.emacs.d/elpa/org-9.4.5/org-footnote hides /home/dick/gnus/lisp/org/org-footnote /home/dick/.emacs.d/elpa/org-9.4.5/ob-stan hides /home/dick/gnus/lisp/org/ob-stan /home/dick/.emacs.d/elpa/org-9.4.5/ob-perl hides /home/dick/gnus/lisp/org/ob-perl /home/dick/.emacs.d/elpa/org-9.4.5/org-timer hides /home/dick/gnus/lisp/org/org-timer /home/dick/.emacs.d/elpa/org-9.4.5/org-table hides /home/dick/gnus/lisp/org/org-table /home/dick/.emacs.d/elpa/org-9.4.5/org-keys hides /home/dick/gnus/lisp/org/org-keys /home/dick/.emacs.d/elpa/org-9.4.5/org-colview hides /home/dick/gnus/lisp/org/org-colview /home/dick/.emacs.d/elpa/org-9.4.5/ol hides /home/dick/gnus/lisp/org/ol /home/dick/.emacs.d/elpa/org-9.4.5/org-entities hides /home/dick/gnus/lisp/org/org-entities /home/dick/.emacs.d/elpa/org-9.4.5/org-src hides /home/dick/gnus/lisp/org/org-src /home/dick/.emacs.d/elpa/org-9.4.5/ob-js hides /home/dick/gnus/lisp/org/ob-js /home/dick/.emacs.d/elpa/org-9.4.5/org hides /home/dick/gnus/lisp/org/org /home/dick/.emacs.d/elpa/org-9.4.5/ob-makefile hides /home/dick/gnus/lisp/org/ob-makefile /home/dick/.emacs.d/elpa/org-9.4.5/ob-io hides /home/dick/gnus/lisp/org/ob-io /home/dick/.emacs.d/elpa/org-9.4.5/org-refile hides /home/dick/gnus/lisp/org/org-refile /home/dick/.emacs.d/elpa/org-9.4.5/org-clock hides /home/dick/gnus/lisp/org/org-clock /home/dick/.emacs.d/elpa/org-9.4.5/ob-dot hides /home/dick/gnus/lisp/org/ob-dot /home/dick/.emacs.d/elpa/org-9.4.5/ob-exp hides /home/dick/gnus/lisp/org/ob-exp /home/dick/.emacs.d/elpa/org-9.4.5/org-compat hides /home/dick/gnus/lisp/org/org-compat /home/dick/.emacs.d/elpa/org-9.4.5/ob-maxima hides /home/dick/gnus/lisp/org/ob-maxima /home/dick/.emacs.d/elpa/org-9.4.5/ob-C hides /home/dick/gnus/lisp/org/ob-C /home/dick/.emacs.d/elpa/org-9.4.5/org-tempo hides /home/dick/gnus/lisp/org/org-tempo /home/dick/.emacs.d/elpa/org-9.4.5/ox-md hides /home/dick/gnus/lisp/org/ox-md /home/dick/.emacs.d/elpa/org-9.4.5/ob-screen hides /home/dick/gnus/lisp/org/ob-screen /home/dick/.emacs.d/elpa/org-9.4.5/ob-lua hides /home/dick/gnus/lisp/org/ob-lua /home/dick/.emacs.d/elpa/org-9.4.5/ob-matlab hides /home/dick/gnus/lisp/org/ob-matlab /home/dick/.emacs.d/elpa/org-9.4.5/ob-groovy hides /home/dick/gnus/lisp/org/ob-groovy /home/dick/.emacs.d/elpa/org-9.4.5/ol-docview hides /home/dick/gnus/lisp/org/ol-docview /home/dick/.emacs.d/elpa/org-9.4.5/ob-ebnf hides /home/dick/gnus/lisp/org/ob-ebnf /home/dick/.emacs.d/elpa/org-9.4.5/ob-sed hides /home/dick/gnus/lisp/org/ob-sed /home/dick/.emacs.d/elpa/org-9.4.5/ox-html hides /home/dick/gnus/lisp/org/ox-html /home/dick/.emacs.d/elpa/org-9.4.5/ob-emacs-lisp hides /home/dick/gnus/lisp/org/ob-emacs-lisp /home/dick/.emacs.d/elpa/org-9.4.5/ol-bbdb hides /home/dick/gnus/lisp/org/ol-bbdb /home/dick/.emacs.d/elpa/org-9.4.5/org-macs hides /home/dick/gnus/lisp/org/org-macs /home/dick/.emacs.d/elpa/org-9.4.5/org-lint hides /home/dick/gnus/lisp/org/org-lint /home/dick/.emacs.d/elpa/org-9.4.5/org-loaddefs hides /home/dick/gnus/lisp/org/org-loaddefs /home/dick/.emacs.d/elpa/org-9.4.5/ob-scheme hides /home/dick/gnus/lisp/org/ob-scheme /home/dick/.emacs.d/elpa/org-9.4.5/org-protocol hides /home/dick/gnus/lisp/org/org-protocol /home/dick/.emacs.d/elpa/org-9.4.5/ol-eww hides /home/dick/gnus/lisp/org/ol-eww /home/dick/.emacs.d/elpa/org-9.4.5/ox-beamer hides /home/dick/gnus/lisp/org/ox-beamer /home/dick/.emacs.d/elpa/org-9.4.5/ob-core hides /home/dick/gnus/lisp/org/ob-core /home/dick/.emacs.d/elpa/org-9.4.5/org-agenda hides /home/dick/gnus/lisp/org/org-agenda /home/dick/.emacs.d/elpa/org-9.4.5/ob-plantuml hides /home/dick/gnus/lisp/org/ob-plantuml /home/dick/.emacs.d/elpa/org-9.4.5/ox-publish hides /home/dick/gnus/lisp/org/ox-publish /home/dick/.emacs.d/elpa/org-9.4.5/ol-eshell hides /home/dick/gnus/lisp/org/ol-eshell /home/dick/.emacs.d/elpa/org-9.4.5/ol-rmail hides /home/dick/gnus/lisp/org/ol-rmail /home/dick/.emacs.d/elpa/org-9.4.5/ob-J hides /home/dick/gnus/lisp/org/ob-J /home/dick/.emacs.d/elpa/org-9.4.5/ob-abc hides /home/dick/gnus/lisp/org/ob-abc /home/dick/.emacs.d/elpa/org-9.4.5/ob-awk hides /home/dick/gnus/lisp/org/ob-awk /home/dick/.emacs.d/elpa/org-9.4.5/ob-gnuplot hides /home/dick/gnus/lisp/org/ob-gnuplot /home/dick/.emacs.d/elpa/org-9.4.5/ob-sql hides /home/dick/gnus/lisp/org/ob-sql /home/dick/.emacs.d/elpa/org-9.4.5/ob-python hides /home/dick/gnus/lisp/org/ob-python /home/dick/.emacs.d/elpa/org-9.4.5/ob-octave hides /home/dick/gnus/lisp/org/ob-octave /home/dick/.emacs.d/elpa/org-9.4.5/ox-man hides /home/dick/gnus/lisp/org/ox-man /home/dick/.emacs.d/elpa/org-9.4.5/ol-bibtex hides /home/dick/gnus/lisp/org/ol-bibtex /home/dick/.emacs.d/elpa/org-9.4.5/org-goto hides /home/dick/gnus/lisp/org/org-goto /home/dick/.emacs.d/elpa/org-9.4.5/ob-org hides /home/dick/gnus/lisp/org/ob-org /home/dick/.emacs.d/elpa/org-9.4.5/ob-lob hides /home/dick/gnus/lisp/org/ob-lob /home/dick/.emacs.d/elpa/org-9.4.5/ob-calc hides /home/dick/gnus/lisp/org/ob-calc /home/dick/.emacs.d/elpa/org-9.4.5/org-macro hides /home/dick/gnus/lisp/org/org-macro /home/dick/.emacs.d/elpa/org-9.4.5/ob hides /home/dick/gnus/lisp/org/ob /home/dick/.emacs.d/elpa/org-9.4.5/ol-info hides /home/dick/gnus/lisp/org/ol-info /home/dick/.emacs.d/elpa/org-9.4.5/ox-ascii hides /home/dick/gnus/lisp/org/ox-ascii /home/dick/.emacs.d/elpa/org-9.4.5/ob-clojure hides /home/dick/gnus/lisp/org/ob-clojure /home/dick/.emacs.d/elpa/org-9.4.5/org-inlinetask hides /home/dick/gnus/lisp/org/org-inlinetask /home/dick/.emacs.d/elpa/org-9.4.5/ob-vala hides /home/dick/gnus/lisp/org/ob-vala /home/dick/.emacs.d/elpa/org-9.4.5/ob-ruby hides /home/dick/gnus/lisp/org/ob-ruby /home/dick/.emacs.d/elpa/org-9.4.5/ob-sass hides /home/dick/gnus/lisp/org/ob-sass /home/dick/.emacs.d/elpa/org-9.4.5/org-faces hides /home/dick/gnus/lisp/org/org-faces /home/dick/.emacs.d/elpa/org-9.4.5/org-attach hides /home/dick/gnus/lisp/org/org-attach /home/dick/.emacs.d/elpa/org-9.4.5/ob-lilypond hides /home/dick/gnus/lisp/org/ob-lilypond /home/dick/.emacs.d/elpa/org-9.4.5/org-archive hides /home/dick/gnus/lisp/org/org-archive /home/dick/.emacs.d/elpa/org-9.4.5/ob-shen hides /home/dick/gnus/lisp/org/ob-shen /home/dick/.emacs.d/elpa/org-9.4.5/org-datetree hides /home/dick/gnus/lisp/org/org-datetree /home/dick/.emacs.d/elpa/org-9.4.5/org-id hides /home/dick/gnus/lisp/org/org-id /home/dick/.emacs.d/elpa/org-9.4.5/ob-eshell hides /home/dick/gnus/lisp/org/ob-eshell /home/dick/.emacs.d/elpa/org-9.4.5/ob-sqlite hides /home/dick/gnus/lisp/org/ob-sqlite /home/dick/.emacs.d/elpa/org-9.4.5/ob-picolisp hides /home/dick/gnus/lisp/org/ob-picolisp /home/dick/.emacs.d/elpa/org-9.4.5/org-habit hides /home/dick/gnus/lisp/org/org-habit /home/dick/.emacs.d/elpa/org-9.4.5/org-ctags hides /home/dick/gnus/lisp/org/org-ctags /home/dick/.emacs.d/elpa/org-9.4.5/ol-gnus hides /home/dick/gnus/lisp/org/ol-gnus /home/dick/.emacs.d/elpa/org-9.4.5/ob-java hides /home/dick/gnus/lisp/org/ob-java /home/dick/.emacs.d/elpa/org-9.4.5/ox-latex hides /home/dick/gnus/lisp/org/ox-latex /home/dick/.emacs.d/elpa/org-9.4.5/org-pcomplete hides /home/dick/gnus/lisp/org/org-pcomplete /home/dick/.emacs.d/elpa/org-9.4.5/ob-processing hides /home/dick/gnus/lisp/org/ob-processing /home/dick/.emacs.d/elpa/org-9.4.5/ox-odt hides /home/dick/gnus/lisp/org/ox-odt /home/dick/.emacs.d/elpa/org-9.4.5/org-feed hides /home/dick/gnus/lisp/org/org-feed /home/dick/.emacs.d/elpa/org-9.4.5/ob-ditaa hides /home/dick/gnus/lisp/org/ob-ditaa /home/dick/.emacs.d/elpa/org-9.4.5/ox-org hides /home/dick/gnus/lisp/org/ox-org /home/dick/.emacs.d/elpa/org-9.4.5/ob-coq hides /home/dick/gnus/lisp/org/ob-coq /home/dick/.emacs.d/elpa/org-9.4.5/ob-R hides /home/dick/gnus/lisp/org/ob-R /home/dick/.emacs.d/elpa/org-9.4.5/ob-fortran hides /home/dick/gnus/lisp/org/ob-fortran /home/dick/.emacs.d/elpa/org-9.4.5/ob-haskell hides /home/dick/gnus/lisp/org/ob-haskell /home/dick/.emacs.d/elpa/org-9.4.5/ox-icalendar hides /home/dick/gnus/lisp/org/ox-icalendar /home/dick/.emacs.d/elpa/org-9.4.5/org-num hides /home/dick/gnus/lisp/org/org-num /home/dick/.emacs.d/elpa/org-9.4.5/ob-ledger hides /home/dick/gnus/lisp/org/ob-ledger /home/dick/.emacs.d/elpa/org-9.4.5/ox hides /home/dick/gnus/lisp/org/ox /home/dick/.emacs.d/elpa/org-9.4.5/org-mobile hides /home/dick/gnus/lisp/org/org-mobile /home/dick/.emacs.d/elpa/org-9.4.5/org-duration hides /home/dick/gnus/lisp/org/org-duration /home/dick/.emacs.d/elpa/org-9.4.5/org-list hides /home/dick/gnus/lisp/org/org-list /home/dick/.emacs.d/elpa/org-9.4.5/ob-latex hides /home/dick/gnus/lisp/org/ob-latex /home/dick/.emacs.d/elpa/org-9.4.5/ob-ocaml hides /home/dick/gnus/lisp/org/ob-ocaml /home/dick/.emacs.d/elpa/org-9.4.5/ob-lisp hides /home/dick/gnus/lisp/org/ob-lisp /home/dick/.emacs.d/elpa/org-9.4.5/ob-mscgen hides /home/dick/gnus/lisp/org/ob-mscgen /home/dick/.emacs.d/elpa/org-9.4.5/ob-comint hides /home/dick/gnus/lisp/org/ob-comint /home/dick/.emacs.d/elpa/org-9.4.5/org-capture hides /home/dick/gnus/lisp/org/org-capture /home/dick/.emacs.d/elpa/org-9.4.5/ob-table hides /home/dick/gnus/lisp/org/ob-table /home/dick/.emacs.d/elpa/org-9.4.5/ob-shell hides /home/dick/gnus/lisp/org/ob-shell /home/dick/.emacs.d/elpa/org-9.4.5/ol-irc hides /home/dick/gnus/lisp/org/ol-irc /home/dick/.emacs.d/elpa/org-9.4.5/org-version hides /home/dick/gnus/lisp/org/org-version /home/dick/.emacs.d/elpa/hierarchy-20171221.1151/hierarchy hides /home/dick/gnus/lisp/emacs-lisp/hierarchy Features: (shadow bbdb-message flyspell ispell footnote emacsbug whitespace ag vc-svn texinfo texinfo-loaddefs vc-git vc-dispatcher bug-reference face-remap magit-patch-changelog magit-patch magit-submodule magit-obsolete magit-popup async-bytecomp async magit-blame magit-stash magit-reflog magit-bisect magit-push magit-pull magit-fetch magit-clone magit-remote magit-commit magit-sequence magit-notes magit-worktree magit-tag magit-merge magit-branch magit-reset magit-files magit-refs magit-status magit magit-repos magit-apply magit-wip magit-log which-func imenu magit-diff smerge-mode diff diff-mode git-commit log-edit pcvs-util add-log magit-core magit-autorevert magit-margin magit-transient magit-process with-editor server magit-mode transient magit-git magit-section magit-utils eww xdg url-queue qp misearch multi-isearch gnus-notifications gnus-fun notifications gnus-kill shr-color sort smiley mm-archive mail-extr gnus-async gnus-dup gnus-ml disp-table gnutls url-cache nntwitter nntwitter-api nnrss nnhackernews nndiscourse benchmark rbenv utf-7 network-stream nnfolder bbdb-gnus gnus-demon nntp nnmairix nnml nnreddit gnus-topic url-http url-auth url-gw nsm virtualenvwrapper gud s json-rpc python tramp-sh tramp tramp-loaddefs trampver tramp-integration files-x tramp-compat ls-lisp gnus-score score-mode gnus-bcklg gnus-srvr gnus-cite bbdb-mua bbdb-com crm bbdb bbdb-site timezone gnus-delay gnus-draft gnus-cache gnus-agent gnus-msg nndraft nnmh use-package use-package-delight use-package-diminish paredit-ext paredit mu4e mu4e-org mu4e-main mu4e-view mu4e-view-gnus gnus-art mm-uu mml2015 mm-view mml-smime smime dig mu4e-view-common mu4e-headers mu4e-compose mu4e-context mu4e-draft mu4e-actions rfc2368 smtpmail sendmail mu4e-mark mu4e-proc mu4e-utils doc-view jka-compr image-mode exif mu4e-lists mu4e-message flow-fill org-tempo tempo org org-macro org-footnote org-pcomplete org-list org-faces org-entities org-version ob-R ob-emacs-lisp ob-ein ein-cell ein-output-area ein-kernel ein-ipdb ein-query ein-events ein-websocket websocket bindat ein-node ewoc ein-log ein-classes ein-core request autorevert filenotify ein ein-utils deferred cc-mode cc-fonts cc-guess cc-menus cc-cmds cc-styles cc-align cc-engine cc-vars cc-defs ob ob-tangle org-src ob-ref ob-lob ob-table ob-exp ob-comint ob-core ob-eval org-table ol org-keys org-compat org-macs org-loaddefs find-func cal-menu calendar cal-loaddefs gnus-sum shr kinsoku svg dom gnus-group mm-url gnus-undo gnus-start gnus-dbus dbus xml gnus-cloud nnimap nnmail mail-source utf7 netrc nnoo parse-time iso8601 gnus-spec gnus-int gnus-range gnus-win mule-util mu4e-vars message rmc puny rfc822 mml mml-sec epa epg epg-config mm-decode mm-bodies mm-encode mail-parse rfc2231 mailabbrev gmm-utils mailheader mu4e-meta subed subed-vtt subed-srt subed-common subed-mpv subed-debug subed-config dired-x inf-ruby ruby-mode smie ht dash anaphora a company haskell-interactive-mode haskell-presentation-mode haskell-process haskell-session haskell-compile haskell-mode haskell-cabal haskell-utils haskell-font-lock haskell-indentation haskell-string haskell-sort-imports haskell-lexeme rx haskell-align-imports haskell-complete-module haskell-ghc-support etags fileloop generator dabbrev haskell-customize hydra lv use-package-ensure paren solarized-theme solarized-definitions projectile skeleton ibuf-macs find-dired dired dired-loaddefs ibuf-ext ibuffer ibuffer-loaddefs grep gnus nnheader gnus-util rmail rmail-loaddefs rfc2047 rfc2045 ietf-drums mm-util mail-prsvr mail-utils time-date flx-ido flx google-translate-default-ui google-translate-core-ui facemenu color ido google-translate-core google-translate-tk google-translate-backend use-package-bind-key bind-key auto-complete advice popup cus-edit pp cus-load wid-edit ess-r-mode ess-r-flymake flymake-proc flymake warnings thingatpt ess-r-xref xref ess-trns ess-r-package shell pcomplete ess-r-completion ess-roxy ess-r-syntax ess-rd noutline outline hideshow ess-s-lang ess-help ess-mode ess-inf project format-spec ess-tracebug ess ess-utils ess-custom compile text-property-search comint ansi-color emms-player-mplayer emms-player-simple emms emms-compat cl-extra help-mode use-package-core derived beacon easy-mmode pcase hl-line winner ring edmacro kmacro finder-inf json-reformat-autoloads json-snatcher-autoloads sml-mode-autoloads tornado-template-mode-autoloads info package browse-url url url-proxy url-privacy url-expand url-methods url-history url-cookie url-domsuf url-util mailcap url-handlers url-parse auth-source cl-seq eieio eieio-core cl-macs eieio-loaddefs password-cache json subr-x map url-vars seq byte-opt gv bytecomp byte-compile cconv cl-loaddefs cl-lib iso-transl tooltip eldoc electric uniquify ediff-hook vc-hooks lisp-float-type mwheel term/x-win x-win term/common-win x-dnd tool-bar dnd fontset image regexp-opt fringe tabulated-list replace newcomment text-mode elisp-mode lisp-mode prog-mode register page tab-bar menu-bar rfn-eshadow isearch easymenu timer select scroll-bar mouse jit-lock font-lock syntax font-core term/tty-colors frame minibuffer cl-generic cham georgian utf-8-lang misc-lang vietnamese tibetan thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek romanian slovak czech european ethiopic indian cyrillic chinese composite charscript charprop case-table epa-hook jka-cmpr-hook help simple abbrev obarray cl-preloaded nadvice button loaddefs faces cus-face macroexp files window text-properties overlay sha1 md5 base64 format env code-pages mule custom widget hashtable-print-readable backquote threads dbusbind inotify lcms2 dynamic-setting system-font-setting font-render-setting cairo move-toolbar gtk x-toolkit x multi-tty make-network-process emacs) Memory information: ((conses 16 1186305 96586) (symbols 48 51832 2) (strings 32 216642 13378) (string-bytes 1 7442351) (vectors 16 70278) (vector-slots 8 928844 137174) (floats 8 2169 1405) (intervals 56 18698 1544) (buffers 992 44)) --=-=-=--