* bug#49065: 28.0.50; Major Changes to Gnus
@ 2021-06-16 17:57 dick.r.chiang
2021-06-21 20:03 ` Filipp Gunbin
0 siblings, 1 reply; 8+ messages in thread
From: dick.r.chiang @ 2021-06-16 17:57 UTC (permalink / raw)
To: 49065
[-- Attachment #1: 0001-Major-changes-to-Gnus.patch --]
[-- Type: text/x-diff, Size: 343661 bytes --]
From 54243028a84a4c1b915d45fea7540638b1c26c95 Mon Sep 17 00:00:00 2001
From: dickmao <none>
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 logic.
* 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-buffer.
(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-buffer.
(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-methods.
* 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 -
| 22 +-
lisp/gnus/nnimap.el | 564 ++++-----
lisp/gnus/nnmail.el | 3 +-
lisp/gnus/nnmaildir.el | 1 -
| 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
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:
@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
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:
@lisp
-(setq gnus-select-method '(nntp "news.somewhere.edu"))
+(setq gnus-select-method '((nntp "news.somewhere.edu")))
@end lisp
If you want to read directly from the local spool, say:
@lisp
-(setq gnus-select-method '(nnspool ""))
+(setq gnus-select-method '((nnspool "")))
@end lisp
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
-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.
-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-alist}.
@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}.
-@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 like:
-
-@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}.
@vindex gnus-init-file
@vindex gnus-site-init-file
@@ -1687,6 +1633,11 @@ Startup Variables
@table @code
+@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.
-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 Parameters}.
@table @kbd
@@ -7323,18 +7273,6 @@ More Threading
This is a number that says how much each sub-thread should be indented.
The default is 4.
-@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
@@ -29693,18 +29631,6 @@ Little Disk Space
@table @code
-@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}
@node User name and password
@type interstitial
-@next
+@next
(if (assistant-password-required-p)
"Enter user name and password"
"Want user name and password?")
diff --git a/lisp/gnus/gnus-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 @@
;;; Code:
-(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)
+(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)
(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 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
(defvar tool-bar-map)
(defvar w3m-minor-mode-map)
@@ -41,7 +40,6 @@ w3m-minor-mode-map
(require 'mm-uu)
(require 'message)
(require 'mouse)
-(require 'seq)
(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"))
(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)
(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)))
-(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)
(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
(defvar gnus-inhibit-hiding nil)
-(defvar gnus-article-edit-mode nil)
-
;;; Macros for dealing with the article buffer.
(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))
+(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-name)
+ (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-buffer)
- (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))))
(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-buffer?
- ;; 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 canceled)"))))))
+ ((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)) (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))))))
;;;###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)))))))
(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-article-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))
;; 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))))
(defun gnus-article-edit-exit ()
"Exit the article editing without updating."
@@ -8134,10 +8131,6 @@ gnus-article-copy-string
;;; Internal functions:
-(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 @@
;;; Code:
-(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 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
-
-(require 'gnus)
(require 'gnus-sum)
(declare-function gnus-agent-load-alist "gnus-agent" (group))
@@ -81,7 +78,7 @@ gnus-cache-coding-system
;;; Internal variables.
-(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 @@
;;; Code:
-(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 @@
;;; Code:
-(require 'gnus)
(require 'gnus-sum)
-(require 'message)
(require 'gnus-msg)
(require 'nndraft)
(require 'gnus-agent)
+(require 'gnus-cache)
;;; Draft minor mode
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:
(require 'mm-util)
-(require 'gnus-util)
(require 'gnus)
(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)
(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)))
(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))))))))
(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 (= (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)))
(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)))
(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))))
(defun gnus-activate-all-groups (level)
@@ -4167,17 +4152,13 @@ gnus-group-get-new-news
(unless gnus-child
(gnus-parent-read-child-newsrc))
- (gnus-get-unread-articles (gnus-group-default-level arg t)
- nil one-level)
+ (gnus-get-unread-articles arg nil one-level)
;; If the user wants it, we scan for new groups.
(when (eq gnus-check-new-newsgroups 'always)
(gnus-find-new-newsgroups))
- (gnus-check-reasonable-setup)
- (gnus-run-hooks 'gnus-after-getting-new-news-hook)
- (gnus-group-list-groups (and (numberp arg)
- (max (car gnus-group-list-mode) arg)))))
+ (gnus-check-reasonable-setup)))
(defun gnus-group-get-new-news-this-group (&optional n dont-scan)
"Check for newly arrived news in the current group (and the N-1 next groups).
@@ -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))))))))
;; 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)
-(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")
(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-opened))
+ (funcall (gnus-get-function gnus-command-method 'server-opened)
(nth 1 gnus-command-method)))))
(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= gnus-nntp-server "")))
- (setq gnus-select-method
- (cond ((or (string= gnus-nntp-server "")
- (string= 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-servers)
+ 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= 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))
- ;; 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)))))
(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
(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))))
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)))))
;; 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 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
-
(require 'gnus)
(require 'gnus-score)
-(require 'gnus-util)
;;; Internal variables.
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))
;;;###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 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
-
-(require 'gnus)
(require 'message)
(require 'gnus-art)
-(require 'gnus-util)
+(require 'cl-extra)
(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-mail'.
- ;; 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 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 ()
- ;; 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= ,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= 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-oarticle ,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)))
(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= gnus-newsgroup-name ""))))
@@ -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-copy)
+ (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 preserved."
+ (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)))))
(defun gnus-post-news (post &optional group header article-buffer yank _subject
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 "newsgroups"))
+ 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))))))
@@ -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-headers.
(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:
-(eval-when-compile (require 'cl-lib))
-
(require 'gnus)
(require 'gnus-art)
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 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
-(eval-when-compile (require 'subr-x))
(require 'gnus)
(require 'gnus-int)
(require 'gnus-sum)
(require 'gnus-art)
-(require 'gnus-util)
(require 'nnmail)
(require 'registry)
+(require 'subr-x)
(defvar gnus-adaptive-word-syntax-table)
@@ -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)))
(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)
(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)
(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 @@
;;; Code:
-(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)))))
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)
-(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.
@@ -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))))))
(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))))
- (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))
@@ -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)))))
;; 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)))))
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")
@@ -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 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
-(defvar gnus-newsrc-file-version)
-
(require 'gnus)
;;; Internal variables.
-(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 "")
@@ -129,13 +127,12 @@ gnus-update-format
(lisp-interaction-mode)
(insert (gnus-pp-to-string spec))))
-(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]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'\\|%[-0-9]*=\\|%[-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))))
(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]+\\)?\\([«»{}()]\\)" nil t)
- (let ((number (if (match-beginning 1)
- (match-string 1) "0"))
- (delim (aref (match-string 2) 0)))
- (if (or (= delim ?\()
- (= delim ?\{)
- (= delim 171)) ; «
- (replace-match (concat "\"("
- (cond ((= delim ?\() "mouse")
- ((= 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]+\\)?\\([«»{}()]\\)" nil t)
+ (let ((number (if (match-beginning 1)
+ (match-string 1) "0"))
+ (delim (aref (match-string 2) 0)))
+ (if (or (= delim ?\()
+ (= delim ?\{)
+ (= delim 171)) ; «
+ (replace-match (concat "\"("
+ (cond ((= delim ?\() "mouse")
+ ((= 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]+\\)=" 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)))))))
@@ -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 @@
;;; Code:
-(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)
-(eval-when-compile (require 'cl-lib))
+(declare-function gnus-group-decoded-name "gnus-group" (string))
+(declare-function gnus-group-default-level "gnus-group")
(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)
-(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.")
-(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")
(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.
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.
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.
E.g.:
(setq gnus-check-new-newsgroups
@@ -217,24 +218,15 @@ gnus-activate-foreign-newsgroups
:type '(choice integer
(const :tag "none" nil)))
-(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")
+(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)
@@ -378,6 +370,17 @@ gnus-options-not-subscribe
:type '(choice regexp
(const :tag "none" nil)))
+(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)
-(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)
-(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")
-(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)
-(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")
(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.")
-(defvar gnus-current-startup-file nil
- "Startup file for the current host.")
-
;; Byte-compiler warning.
(defvar gnus-group-line-format)
;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
(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-file)
+ (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)))
- (if gnus-agent
- (gnus-agentize))
+ (when gnus-agent
+ (gnus-agentize))
(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))
;; 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)))))
-\f
;;;
;;; 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"))
(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)))))))
(defun gnus-dribble-eval-file ()
@@ -941,27 +927,23 @@ gnus-dribble-clear
(set-buffer-modified-p nil)
(setq buffer-saved-size (buffer-size)))))
-\f
;;;
;;; Active & Newsrc File Handling
;;;
-(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))
;; 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))))))))
-(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-check)
"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 info.
- (when gnus-use-cache
- (inline (gnus-cache-possibly-alter-active
- group active)))
-
- ;; If the agent is enabled, we may have to alter the active info.
- (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)))))
(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))
- (let* ((range (gnus-info-read info))
- (num 0))
+ (let ((range (gnus-info-read info))
+ (num 0))
;; These checks are present in gnus-activate-group but skipped
;; due to setting dont-check in the preceding call.
;; 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))
;; 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)))
-;; 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-name))))
+
+(defun gnus-thread-group-running-p (thread-group)
+ (when-let ((thr (cl-some (lambda (thr)
+ (when (cl-search thread-group (thread-name thr))
+ 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 requested-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 #'= #'<=) (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 #'= #'<=)
+ (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 supported.
+ (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-server))
+ (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-articles: all done")
+ (when-let ((timer (cl-find-if (lambda (timer)
+ (eq (timer--function timer)
+ #'gnus-time-out-thread))
+ 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-group info))
+ update-p*)
+ (gnus-group-update-group (gnus-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."
+ (<= (cl-count thread-group*
+ (all-threads)
+ :test (lambda (s thr)
+ (cl-search s (thread-name thr))))
+ 1))
+ gnus-thread-group))
+ (gnus-push-end (gnus-chain-arg nil coda) commands)
+ (apply #'gnus-run-thread
+ (mapconcat (apply-partially #'format "%s")
+ (cl-subseq method 0 (min (length 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--subresult)))
+ commands))))))
+ infos-by-method)
+ (unless gnus-background-get-unread-articles
+ (funcall coda))))))
(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 method))
(or (not (gnus-agent-method-p method))
- (gnus-online method)))
+ (gnus-online method)))
(gnus-finish-retrieve-group-infos method infos early-data)
;; We may have altered the data now, so mark the dribble buffer
;; as dirty so that it gets saved.
@@ -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))))))
(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-method))
+ 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))))))
-(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))
(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)
-(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)))
-(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)
(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))
- ;; 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)))))
(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 mtime)
(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-system)
(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)))))
@@ -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)))
(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)))))
-
-\f
;;;
;;; Child functions.
;;;
@@ -3007,22 +2935,17 @@ 'gnus-slave-mode-hook
(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)))))
(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"))))
-\f
;;;
;;; Group description.
;;;
(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)
(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")
(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)
(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)
(defcustom gnus-thread-expunge-below nil
"All threads that have a total score less than this variable will be expunged.
@@ -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)
(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)
(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
(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)
(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 together.")
+(make-obsolete-variable 'gnus-sort-gathered-threads-function nil "28.1")
(defvar gnus-summary-save-parts-type-history nil)
(defvar gnus-summary-save-parts-last-directory mm-default-directory)
;; 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)
-(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".
-(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.")
(defvar gnus-summary-line-format-alist
@@ -1519,208 +1520,126 @@ gnus-last-shell-command
(defvar gnus-newsgroup-agentized nil
"Locally bound in each summary buffer to indicate if server has been agentized.")
-(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.")
-(defvar gnus-newsgroup-unselected nil
+(defvar-local gnus-newsgroup-unselected nil
"Sorted list of unselected unread articles in the current newsgroup.")
-(defvar gnus-newsgroup-reads nil
+(defvar-local gnus-newsgroup-reads nil
"Alist of read articles and article marks in the current newsgroup.")
-(defvar gnus-newsgroup-expunged-tally nil)
+(defvar-local gnus-newsgroup-expunged-tally 0)
-(defvar gnus-newsgroup-marked nil
+(defvar-local gnus-newsgroup-marked nil
"Sorted list of ticked articles in current newsgroup (a subset of unread art).")
-(defvar gnus-newsgroup-spam-marked nil
+(defvar-local gnus-newsgroup-spam-marked nil
"List of ranges of articles that have been marked as spam.")
-(defvar gnus-newsgroup-killed nil
+(defvar-local gnus-newsgroup-killed nil
"List of ranges of articles that have been through the scoring process.")
-(defvar gnus-newsgroup-cached nil
+(defvar-local gnus-newsgroup-cached nil
"Sorted list of articles that come from the article cache.")
-(defvar gnus-newsgroup-saved nil
+(defvar-local gnus-newsgroup-saved nil
"List of articles that have been saved.")
-(defvar gnus-newsgroup-kill-headers nil)
+(defvar-local gnus-newsgroup-kill-headers nil)
-(defvar gnus-newsgroup-replied nil
+(defvar-local gnus-newsgroup-replied nil
"List of articles that have been replied to in the current newsgroup.")
-(defvar gnus-newsgroup-forwarded nil
+(defvar-local gnus-newsgroup-forwarded nil
"List of articles that have been forwarded in the current newsgroup.")
-(defvar gnus-newsgroup-expirable nil
+(defvar-local gnus-newsgroup-expirable nil
"Sorted list of articles in the current newsgroup that can be expired.")
-(defvar gnus-newsgroup-processable nil
+(defvar-local gnus-newsgroup-processable nil
"List of articles in the current newsgroup that can be processed.")
-(defvar gnus-newsgroup-downloadable nil
+(defvar-local gnus-newsgroup-downloadable nil
"Sorted list of articles in the current newsgroup that can be processed.")
-(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.
This list will always be a subset of gnus-newsgroup-undownloaded.")
-(defvar gnus-newsgroup-undownloaded nil
+(defvar-local gnus-newsgroup-undownloaded nil
"List of articles in the current newsgroup that haven't been downloaded.")
-(defvar gnus-newsgroup-unsendable nil
+(defvar-local gnus-newsgroup-unsendable nil
"List of articles in the current newsgroup that won't be sent.")
-(defvar gnus-newsgroup-bookmarks nil
+(defvar-local gnus-newsgroup-bookmarks nil
"List of articles in the current newsgroup that have bookmarks.")
-(defvar gnus-newsgroup-dormant nil
+(defvar-local gnus-newsgroup-dormant nil
"Sorted list of dormant articles in the current newsgroup.")
-(defvar gnus-newsgroup-unseen nil
+(defvar-local gnus-newsgroup-unseen nil
"List of unseen articles in the current newsgroup.")
-(defvar gnus-newsgroup-seen nil
+(defvar-local gnus-newsgroup-seen nil
"Range of seen articles in the current newsgroup.")
-(defvar gnus-newsgroup-unexist nil
+(defvar-local gnus-newsgroup-unexist nil
"Range of unexisting articles in the current newsgroup.")
-(defvar gnus-newsgroup-articles nil
+(defvar-local gnus-newsgroup-articles nil
"List of articles in the current newsgroup.")
-(defvar gnus-newsgroup-scored nil
+(defvar-local gnus-newsgroup-scored nil
"List of scored articles in the current newsgroup.")
-(defvar gnus-newsgroup-headers nil
+(defvar-local gnus-newsgroup-headers nil
"List of article headers in the current newsgroup.")
-(defvar gnus-newsgroup-threads nil)
+(defvar-local gnus-newsgroup-threads nil)
-(defvar gnus-newsgroup-prepared nil
+(defvar-local gnus-newsgroup-prepared nil
"Whether the current group has been prepared properly.")
-(defvar gnus-newsgroup-ancient nil
+(defvar-local gnus-newsgroup-ancient nil
"List of `gnus-fetch-old-headers' articles in the current newsgroup.")
-(defvar gnus-newsgroup-sparse nil)
+(defvar-local gnus-newsgroup-sparse nil)
-(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)
-(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
- \\='(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")
(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))))
(defsubst gnus-simplify-subject-fully (subject)
"Simplify a subject string according to `gnus-summary-gather-subject-limit'."
@@ -3119,11 +3036,6 @@ bookmark-make-record-function
\f
(defvar bidi-paragraph-direction)
-(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.
\\<gnus-summary-mode-map>
@@ -3143,10 +3055,6 @@ gnus-summary-mode
\\{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))
;; Summary data functions.
@@ -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'.
-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 'summary-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))))
(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))
(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)))
(defun gnus-make-thread-indent-array (&optional n)
(when (or n
@@ -3635,63 +3476,57 @@ gnus-make-thread-indent-array
(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-<field> 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-<field> 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 "" 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)
+ pos)))))
(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 (= 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 articles,
+ ;; 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 removed
+ (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 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
+ '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-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-undownloaded))
+ (not (memq art gnus-newsgroup-downloadable)))
+ (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)))
(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))
-(defun gnus-sort-gathered-threads (threads)
- "Sort subthreads inside each gathered thread by `gnus-sort-gathered-threads-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)))))))
+(defmacro gnus-summary-assume-in-summary (&rest body)
+ "If we are not in an summary buffer, go there, and execute BODY. Restore."
+ (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)))))
(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 group)))
-
(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))))
(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)
(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))
;; Kludge to avoid having cached articles nixed out in virtual groups.
@@ -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))
(defun gnus-summary-display-make-predicate (display)
- (require 'gnus-agent)
(when (= (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
(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 nil 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-nil."
(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
(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 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))
+ (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))))
(defun gnus-summary-select-article (&optional all-headers force pseudo article)
"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))))
(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)))
(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)))))))))
(defun gnus-summary-walk-group-buffer (_from-group cmd unread backward start)
(let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
@@ -7909,7 +7712,6 @@ gnus-summary-next-page
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))))
(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)
+ (/= (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 @@
;;; Code:
-(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)
(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))))
- (gnus-update-format-specifications nil 'topic)
+ (gnus-update-format-specifications 'topic)
(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 @@
;;; Code:
-(require 'gnus-util)
(require 'gnus)
(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 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
-
(require 'seq)
(require 'time-date)
(require 'text-property-search)
+(require 'cl-seq)
(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)))))
+(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)))
@@ -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))))))
-(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)))
(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))
-(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)))
(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)))
-(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)
(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)))))
+(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)))))
+(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 entry)))
+ -1)))
+ (buffer-local-variables))))
+ (with-temp-buffer
+ (mapc (lambda (v) (set (make-local-variable (car v)) (cdr v))) gnus-vars)
+ ,@forms)))
+
(provide 'gnus-util)
;;; 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 @@
;;; Code:
-(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 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
-
(require 'gnus)
-(require 'gnus-util)
-(require 'seq)
+
+(declare-function gnus-group-name-at-point "gnus-group")
(defgroup gnus-windows nil
"Window configuration."
@@ -237,7 +235,28 @@ gnus-window-to-buffer-helper
nil)))
(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
(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))
- ;; 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)))
;; 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)
- ;; 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))))
(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 <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news, mail
-;; Version: 5.13
+;; Version: 5.14pre
;; This file is part of GNU Emacs.
@@ -29,12 +29,11 @@
(run-hooks 'gnus-load-hook)
-(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)
;; 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)
-(defconst gnus-version-number "5.13"
+(defconst gnus-version-number "5.14pre"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Gnus v%s" gnus-version-number)
@@ -850,9 +849,6 @@ gnus-splash-svg-color-symbols
;;; Do the rest.
-(require 'gnus-util)
-(require 'nnheader)
-
(defcustom gnus-parameters nil
"Alist of group parameters.
@@ -1024,35 +1020,29 @@ gnus-getenv-nntpserver
;; starting or even loading Gnus.
;;;###autoload(custom-autoload 'gnus-select-method "gnus")
+(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= 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 \\='(nntp \"flab.flab.edu\"))
-
-If you want to use your local spool, say:
-
-\(setq gnus-select-method (list \\='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-methods)))
:type 'gnus-select-method)
+(make-obsolete-variable 'gnus-select-method 'gnus-select-methods "28.1" 'set)
+(add-variable-watcher
+ 'gnus-select-method
+ (lambda (symbol newval operation _where)
+ (pcase operation
+ ((or 'set 'let 'unlet)
+ (custom-set-variables `(,symbol (quote ,newval)))))))
(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")
(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 \\='((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-methods "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-select-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 \\=`(gnus-select-methods
+ \\='((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)))))))
(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.")
-(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*")
(defvar gnus-child nil
@@ -2487,7 +2528,7 @@ gnus-moderated-hashtb
;; Save window configuration.
(defvar gnus-prev-winconf nil)
-(defvar gnus-reffed-article-number nil)
+(defvar-local gnus-reffed-article-number -1)
(defvar gnus-dead-summary nil)
@@ -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-*$" version)
(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))))
-(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))))
(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 @@
;;; Code:
(require 'gnus-start)
-(require 'gnus-util)
(require 'gnus-range)
(require 'gnus-agent)
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")
(declare-function gnus-setup-posting-charset "gnus-msg" (group))
+(declare-function gnus-msg-inherit-variables "gnus-msg" (source-buffer dest-buffer))
(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))
- (message-pop-to-buffer (message-buffer-name "followup" from newsgroups))
+ (let ((before-pop (current-buffer)))
+ (message-pop-to-buffer (message-buffer-name "followup" from newsgroups))
+ (gnus-msg-inherit-variables before-pop (current-buffer)))
(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)
;; FIXME not explicitly used in this file.
--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 @@
;;; Code:
-(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)
-;; 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
(autoload 'gnus-get-buffer-create "gnus")
-(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-buffer' 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))
+(defun nnheader-init-server-buffer ()
+ "Initialize the Gnus-backend communication buffer."
+ (unless (gnus-buffer-live-p nntp-server-buffer)
+ (setq nntp-server-buffer (get-buffer-create " *nntpd*")))
+ (nnheader-prep-server-buffer nntp-server-buffer))
+
;;; Various functions the backends use.
(defun nnheader-file-error (file)
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 3e2a202a6c..fe0b79870b 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -26,21 +26,37 @@
;;; Code:
-(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)
(autoload 'auth-source-forget+ "auth-source")
(autoload 'auth-source-search "auth-source")
+(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)
(defvoo nnimap-address nil
@@ -123,8 +139,6 @@ nnimap-streaming
Switching this off will make nnimap slower, but it helps with
some servers.")
-(defvoo nnimap-connection-alist nil)
-
(defvoo nnimap-current-infos nil)
(defvoo nnimap-namespace nil)
@@ -174,7 +188,6 @@ nnimap-process
(defvar nnimap-status-string "")
(defvar nnimap-keepalive-timer nil)
-(defvar nnimap-process-buffers nil)
(cl-defstruct nnimap
group process commands capabilities select-result newlinep server
@@ -199,10 +212,29 @@ nnimap-quirks
(defvar nnimap-inhibit-logging nil)
+(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)))
-(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)))
(defun nnimap-header-parameters ()
(let (params)
@@ -233,10 +268,10 @@ nnimap-header-parameters
(format "%s" (nreverse params))))
(deffoo nnimap-retrieve-headers (articles &optional group server _fetch-old)
- (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))
(defun nnimap-transform-headers ()
@@ -366,32 +400,35 @@ nnimap-article-ranges
result))
(mapconcat #'identity (nreverse result) ",")))))
-(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))) nnimap-vars)
+ (setq-local nnimap-object (make-nnimap :server server
+ :initial-resync 0))))))
(defvar auth-source-creation-prompts)
@@ -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 = (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 = (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)))
-;; 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)
- (<= (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= "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 "NAMESPACE"))
- (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))))))))
+ `(,@(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= "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 "NAMESPACE"))
+ (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)))))))
(autoload 'rfc2104-hash "rfc2104")
@@ -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))
@@ -664,16 +700,13 @@ nnimap-request-close
t)
(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))
(deffoo nnimap-status-message (&optional _server)
nnimap-status-string)
(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
(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)))))))
(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
(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))))))
(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))))))
(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
(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")))))
(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"))))
(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
(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)))))))
(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
(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
(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)))
(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))
-(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)))))
(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)))))))
-(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,
+\((#<buffer *nntpd*> #<buffer *nnimap localhost 143 *nntpd**-XXXXXX>))
+
+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))
;; 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))))
(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))
(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"))))))
(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 @@
(require 'nnheader)
(require 'gnus)
-(require 'gnus-util)
(require 'gnus-range)
(require 'gnus-start)
(require 'gnus-int)
--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 @@
(require 'nnheader)
(require 'nnoo)
-(require 'gnus-util)
-(require 'gnus)
(require 'gnus-group) ;; gnus-group-name-charset
(nnoo-declare nntp)
@@ -252,7 +250,6 @@ nntp-server-list-active-group
;;; Internal variables.
-(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
(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)))
@@ -410,7 +406,7 @@ nntp-erase-buffer
(with-current-buffer buffer
(erase-buffer)))
-(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
(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)))
(defun nntp-retrieve-data (command address _port buffer
&optional wait-for callback decode)
@@ -528,8 +523,8 @@ nntp-send-command-nodelete
(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 value
+ (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)))))
(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 retrieval 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)))
(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 buffer))))
+ (setq nntp-connection-list
+ (delq process nntp-connection-list))
+ (setq nntp-connection-alist
+ (assq-delete-all process nntp-connection-alist))
+ (ignore-errors (delete-process process))))
+ buffer)
+ nil t))
(with-current-buffer pbuffer
(nntp-read-server-type)
(erase-buffer)
diff --git a/lisp/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 @@
(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 @@
;;; Code:
-(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
(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))
;; 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:
(require 'gnus-sum)
-(require 'gnus-util)
(require 'nnheader)
(or (require 'nnselect nil t) ; Emacs >= 28
(require 'nnir nil t)) ; Emacs < 28
diff --git a/test/lisp/gnus/gnus-test-select-methods.el b/test/lisp/gnus/gnus-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 <https://www.gnu.org/licenses/>.
+
+;;; 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 test-methods))))
+ (should (cl-every #'identity
+ (cl-mapcar #'gnus-methods-equal-p gnus-select-methods 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-select-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-methods 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-select-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 test-methods)))
+ `(gnus-select-methods (quote ,override-methods)))
+ (should (cl-every #'identity
+ (cl-mapcar #'gnus-methods-equal-p gnus-select-methods 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-select-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-name)))))))
+
+(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.
;;; 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 "gnus-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.eld"))
+ (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)))
(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!"))))))
+(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:
(require 'thread)
+(require 'eieio)
+(require 'ring)
;; Declare the functions in case Emacs has been configured --without-threads.
(declare-function all-threads "thread.c" ())
@@ -42,6 +44,26 @@
(declare-function thread-yield "thread.c" ())
(defvar main-thread)
+(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) message)
+ (with-slots (condition msg-queue) channel
+ (with-mutex (condition-mutex condition)
+ (while (<= (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)))))
@@ -389,7 +411,99 @@ threads-condvar-wait
(should (equal (thread-last-error) '(error "Die, die, die!")))))
(ert-deftest threads-test-bug33073 ()
+ (skip-unless (featurep 'threads))
(let ((th (make-thread 'ignore)))
(should-not (equal th main-thread))))
-;;; threads.el ends here
+(ert-deftest threads-test-bug36609-signal ()
+ "Would only fail under TEST_INTERACTIVE=yes, 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 wait()
+ (make-thread notify "notify")
+ (funcall wait)
+ (thread-signal herring 'quit nil)))
+
+(ert-deftest threads-test-glib-lock ()
+ "Would only fail under TEST_INTERACTIVE=yes, 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) "channel")
+ :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 "/dev/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-process 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 thr)))
+ (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
--
2.26.2
[-- Attachment #2: Type: text/plain, Size: 20240 bytes --]
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))
^ permalink raw reply related [flat|nested] 8+ messages in thread
* bug#49065: 28.0.50; Major Changes to Gnus
2021-06-16 17:57 bug#49065: 28.0.50; Major Changes to Gnus dick.r.chiang
@ 2021-06-21 20:03 ` Filipp Gunbin
2021-06-21 20:39 ` Eric Abrahamsen
0 siblings, 1 reply; 8+ messages in thread
From: Filipp Gunbin @ 2021-06-21 20:03 UTC (permalink / raw)
To: dick.r.chiang; +Cc: 49065
It'd be more helpful to submit this in series of small-to-middle
patches. It's very hard to review a "patch bomb"...
Filipp
^ permalink raw reply [flat|nested] 8+ messages in thread
* bug#49065: 28.0.50; Major Changes to Gnus
2021-06-21 20:03 ` Filipp Gunbin
@ 2021-06-21 20:39 ` Eric Abrahamsen
2021-09-19 16:52 ` Stefan Kangas
2021-11-11 5:11 ` Lars Ingebrigtsen
0 siblings, 2 replies; 8+ messages in thread
From: Eric Abrahamsen @ 2021-06-21 20:39 UTC (permalink / raw)
To: Filipp Gunbin; +Cc: 49065, dick.r.chiang
Filipp Gunbin <fgunbin@fastmail.fm> writes:
> It'd be more helpful to submit this in series of small-to-middle
> patches. It's very hard to review a "patch bomb"...
+1. You're stuck with the code reviewers you've got, so in the interest
of seeing your changes go in, I'd recommend making things easier on us
mere mortals. At the very least, separate your doc changes out from your
code changes.
Sincerely,
Someone who would like these changes or something like them to be applied
^ permalink raw reply [flat|nested] 8+ messages in thread
* bug#49065: 28.0.50; Major Changes to Gnus
2021-06-21 20:39 ` Eric Abrahamsen
@ 2021-09-19 16:52 ` Stefan Kangas
2021-09-20 1:20 ` Eric Abrahamsen
2021-11-11 5:11 ` Lars Ingebrigtsen
1 sibling, 1 reply; 8+ messages in thread
From: Stefan Kangas @ 2021-09-19 16:52 UTC (permalink / raw)
To: Eric Abrahamsen; +Cc: 49065, Filipp Gunbin, dick.r.chiang
Eric Abrahamsen <eric@ericabrahamsen.net> writes:
> Filipp Gunbin <fgunbin@fastmail.fm> writes:
>
>> It'd be more helpful to submit this in series of small-to-middle
>> patches. It's very hard to review a "patch bomb"...
>
> +1. You're stuck with the code reviewers you've got, so in the interest
> of seeing your changes go in, I'd recommend making things easier on us
> mere mortals. At the very least, separate your doc changes out from your
> code changes.
>
> Sincerely,
> Someone who would like these changes or something like them to be applied
Any updates here? It would be great if these changes could go in, but
they would need to be broken down into much smaller chunks for that to
happen.
^ permalink raw reply [flat|nested] 8+ messages in thread
* bug#49065: 28.0.50; Major Changes to Gnus
2021-09-19 16:52 ` Stefan Kangas
@ 2021-09-20 1:20 ` Eric Abrahamsen
2021-09-20 7:12 ` Stefan Kangas
0 siblings, 1 reply; 8+ messages in thread
From: Eric Abrahamsen @ 2021-09-20 1:20 UTC (permalink / raw)
To: Stefan Kangas; +Cc: 49065, Filipp Gunbin, dick.r.chiang
Stefan Kangas <stefan@marxist.se> writes:
> Eric Abrahamsen <eric@ericabrahamsen.net> writes:
>
>> Filipp Gunbin <fgunbin@fastmail.fm> writes:
>>
>>> It'd be more helpful to submit this in series of small-to-middle
>>> patches. It's very hard to review a "patch bomb"...
>>
>> +1. You're stuck with the code reviewers you've got, so in the interest
>> of seeing your changes go in, I'd recommend making things easier on us
>> mere mortals. At the very least, separate your doc changes out from your
>> code changes.
>>
>> Sincerely,
>> Someone who would like these changes or something like them to be applied
>
> Any updates here? It would be great if these changes could go in, but
> they would need to be broken down into much smaller chunks for that to
> happen.
I think the update is that the bug reporter has forked Emacs entirely:
https://github.com/dickmao/commercial-emacs
Probably this bug report can be closed.
^ permalink raw reply [flat|nested] 8+ messages in thread
* bug#49065: 28.0.50; Major Changes to Gnus
2021-09-20 1:20 ` Eric Abrahamsen
@ 2021-09-20 7:12 ` Stefan Kangas
2021-09-21 22:15 ` Richard Stallman
0 siblings, 1 reply; 8+ messages in thread
From: Stefan Kangas @ 2021-09-20 7:12 UTC (permalink / raw)
To: Eric Abrahamsen; +Cc: 49065, Filipp Gunbin, dick.r.chiang
Eric Abrahamsen <eric@ericabrahamsen.net> writes:
> I think the update is that the bug reporter has forked Emacs entirely:
>
> https://github.com/dickmao/commercial-emacs
>
> Probably this bug report can be closed.
This code was offered to Emacs, so I don't think the fork is relevant.
We are still waiting to hear back from the original poster of this bug
report, to see if he is prepared to break this patch down into smaller
chunks. That would be by far the best outcome for Emacs, both the
original version and his fork. (It would, among other things, of course
make the work of maintaining his fork easier.)
If he can't or won't do that, perhaps there is someone else here who is
capable and willing to do that work. Perhaps there are features in
there that are indeed very useful. I don't know, but I feel like it
would at the very least be worth taking a look.
Only if both those options fail, should we close this bug report.
But that's just my opinion, of course.
^ permalink raw reply [flat|nested] 8+ messages in thread
* bug#49065: 28.0.50; Major Changes to Gnus
2021-09-20 7:12 ` Stefan Kangas
@ 2021-09-21 22:15 ` Richard Stallman
0 siblings, 0 replies; 8+ messages in thread
From: Richard Stallman @ 2021-09-21 22:15 UTC (permalink / raw)
To: Stefan Kangas; +Cc: eric, 49065, fgunbin, dick.r.chiang
[[[ To any NSA and FBI agents reading my email: please consider ]]]
[[[ whether defending the US Constitution against all enemies, ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]
> This code was offered to Emacs, so I don't think the fork is relevant.
That is good news. If his changes are good, we would definitely want
to merge them.
--
Dr Richard Stallman (https://stallman.org)
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)
^ permalink raw reply [flat|nested] 8+ messages in thread
* bug#49065: 28.0.50; Major Changes to Gnus
2021-06-21 20:39 ` Eric Abrahamsen
2021-09-19 16:52 ` Stefan Kangas
@ 2021-11-11 5:11 ` Lars Ingebrigtsen
1 sibling, 0 replies; 8+ messages in thread
From: Lars Ingebrigtsen @ 2021-11-11 5:11 UTC (permalink / raw)
To: Eric Abrahamsen; +Cc: 49065, Filipp Gunbin, dick.r.chiang
Eric Abrahamsen <eric@ericabrahamsen.net> writes:
> +1. You're stuck with the code reviewers you've got, so in the interest
> of seeing your changes go in, I'd recommend making things easier on us
> mere mortals. At the very least, separate your doc changes out from your
> code changes.
There's been no movement here in 20 weeks, so it seems unlikely there'll
be any further developments here, and I'm closing this bug report.
(Improving Gnus in the areas I ... imagine these changes do would be
great, though, so I hope they'll be resubmitted in a fashion that will
allow us to apply them.)
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 8+ messages in thread
end of thread, other threads:[~2021-11-11 5:11 UTC | newest]
Thread overview: 8+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2021-06-16 17:57 bug#49065: 28.0.50; Major Changes to Gnus dick.r.chiang
2021-06-21 20:03 ` Filipp Gunbin
2021-06-21 20:39 ` Eric Abrahamsen
2021-09-19 16:52 ` Stefan Kangas
2021-09-20 1:20 ` Eric Abrahamsen
2021-09-20 7:12 ` Stefan Kangas
2021-09-21 22:15 ` Richard Stallman
2021-11-11 5:11 ` Lars Ingebrigtsen
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).