;;; gnus-sum.el --- summary mode commands for Gnus
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 2, or (at your option)
-;; any later version.
+;; 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
+;; 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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
+;; For Emacs <22.2 and XEmacs.
+(eval-and-compile
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile
- (require 'cl)
- (defvar tool-bar-mode))
+ (require 'cl))
+(eval-when-compile
+ (when (featurep 'xemacs)
+ (require 'easy-mmode))) ; for `define-minor-mode'
+
+(defvar tool-bar-mode)
+(defvar gnus-tmp-header)
(require 'gnus)
(require 'gnus-group)
:group 'gnus-summary-exit
:type 'boolean)
+(defcustom gnus-summary-next-group-on-exit t
+ "If non-nil, go to the next unread newsgroup on summary exit.
+See `gnus-group-goto-unread'."
+ :link '(custom-manual "(gnus)Group Maneuvering")
+ :group 'gnus-summary-exit
+ :version "23.1" ;; No Gnus
+ :type 'boolean)
+
+(defcustom gnus-summary-stop-at-end-of-message nil
+ "If non-nil, don't select the next message when using `SPC'."
+ :link '(custom-manual "(gnus)Group Maneuvering")
+ :group 'gnus-summary-maneuvering
+ :version "24.1"
+ :type 'boolean)
+
(defcustom gnus-fetch-old-headers nil
"*Non-nil means that Gnus will try to build threads by grabbing old headers.
If an unread article in the group refers to an older, already
The server has to support NOV for any of this to work.
This feature can seriously impact performance it ignores all
-locally cached header entries."
+locally cached header entries. Setting it to t for groups for a
+server that doesn't expire articles (such as news.gmane.org),
+leads to very slow summary generation."
:group 'gnus-thread
:type '(choice (const :tag "off" nil)
(const :tag "on" t)
If this variable is `adopt', Gnus will make one of the \"children\"
the parent and mark all the step-children as such.
If this variable is `empty', the \"children\" are printed with empty
-subject fields. (Or rather, they will be printed with a string
+subject fields. (Or rather, they will be printed with a string
given by the `gnus-summary-same-subject' variable.)"
:group 'gnus-thread
:type '(choice (const :tag "off" nil)
:group 'gnus-summary-format
:type 'string)
-(defcustom gnus-summary-goto-unread t
+(defcustom gnus-summary-goto-unread nil
"*If t, many commands will go to the next unread article.
This applies to marking commands as well as other commands that
\"naturally\" select the next article, like, for instance, `SPC' at
\(they go to the next article instead). If `never', commands that
usually go to the next unread article, will go to the next article,
whether it is read or not."
+ :version "24.1"
:group 'gnus-summary-marks
:link '(custom-manual "(gnus)Setting Marks")
:type '(choice (const :tag "off" nil)
:type 'boolean)
(defcustom gnus-auto-select-first t
- "*If non-nil, select the article under point.
-Which article this is is controlled by the `gnus-auto-select-subject'
-variable.
+ "If non-nil, select an article on group entry.
+An article is selected automatically when entering a group
+e.g. with \\<gnus-group-mode-map>\\[gnus-group-read-group], or via `gnus-summary-next-page' or
+`gnus-summary-catchup-and-goto-next-group'.
+
+Which article is selected is controlled by the variable
+`gnus-auto-select-subject'.
If you want to prevent automatic selection of articles in some
newsgroups, set the variable to nil in `gnus-select-group-hook'."
+ ;; Commands include...
+ ;; \\<gnus-group-mode-map>\\[gnus-group-read-group]
+ ;; \\<gnus-summary-mode-map>\\[gnus-summary-next-page]
+ ;; \\<gnus-summary-mode-map>\\[gnus-summary-catchup-and-goto-next-group]
:group 'gnus-group-select
:type '(choice (const :tag "none" nil)
(sexp :menu-tag "first" t)))
-(defcustom gnus-auto-select-subject 'unread
+(defcustom gnus-auto-select-subject 'unseen-or-unread
"*Says what subject to place under point when entering a group.
This variable can either be the symbols `first' (place point on the
line of the first unseen article or, if all article have been seen, on the
subject line of the first unread article), or a function to be called to
place point on some subject line."
- :version "22.1"
+ :version "24.1"
:group 'gnus-group-select
:type '(choice (const best)
(const unread)
:group 'gnus-summary-maneuvering
:type 'boolean)
+(defcustom gnus-auto-select-on-ephemeral-exit 'next-noselect
+ "What article should be selected after exiting an ephemeral group.
+Valid values include:
+
+`next'
+ Select the next article.
+`next-unread'
+ Select the next unread article.
+`next-noselect'
+ Move the cursor to the next article. This is the default.
+`next-unread-noselect'
+ Move the cursor to the next unread article.
+
+If it has any other value or there is no next (unread) article, the
+article selected before entering to the ephemeral group will appear."
+ :version "23.1" ;; No Gnus
+ :group 'gnus-summary-maneuvering
+ :type '(choice :format "%{%t%}:\n %[Value Menu%] %v"
+ (const next) (const next-unread)
+ (const next-noselect) (const next-unread-noselect)
+ (sexp :tag "other" :value nil)))
+
(defcustom gnus-auto-goto-ignores 'unfetched
"*Says how to handle unfetched articles when maneuvering.
(integer :tag "height")
(sexp :menu-tag "both" t)))
-(defvar gnus-auto-center-group t
- "*If non-nil, always center the group buffer.")
+(defcustom gnus-auto-center-group t
+ "If non-nil, always center the group buffer."
+ :group 'gnus-summary-maneuvering
+ :type 'boolean)
(defcustom gnus-show-all-headers nil
"*If non-nil, don't hide any headers."
:group 'gnus-summary
:type 'boolean)
-(defcustom gnus-single-article-buffer t
+(defcustom gnus-single-article-buffer nil
"*If non-nil, display all articles in the same buffer.
If nil, each group will get its own article buffer."
+ :version "24.1"
+ :group 'gnus-article-various
+ :type 'boolean)
+
+(defcustom gnus-widen-article-window nil
+ "If non-nil, selecting the article buffer will display only the article buffer."
+ :version "24.1"
:group 'gnus-article-various
:type 'boolean)
:group 'gnus-summary-marks
:type 'character)
-(defcustom gnus-souped-mark ?F
- "*Mark used for souped articles."
- :group 'gnus-summary-marks
- :type 'character)
-
(defcustom gnus-kill-file-mark ?X
"*Mark used for articles killed by kill files."
:group 'gnus-summary-marks
(defcustom gnus-auto-expirable-marks
(list gnus-killed-mark gnus-del-mark gnus-catchup-mark
gnus-low-score-mark gnus-ancient-mark gnus-read-mark
- gnus-souped-mark gnus-duplicate-mark)
+ gnus-duplicate-mark)
"*The list of marks converted into expiration if a group is auto-expirable."
- :version "21.1"
+ :version "24.1"
:group 'gnus-summary
:type '(repeat character))
:group 'gnus-summary
:type 'boolean)
+(defcustom gnus-mark-copied-or-moved-articles-as-expirable nil
+ "If non-nil, mark articles copied or moved to auto-expire group as expirable.
+If nil, the expirable marks will be unchanged except that the marks
+will be removed when copying or moving articles to a group that has
+not turned auto-expire on. If non-nil, articles that have been read
+will be marked as expirable when being copied or moved to a group in
+which auto-expire is turned on."
+ :version "23.2"
+ :type 'boolean
+ :group 'gnus-summary-marks)
+
(defcustom gnus-view-pseudos nil
"*If `automatic', pseudo-articles will be viewed automatically.
If `not-confirm', pseudos will be viewed automatically, and the user
:group 'gnus-various
:type 'hook)
-(defcustom gnus-summary-update-hook
- (list 'gnus-summary-highlight-line)
+(defcustom gnus-summary-update-hook nil
"*A hook called when a summary line is changed.
The hook will not be called if `gnus-visual' is nil.
. gnus-summary-normal-read))
"*Controls the highlighting of summary buffer lines.
-A list of (FORM . FACE) pairs. When deciding how a a particular
+A list of (FORM . FACE) pairs. When deciding how a particular
summary line should be displayed, each form is evaluated. The content
of the face field after the first true form is used. You can change
how those summary lines are displayed, by editing the face field.
You can use the following variables in the FORM field.
-score: The article's score
+score: The article's score.
default: The default article score.
default-high: The default score for high scored articles.
default-low: The default score for low scored articles.
:group 'gnus-summary-visual
:type '(repeat (cons (sexp :tag "Form" nil)
face)))
+(put 'gnus-summary-highlight 'risky-local-variable t)
(defcustom gnus-alter-header-function nil
"Function called to allow alteration of article header structures.
(and user-mail-address
(not (string= user-mail-address ""))
(regexp-quote user-mail-address))
- "*Regexp of From headers that may be suppressed in favor of To headers."
+ "*From headers that may be suppressed in favor of To headers.
+This can be a regexp or a list of regexps."
:version "21.1"
:group 'gnus-summary
- :type 'regexp)
+ :type '(choice regexp
+ (repeat :tag "Regexp List" regexp)))
+
+(defsubst gnus-ignored-from-addresses ()
+ (gmm-regexp-concat gnus-ignored-from-addresses))
(defcustom gnus-summary-to-prefix "-> "
"*String prefixed to the To field in the summary line when
:type '(repeat symbol)
:group 'gnus-charset)
+(defcustom gnus-newsgroup-maximum-articles nil
+ "The maximum number of articles a newsgroup.
+If this is a number, old articles in a newsgroup exceeding this number
+are silently ignored. If it is nil, no article is ignored. Note that
+setting this variable to a number might prevent you from reading very
+old articles."
+ :group 'gnus-group-select
+ :version "22.2"
+ :type '(choice (const :tag "No limit" nil)
+ integer))
+
(gnus-define-group-parameter
ignored-charsets
:type list
:type 'boolean
:group 'gnus-summary-marks)
+(defcustom gnus-propagate-marks t
+ "If non-nil, do not propagate marks to the backends."
+ :version "23.1" ;; No Gnus
+ :type 'boolean
+ :group 'gnus-summary-marks)
+
(defcustom gnus-alter-articles-to-read-function nil
"Function to be called to alter the list of articles to be selected."
:type '(choice (const nil) function)
"Whether Gnus should parse all headers made available to it.
This is mostly relevant for slow back ends where the user may
wish to widen the summary buffer to include all headers
-that were fetched. Say, for nnultimate groups."
+that were fetched."
:version "22.1"
:group 'gnus-summary
:type '(choice boolean regexp))
+(defcustom gnus-summary-pipe-output-default-command nil
+ "Command (and optional arguments) used to pipe article to subprocess.
+This will be used as the default command if it is non-nil. The value
+will be updated if you modify it when executing the command
+`gnus-summary-pipe-output' or the function `gnus-summary-save-in-pipe'."
+ :version "23.1" ;; No Gnus
+ :group 'gnus-summary
+ :type '(radio (const :tag "None" nil) (string :tag "Command")))
+
(defcustom gnus-summary-muttprint-program "muttprint"
- "Command (and optional arguments) used to run Muttprint."
+ "Command (and optional arguments) used to run Muttprint.
+The value will be updated if you modify it when executing the command
+`gnus-summary-muttprint'."
:version "22.1"
:group 'gnus-summary
:type 'string)
(?E gnus-newsgroup-expunged-tally ?d)
(?s (gnus-current-score-file-nondirectory) ?s)))
+;; This is here rather than in gnus-art for compilation reasons.
+(defvar gnus-article-mode-line-format-alist
+ (nconc '((?w (gnus-article-wash-status) ?s)
+ (?m (gnus-article-mime-part-status) ?s))
+ gnus-summary-mode-line-format-alist))
+
(defvar gnus-last-search-regexp nil
"Default regexp for article search command.")
(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-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-recent
+ gnus-newsgroup-expirable
+ gnus-newsgroup-killed
+ gnus-newsgroup-unseen
+ gnus-newsgroup-seen
+ gnus-newsgroup-cached
+ gnus-newsgroup-downloadable
+ gnus-newsgroup-undownloaded
+ gnus-newsgroup-unsendable
+
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-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-recent
- gnus-newsgroup-expirable
- gnus-newsgroup-processable gnus-newsgroup-killed
- gnus-newsgroup-downloadable gnus-newsgroup-undownloaded
+ gnus-newsgroup-auto-expire
+ gnus-newsgroup-processable
gnus-newsgroup-unfetched
- gnus-newsgroup-unsendable gnus-newsgroup-unseen
- gnus-newsgroup-seen gnus-newsgroup-articles
+ gnus-newsgroup-articles
gnus-newsgroup-bookmarks gnus-newsgroup-dormant
gnus-newsgroup-headers gnus-newsgroup-threads
gnus-newsgroup-prepared gnus-summary-highlight-line-function
(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-cached
+ gnus-cache-removable-articles
gnus-newsgroup-data gnus-newsgroup-data-reverse
gnus-newsgroup-limit gnus-newsgroup-limits
gnus-newsgroup-charset gnus-newsgroup-display
\"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\")))
")
-;; Byte-compiler warning.
(eval-when-compile
;; Bind features so that require will believe that gnus-sum has
;; already been loaded (avoids infinite recursion)
(let ((features (cons 'gnus-sum features)))
- ;; Several of the declarations in gnus-sum are needed to load the
- ;; following files. Right now, these definitions have been
- ;; compiled but not defined (evaluated). We could either do a
- ;; eval-and-compile about all of the declarations or evaluate the
- ;; source file.
- (if (boundp 'gnus-newsgroup-variables)
- nil
- (load "gnus-sum.el" t t t))
- (require 'gnus)
(require 'gnus-art)))
;; MIME stuff.
(eq gnus-newsgroup-name
(car gnus-decode-encoded-word-methods-cache)))
(setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name))
- (mapcar (lambda (x)
- (if (symbolp x)
- (nconc gnus-decode-encoded-word-methods-cache (list x))
- (if (and gnus-newsgroup-name
- (string-match (car x) gnus-newsgroup-name))
- (nconc gnus-decode-encoded-word-methods-cache
- (list (cdr x))))))
- gnus-decode-encoded-word-methods))
- (let ((xlist gnus-decode-encoded-word-methods-cache))
- (pop xlist)
- (while xlist
- (setq string (funcall (pop xlist) string))))
- string)
+ (dolist (method gnus-decode-encoded-word-methods)
+ (if (symbolp method)
+ (nconc gnus-decode-encoded-word-methods-cache (list method))
+ (if (and gnus-newsgroup-name
+ (string-match (car method) gnus-newsgroup-name))
+ (nconc gnus-decode-encoded-word-methods-cache
+ (list (cdr method)))))))
+ (dolist (method (cdr gnus-decode-encoded-word-methods-cache) string)
+ (setq string (funcall method string))))
;; Subject simplification.
(setq modified-tick (buffer-modified-tick))
(cond
((listp gnus-simplify-subject-fuzzy-regexp)
- (mapcar 'gnus-simplify-buffer-fuzzy-step
- gnus-simplify-subject-fuzzy-regexp))
+ (mapc 'gnus-simplify-buffer-fuzzy-step
+ gnus-simplify-subject-fuzzy-regexp))
(gnus-simplify-subject-fuzzy-regexp
(gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp)))
(gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *")
((eq gnus-summary-gather-subject-limit 'fuzzy)
(gnus-simplify-subject-fuzzy subject))
((numberp gnus-summary-gather-subject-limit)
- (gnus-limit-string (gnus-simplify-subject-re subject)
- gnus-summary-gather-subject-limit))
+ (truncate-string-to-width (gnus-simplify-subject-re subject)
+ gnus-summary-gather-subject-limit))
(t
subject)))
"?" gnus-summary-mark-as-dormant
"\C-c\M-\C-s" gnus-summary-limit-include-expunged
"\C-c\C-s\C-n" gnus-summary-sort-by-number
+ "\C-c\C-s\C-m\C-n" gnus-summary-sort-by-most-recent-number
"\C-c\C-s\C-l" gnus-summary-sort-by-lines
"\C-c\C-s\C-c" gnus-summary-sort-by-chars
"\C-c\C-s\C-a" gnus-summary-sort-by-author
"\C-c\C-s\C-t" gnus-summary-sort-by-recipient
"\C-c\C-s\C-s" gnus-summary-sort-by-subject
"\C-c\C-s\C-d" gnus-summary-sort-by-date
+ "\C-c\C-s\C-m\C-d" gnus-summary-sort-by-most-recent-date
"\C-c\C-s\C-i" gnus-summary-sort-by-score
"\C-c\C-s\C-o" gnus-summary-sort-by-original
"\C-c\C-s\C-r" gnus-summary-sort-by-random
"=" gnus-summary-expand-window
"\C-x\C-s" gnus-summary-reselect-current-group
"\M-g" gnus-summary-rescan-group
- "w" gnus-summary-stop-page-breaking
"\C-c\C-r" gnus-summary-caesar-message
"f" gnus-summary-followup
"F" gnus-summary-followup-with-original
[follow-link] mouse-face
"m" gnus-summary-mail-other-window
"a" gnus-summary-post-news
- "i" gnus-summary-news-other-window
"x" gnus-summary-limit-to-unread
"s" gnus-summary-isearch-article
"t" gnus-summary-toggle-header
"/" gnus-summary-limit-to-subject
"n" gnus-summary-limit-to-articles
"b" gnus-summary-limit-to-bodies
+ "h" gnus-summary-limit-to-headers
"w" gnus-summary-pop-limit
"s" gnus-summary-limit-to-subject
"a" gnus-summary-limit-to-author
"C" gnus-summary-limit-mark-excluded-as-read
"o" gnus-summary-insert-old-articles
"N" gnus-summary-insert-new-articles
+ "S" gnus-summary-limit-to-singletons
"r" gnus-summary-limit-to-replied
- "R" gnus-summary-limit-to-recipient)
+ "R" gnus-summary-limit-to-recipient
+ "A" gnus-summary-limit-to-address)
(gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
"n" gnus-summary-next-unread-article
(gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map)
"k" gnus-summary-kill-thread
+ "E" gnus-summary-expire-thread
"l" gnus-summary-lower-thread
"i" gnus-summary-raise-thread
"T" gnus-summary-toggle-threads
(gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map)
"g" gnus-summary-prepare
"c" gnus-summary-insert-cached-articles
- "d" gnus-summary-insert-dormant-articles)
+ "d" gnus-summary-insert-dormant-articles
+ "t" gnus-summary-insert-ticked-articles)
(gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
"c" gnus-summary-catchup-and-exit
"e" gnus-summary-end-of-article
"^" gnus-summary-refer-parent-article
"r" gnus-summary-refer-parent-article
+ "C" gnus-summary-show-complete-article
"D" gnus-summary-enter-digest-group
"R" gnus-summary-refer-references
"T" gnus-summary-refer-thread
"g" gnus-summary-show-article
"s" gnus-summary-isearch-article
"P" gnus-summary-print-article
+ "S" gnus-sticky-article
"M" gnus-mailing-list-insinuate
"t" gnus-article-babel)
"d" gnus-article-display-face
"s" gnus-treat-smiley
"D" gnus-article-remove-images
+ "W" gnus-html-show-images
"f" gnus-treat-from-picon
"m" gnus-treat-mail-picon
- "n" gnus-treat-newsgroups-picon)
+ "n" gnus-treat-newsgroups-picon
+ "g" gnus-treat-from-gravatar
+ "h" gnus-treat-mail-gravatar)
(gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map)
"w" gnus-article-decode-mime-words
(gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
"v" gnus-version
- "f" gnus-summary-fetch-faq
"d" gnus-summary-describe-group
"h" gnus-summary-describe-briefly
"i" gnus-info-find-node
- "c" gnus-group-fetch-charter
"C" gnus-group-fetch-control)
(gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
"h" gnus-summary-save-article-folder
"v" gnus-summary-save-article-vm
"p" gnus-summary-pipe-output
- "P" gnus-summary-muttprint
- "s" gnus-soup-add-article)
+ "P" gnus-summary-muttprint)
(gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
"b" gnus-summary-display-buttonized
"O" gnus-uu-decode-save
"b" gnus-uu-decode-binhex
"B" gnus-uu-decode-binhex
+ "Y" gnus-uu-decode-yenc
"p" gnus-uu-decode-postscript
"P" gnus-uu-decode-postscript-and-save)
["Set mark below..." gnus-score-set-mark-below t]
["Set expunge below..." gnus-score-set-expunge-below t]
["Edit current score file" gnus-score-edit-current-scores t]
- ["Edit score file" gnus-score-edit-file t]
+ ["Edit score file..." gnus-score-edit-file t]
["Trace score" gnus-score-find-trace t]
["Find words" gnus-score-find-favourite-words t]
["Rescore buffer" gnus-summary-rescore t]
["Show picons in From" gnus-treat-from-picon t]
["Show picons in mail headers" gnus-treat-mail-picon t]
["Show picons in news headers" gnus-treat-newsgroups-picon t]
+ ["Show Gravatars in From" gnus-treat-from-gravatar t]
+ ["Show Gravatars in mail headers" gnus-treat-mail-gravatar t]
("View as different encoding"
,@(gnus-summary-menu-split
(mapcar
["Save in RMAIL mbox..." gnus-summary-save-article-rmail t]
["Save body in file..." gnus-summary-save-article-body-file t]
["Pipe through a filter..." gnus-summary-pipe-output t]
- ["Add to SOUP packet" gnus-soup-add-article t]
["Print with Muttprint..." gnus-summary-muttprint t]
["Print" gnus-summary-print-article
,@(if (featurep 'xemacs) '(t)
["Remove article" gnus-cache-remove-article t])
["Translate" gnus-article-babel t]
["Select article buffer" gnus-summary-select-article-buffer t]
+ ["Make article buffer sticky" gnus-sticky-article t]
["Enter digest buffer" gnus-summary-enter-digest-group t]
["Isearch article..." gnus-summary-isearch-article t]
["Beginning of the article" gnus-summary-beginning-of-article t]
["Go up thread" gnus-summary-up-thread t]
["Top of thread" gnus-summary-top-thread t]
["Mark thread as read" gnus-summary-kill-thread t]
+ ["Mark thread as expired" gnus-summary-expire-thread t]
["Lower thread score" gnus-summary-lower-thread t]
["Raise thread score" gnus-summary-raise-thread t]
["Rethread current" gnus-summary-rethread-current t]))
["Followup via news" gnus-summary-followup-to-mail t]
["Followup via news and yank"
gnus-summary-followup-to-mail-with-original t]
+ ["Strip signature on reply"
+ (lambda ()
+ (interactive)
+ (if (not (memq message-cite-function
+ '(message-cite-original-without-signature
+ message-cite-original)))
+ ;; Stupid workaround for XEmacs not honoring :visible.
+ (message "Can't toggle this value of `message-cite-function'")
+ (setq message-cite-function
+ (if (eq message-cite-function
+ 'message-cite-original-without-signature)
+ 'message-cite-original
+ 'message-cite-original-without-signature))))
+ ;; XEmacs barfs on :visible.
+ ,@(if (featurep 'xemacs) nil
+ '(:visible (memq message-cite-function
+ '(message-cite-original-without-signature
+ message-cite-original))))
+ :style toggle
+ :selected (eq message-cite-function
+ 'message-cite-original-without-signature)
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Strip signature from cited article when replying."))]
;;("Draft"
;;["Send" gnus-summary-send-draft t]
;;["Send bounced" gnus-resend-bounced-mail t])
["Subject..." gnus-summary-limit-to-subject t]
["Author..." gnus-summary-limit-to-author t]
["Recipient..." gnus-summary-limit-to-recipient t]
+ ["Address..." gnus-summary-limit-to-address t]
["Age..." gnus-summary-limit-to-age t]
["Extra..." gnus-summary-limit-to-extra t]
["Score..." gnus-summary-limit-to-score t]
["Display Predicate" gnus-summary-limit-to-display-predicate t]
["Unread" gnus-summary-limit-to-unread t]
["Unseen" gnus-summary-limit-to-unseen t]
+ ["Singletons" gnus-summary-limit-to-singletons t]
["Replied" gnus-summary-limit-to-replied t]
["Non-dormant" gnus-summary-limit-exclude-dormant t]
["Next or process marked articles" gnus-summary-limit-to-articles t]
gnus-newsgroup-process-stack]
["Save" gnus-summary-save-process-mark t]
["Run command on marked..." gnus-summary-universal-argument t]))
+ ("Registry Marks")
("Scroll article"
["Page forward" gnus-summary-next-page
,@(if (featurep 'xemacs) '(t)
["Pop article off history" gnus-summary-pop-article t])
("Sort"
["Sort by number" gnus-summary-sort-by-number t]
+ ["Sort by most recent number" gnus-summary-sort-by-most-recent-number t]
["Sort by author" gnus-summary-sort-by-author t]
["Sort by recipient" gnus-summary-sort-by-recipient t]
["Sort by subject" gnus-summary-sort-by-subject t]
["Sort by date" gnus-summary-sort-by-date t]
+ ["Sort by most recent date" gnus-summary-sort-by-most-recent-date t]
["Sort by score" gnus-summary-sort-by-score t]
["Sort by lines" gnus-summary-sort-by-lines t]
["Sort by characters" gnus-summary-sort-by-chars t]
["Randomize" gnus-summary-sort-by-random t]
["Original sort" gnus-summary-sort-by-original t])
("Help"
- ["Fetch group FAQ" gnus-summary-fetch-faq t]
["Describe group" gnus-summary-describe-group t]
- ["Fetch charter" gnus-group-fetch-charter
- ,@(if (featurep 'xemacs) nil
- '(:help "Display the charter of the current group"))]
["Fetch control message" gnus-group-fetch-control
,@(if (featurep 'xemacs) nil
'(:help "Display the archived control message for the current group"))]
["Regenerate" gnus-summary-prepare t]
["Insert cached articles" gnus-summary-insert-cached-articles t]
["Insert dormant articles" gnus-summary-insert-dormant-articles t]
+ ["Insert ticked articles" gnus-summary-insert-ticked-articles t]
["Toggle threading" gnus-summary-toggle-threads t])
["See old articles" gnus-summary-insert-old-articles t]
["See new articles" gnus-summary-insert-new-articles t]
(const :tag "Retro look" gnus-summary-tool-bar-retro)
(repeat :tag "User defined list" gmm-tool-bar-item)
(symbol))
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:initialize 'custom-initialize-default
:set 'gnus-summary-tool-bar-update
:group 'gnus-summary)
See `gmm-tool-bar-from-list' for the format of the list."
:type '(repeat gmm-tool-bar-item)
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:initialize 'custom-initialize-default
:set 'gnus-summary-tool-bar-update
:group 'gnus-summary)
See `gmm-tool-bar-from-list' for the format of the list."
:type '(repeat gmm-tool-bar-item)
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:initialize 'custom-initialize-default
:set 'gnus-summary-tool-bar-update
:group 'gnus-summary)
See `gmm-tool-bar-from-list' for the format of the list."
:type 'gmm-tool-bar-zap-list
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:initialize 'custom-initialize-default
:set 'gnus-summary-tool-bar-update
:group 'gnus-summary)
(defvar image-load-path)
+(defvar tool-bar-map)
(defun gnus-summary-make-tool-bar (&optional force)
"Make a summary mode tool bar from `gnus-summary-tool-bar'.
(setq headers (cdr headers)))
(list (nreverse outh))))))))
+
+(declare-function turn-on-gnus-mailing-list-mode "gnus-ml" ())
+(defvar bookmark-make-record-function)
\f
(defun gnus-summary-mode (&optional group)
(gnus-simplify-mode-line)
(setq major-mode 'gnus-summary-mode)
(setq mode-name "Summary")
- (make-local-variable 'minor-mode-alist)
(use-local-map gnus-summary-mode-map)
(buffer-disable-undo)
(setq buffer-read-only t ;Disable modification
show-trailing-whitespace nil)
(setq truncate-lines t)
- (setq selective-display t)
- (setq selective-display-ellipses t) ;Display `...'
+ (add-to-invisibility-spec '(gnus-sum . t))
(gnus-summary-set-display-table)
(gnus-set-default-directory)
(make-local-variable 'gnus-summary-line-format)
(gnus-run-mode-hooks 'gnus-summary-mode-hook)
(turn-on-gnus-mailing-list-mode)
(mm-enable-multibyte)
+ (set (make-local-variable 'bookmark-make-record-function)
+ 'gnus-summary-bookmark-make-record)
(gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy)
(gnus-update-summary-mark-positions))
;; Simple nil-valued local variable.
(set (make-local-variable local) nil)))))
-(defun gnus-summary-clear-local-variables ()
- (let ((locals gnus-summary-local-variables))
- (while locals
- (if (consp (car locals))
- (and (symbolp (caar locals))
- (set (caar locals) nil))
- (and (symbolp (car locals))
- (set (car locals) nil)))
- (setq locals (cdr locals)))))
-
;; Summary data functions.
(defmacro gnus-data-number (data)
(save-excursion
(let (config)
(goto-char (point-min))
- (while (search-forward "\r" nil t)
- (push (1- (point)) config))
+ (while (not (eobp))
+ (when (eq (get-char-property (point-at-eol) 'invisible) 'gnus-sum)
+ (push (save-excursion (forward-line 0) (point)) config))
+ (forward-line 1))
config)))
(defun gnus-restore-hidden-threads-configuration (config)
"Restore hidden threads configuration from CONFIG."
(save-excursion
- (let (point buffer-read-only)
+ (let (point (inhibit-read-only t))
(while (setq point (pop config))
- (when (and (< point (point-max))
- (goto-char point)
- (eq (char-after) ?\n))
- (subst-char-in-region point (1+ point) ?\n ?\r))))))
+ (goto-char point)
+ (gnus-summary-hide-thread)))))
;; Various summary mode internalish functions.
(i 32))
;; Nix out all the control chars...
(while (>= (setq i (1- i)) 0)
- (aset table i [??]))
+ (gnus-put-display-table i [??] table))
;; ... but not newline and cr, of course. (cr is necessary for the
;; selective display).
- (aset table ?\n nil)
- (aset table ?\r nil)
+ (gnus-put-display-table ?\n nil table)
+ (gnus-put-display-table ?\r nil table)
;; We keep TAB as well.
- (aset table ?\t nil)
+ (gnus-put-display-table ?\t nil table)
;; We nix out any glyphs 127 through 255, or 127 through 159 in
;; Emacs 23 (unicode), that are not set already.
(let ((i (if (ignore-errors (= (make-char 'latin-iso8859-1 160) 160))
256)))
(while (>= (setq i (1- i)) 127)
;; Only modify if the entry is nil.
- (unless (aref table i)
- (aset table i [??]))))
+ (unless (gnus-get-display-table i table)
+ (gnus-put-display-table i [??] table))))
(setq buffer-display-table table)))
(defun gnus-summary-set-article-display-arrow (pos)
"Update the overlay arrow to point to line at position POS."
- (when (and gnus-summary-display-arrow
- (boundp 'overlay-arrow-position)
- (boundp 'overlay-arrow-string))
+ (when gnus-summary-display-arrow
+ (make-local-variable 'overlay-arrow-position)
+ (make-local-variable 'overlay-arrow-string)
(save-excursion
(goto-char pos)
(beginning-of-line)
;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
(setq gnus-summary-buffer (set-buffer (gnus-get-buffer-create buffer)))
(gnus-summary-mode group)
- (when gnus-carpal
- (gnus-carpal-setup-buffer 'summary))
(when (gnus-group-quit-config group)
(set (make-local-variable 'gnus-single-article-buffer) nil))
(make-local-variable 'gnus-article-buffer)
t
(not (cdr (gnus-data-find-list article)))))
-(defun gnus-make-thread-indent-array ()
- (let ((n 200))
- (unless (and gnus-thread-indent-array
- (= gnus-thread-indent-level gnus-thread-indent-array-level))
- (setq gnus-thread-indent-array (make-vector 201 "")
- gnus-thread-indent-array-level gnus-thread-indent-level)
- (while (>= n 0)
- (aset gnus-thread-indent-array n
- (make-string (* n gnus-thread-indent-level) ? ))
- (setq n (1- n))))))
+(defun gnus-make-thread-indent-array (&optional n)
+ (when (or n
+ (progn (setq n 200) nil)
+ (null gnus-thread-indent-array)
+ (/= gnus-thread-indent-level gnus-thread-indent-array-level))
+ (setq gnus-thread-indent-array (make-vector (1+ n) "")
+ gnus-thread-indent-array-level gnus-thread-indent-level)
+ (while (>= n 0)
+ (aset gnus-thread-indent-array n
+ (make-string (* n gnus-thread-indent-level) ? ))
+ (setq n (1- n)))))
(defun gnus-update-summary-mark-positions ()
"Compute where the summary marks are to go."
(defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from)
(let ((mail-parse-charset gnus-newsgroup-charset)
+ (ignored-from-addresses (gnus-ignored-from-addresses))
; Is it really necessary to do this next part for each summary line?
; Luckily, doesn't seem to slow things down much.
(mail-parse-ignored-charsets
(with-current-buffer gnus-summary-buffer
gnus-newsgroup-ignored-charsets)))
(or
- (and gnus-ignored-from-addresses
- (string-match gnus-ignored-from-addresses gnus-tmp-from)
+ (and ignored-from-addresses
+ (string-match ignored-from-addresses gnus-tmp-from)
(let ((extra-headers (mail-header-extra header))
to
newsgroups)
gnus-tmp-expirable gnus-tmp-subject-or-nil
&optional gnus-tmp-dummy gnus-tmp-score
gnus-tmp-process)
+ (if (>= gnus-tmp-level (length gnus-thread-indent-array))
+ (gnus-make-thread-indent-array (max (* 2 (length gnus-thread-indent-array))
+ gnus-tmp-level)))
(let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
(gnus-tmp-lines (mail-header-lines gnus-tmp-header))
(gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
(gnus-tmp-subject (mail-header-subject gnus-tmp-header))
(gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
(gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
- (buffer-read-only nil))
+ (inhibit-read-only t))
(when (string= gnus-tmp-name "")
(setq gnus-tmp-name gnus-tmp-from))
(unless (numberp gnus-tmp-lines)
(if (= gnus-tmp-lines -1)
(setq gnus-tmp-lines "?")
(setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
- (gnus-put-text-property
- (point)
- (progn (eval gnus-summary-line-format-spec) (point))
- 'gnus-number gnus-tmp-number)
+ (condition-case ()
+ (gnus-put-text-property
+ (point)
+ (progn (eval gnus-summary-line-format-spec) (point))
+ 'gnus-number gnus-tmp-number)
+ (error (gnus-message 5 "Error updating the summary line")))
(when (gnus-visual-p 'summary-highlight 'highlight)
(forward-line -1)
+ (gnus-summary-highlight-line)
(gnus-run-hooks 'gnus-summary-update-hook)
(forward-line 1))))
'score))
;; Do visual highlighting.
(when (gnus-visual-p 'summary-highlight 'highlight)
+ (gnus-summary-highlight-line)
(gnus-run-hooks 'gnus-summary-update-hook)))))
(defvar gnus-tmp-new-adopts nil)
(defun gnus-summary-set-local-parameters (group)
"Go through the local params of GROUP and set all variable specs in that list."
- (let ((vars '(quit-config))) ; Ignore quit-config.
+ (let ((vars '(quit-config active))) ; Ignore things that aren't
+ ; really variables.
(dolist (elem (gnus-group-find-parameter group))
(and (consp elem) ; Has to be a cons.
(consp (cdr elem)) ; The cdr has to be a list.
(symbolp (car elem)) ; Has to be a symbol in there.
(not (memq (car elem) vars))
- (ignore-errors ; So we set it.
+ (ignore-errors
(push (car elem) vars)
- (make-local-variable (car elem))
- (set (car elem) (eval (nth 1 elem))))))))
+ ;; Variables like `gnus-show-threads' that are globally
+ ;; bound, if used as group parameters, need to get to be
+ ;; buffer-local, whereas just parameters like `gcc-self',
+ ;; `timestamp', etc. should not be bound as variables.
+ (if (boundp (car elem))
+ (set (make-local-variable (car elem)) (eval (nth 1 elem)))
+ (eval (nth 1 elem))))))))
(defun gnus-summary-read-group (group &optional show-all no-article
kill-buffer no-display backward
(progn
(set-buffer gnus-group-buffer)
(gnus-group-jump-to-group group)
- (gnus-group-next-unread-group 1)
(gnus-configure-windows 'group 'force))
(gnus-handle-ephemeral-exit quit-config))
;; Finally signal the quit.
(setq gnus-newsgroup-active
(gnus-copy-sequence
(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
(defun gnus-summary-prepare ()
"Generate the summary buffer."
(interactive)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(erase-buffer)
(setq gnus-newsgroup-data nil
gnus-newsgroup-data-reverse nil)
"Query where the respool algorithm would put this article."
(interactive)
(gnus-summary-select-article)
- (message (gnus-general-simplify-subject (gnus-summary-article-subject))))
+ (message "%s" (gnus-general-simplify-subject (gnus-summary-article-subject))))
(defun gnus-gather-threads-by-subject (threads)
"Gather threads by looking at Subject headers."
infloop))
(defun gnus-make-threads ()
- "Go through the dependency hashtb and find the roots. Return all threads."
+ "Go through the dependency hashtb and find the roots. Return all threads."
(let (threads)
(while (catch 'infloop
(mapatoms
(erase-buffer)))
(kill-buffer (current-buffer)))
;; Sort over trustworthiness.
- (mapcar
- (lambda (relation)
- (when (gnus-dependencies-add-header
- (make-full-mail-header
- gnus-reffed-article-number
- (nth 3 relation) "" (or (nth 4 relation) "")
- (nth 1 relation)
- (or (nth 2 relation) "") 0 0 "")
- gnus-newsgroup-dependencies nil)
- (push gnus-reffed-article-number gnus-newsgroup-limit)
- (push gnus-reffed-article-number gnus-newsgroup-sparse)
- (push (cons gnus-reffed-article-number gnus-sparse-mark)
- gnus-newsgroup-reads)
- (decf gnus-reffed-article-number)))
- (sort relations 'car-less-than-car))
+ (dolist (relation (sort relations 'car-less-than-car))
+ (when (gnus-dependencies-add-header
+ (make-full-mail-header
+ gnus-reffed-article-number
+ (nth 3 relation) "" (or (nth 4 relation) "")
+ (nth 1 relation)
+ (or (nth 2 relation) "") 0 0 "")
+ gnus-newsgroup-dependencies nil)
+ (push gnus-reffed-article-number gnus-newsgroup-limit)
+ (push gnus-reffed-article-number gnus-newsgroup-sparse)
+ (push (cons gnus-reffed-article-number gnus-sparse-mark)
+ gnus-newsgroup-reads)
+ (decf gnus-reffed-article-number)))
(gnus-message 7 "Making sparse threads...done")))
(defun gnus-build-old-threads ()
(let ((deps gnus-newsgroup-dependencies)
found header)
(prog1
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(let ((case-fold-search nil))
(goto-char (point-min))
(while (and (not found)
(mail-parse-charset gnus-newsgroup-charset)
(dependencies gnus-newsgroup-dependencies)
header article)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(let ((case-fold-search nil))
(goto-char (point-min))
(while (not (eobp))
(gnus-summary-goto-subject article)
(let* ((datal (gnus-data-find-list article))
(data (car datal))
- (buffer-read-only nil)
+ (inhibit-read-only t)
(level (gnus-summary-thread-level)))
(gnus-delete-line)
(let ((inserted (- (point)
(not (equal "" references)))
references))
"none")))
- (buffer-read-only nil)
+ (inhibit-read-only t)
(old (car thread)))
(when thread
(unless iheader
(defun gnus-rebuild-thread (id &optional line)
"Rebuild the thread containing ID.
If LINE, insert the rebuilt thread starting on line LINE."
- (let ((buffer-read-only nil)
+ (let ((inhibit-read-only t)
old-pos current thread data)
(if (not gnus-show-threads)
(setq thread (list (car (gnus-id-to-thread id))))
;; First go up in this thread until we find the root.
(setq last-id (gnus-root-id id)
headers (message-flatten-list (gnus-id-to-thread last-id)))
- ;; We have now found the real root of this thread. It might have
+ ;; We have now found the real root of this thread. It might have
;; been gathered into some loose thread, so we have to search
;; through the threads to find the thread we wanted.
(let ((threads gnus-newsgroup-threads)
(1+ (point-at-eol))
(gnus-delete-line)))))))
-(defun gnus-sort-threads-1 (threads func)
+(defun gnus-sort-threads-recursive (threads func)
(sort (mapcar (lambda (thread)
(cons (car thread)
(and (cdr thread)
- (gnus-sort-threads-1 (cdr thread) func))))
+ (gnus-sort-threads-recursive (cdr thread) func))))
threads) func))
+(defun gnus-sort-threads-loop (threads func)
+ (let* ((superthread (cons nil threads))
+ (stack (list (cons superthread threads)))
+ remaining-threads thread)
+ (while stack
+ (setq remaining-threads (cdr (car stack)))
+ (if remaining-threads
+ (progn (setq thread (car remaining-threads))
+ (setcdr (car stack) (cdr remaining-threads))
+ (if (cdr thread)
+ (push (cons thread (cdr thread)) stack)))
+ (setq thread (caar stack))
+ (setcdr thread (sort (cdr thread) func))
+ (pop stack)))
+ (cdr superthread)))
+
(defun gnus-sort-threads (threads)
"Sort THREADS."
(if (not gnus-thread-sort-functions)
threads
(gnus-message 8 "Sorting threads...")
- (let ((max-lisp-eval-depth 5000))
- (prog1 (gnus-sort-threads-1
- threads
- (gnus-make-sort-function gnus-thread-sort-functions))
- (gnus-message 8 "Sorting threads...done")))))
+ (prog1
+ (condition-case nil
+ (let ((max-lisp-eval-depth (max max-lisp-eval-depth 5000)))
+ (gnus-sort-threads-recursive
+ threads (gnus-make-sort-function gnus-thread-sort-functions)))
+ ;; Even after binding max-lisp-eval-depth, the recursive
+ ;; sorter might fail for very long threads. In that case,
+ ;; try using a (less well-tested) non-recursive sorter.
+ (error (gnus-message 9 "Sorting threads with loop...")
+ (gnus-sort-threads-loop
+ threads (gnus-make-sort-function
+ gnus-thread-sort-functions))))
+ (gnus-message 8 "Sorting threads...done"))))
(defun gnus-sort-articles (articles)
"Sort ARTICLES."
(gnus-thread-header h1) (gnus-thread-header h2)))
(defsubst gnus-article-sort-by-random (h1 h2)
- "Sort articles by article number."
+ "Sort articles randomly."
(zerop (random 2)))
(defun gnus-thread-sort-by-random (h1 h2)
- "Sort threads by root article number."
+ "Sort threads randomly."
(gnus-article-sort-by-random
(gnus-thread-header h1) (gnus-thread-header h2)))
(defsubst gnus-article-sort-by-author (h1 h2)
"Sort articles by root author."
- (string-lessp
+ (gnus-string<
(let ((extract (funcall
gnus-extract-address-components
(mail-header-from h1))))
(defsubst gnus-article-sort-by-recipient (h1 h2)
"Sort articles by recipient."
- (string-lessp
+ (gnus-string<
(let ((extract (funcall
gnus-extract-address-components
(or (cdr (assq 'To (mail-header-extra h1))) ""))))
(defsubst gnus-article-sort-by-subject (h1 h2)
"Sort articles by root subject."
- (string-lessp
+ (gnus-string<
(downcase (gnus-simplify-subject-re (mail-header-subject h1)))
(downcase (gnus-simplify-subject-re (mail-header-subject h2)))))
(t
(gnus-thread-total-score-1 (list thread)))))
+(defun gnus-article-sort-by-most-recent-number (h1 h2)
+ "Sort articles by number."
+ (gnus-article-sort-by-number h1 h2))
+
(defun gnus-thread-sort-by-most-recent-number (h1 h2)
"Sort threads such that the thread with the most recently arrived article comes first."
(> (gnus-thread-highest-number h1) (gnus-thread-highest-number h2)))
(mail-header-number header))
(message-flatten-list thread))))
+(defun gnus-article-sort-by-most-recent-date (h1 h2)
+ "Sort articles by number."
+ (gnus-article-sort-by-date h1 h2))
+
(defun gnus-thread-sort-by-most-recent-date (h1 h2)
"Sort threads such that the thread with the most recently dated article comes first."
(> (gnus-thread-latest-date h1) (gnus-thread-latest-date h2)))
+; Since this is called not only to sort the top-level threads, but
+; also in recursive sorts to order the articles within a thread, each
+; article will be processed many times. Thus it speeds things up
+; quite a bit to use gnus-date-get-time, which caches the time value.
(defun gnus-thread-latest-date (thread)
"Return the highest article date in THREAD."
- (let ((previous-time 0))
- (apply 'max
- (mapcar
- (lambda (header)
- (setq previous-time
- (condition-case ()
- (time-to-seconds (mail-header-parse-date
- (mail-header-date header)))
- (error previous-time))))
- (sort
- (message-flatten-list thread)
- (lambda (h1 h2)
- (< (mail-header-number h1)
- (mail-header-number h2))))))))
+ (apply 'max
+ (mapcar (lambda (header) (gnus-float-time
+ (gnus-date-get-time
+ (mail-header-date header))))
+ (message-flatten-list thread))))
(defun gnus-thread-total-score-1 (root)
;; This function find the total score of the thread below ROOT.
(defvar gnus-tmp-root-expunged nil)
(defvar gnus-tmp-dummy-line nil)
-(eval-when-compile (defvar gnus-tmp-header))
(defun gnus-extra-header (type &optional header)
"Return the extra header of TYPE."
(or (cdr (assq type (mail-header-extra (or header gnus-tmp-header))))
:type 'string
:group 'gnus-thread)
+(defcustom gnus-summary-display-while-building nil
+ "If non-nil, show and update the summary buffer as it's being built.
+If the value is t, update the buffer after every line is inserted. If
+the value is an integer (N), update the display every N lines."
+ :version "22.1"
+ :group 'gnus-thread
+ :type '(choice (const :tag "off" nil)
+ number
+ (const :tag "frequently" t)))
+
(defun gnus-summary-prepare-threads (threads)
"Prepare summary buffer from THREADS and indentation LEVEL.
THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
gnus-tmp-closing-bracket ?\>)
(setq gnus-tmp-opening-bracket ?\[
gnus-tmp-closing-bracket ?\]))
+ (if (>= gnus-tmp-level (length gnus-thread-indent-array))
+ (gnus-make-thread-indent-array
+ (max (* 2 (length gnus-thread-indent-array))
+ gnus-tmp-level)))
(setq
gnus-tmp-indentation
(aref gnus-thread-indent-array gnus-tmp-level)
(if (= gnus-tmp-lines -1)
(setq gnus-tmp-lines "?")
(setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
- (gnus-put-text-property
+ (gnus-put-text-property
(point)
(progn (eval gnus-summary-line-format-spec) (point))
- 'gnus-number number)
+ 'gnus-number number)
(when gnus-visual-p
(forward-line -1)
- (gnus-run-hooks 'gnus-summary-update-hook)
+ (gnus-summary-highlight-line)
+ (when gnus-summary-update-hook
+ (gnus-run-hooks 'gnus-summary-update-hook))
(forward-line 1))
(setq gnus-tmp-prev-subject simp-subject)))
t
gnus-summary-ignore-duplicates))
(info (nth 2 entry))
- articles fetched-articles cached)
+ charset articles fetched-articles cached)
(unless (gnus-check-server
(set (make-local-variable 'gnus-current-select-method)
(gnus-find-method-for-group group)))
(error "Couldn't open server"))
+ (setq charset (gnus-group-name-charset gnus-current-select-method group))
(or (and entry (not (eq (car entry) t))) ; Either it's active...
(gnus-activate-group group) ; Or we can activate it...
(progn ; Or we bug out.
(when (equal major-mode 'gnus-summary-mode)
(gnus-kill-buffer (current-buffer)))
- (error "Couldn't activate group %s: %s"
- (gnus-group-decoded-name group) (gnus-status-message group))))
+ (error
+ "Couldn't activate group %s: %s"
+ (mm-decode-coding-string group charset)
+ (mm-decode-coding-string (gnus-status-message group) charset))))
(unless (gnus-request-group group t)
(when (equal major-mode 'gnus-summary-mode)
(gnus-kill-buffer (current-buffer)))
(error "Couldn't request group %s: %s"
- (gnus-group-decoded-name group) (gnus-status-message group)))
+ (mm-decode-coding-string group charset)
+ (mm-decode-coding-string (gnus-status-message group) charset)))
(when gnus-agent
(gnus-agent-possibly-alter-active group (gnus-active group) info)
(gnus-inverse-list-range-intersection
gnus-newsgroup-articles gnus-newsgroup-seen))))
+(declare-function gnus-get-predicate "gnus-agent" (predicate))
+
(defun gnus-summary-display-make-predicate (display)
(require 'gnus-agent)
(when (= (length display) 1)
(unseen . unseen))
gnus-article-mark-lists))
(push (cons (cdr elem)
- (gnus-byte-compile
+ (gnus-byte-compile ;Why bother?
`(lambda () (gnus-article-marked-p ',(cdr elem)))))
gnus-summary-display-cache)))
(let ((gnus-category-predicate-alist gnus-summary-display-cache)
(gnus-category-predicate-cache gnus-summary-display-cache))
(gnus-get-predicate display)))
-;; Uses the dynamically bound `number' variable.
-(eval-when-compile
- (defvar number))
+;; Uses the dynamically bound `gnus-number' variable.
+(defvar gnus-number)
(defun gnus-article-marked-p (type &optional article)
- (let ((article (or article number)))
+ (let ((article (or article gnus-number)))
(cond
((eq type 'tick)
(memq article gnus-newsgroup-marked))
;; articles in the group, or (if that's nil), the
;; articles in the cache.
(or
- (gnus-uncompress-range (gnus-active group))
+ (if gnus-newsgroup-maximum-articles
+ (let ((active (gnus-active group)))
+ (gnus-uncompress-range
+ (cons (max (car active)
+ (- (cdr active)
+ gnus-newsgroup-maximum-articles
+ -1))
+ (cdr active))))
+ (gnus-uncompress-range (gnus-active group)))
(gnus-cache-articles-in-group group))
;; Select only the "normal" subset of articles.
(gnus-sorted-nunion
(read-string
(format
"How many articles from %s (%s %d): "
- (gnus-limit-string
- (gnus-group-decoded-name gnus-newsgroup-name)
- 35)
+ (gnus-group-decoded-name gnus-newsgroup-name)
(if initial "max" "default")
number)
(if initial
(types gnus-article-mark-lists)
marks var articles article mark mark-type
bgn end)
+ ;; Hack to avoid adjusting marks for imap.
+ (when (eq (car (gnus-find-method-for-group (gnus-info-group info)))
+ 'nnimap)
+ (setq min 1))
(dolist (marks marked-lists)
(setq mark (car marks)
(when add
(push (list add 'add (list (cdr type))) delta-marks))
(when del
+ ;; Don't delete marks from outside the active range. This
+ ;; shouldn't happen, but is a sanity check.
+ (setq del (gnus-sorted-range-intersection
+ (gnus-active gnus-newsgroup-name) del))
(push (list del 'del (list (cdr type))) delta-marks))))
(when list
(symbol-value
(intern (format "gnus-%s-mode-line-format-spec" where))))
(let (mode-string)
- (save-excursion
- ;; We evaluate this in the summary buffer since these
- ;; variables are buffer-local to that buffer.
- (set-buffer gnus-summary-buffer)
- ;; We bind all these variables that are used in the `eval' form
+ ;; We evaluate this in the summary buffer since these
+ ;; variables are buffer-local to that buffer.
+ (with-current-buffer gnus-summary-buffer
+ ;; We bind all these variables that are used in the `eval' form
;; below.
(let* ((mformat (symbol-value
(intern
(when (> (length mode-string) max-len)
(setq mode-string
(concat (truncate-string-to-width mode-string (- max-len 3))
- "...")))
- ;; Pad the mode string a bit.
- (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
+ "...")))))
;; Update the mode line.
(setq mode-line-buffer-identification
(gnus-mode-line-buffer-identification (list mode-string)))
"Look through all the headers and mark the Xrefs as read."
(let ((virtual (gnus-virtual-group-p from-newsgroup))
name info xref-hashtb idlist method nth4)
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(when (setq xref-hashtb
(gnus-create-xref-hashtb from-newsgroup headers unreads))
(mapatoms
(info (nth 2 entry))
(active (gnus-active group))
range)
- (when entry
+ (if (not entry)
+ ;; Group that Gnus doesn't know exists, but still allow the
+ ;; backend to set marks.
+ (gnus-request-set-mark
+ group (list (list (gnus-compress-sequence (sort articles #'<))
+ 'add '(read))))
+ ;; Normal, subscribed groups.
(setq range (gnus-compute-read-articles group articles))
(with-current-buffer gnus-group-buffer
(gnus-undo-register
(unless (gnus-ephemeral-group-p group)
(gnus-group-update-group group t))))))
-(defvar gnus-newsgroup-none-id 0)
-
(defun gnus-get-newsgroup-headers (&optional dependencies force-new)
(let ((cur nntp-server-buffer)
(dependencies
headers id end ref number
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
- (save-excursion (condition-case nil
- (set-buffer gnus-summary-buffer)
- (error))
- gnus-newsgroup-ignored-charsets)))
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (save-current-buffer (condition-case nil
+ (set-buffer gnus-summary-buffer)
+ (error))
+ gnus-newsgroup-ignored-charsets)))
+ (with-current-buffer nntp-server-buffer
;; Translate all TAB characters into SPACE characters.
(subst-char-in-region (point-min) (point-max) ?\t ? t)
(subst-char-in-region (point-min) (point-max) ?\r ? t)
(let ((case-fold-search t)
in-reply-to header p lines chars)
(goto-char (point-min))
- ;; Search to the beginning of the next header. Error messages
+ ;; Search to the beginning of the next header. Error messages
;; do not begin with 2 or 3.
(while (re-search-forward "^[23][0-9]+ " nil t)
(setq id nil
;; This implementation of this function, with nine
;; search-forwards instead of the one re-search-forward and
;; a case (which basically was the old function) is actually
- ;; about twice as fast, even though it looks messier. You
+ ;; about twice as fast, even though it looks messier. You
;; can't have everything, I guess. Speed and elegance
;; doesn't always go hand in hand.
(setq
(t
nil)))
number headers header)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(subst-char-in-region (point-min) (point-max) ?\r ? t)
;; Allow the user to mangle the headers before parsing them.
(gnus-run-hooks 'gnus-parse-headers-hook)
"Return a list of articles to be worked upon.
The prefix argument, the list of process marked articles, and the
current article will be taken into consideration."
- (save-excursion
- (set-buffer gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
(cond
(n
;; A numerical prefix has been given.
(defun gnus-summary-search-group (&optional backward use-level)
"Search for next unread newsgroup.
If optional argument BACKWARD is non-nil, search backward instead."
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(when (gnus-group-search-forward
backward nil (if use-level (gnus-group-group-level) nil))
(gnus-group-group-name))))
(when (and gnus-auto-center-summary
(not (eq gnus-auto-center-summary 'vertical)))
(gnus-horizontal-recenter))
- (recenter n))
+ (if (fboundp 'recenter-top-bottom)
+ (recenter-top-bottom n)
+ (recenter n)))
+
+(put 'gnus-recenter 'isearch-scroll t)
+
+(defun gnus-forward-line-ignore-invisible (n)
+ "Move N lines forward (backward if N is negative).
+Like forward-line, but skip over (and don't count) invisible lines."
+ (let (done)
+ (while (and (> n 0) (not done))
+ ;; If the following character is currently invisible,
+ ;; skip all characters with that same `invisible' property value.
+ (while (gnus-invisible-p (point))
+ (goto-char (gnus-next-char-property-change (point))))
+ (forward-line 1)
+ (if (eobp)
+ (setq done t)
+ (setq n (1- n))))
+ (while (and (< n 0) (not done))
+ (forward-line -1)
+ (if (bobp) (setq done t)
+ (setq n (1+ n))
+ (while (and (not (bobp)) (gnus-invisible-p (1- (point))))
+ (goto-char (gnus-previous-char-property-change (point))))))))
(defun gnus-summary-recenter ()
"Center point in the summary window.
gnus-auto-center-summary
(/ (1- (window-height)) 2)))))
(height (1- (window-height)))
- (bottom (save-excursion (goto-char (point-max))
- (forward-line (- height))
- (point)))
+ (bottom (save-excursion
+ (goto-char (point-max))
+ (gnus-forward-line-ignore-invisible (- height))
+ (point)))
(window (get-buffer-window (current-buffer))))
(when (get-buffer-window gnus-article-buffer)
;; Only do recentering when the article buffer is displayed,
;; Set the window start to either `bottom', which is the biggest
;; possible valid number, or the second line from the top,
;; whichever is the least.
- (let ((top-pos (save-excursion (forward-line (- top)) (point))))
+ (let ((top-pos (save-excursion
+ (gnus-forward-line-ignore-invisible (- top))
+ (point))))
(if (> bottom top-pos)
;; Keep the second line from the top visible
- (set-window-start window top-pos t)
+ (set-window-start window top-pos)
;; Try to keep the bottom line visible; if it's partially
;; obscured, either scroll one more line to make it fully
;; visible, or revert to using TOP-POS.
(save-excursion
(goto-char (point-max))
- (forward-line -1)
+ (gnus-forward-line-ignore-invisible -1)
(let ((last-line-start (point)))
(goto-char bottom)
(set-window-start window (point) t)
(when (not (pos-visible-in-window-p last-line-start window))
- (forward-line 1)
+ (gnus-forward-line-ignore-invisible 1)
(set-window-start window (min (point) top-pos) t)))))))
;; Do horizontal recentering while we're at it.
(when (and (get-buffer-window (current-buffer) t)
(gnus-group-jump-to-group newsgroup))
(save-excursion
;; Take care of tree window mode.
- (if (get-buffer-window gnus-group-buffer)
+ (if (get-buffer-window gnus-group-buffer 0)
(pop-to-buffer gnus-group-buffer)
(set-buffer gnus-group-buffer))
(gnus-group-jump-to-group newsgroup))))
(active (or (gnus-active group) (gnus-activate-group group)))
(last (or (cdr active)
(error "Group %s couldn't be activated " group)))
+ (bottom (if gnus-newsgroup-maximum-articles
+ (max (car active)
+ (- last gnus-newsgroup-maximum-articles -1))
+ (car active)))
first nlast unread)
;; If none are read, then all are unread.
(if (not read)
- (setq first (car active))
+ (setq first bottom)
;; If the range of read articles is a single range, then the
;; first unread article is the article after the last read
;; article. Sounds logical, doesn't it?
(if (and (not (listp (cdr read)))
- (or (< (car read) (car active))
+ (or (< (car read) bottom)
(progn (setq read (list read))
nil)))
- (setq first (max (car active) (1+ (cdr read))))
+ (setq first (max bottom (1+ (cdr read))))
;; `read' is a list of ranges.
(when (/= (setq nlast (or (and (numberp (car read)) (car read))
(caar read)))
1)
- (setq first (car active)))
+ (setq first bottom))
(while read
(when first
(while (< first nlast)
(gnus-list-range-difference
(gnus-list-range-difference
(gnus-sorted-complement
- (gnus-uncompress-range active)
+ (gnus-uncompress-range
+ (if gnus-newsgroup-maximum-articles
+ (cons (max (car active)
+ (- (cdr active)
+ gnus-newsgroup-maximum-articles
+ -1))
+ (cdr active))
+ active))
(gnus-list-of-unread-articles group))
(cdr (assq 'dormant marked)))
(cdr (assq 'tick marked))))))
(let* ((read (gnus-info-read (gnus-get-info group)))
(active (or (gnus-active group) (gnus-activate-group group)))
(last (cdr active))
+ (bottom (if gnus-newsgroup-maximum-articles
+ (max (car active)
+ (- last gnus-newsgroup-maximum-articles -1))
+ (car active)))
first nlast unread)
;; If none are read, then all are unread.
(if (not read)
- (setq first (car active))
+ (setq first bottom)
;; If the range of read articles is a single range, then the
;; first unread article is the article after the last read
;; article. Sounds logical, doesn't it?
(if (and (not (listp (cdr read)))
- (or (< (car read) (car active))
+ (or (< (car read) bottom)
(progn (setq read (list read))
nil)))
- (setq first (max (car active) (1+ (cdr read))))
+ (setq first (max bottom (1+ (cdr read))))
;; `read' is a list of ranges.
(when (/= (setq nlast (or (and (numberp (car read)) (car read))
(caar read)))
1)
- (setq first (car active)))
+ (setq first bottom))
(while read
(when first
(push (cons first nlast) unread))
;; Various summary commands
(defun gnus-summary-select-article-buffer ()
- "Reconfigure windows to show article buffer."
+ "Reconfigure windows to show the article buffer.
+If `gnus-widen-article-buffer' is set, show only the article
+buffer."
(interactive)
(if (not (gnus-buffer-live-p gnus-article-buffer))
(error "There is no article buffer for this summary buffer")
- (gnus-configure-windows 'article)
+ (unless (get-buffer-window gnus-article-buffer)
+ (gnus-summary-show-article))
+ (gnus-configure-windows
+ (if gnus-widen-article-window
+ 'only-article
+ 'article)
+ t)
(select-window (get-buffer-window gnus-article-buffer))))
(defun gnus-summary-universal-argument (arg)
(gnus-save-newsrc-file)
(gnus-dribble-save)))
+(declare-function gnus-cache-write-active "gnus-cache" (&optional force))
+
(defun gnus-summary-exit (&optional temporary leave-hidden)
"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)
(gnus-set-global-variables)
(when (gnus-buffer-live-p gnus-article-buffer)
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(mm-destroy-parts gnus-article-mime-handles)
;; Set it to nil for safety reason.
(setq gnus-article-mime-handle-alist nil)
(when gnus-use-scoring
(gnus-score-save)))
(gnus-run-hooks 'gnus-summary-prepare-exit-hook)
- ;; If we have several article buffers, we kill them at exit.
- (unless gnus-single-article-buffer
- (gnus-kill-buffer gnus-article-buffer)
- (gnus-kill-buffer gnus-original-article-buffer)
- (setq gnus-article-current nil))
(when gnus-use-cache
(gnus-cache-possibly-remove-articles)
(gnus-cache-save-buffers))
(gnus-group-jump-to-group group))
(gnus-run-hooks 'gnus-summary-exit-hook)
(unless (or quit-config
+ (not gnus-summary-next-group-on-exit)
;; If this group has disappeared from the summary
;; buffer, don't skip forwards.
(not (string= group (gnus-group-group-name))))
(setq group-point (point))
(if temporary
nil ;Nothing to do.
- ;; If we have several article buffers, we kill them at exit.
- (unless gnus-single-article-buffer
- (gnus-kill-buffer gnus-article-buffer)
- (gnus-kill-buffer gnus-original-article-buffer)
- (setq gnus-article-current nil))
(set-buffer buf)
(if (not gnus-kill-summary-on-exit)
(progn
(gnus-deaden-summary)
(setq mode nil))
- ;; We set all buffer-local variables to nil. It is unclear why
- ;; this is needed, but if we don't, buffer-local variables are
- ;; not garbage-collected, it seems. This would the lead to en
- ;; ever-growing Emacs.
- (gnus-summary-clear-local-variables)
- (let ((gnus-summary-local-variables gnus-newsgroup-variables))
- (gnus-summary-clear-local-variables))
(when (get-buffer gnus-article-buffer)
(bury-buffer gnus-article-buffer))
;; Return to group mode buffer.
(when (eq mode 'gnus-summary-mode)
(gnus-kill-buffer buf)))
+
+ ;; If we have several article buffers, we kill them at exit.
+ (unless gnus-single-article-buffer
+ (when (gnus-buffer-live-p gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
+ ;; Don't kill sticky article buffers
+ (unless (eq major-mode 'gnus-sticky-article-mode)
+ (gnus-kill-buffer gnus-article-buffer)
+ (setq gnus-article-current nil))))
+ (gnus-kill-buffer gnus-original-article-buffer))
+
(setq gnus-current-select-method gnus-select-method)
(set-buffer gnus-group-buffer)
(if quit-config
(gnus-async-halt-prefetch)
(run-hooks 'gnus-summary-prepare-exit-hook)
(when (gnus-buffer-live-p gnus-article-buffer)
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(mm-destroy-parts gnus-article-mime-handles)
;; Set it to nil for safety reason.
(setq gnus-article-mime-handle-alist nil)
(if (not gnus-kill-summary-on-exit)
(gnus-deaden-summary)
(gnus-close-group group)
- (gnus-summary-clear-local-variables)
- (let ((gnus-summary-local-variables gnus-newsgroup-variables))
- (gnus-summary-clear-local-variables))
(gnus-kill-buffer gnus-summary-buffer))
(unless gnus-single-article-buffer
(setq gnus-article-current nil))
(cond ((eq major-mode 'gnus-summary-mode)
(gnus-set-global-variables))
((eq major-mode 'gnus-article-mode)
- (save-excursion
+ (save-current-buffer
;; The `gnus-summary-buffer' variable may point
;; to the old summary buffer when using a single
;; article buffer.
(gnus-configure-windows (cdr quit-config) 'force))
(gnus-configure-windows (cdr quit-config) 'force))
(when (eq major-mode 'gnus-summary-mode)
+ (if (memq gnus-auto-select-on-ephemeral-exit '(next-noselect
+ next-unread-noselect))
+ (when (zerop (cond ((eq gnus-auto-select-on-ephemeral-exit
+ 'next-noselect)
+ (gnus-summary-next-subject 1 nil t))
+ ((eq gnus-auto-select-on-ephemeral-exit
+ 'next-unread-noselect)
+ (gnus-summary-next-subject 1 t t))))
+ ;; Hide the article buffer which displays the article different
+ ;; from the one that the cursor points to in the summary buffer.
+ (gnus-configure-windows 'summary 'force))
+ (cond ((eq gnus-auto-select-on-ephemeral-exit 'next)
+ (gnus-summary-next-subject 1))
+ ((eq gnus-auto-select-on-ephemeral-exit 'next-unread)
+ (gnus-summary-next-subject 1 t))))
(gnus-summary-recenter)
(gnus-summary-position-point))))
;;; Dead summaries.
-(defvar gnus-dead-summary-mode-map nil)
-
-(unless gnus-dead-summary-mode-map
- (setq gnus-dead-summary-mode-map (make-keymap))
- (suppress-keymap gnus-dead-summary-mode-map)
- (substitute-key-definition
- 'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
- (dolist (key '("\C-d" "\r" "\177" [delete]))
- (define-key gnus-dead-summary-mode-map
- key 'gnus-summary-wake-up-the-dead))
- (dolist (key '("q" "Q"))
- (define-key gnus-dead-summary-mode-map key 'bury-buffer)))
-
-(defvar gnus-dead-summary-mode nil
- "Minor mode for Gnus summary buffers.")
-
-(defun gnus-dead-summary-mode (&optional arg)
+(defvar gnus-dead-summary-mode-map
+ (let ((map (make-keymap)))
+ (suppress-keymap map)
+ (substitute-key-definition 'undefined 'gnus-summary-wake-up-the-dead map)
+ (dolist (key '("\C-d" "\r" "\177" [delete]))
+ (define-key map key 'gnus-summary-wake-up-the-dead))
+ (dolist (key '("q" "Q"))
+ (define-key map key 'bury-buffer))
+ map))
+
+(define-minor-mode gnus-dead-summary-mode
"Minor mode for Gnus summary buffers."
- (interactive "P")
- (when (eq major-mode 'gnus-summary-mode)
- (make-local-variable 'gnus-dead-summary-mode)
- (setq gnus-dead-summary-mode
- (if (null arg) (not gnus-dead-summary-mode)
- (> (prefix-numeric-value arg) 0)))
- (when gnus-dead-summary-mode
- (add-minor-mode
- 'gnus-dead-summary-mode " Dead" gnus-dead-summary-mode-map))))
+ :lighter " Dead" :keymap gnus-dead-summary-mode-map
+ (unless (derived-mode-p 'gnus-summary-mode)
+ (setq gnus-dead-summary-mode nil)))
(defun gnus-deaden-summary ()
"Make the current summary buffer into a dead summary buffer."
(gnus-kill-summary-on-exit
(when (and gnus-use-trees
(gnus-buffer-exists-p buffer))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(gnus-tree-close gnus-newsgroup-name)))
(gnus-kill-buffer buffer))
;; Deaden the buffer.
((gnus-buffer-exists-p buffer)
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(gnus-deaden-summary))))))
(defun gnus-summary-wake-up-the-dead (&rest args)
t)))
(gnus-message 3 "This dead summary is now alive again"))
-;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
-(defun gnus-summary-fetch-faq (&optional faq-dir)
- "Fetch the FAQ for the current group.
-If FAQ-DIR (the prefix), prompt for a directory to search for the faq
-in."
- (interactive
- (list
- (when current-prefix-arg
- (completing-read
- "FAQ dir: " (and (listp gnus-group-faq-directory)
- (mapcar 'list
- gnus-group-faq-directory))))))
- (let (gnus-faq-buffer)
- (when (setq gnus-faq-buffer
- (gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
- (gnus-configure-windows 'summary-faq))))
-
;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
(defun gnus-summary-describe-group (&optional force)
"Describe the current newsgroup."
(defun gnus-summary-describe-briefly ()
"Describe summary mode commands briefly."
(interactive)
- (gnus-message 6 (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
+ (gnus-message 6 "%s" (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
;; Walking around group mode buffer from summary mode.
"Go to the first subject satisfying any non-nil constraint.
If UNREAD is non-nil, the article should be unread.
If UNDOWNLOADED is non-nil, the article should be undownloaded.
-If UNSEEN is non-nil, the article should be unseen.
+If UNSEEN is non-nil, the article should be unseen as well as unread.
Returns the article selected or nil if there are no matching articles."
(interactive "P")
(cond
(and undownloaded
(memq num gnus-newsgroup-undownloaded))
(and unseen
- (memq num gnus-newsgroup-unseen)))))))
+ (memq num gnus-newsgroup-unseen)
+ (memq num gnus-newsgroup-unreads)))))))
(setq data (cdr data)))
(prog1
(if data
(gnus-summary-position-point))
(defun gnus-summary-goto-subject (article &optional force silent)
- "Go the subject line of ARTICLE.
+ "Go to the subject line of ARTICLE.
If FORCE, also allow jumping to articles not currently shown."
(interactive "nArticle number: ")
(unless (numberp article)
(defun gnus-summary-display-article (article &optional all-header)
"Display ARTICLE in article buffer."
- (when (gnus-buffer-live-p gnus-article-buffer)
- (with-current-buffer gnus-article-buffer
- (mm-enable-multibyte)))
+ (unless (and (gnus-buffer-live-p gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
+ (eq major-mode 'gnus-article-mode)))
+ (gnus-article-setup-buffer))
(gnus-set-global-variables)
- (when (gnus-buffer-live-p gnus-article-buffer)
- (with-current-buffer gnus-article-buffer
- (setq gnus-article-charset gnus-newsgroup-charset)
- (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets)
- (mm-enable-multibyte)))
+ (with-current-buffer gnus-article-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
(and (not pseudo)
(gnus-summary-article-pseudo-p article)
(error "This is a pseudo-article"))
- (save-excursion
- (set-buffer gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
(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))))
+ gnus-newsgroup-name))
+ (not (get-buffer gnus-original-article-buffer))))
(and (not gnus-single-article-buffer)
(or (null gnus-current-article)
(not (eq gnus-current-article article))))
If SUBJECT, only articles with SUBJECT are selected.
If BACKWARD, the previous article is selected instead of the next."
(interactive "P")
+ ;; Make sure we are in the summary buffer.
+ (unless (eq major-mode 'gnus-summary-mode)
+ (set-buffer gnus-summary-buffer))
(cond
;; Is there such an article?
((and (gnus-summary-search-forward unread subject backward)
(t
(unless (gnus-ephemeral-group-p gnus-newsgroup-name)
(gnus-summary-jump-to-group gnus-newsgroup-name))
- (let ((cmd last-command-char)
+ (let ((cmd (if (featurep 'xemacs)
+ last-command-char
+ last-command-event))
(point
(with-current-buffer gnus-group-buffer
(point)))
(?\C-p (gnus-group-prev-unread-group 1))))
(cursor-in-echo-area t)
keve key group ended prompt)
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(goto-char start)
(setq group
(if (eq gnus-keep-same-level 'best)
(gnus-summary-article-subject))))
(defun gnus-summary-prev-article (&optional unread subject)
- "Select the article after the current one.
+ "Select the article before the current one.
If UNREAD is non-nil, only unread articles are selected."
(interactive "P")
(gnus-summary-next-article unread subject t))
(setq endp (or (gnus-article-next-page lines)
(gnus-article-only-boring-p))))
(when endp
- (cond (stop
+ (cond ((or stop gnus-summary-stop-at-end-of-message)
(gnus-message 3 "End of message"))
(circular
(gnus-summary-beginning-of-article))
(defun gnus-summary-scroll-up (lines)
"Scroll up (or down) one line current article.
-Argument LINES specifies lines to be scrolled up (or down if negative)."
+Argument LINES specifies lines to be scrolled up (or down if negative).
+If no article is selected, then the current article will be selected first."
(interactive "p")
(gnus-configure-windows 'article)
(gnus-summary-show-thread)
(defun gnus-summary-scroll-down (lines)
"Scroll down (or up) one line current article.
-Argument LINES specifies lines to be scrolled down (or up if negative)."
+Argument LINES specifies lines to be scrolled down (or up if negative).
+If no article is selected, then the current article will be selected first."
(interactive "p")
(gnus-summary-scroll-up (- lines)))
(gnus-summary-position-point)))
(defun gnus-summary-first-unseen-or-unread-subject ()
- "Place the point on the subject line of the first unseen article or,
-if all article have been seen, on the subject line of the first unread
+ "Place the point on the subject line of the first unseen and unread article.
+If all article have been seen, on the subject line of the first unread
article."
(interactive)
(prog1
is a number, it is the line the article is to be displayed on."
(interactive
(list
- (completing-read
- "Article number or Message-ID: "
- (mapcar (lambda (number) (list (int-to-string number)))
- gnus-newsgroup-limit))
+ (gnus-completing-read
+ "Article number or Message-ID"
+ (mapcar 'int-to-string gnus-newsgroup-limit))
current-prefix-arg
t))
(prog1
(gnus-summary-limit articles))
(gnus-summary-position-point))))
+(defun gnus-summary-limit-to-address (address &optional not-matching)
+ "Limit the summary buffer to articles with the given ADDRESS.
+
+If NOT-MATCHING, exclude ADDRESS.
+
+To, Cc and From headers are checked. You need to include `To' and `Cc'
+in `nnmail-extra-headers'."
+ (interactive
+ (list (read-string (format "%s address (regexp): "
+ (if current-prefix-arg "Exclude" "Limit to")))
+ current-prefix-arg))
+ (when (not (equal "" address))
+ (prog1 (let* ((to
+ (if (memq 'To nnmail-extra-headers)
+ (gnus-summary-find-matching
+ (cons 'extra 'To) address 'all nil nil
+ not-matching)
+ (gnus-message
+ 1 "`To' isn't present in `nnmail-extra-headers'")
+ (sit-for 1)
+ t))
+ (cc
+ (if (memq 'Cc nnmail-extra-headers)
+ (gnus-summary-find-matching
+ (cons 'extra 'Cc) address 'all nil nil
+ not-matching)
+ (gnus-message
+ 1 "`Cc' isn't present in `nnmail-extra-headers'")
+ (sit-for 1)
+ t))
+ (from
+ (gnus-summary-find-matching "from" address
+ 'all nil nil not-matching))
+ (articles
+ (if not-matching
+ ;; We need the numbers that are in all lists:
+ (if (eq cc t)
+ (if (eq to t)
+ from
+ (mapcar (lambda (a) (car (memq a from))) to))
+ (if (eq to t)
+ (mapcar (lambda (a) (car (memq a from))) cc)
+ (mapcar (lambda (a) (car (memq a from)))
+ (mapcar (lambda (a) (car (memq a to)))
+ cc))))
+ (nconc (if (eq to t) nil to)
+ (if (eq cc t) nil cc)
+ from))))
+ (unless articles
+ (error "Found no matches for \"%s\"" address))
+ (gnus-summary-limit articles))
+ (gnus-summary-position-point))))
+
+(defun gnus-summary-limit-strange-charsets-predicate (header)
+ (when (fboundp 'char-charset)
+ (let ((string (concat (mail-header-subject header)
+ (mail-header-from header)))
+ charset found)
+ (dotimes (i (1- (length string)))
+ (setq charset (format "%s" (char-charset (aref string (1+ i)))))
+ (when (string-match "unicode\\|big\\|japanese" charset)
+ (setq found t)))
+ found)))
+
+(defun gnus-summary-limit-to-predicate (predicate)
+ "Limit to articles where PREDICATE returns non-nil.
+PREDICATE will be called with the header structures of the
+articles."
+ (let ((articles nil)
+ (case-fold-search t))
+ (dolist (header gnus-newsgroup-headers)
+ (when (funcall predicate header)
+ (push (mail-header-number header) articles)))
+ (gnus-summary-limit (nreverse articles))))
+
(defun gnus-summary-limit-to-age (age &optional younger-p)
"Limit the summary buffer to articles that are older than (or equal) AGE days.
If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to
(when (and (vectorp (gnus-data-header d))
(setq date (mail-header-date (gnus-data-header d))))
(setq is-younger (time-less-p
- (time-since (condition-case ()
- (date-to-time date)
- (error '(0 0))))
+ (time-since (gnus-date-get-time date))
cutoff))
(when (if younger-p
is-younger
(interactive
(let ((header
(intern
- (gnus-completing-read-with-default
- (symbol-name (car gnus-extra-headers))
+ (gnus-completing-read
(if current-prefix-arg
"Exclude extra header"
"Limit extra header")
- (mapcar (lambda (x)
- (cons (symbol-name x) x))
- gnus-extra-headers)
- nil
- t))))
+ (mapcar 'symbol-name gnus-extra-headers)
+ t nil nil
+ (symbol-name (car gnus-extra-headers))))))
(list header
(read-string (format "%s header %s (regexp): "
(if current-prefix-arg "Exclude" "Limit to")
(unless gnus-newsgroup-display
(error "There is no `display' group parameter"))
(let (articles)
- (dolist (number gnus-newsgroup-articles)
+ (dolist (gnus-number gnus-newsgroup-articles)
(when (funcall gnus-newsgroup-display)
- (push number articles)))
+ (push gnus-number articles)))
(gnus-summary-limit articles))
(gnus-summary-position-point))
(defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
(make-obsolete
- 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
+ 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread "Emacs 20.4")
(defun gnus-summary-limit-to-unread (&optional all)
"Limit the summary buffer to articles that are not marked as read.
gnus-killed-mark gnus-spam-mark gnus-kill-file-mark
gnus-low-score-mark gnus-expirable-mark
gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark
- gnus-duplicate-mark gnus-souped-mark)
+ gnus-duplicate-mark)
'reverse)))
-(defun gnus-summary-limit-to-bodies (match &optional reverse)
+(defun gnus-summary-limit-to-headers (match &optional reverse)
+ "Limit the summary buffer to articles that have headers that match MATCH.
+If REVERSE (the prefix), limit to articles that don't match."
+ (interactive "sMatch headers (regexp): \nP")
+ (gnus-summary-limit-to-bodies match reverse t))
+
+(defun gnus-summary-limit-to-bodies (match &optional reverse headersp)
"Limit the summary buffer to articles that have bodies that match MATCH.
If REVERSE (the prefix), limit to articles that don't match."
(interactive "sMatch body (regexp): \nP")
(dolist (data gnus-newsgroup-data)
(let (gnus-mark-article-hook)
(gnus-summary-select-article t t nil (gnus-data-number data)))
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(article-goto-body)
(let* ((case-fold-search t)
- (found (re-search-forward match nil t)))
+ (found (if headersp
+ (re-search-backward match nil t)
+ (re-search-forward match nil t))))
(when (or (and found
(not reverse))
(and (not found)
(gnus-summary-limit articles)))
(gnus-summary-position-point))
+(defun gnus-summary-limit-to-singletons (&optional threadsp)
+ "Limit the summary buffer to articles that aren't part on any thread.
+If THREADSP (the prefix), limit to articles that are in threads."
+ (interactive "P")
+ (let ((articles nil)
+ thread-articles
+ threads)
+ (dolist (thread gnus-newsgroup-threads)
+ (if (stringp (car thread))
+ (dolist (thread (cdr thread))
+ (push thread threads))
+ (push thread threads)))
+ (dolist (thread threads)
+ (setq thread-articles (gnus-articles-in-thread thread))
+ (when (or (and threadsp
+ (> (length thread-articles) 1))
+ (and (not threadsp)
+ (= (length thread-articles) 1)))
+ (setq articles (nconc thread-articles articles))))
+ (if (not articles)
+ (message "No messages matched")
+ (gnus-summary-limit articles))
+ (gnus-summary-position-point)))
+
(defun gnus-summary-limit-to-replied (&optional unreplied)
"Limit the summary buffer to replied articles.
If UNREPLIED (the prefix), limit to unreplied articles."
(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks)
(make-obsolete 'gnus-summary-delete-marked-with
- 'gnus-summary-limit-exclude-marks)
+ 'gnus-summary-limit-exclude-marks "Emacs 20.4")
(defun gnus-summary-limit-exclude-marks (marks &optional reverse)
"Exclude articles that are marked with MARKS (e.g. \"DK\").
(interactive)
(let ((gnus-verbose (max 6 gnus-verbose)))
(if (not gnus-newsgroup-dormant)
- (gnus-message 3 "No cached articles for this group")
+ (gnus-message 3 "No dormant articles for this group")
(gnus-summary-goto-subjects gnus-newsgroup-dormant))))
+(defun gnus-summary-insert-ticked-articles ()
+ "Insert ticked articles for this group into the current buffer."
+ (interactive)
+ (let ((gnus-verbose (max 6 gnus-verbose)))
+ (if (not gnus-newsgroup-marked)
+ (gnus-message 3 "No ticked articles for this group")
+ (gnus-summary-goto-subjects gnus-newsgroup-marked))))
+
(defun gnus-summary-limit-include-dormant ()
"Display all the hidden articles that are marked as dormant.
Note that this command only works on a subset of the articles currently
This entails weeding out unwanted dormants, low-scored articles,
fetch-old-headers verbiage, and so on."
;; Most groups have nothing to remove.
- (if (or gnus-inhibit-limiting
- (and (null gnus-newsgroup-dormant)
- (eq gnus-newsgroup-display 'gnus-not-ignore)
- (not (eq gnus-fetch-old-headers 'some))
- (not (numberp gnus-fetch-old-headers))
- (not (eq gnus-fetch-old-headers 'invisible))
- (null gnus-summary-expunge-below)
- (not (eq gnus-build-sparse-threads 'some))
- (not (eq gnus-build-sparse-threads 'more))
- (null gnus-thread-expunge-below)
- (not gnus-use-nocem)))
- () ; Do nothing.
+ (unless (or gnus-inhibit-limiting
+ (and (null gnus-newsgroup-dormant)
+ (eq gnus-newsgroup-display 'gnus-not-ignore)
+ (not (eq gnus-fetch-old-headers 'some))
+ (not (numberp gnus-fetch-old-headers))
+ (not (eq gnus-fetch-old-headers 'invisible))
+ (null gnus-summary-expunge-below)
+ (not (eq gnus-build-sparse-threads 'some))
+ (not (eq gnus-build-sparse-threads 'more))
+ (null gnus-thread-expunge-below)))
(push gnus-newsgroup-limit gnus-newsgroup-limits)
(setq gnus-newsgroup-limit nil)
(mapatoms
;; will really go down to a leaf article first, before slowly
;; working its way up towards the root.
(when thread
- (let* ((max-lisp-eval-depth 5000)
+ (let* ((max-lisp-eval-depth (max 5000 max-lisp-eval-depth))
(children
(if (cdr thread)
(apply '+ (mapcar 'gnus-summary-limit-children
(cdr thread)))
0))
- (number (mail-header-number (car thread)))
- score)
+ (number (mail-header-number (car thread)))
+ score)
(if (and
(not (memq number gnus-newsgroup-marked))
(or
t)
;; Do the `display' group parameter.
(and gnus-newsgroup-display
- (not (funcall gnus-newsgroup-display)))
- ;; Check NoCeM things.
- (when (and gnus-use-nocem
- (gnus-nocem-unwanted-article-p
- (mail-header-id (car thread))))
- (setq gnus-newsgroup-unreads
- (delq number gnus-newsgroup-unreads))
- t)))
+ (let ((gnus-number number))
+ (not (funcall gnus-newsgroup-display))))))
;; Nope, invisible article.
0
;; Ok, this article is to be visible, so we add it to the limit
;; References header, since this is slightly more
;; reliable than the References field we got from the
;; server.
- (save-excursion
- (set-buffer gnus-original-article-buffer)
+ (with-current-buffer gnus-original-article-buffer
(nnheader-narrow-to-headers)
(unless (setq ref (message-fetch-field "references"))
(when (setq ref (message-fetch-field "in-reply-to"))
(defun gnus-summary-refer-thread (&optional limit)
"Fetch all articles in the current thread.
-If LIMIT (the numerical prefix), fetch that many old headers instead
-of what's specified by the `gnus-refer-thread-limit' variable."
+If no backend-specific 'request-thread function is available
+fetch LIMIT (the numerical prefix) old headers. If LIMIT is nil
+fetch what's specified by the `gnus-refer-thread-limit'
+variable."
(interactive "P")
(let ((id (mail-header-id (gnus-summary-article-header)))
+ (gnus-summary-ignore-duplicates t)
(limit (if limit (prefix-numeric-value limit)
gnus-refer-thread-limit)))
- (unless (eq gnus-fetch-old-headers 'invisible)
- (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
- ;; Retrieve the headers and read them in.
- (if (eq (if (numberp limit)
- (gnus-retrieve-headers
- (list (min
- (+ (mail-header-number
- (gnus-summary-article-header))
- limit)
- gnus-newsgroup-end))
- gnus-newsgroup-name (* limit 2))
- ;; gnus-refer-thread-limit is t, i.e. fetch _all_
- ;; headers.
- (gnus-retrieve-headers (list gnus-newsgroup-end)
- gnus-newsgroup-name limit))
- 'nov)
- (gnus-build-all-threads)
- (error "Can't fetch thread from back ends that don't support NOV"))
- (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name))
+ (if (gnus-check-backend-function 'request-thread gnus-newsgroup-name)
+ (setq gnus-newsgroup-headers
+ (gnus-merge 'list
+ gnus-newsgroup-headers
+ (gnus-request-thread id)
+ 'gnus-article-sort-by-number))
+ (unless (eq gnus-fetch-old-headers 'invisible)
+ (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
+ ;; Retrieve the headers and read them in.
+ (if (numberp limit)
+ (gnus-retrieve-headers
+ (list (min
+ (+ (mail-header-number
+ (gnus-summary-article-header))
+ limit)
+ gnus-newsgroup-end))
+ gnus-newsgroup-name (* limit 2))
+ ;; gnus-refer-thread-limit is t, i.e. fetch _all_
+ ;; headers.
+ (gnus-retrieve-headers (list gnus-newsgroup-end)
+ gnus-newsgroup-name limit)
+ (gnus-message 5 "Fetching headers for %s...done"
+ gnus-newsgroup-name))))
+ (when (eq gnus-headers-retrieved-by 'nov)
+ (gnus-build-all-threads))
(gnus-summary-limit-include-thread id)))
(defun gnus-summary-refer-article (message-id)
(case-fold-search t)
(buf (current-buffer))
dig to-address)
- (save-excursion
- (set-buffer gnus-original-article-buffer)
+ (with-current-buffer gnus-original-article-buffer
;; Have the digest group inherit the main mail address of
;; the parent article.
(when (setq to-address (or (gnus-fetch-field "reply-to")
(setq group (format "%s-%d" gnus-newsgroup-name article))
(gnus-summary-remove-process-mark article)
(when (gnus-summary-display-article article)
- (save-excursion
+ (save-excursion ;;What for?
(with-temp-buffer
(insert-buffer-substring gnus-original-article-buffer)
;; Remove some headers that may lead nndoc to make
(nndoc-article-type guess))
t nil t))
(progn
- ;; Make all postings to this group go to the parent group.
+ ;; Make all postings to this group go to the parent group.
(nconc (gnus-info-params (gnus-get-info egroup))
params)
(push egroup groups))
This search includes all articles in the current group that Gnus has
fetched headers for, whether they are displayed or not."
(let ((articles nil)
+ ;; Can't eta-reduce because it's a macro.
(func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
(case-fold-search t))
(dolist (header gnus-newsgroup-headers)
article. If BACKWARD (the prefix) is non-nil, search backward instead."
(interactive
(list (let ((completion-ignore-case t))
- (completing-read
- "Header name: "
- (mapcar (lambda (header) (list (format "%s" header)))
+ (gnus-completing-read
+ "Header name"
+ (mapcar 'symbol-name
(append
- '("Number" "Subject" "From" "Lines" "Date"
- "Message-ID" "Xref" "References" "Body")
+ '(Number Subject From Lines Date
+ Message-ID Xref References Body)
gnus-extra-headers))
- nil 'require-match))
+ 'require-match))
(read-string "Regexp: ")
(read-key-sequence "Command: ")
current-prefix-arg))
(goto-char (point-max))
(recenter -3)
(when gnus-break-pages
- (when (re-search-backward page-delimiter nil t)
- (narrow-to-region (match-end 0) (point-max)))
(gnus-narrow-to-page))))
(defun gnus-summary-print-truncate-and-quote (string &optional len)
(mail-header-date gnus-current-headers) ")"))))
(gnus-run-hooks 'gnus-ps-print-hook)
(save-excursion
- (if window-system
+ (if ps-print-color-p
(ps-spool-buffer-with-faces)
(ps-spool-buffer)))))
(kill-buffer buffer))))
+(defun gnus-summary-show-complete-article ()
+ "Show a complete version of the current article.
+This is only useful if you're looking at a partial version of the
+article currently."
+ (interactive)
+ (let ((gnus-keep-backlog nil)
+ (gnus-use-cache nil)
+ (gnus-agent nil)
+ (variable (intern
+ (format "%s-fetch-partial-articles"
+ (car (gnus-find-method-for-group
+ gnus-newsgroup-name)))
+ obarray))
+ old-val)
+ (unwind-protect
+ (progn
+ (setq old-val (symbol-value variable))
+ (set variable nil)
+ (gnus-flush-original-article-buffer)
+ (gnus-summary-show-article))
+ (set variable old-val))))
+
(defun gnus-summary-show-article (&optional arg)
"Force redisplaying of the current article.
If ARG (the prefix) is a number, show the article with the charset
(gnus-summary-select-article nil 'force)
(let ((deps gnus-newsgroup-dependencies)
head header lines)
- (save-excursion
- (set-buffer gnus-original-article-buffer)
+ (with-current-buffer gnus-original-article-buffer
(save-restriction
(message-narrow-to-head)
(setq head (buffer-string))
gnus-break-pages)
;; Destroy any MIME parts.
(when (gnus-buffer-live-p gnus-article-buffer)
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(mm-destroy-parts gnus-article-mime-handles)
;; Set it to nil for safety reason.
(setq gnus-article-mime-handle-alist nil)
(with-current-buffer gnus-article-buffer
(widen)
(article-narrow-to-head)
- (let* ((buffer-read-only nil)
+ (let* ((inhibit-read-only t)
(inhibit-point-motion-hooks t)
(hidden (if (numberp arg)
(>= arg 0)
(if gnus-break-pages
(gnus-narrow-to-page)
(when (gnus-visual-p 'page-marker)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(gnus-remove-text-with-property 'gnus-prev)
(gnus-remove-text-with-property 'gnus-next))))
(gnus-set-mode-line 'article)))))
(save-restriction
(widen)
(let ((start (window-start))
- buffer-read-only)
+ (inhibit-read-only t))
(if (equal arg '(4))
(message-caesar-buffer-body nil t)
(message-caesar-buffer-body arg))
;; Create buttons and stuff...
(gnus-treat-article nil))
+(declare-function idna-to-unicode "ext:idna" (str))
+
(defun gnus-summary-idna-message (&optional arg)
"Decode IDNA encoded domain names in the current articles.
IDNA encoded domain names looks like `xn--bar'. If a string
remain unencoded after running this function, it is likely an
invalid IDNA string (`xn--bar' is invalid).
-You must have GNU Libidn (`http://www.gnu.org/software/libidn/')
+You must have GNU Libidn (URL `http://www.gnu.org/software/libidn/')
installed for this command to work."
(interactive "P")
(if (not (and (condition-case nil (require 'idna)
(save-restriction
(widen)
(let ((pos (window-start))
- buffer-read-only)
+ (inhibit-read-only t))
(goto-char (point-min))
(when (message-goto-body)
(gnus-narrow-to-body))
(gnus-eval-in-buffer-window gnus-article-buffer
(widen)
(when (gnus-visual-p 'page-marker)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(gnus-remove-text-with-property 'gnus-prev)
(gnus-remove-text-with-property 'gnus-next))
(setq gnus-page-broken nil))))
(crosspost "Crosspost" "Crossposting")))
(copy-buf (save-excursion
(nnheader-set-temp-buffer " *copy article*")))
- art-group to-method new-xref article to-groups articles-to-update-marks)
+ art-group to-method new-xref article to-groups
+ articles-to-update-marks encoded)
(unless (assq action names)
(error "Unknown action %s" action))
;; Read the newsgroup name.
(gnus-article-prepare-hook nil)
(gnus-mark-article-hook nil))
(gnus-summary-select-article nil nil nil (car articles))))
- (setq to-newsgroup
- (gnus-read-move-group-name
- (cadr (assq action names))
- (symbol-value (intern (format "gnus-current-%s-group" action)))
- articles prefix))
- (set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
- (setq to-method (or select-method
- (gnus-server-to-method
- (gnus-group-method to-newsgroup))))
+ (setq to-newsgroup (gnus-read-move-group-name
+ (cadr (assq action names))
+ (symbol-value
+ (intern (format "gnus-current-%s-group" action)))
+ articles prefix)
+ encoded to-newsgroup
+ to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))
+ (set (intern (format "gnus-current-%s-group" action))
+ (mm-decode-coding-string
+ to-newsgroup
+ (gnus-group-name-charset to-method to-newsgroup))))
+ (unless to-method
+ (setq to-method (or select-method
+ (gnus-server-to-method
+ (gnus-group-method to-newsgroup)))))
+ (setq to-newsgroup
+ (or encoded
+ (and to-newsgroup
+ (mm-encode-coding-string
+ to-newsgroup
+ (gnus-group-name-charset to-method to-newsgroup)))))
;; Check the method we are to move this article to...
(unless (gnus-check-backend-function
'request-accept-article (car to-method))
(error "Can't open server %s" (car to-method)))
(gnus-message 6 "%s to %s: %s..."
(caddr (assq action names))
- (or (car select-method) to-newsgroup) articles)
+ (or (car select-method)
+ (gnus-group-decoded-name to-newsgroup))
+ articles)
(while articles
(setq article (pop articles))
(setq
(gnus-dup-unsuppress-article article)
(let* ((from-method (gnus-find-method-for-group
gnus-newsgroup-name))
- (to-method (gnus-find-method-for-group
- to-newsgroup))
- (move-is-internal (gnus-method-equal from-method to-method)))
+ (to-method (or select-method
+ (gnus-find-method-for-group to-newsgroup)))
+ (move-is-internal (gnus-server-equal from-method to-method)))
(gnus-request-move-article
article ; Article to move
gnus-newsgroup-name ; From newsgroup
to-newsgroup (list 'quote select-method)
(not articles) t) ; Accept form
(not articles) ; Only save nov last time
- move-is-internal))) ; is this move internal?
+ (and move-is-internal
+ to-newsgroup ; Not respooling
+ (gnus-group-real-name to-newsgroup))))) ; Is this move internal?
;; Copy the article.
((eq action 'copy)
- (save-excursion
- (set-buffer copy-buf)
+ (with-current-buffer copy-buf
(when (gnus-request-article-this-buffer article gnus-newsgroup-name)
(save-restriction
(nnheader-narrow-to-headers)
(delete "Xref:" (delete new-xref xref))
" ")
" " new-xref))
- (save-excursion
- (set-buffer copy-buf)
+ (with-current-buffer copy-buf
;; First put the article in the destination group.
(gnus-request-article-this-buffer article gnus-newsgroup-name)
(when (consp (setq art-group
(list (cdr art-group)))))
;; See whether the article is to be put in the cache.
- (let ((marks (if (gnus-group-auto-expirable-p to-group)
- gnus-article-mark-lists
- (delete '(expirable . expire)
- (copy-sequence gnus-article-mark-lists))))
- (to-article (cdr art-group)))
+ (let* ((expirable (gnus-group-auto-expirable-p to-group))
+ (marks (if expirable
+ gnus-article-mark-lists
+ (delete '(expirable . expire)
+ (copy-sequence gnus-article-mark-lists))))
+ (to-article (cdr art-group)))
;; Enter the article into the cache in the new group,
;; if that is required.
(not (memq article gnus-newsgroup-unreads)))
;; Mark this article as read in this group.
(push (cons to-article gnus-read-mark) gnus-newsgroup-reads)
+ ;; Increase the active status of this group.
(setcdr (gnus-active to-group) to-article)
- (setcdr gnus-newsgroup-active to-article))
+ (setcdr gnus-newsgroup-active to-article))
(while marks
(when (eq (gnus-article-mark-to-type (cdar marks)) 'list)
to-group (cdar marks) (list to-article) info)))
(setq marks (cdr marks)))
- (gnus-request-set-mark
- to-group (list (list (list to-article) 'add to-marks))))
+ (when (and expirable
+ gnus-mark-copied-or-moved-articles-as-expirable
+ (not (memq 'expire to-marks)))
+ ;; Mark this article as expirable.
+ (push 'expire to-marks)
+ (when (equal to-group gnus-newsgroup-name)
+ (push to-article gnus-newsgroup-expirable))
+ ;; Copy the expirable mark to other group.
+ (gnus-add-marked-articles
+ to-group 'expire (list to-article) info))
+
+ (when to-marks
+ (gnus-request-set-mark
+ to-group (list (list (list to-article) 'add to-marks)))))
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
;; Update the Xref header in this article to point to
;; the new crossposted article we have just created.
(when (eq action 'crosspost)
- (save-excursion
- (set-buffer copy-buf)
+ (with-current-buffer copy-buf
(gnus-request-article-this-buffer article gnus-newsgroup-name)
(nnheader-replace-header "Xref" new-xref)
(gnus-request-replace-article
;;;!!!Why is this necessary?
(set-buffer gnus-summary-buffer)
- (gnus-summary-goto-subject article)
(when (eq action 'move)
- (gnus-summary-mark-article article gnus-canceled-mark))))
+ (save-excursion
+ (gnus-summary-goto-subject article)
+ (gnus-summary-mark-article article gnus-canceled-mark)))))
(push article articles-to-update-marks))
- (apply 'gnus-summary-remove-process-mark articles-to-update-marks)
- ;; Re-activate all groups that have been moved to.
(save-excursion
- (set-buffer gnus-group-buffer)
+ (apply 'gnus-summary-remove-process-mark articles-to-update-marks))
+ ;; Re-activate all groups that have been moved to.
+ (with-current-buffer gnus-group-buffer
(let ((gnus-group-marked to-groups))
(gnus-group-get-new-news-this-group nil t)))
:type 'symbol
:group 'gnus-summary-mail)
-(defcustom gnus-summary-display-while-building nil
- "If non-nil, show and update the summary buffer as it's being built.
-If the value is t, update the buffer after every line is inserted. If
-the value is an integer (N), update the display every N lines."
- :version "22.1"
- :group 'gnus-thread
- :type '(choice (const :tag "off" nil)
- number
- (const :tag "frequently" t)))
-
(defun gnus-summary-respool-article (&optional n method)
"Respool the current article.
The article will be squeezed through the mail spooling process again,
(car (gnus-find-method-for-group
gnus-newsgroup-name)))))
(method
- (gnus-completing-read-with-default
- methname "Backend to use when respooling"
- methods nil t nil 'gnus-mail-method-history))
+ (gnus-completing-read
+ "Backend to use when respooling"
+ methods t nil 'gnus-mail-method-history methname))
ms)
(cond
((zerop (length (setq ms (gnus-servers-using-backend
(car ms))
(t
(let ((ms-alist (mapcar (lambda (m) (cons (cadr m) m)) ms)))
- (cdr (assoc (completing-read "Server name: " ms-alist nil t)
+ (cdr (assoc (gnus-completing-read "Server name" ms-alist t)
ms-alist))))))))
(unless method
(error "No method given for respooling"))
(or (file-readable-p file)
(not (file-regular-p file))
(error "Can't read %s" file))
- (save-excursion
- (set-buffer (gnus-get-buffer-create " *import file*"))
+ (with-current-buffer (gnus-get-buffer-create " *import file*")
(erase-buffer)
(nnheader-insert-file-contents file)
(goto-char (point-min))
group-art)
(unless (gnus-check-backend-function 'request-accept-article group)
(error "%s does not support article importing" group))
- (save-excursion
- (set-buffer (gnus-get-buffer-create " *import file*"))
+ (with-current-buffer (gnus-get-buffer-create " *import file*")
(erase-buffer)
(goto-char (point-min))
;; This doesn't look like an article, so we fudge some headers.
;; Delete the articles.
(setq not-deleted (gnus-request-expire-articles
articles gnus-newsgroup-name 'force))
- (while articles
- (gnus-summary-remove-process-mark (car articles))
- ;; The backend might not have been able to delete the article
- ;; after all.
- (unless (memq (car articles) not-deleted)
- (gnus-summary-mark-article (car articles) gnus-canceled-mark))
- (let* ((article (car articles))
- (ghead (gnus-data-header
- (assoc article (gnus-data-list nil)))))
- (run-hook-with-args 'gnus-summary-article-delete-hook
- 'delete ghead gnus-newsgroup-name nil
- nil))
- (setq articles (cdr articles)))
+ (save-excursion
+ (while articles
+ (gnus-summary-remove-process-mark (car articles))
+ ;; The backend might not have been able to delete the article
+ ;; after all.
+ (unless (memq (car articles) not-deleted)
+ (gnus-summary-mark-article (car articles) gnus-canceled-mark))
+ (let* ((article (car articles))
+ (ghead (gnus-data-header
+ (assoc article (gnus-data-list nil)))))
+ (run-hook-with-args 'gnus-summary-article-delete-hook
+ 'delete ghead gnus-newsgroup-name nil
+ nil))
+ (setq articles (cdr articles))))
(when not-deleted
(gnus-message 4 "Couldn't delete articles %s" not-deleted)))
(gnus-summary-position-point)
"nndraft:queue")))
(error "Can't edit the raw article in group %s"
gnus-newsgroup-name))
- (save-excursion
- (set-buffer gnus-summary-buffer)
+ (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)
(message-options message-options)
(message-options-set-recipient)
(mail-parse-ignored-charsets
- ',gnus-newsgroup-ignored-charsets))
+ ',gnus-newsgroup-ignored-charsets)
+ (rfc2047-header-encoding-alist
+ ',(let ((charset (gnus-group-name-charset
+ (gnus-find-method-for-group
+ gnus-newsgroup-name)
+ gnus-newsgroup-name)))
+ (append (list (cons "Newsgroups" charset)
+ (cons "Followup-To" charset)
+ (cons "Xref" charset))
+ rfc2047-header-encoding-alist))))
,(if (not raw) '(progn
(mml-to-mime)
(mml-destroy-buffers)
"Make edits to the current article permanent."
(interactive)
(save-excursion
- ;; The buffer restriction contains the entire article if it exists.
+ ;; The buffer restriction contains the entire article if it exists.
(when (article-goto-body)
(let ((lines (count-lines (point) (point-max)))
(length (- (point-max) (point)))
(delete-region (match-beginning 1) (match-end 1))
(insert (number-to-string lines))))))
;; Replace the article.
- (let ((buf (current-buffer)))
+ (let ((buf (current-buffer))
+ (article (cdr gnus-article-current))
+ replace-result)
(with-temp-buffer
(insert-buffer-substring buf)
-
(if (and (not read-only)
- (not (gnus-request-replace-article
- (cdr gnus-article-current) (car gnus-article-current)
- (current-buffer) t)))
+ (not (setq replace-result
+ (gnus-request-replace-article
+ article (car gnus-article-current)
+ (current-buffer) t))))
(error "Couldn't replace article")
+ ;; If we got a number back, then that's the new article number
+ ;; for this article. Otherwise, the article number didn't change.
+ (when (numberp replace-result)
+ (with-current-buffer gnus-summary-buffer
+ (setq gnus-newsgroup-limit (delq article gnus-newsgroup-limit))
+ (gnus-summary-limit gnus-newsgroup-limit)
+ (setq article replace-result)
+ (gnus-summary-goto-subject article t)))
;; Update the summary buffer.
(if (and references
(equal (message-tokenize-header references " ")
(point-min) (point-max)))
header)
(with-temp-buffer
- (insert (format "211 %d Article retrieved.\n"
- (cdr gnus-article-current)))
+ (insert (format "211 %d Article retrieved.\n" article))
(insert head)
(insert ".\n")
(let ((nntp-server-buffer (current-buffer)))
- (setq header (car (gnus-get-newsgroup-headers
- nil t))))
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-data-set-header
- (gnus-data-find (cdr gnus-article-current))
- header)
- (gnus-summary-update-article-line
- (cdr gnus-article-current) header)
- (if (gnus-summary-goto-subject
- (cdr gnus-article-current) nil t)
- (gnus-summary-update-secondary-mark
- (cdr gnus-article-current))))))))
+ (setq header (car (gnus-get-newsgroup-headers nil t))))
+ (with-current-buffer gnus-summary-buffer
+ (gnus-data-set-header (gnus-data-find article) header)
+ (gnus-summary-update-article-line article header)
+ (if (gnus-summary-goto-subject article nil t)
+ (gnus-summary-update-secondary-mark article)))))))
;; Update threads.
(set-buffer (or buffer gnus-summary-buffer))
- (gnus-summary-update-article (cdr gnus-article-current))
- (if (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
- (gnus-summary-update-secondary-mark
- (cdr gnus-article-current))))
+ (gnus-summary-update-article article)
+ (if (gnus-summary-goto-subject article nil t)
+ (gnus-summary-update-secondary-mark article)))
;; Prettify the article buffer again.
(unless no-highlight
- (save-excursion
- (set-buffer gnus-article-buffer)
- ;;;!!! Fix this -- article should be rehighlighted.
- ;;;(gnus-run-hooks 'gnus-article-display-hook)
+ (with-current-buffer gnus-article-buffer
+ ;;!!! Fix this -- article should be rehighlighted.
+ ;;(gnus-run-hooks 'gnus-article-display-hook)
(set-buffer gnus-original-article-buffer)
(gnus-request-article
- (cdr gnus-article-current)
- (car gnus-article-current) (current-buffer))))
+ article (car gnus-article-current) (current-buffer))))
;; Prettify the summary buffer line.
(when (gnus-visual-p 'summary-highlight 'highlight)
(gnus-run-hooks 'gnus-visual-mark-article-hook))))))
(interactive)
(let (gnus-mark-article-hook)
(gnus-summary-select-article)
- (save-excursion
- (set-buffer gnus-original-article-buffer)
+ (with-current-buffer gnus-original-article-buffer
(let ((groups (nnmail-article-group 'identity trace)))
(unless silent
(if groups
(unless (numberp article)
(error "%s is not a number" article))
(push article gnus-newsgroup-replied)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(when (gnus-summary-goto-subject article nil t)
(gnus-summary-update-secondary-mark article))))))
(let ((articles (if (listp article) article (list article))))
(dolist (article articles)
(push article gnus-newsgroup-forwarded)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(when (gnus-summary-goto-subject article nil t)
(gnus-summary-update-secondary-mark article))))))
(not (equal gnus-newsgroup-name (car gnus-article-current))))
(error "No current article selected"))
;; Remove old bookmark, if one exists.
- (gnus-pull article gnus-newsgroup-bookmarks)
+ (gnus-alist-pull article gnus-newsgroup-bookmarks)
;; Set the new bookmark, which is on the form
;; (article-number . line-number-in-body).
(push
;; Remove old bookmark, if one exists.
(if (not (assq article gnus-newsgroup-bookmarks))
(gnus-message 6 "No bookmark in current article.")
- (gnus-pull article gnus-newsgroup-bookmarks)
+ (gnus-alist-pull article gnus-newsgroup-bookmarks)
(gnus-message 6 "Removed bookmark.")))
;; Suggested by Daniel Quinlan <quinlan@best.com>.
(setq gnus-newsgroup-unreads
(gnus-add-to-sorted-list gnus-newsgroup-unreads
article))))
- (gnus-pull article gnus-newsgroup-reads)
+ (gnus-alist-pull article gnus-newsgroup-reads)
;; See whether the article is to be put in the cache.
(and gnus-use-cache
(= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
(when (gnus-summary-goto-subject article nil t)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(gnus-summary-show-thread)
;; Fix the mark.
(gnus-summary-update-mark mark 'unread)
(t gnus-no-mark))
'replied)
(when (gnus-visual-p 'summary-highlight 'highlight)
+ (gnus-summary-highlight-line)
(gnus-run-hooks 'gnus-summary-update-hook))
t)
(defun gnus-summary-update-mark (mark type)
(let ((forward (cdr (assq type gnus-summary-mark-positions)))
- (buffer-read-only nil))
+ (inhibit-read-only t))
(re-search-backward "[\n\r]" (point-at-bol) 'move-to-limit)
(when forward
(when (looking-at "\r")
;; Go to the right position on the line.
(goto-char (+ forward (point)))
;; Replace the old mark with the new mark.
- (subst-char-in-region (point) (1+ (point)) (char-after) mark)
+ (let ((to-insert
+ (mm-subst-char-in-string
+ (char-after) mark
+ (buffer-substring (point) (1+ (point))))))
+ (delete-region (point) (1+ (point)))
+ (insert to-insert))
;; Optionally update the marks by some user rule.
(when (eq type 'unread)
(gnus-data-set-mark
(t
(setq gnus-newsgroup-unreads
(gnus-add-to-sorted-list gnus-newsgroup-unreads article))))
- (gnus-pull article gnus-newsgroup-reads)
+ (gnus-alist-pull article gnus-newsgroup-reads)
t)))
-(defalias 'gnus-summary-mark-as-unread-forward
- 'gnus-summary-tick-article-forward)
-(make-obsolete 'gnus-summary-mark-as-unread-forward
- 'gnus-summary-tick-article-forward)
(defun gnus-summary-tick-article-forward (n)
"Tick N articles forwards.
If N is negative, tick backwards instead.
(interactive "p")
(gnus-summary-mark-forward n gnus-ticked-mark))
-(defalias 'gnus-summary-mark-as-unread-backward
- 'gnus-summary-tick-article-backward)
-(make-obsolete 'gnus-summary-mark-as-unread-backward
- 'gnus-summary-tick-article-backward)
(defun gnus-summary-tick-article-backward (n)
"Tick N articles backwards.
The difference between N and the number of articles ticked is returned."
(interactive "p")
(gnus-summary-mark-forward (- n) gnus-ticked-mark))
-(defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
-(make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
(defun gnus-summary-tick-article (&optional article clear-mark)
"Mark current article as unread.
Optional 1st argument ARTICLE specifies article number to be marked as unread.
(gnus-summary-mark-forward (- n) gnus-unread-mark))
(defun gnus-summary-mark-unread-as-read ()
- "Intended to be used by `gnus-summary-mark-article-hook'."
+ "Intended to be used by `gnus-mark-article-hook'."
(when (memq gnus-current-article gnus-newsgroup-unreads)
(gnus-summary-mark-article gnus-current-article gnus-read-mark)))
(defun gnus-summary-mark-read-and-unread-as-read (&optional new-mark)
- "Intended to be used by `gnus-summary-mark-article-hook'."
+ "Intended to be used by `gnus-mark-article-hook'."
(let ((mark (gnus-summary-article-mark)))
(when (or (gnus-unread-mark-p mark)
(gnus-read-mark-p mark))
(or new-mark gnus-read-mark)))))
(defun gnus-summary-mark-current-read-and-unread-as-read (&optional new-mark)
- "Intended to be used by `gnus-summary-mark-article-hook'."
+ "Intended to be used by `gnus-mark-article-hook'."
(let ((mark (gnus-summary-article-mark)))
(when (or (gnus-unread-mark-p mark)
(gnus-read-mark-p mark))
(or new-mark gnus-read-mark)))))
(defun gnus-summary-mark-unread-as-ticked ()
- "Intended to be used by `gnus-summary-mark-article-hook'."
+ "Intended to be used by `gnus-mark-article-hook'."
(when (memq gnus-current-article gnus-newsgroup-unreads)
(gnus-summary-mark-article gnus-current-article gnus-ticked-mark)))
(setq score (if score
(prefix-numeric-value score)
(or gnus-summary-default-score 0)))
- (save-excursion
- (set-buffer gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
(goto-char (point-min))
(while
(progn
(setq score (if score
(prefix-numeric-value score)
(or gnus-summary-default-score 0)))
- (save-excursion
- (set-buffer gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
(goto-char (point-min))
(while (and (progn
(when (> (gnus-summary-article-score) score)
(defun gnus-summary-limit-include-expunged (&optional no-error)
"Display all the hidden articles that were expunged for low scores."
(interactive)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(let ((scored gnus-newsgroup-scored)
headers h)
(while scored
(goto-char (point-min))
(push gnus-newsgroup-limit gnus-newsgroup-limits)
(setq gnus-newsgroup-limit (copy-sequence gnus-newsgroup-limit))
- (mapcar (lambda (x) (push (mail-header-number x)
- gnus-newsgroup-limit))
- headers)
+ (dolist (x headers)
+ (push (mail-header-number x) gnus-newsgroup-limit))
(gnus-summary-prepare-unthreaded (nreverse headers))
(goto-char (point-min))
(gnus-summary-position-point)
gnus-newsgroup-dormant nil))
(setq gnus-newsgroup-unreads
(gnus-sorted-nunion
- (gnus-intersection gnus-newsgroup-unreads
- gnus-newsgroup-downloadable)
- gnus-newsgroup-unfetched)))
+ (gnus-sorted-intersection gnus-newsgroup-unreads
+ gnus-newsgroup-downloadable)
+ (gnus-sorted-difference gnus-newsgroup-unfetched
+ gnus-newsgroup-cached))))
;; We actually mark all articles as canceled, which we
;; have to do when using auto-expiry or adaptive scoring.
(gnus-summary-show-all-threads)
(defun gnus-summary-reparent-children (parent children)
"Make PARENT the parent of CHILDREN.
-When called interactively, PARENT is is current article and
-CHILDREN are the process-marked articles."
+When called interactively, PARENT is the current article and CHILDREN
+are the process-marked articles."
(interactive
(list (gnus-summary-article-number)
(gnus-summary-work-articles nil)))
(gnus-message 6 "Threading is now %s" (if gnus-show-threads "on" "off"))
(gnus-summary-position-point)))
+(eval-and-compile
+ (if (fboundp 'remove-overlays)
+ (defalias 'gnus-remove-overlays 'remove-overlays)
+ (defun gnus-remove-overlays (beg end name val)
+ "Clear BEG and END of overlays whose property NAME has value VAL.
+For compatibility with XEmacs."
+ (dolist (ov (gnus-overlays-in beg end))
+ (when (eq (gnus-overlay-get ov name) val)
+ (gnus-delete-overlay ov))))))
+
(defun gnus-summary-show-all-threads ()
"Show all threads."
(interactive)
- (save-excursion
- (let ((buffer-read-only nil))
- (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
+ (gnus-remove-overlays (point-min) (point-max) 'invisible 'gnus-sum)
(gnus-summary-position-point))
+(defsubst gnus-summary--inv (p)
+ (and (eq (get-char-property p 'invisible) 'gnus-sum) p))
+
(defun gnus-summary-show-thread ()
"Show thread subtrees.
Returns nil if no thread was there to be shown."
(interactive)
- (let ((buffer-read-only nil)
- (orig (point))
- (end (point-at-eol))
- ;; Leave point at bol
- (beg (progn (beginning-of-line) (point))))
- (prog1
- ;; Any hidden lines here?
- (search-forward "\r" end t)
- (subst-char-in-region beg end ?\^M ?\n t)
+ (let* ((orig (point))
+ (end (point-at-eol))
+ (end (or (gnus-summary--inv end) (gnus-summary--inv (1- end))))
+ ;; Leave point at bol
+ (beg (progn (beginning-of-line) (if (bobp) (point) (1- (point)))))
+ (eoi (when end
+ (if (fboundp 'next-single-char-property-change)
+ (or (next-single-char-property-change end 'invisible)
+ (point-max))
+ (while (progn
+ (end-of-line 2)
+ (and (not (eobp))
+ (eq (get-char-property (point) 'invisible)
+ 'gnus-sum))))
+ (point)))))
+ (when eoi
+ (gnus-remove-overlays beg eoi 'invisible 'gnus-sum)
(goto-char orig)
- (gnus-summary-position-point))))
+ (gnus-summary-position-point)
+ eoi)))
(defun gnus-summary-maybe-hide-threads ()
"If requested, hide the threads that should be hidden."
will not be hidden.
Returns nil if no threads were there to be hidden."
(interactive)
- (let ((buffer-read-only nil)
- (start (point))
+ (let ((start (point))
+ (starteol (line-end-position))
(article (gnus-summary-article-number)))
(goto-char start)
- ;; Go forward until either the buffer ends or the subthread
- ;; ends.
+ ;; Go forward until either the buffer ends or the subthread ends.
(when (and (not (eobp))
(or (zerop (gnus-summary-next-thread 1 t))
(goto-char (point-max))))
- (prog1
- (if (and (> (point) start)
- (search-backward "\n" start t))
- (progn
- (subst-char-in-region start (point) ?\n ?\^M)
- (gnus-summary-goto-subject article))
- (goto-char start)
- nil)))))
+ (if (and (> (point) start)
+ ;; FIXME: this should actually search for a non-invisible \n.
+ (search-backward "\n" start t))
+ (progn
+ (when (> (point) starteol)
+ (gnus-remove-overlays starteol (point) 'invisible 'gnus-sum)
+ (let ((ol (gnus-make-overlay starteol (point) nil t nil)))
+ (gnus-overlay-put ol 'invisible 'gnus-sum)
+ (gnus-overlay-put ol 'evaporate t)))
+ (gnus-summary-goto-subject article))
+ (goto-char start)
+ nil))))
(defun gnus-summary-go-to-next-thread (&optional previous)
"Go to the same level (or less) next thread.
(while (gnus-summary-go-up-thread))
(gnus-summary-article-number))
+(defun gnus-summary-expire-thread ()
+ "Mark articles under current thread as expired."
+ (interactive)
+ (gnus-summary-kill-thread 0))
+
(defun gnus-summary-kill-thread (&optional unmark)
"Mark articles under current thread as read.
If the prefix argument is positive, remove any kinds of marks.
+If the prefix argument is zero, mark thread as expired.
If the prefix argument is negative, tick articles instead."
(interactive "P")
(when unmark
(setq unmark (prefix-numeric-value unmark)))
- (let ((articles (gnus-summary-articles-in-thread)))
+ (let ((articles (gnus-summary-articles-in-thread))
+ (hide (or (null unmark) (= unmark 0))))
(save-excursion
;; Expand the thread.
(gnus-summary-show-thread)
(gnus-summary-mark-article-as-read gnus-killed-mark))
((> unmark 0)
(gnus-summary-mark-article-as-unread gnus-unread-mark))
+ ((= unmark 0)
+ (gnus-summary-mark-article nil gnus-expirable-mark))
(t
(gnus-summary-mark-article-as-unread gnus-ticked-mark)))
(setq articles (cdr articles))))
- ;; Hide killed subtrees.
- (and (null unmark)
+ ;; Hide killed subtrees when hide is true.
+ (and hide
gnus-thread-hide-killed
(gnus-summary-hide-thread))
- ;; If marked as read, go to next unread subject.
- (when (null unmark)
+ ;; If hide is t, go to next unread subject.
+ (when hide
;; Go to next unread subject.
(gnus-summary-next-subject 1 t)))
(gnus-set-mode-line 'summary))
(interactive "P")
(gnus-summary-sort 'number reverse))
+(defun gnus-summary-sort-by-most-recent-number (&optional reverse)
+ "Sort the summary buffer by most recent article number.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'most-recent-number reverse))
+
(defun gnus-summary-sort-by-random (&optional reverse)
"Randomize the order in the summary buffer.
Argument REVERSE means to randomize in reverse order."
(interactive "P")
(gnus-summary-sort 'date reverse))
+(defun gnus-summary-sort-by-most-recent-date (&optional reverse)
+ "Sort the summary buffer by most recent date.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'most-recent-date reverse))
+
(defun gnus-summary-sort-by-score (&optional reverse)
"Sort the summary buffer by score.
Argument REVERSE means reverse order."
"Sort the summary buffer using the default sorting method.
Argument REVERSE means reverse order."
(interactive "P")
- (let* ((buffer-read-only)
+ (let* ((inhibit-read-only t)
(gnus-summary-prepare-hook nil))
;; We do the sorting by regenerating the threads.
(gnus-summary-prepare)
article
`(lambda (t1 t2)
(,article t2 t1))))
- (buffer-read-only)
+ (inhibit-read-only t)
(gnus-summary-prepare-hook nil))
;; We do the sorting by regenerating the threads.
(gnus-summary-prepare)
(gnus-message 1 "Article %d is unsaveable" article))
;; This is a real article.
(save-window-excursion
- (let ((gnus-display-mime-function (when decode
- gnus-display-mime-function))
- (gnus-article-prepare-hook (when decode
- gnus-article-prepare-hook)))
- (gnus-summary-select-article t nil nil article)
- (gnus-summary-goto-subject article)))
- (save-excursion
- (set-buffer save-buffer)
+ (gnus-summary-select-article decode decode nil article)
+ (gnus-summary-goto-subject article))
+ (with-current-buffer save-buffer
(erase-buffer)
(insert-buffer-substring (if decode
gnus-article-buffer
(gnus-set-mode-line 'summary)
n))
-(defun gnus-summary-pipe-output (&optional arg headers)
+(defun gnus-summary-pipe-output (&optional n sym)
"Pipe the current article to a subprocess.
If N is a positive number, pipe the N next articles.
If N is a negative number, pipe the N previous articles.
If N is nil and any articles have been marked with the process mark,
pipe those articles instead.
-If HEADERS (the symbolic prefix), include the headers, too."
+The default command to which articles are piped is specified by the
+variable `gnus-summary-pipe-output-default-command'; if it is nil, you
+will be prompted for the command.
+
+The properties `:decode' and `:headers' that are put to the function
+symbol `gnus-summary-save-in-pipe' control whether this function
+decodes articles and what headers to keep (see the doc string for the
+`gnus-default-article-saver' variable). If SYM (the symbolic prefix)
+is neither omitted nor the symbol `r', force including all headers
+regardless of the `:headers' property. If it is the symbol `r',
+articles that are not decoded and include all headers will be piped
+no matter what the properties `:decode' and `:headers' are."
(interactive (gnus-interactive "P\ny"))
(require 'gnus-art)
- (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)
- (gnus-save-all-headers (or headers gnus-save-all-headers)))
- (gnus-summary-save-article arg t))
- (let ((buffer (get-buffer "*Shell Command Output*")))
- (when (and buffer
- (not (zerop (buffer-size buffer))))
- (gnus-configure-windows 'pipe))))
+ (let* ((articles (gnus-summary-work-articles n))
+ (result-buffer "*Shell Command Output*")
+ (all-headers (not (memq sym '(nil r))))
+ (gnus-save-all-headers (or all-headers gnus-save-all-headers))
+ (raw (eq sym 'r))
+ (headers (get 'gnus-summary-save-in-pipe :headers))
+ command result)
+ (unless (numberp (car articles))
+ (error "No article to pipe"))
+ (setq command (gnus-read-shell-command
+ (concat "Shell command on "
+ (if (cdr articles)
+ (format "these %d articles" (length articles))
+ "this article")
+ ": ")
+ gnus-summary-pipe-output-default-command))
+ (when (string-equal command "")
+ (error "A command is required"))
+ (when all-headers
+ (put 'gnus-summary-save-in-pipe :headers nil))
+ (unwind-protect
+ (while articles
+ (gnus-summary-goto-subject (pop articles))
+ (save-window-excursion (gnus-summary-save-in-pipe command raw))
+ (when (and (get-buffer result-buffer)
+ (not (zerop (buffer-size (get-buffer result-buffer)))))
+ (setq result (concat result (with-current-buffer result-buffer
+ (buffer-string))))))
+ (put 'gnus-summary-save-in-pipe :headers headers))
+ (unless (zerop (length result))
+ (if (with-current-buffer (get-buffer-create result-buffer)
+ (erase-buffer)
+ (insert result)
+ (prog1
+ (and (= (count-lines (point-min) (point)) 1)
+ (progn
+ (end-of-line 0)
+ (<= (current-column)
+ (window-width (minibuffer-window)))))
+ (goto-char (point-min))))
+ (message "%s" (substring result 0 -1))
+ (message nil)
+ (gnus-configure-windows 'pipe)))))
(defun gnus-summary-save-article-mail (&optional arg)
"Append the current article to a Unix mail box file.
(save-restriction
(widen)
(let ((start (window-start))
- buffer-read-only)
+ (inhibit-read-only t))
(message-pipe-buffer-body program)
(set-window-start (get-buffer-window (current-buffer)) start))))))
"Return a value based on the split METHODS."
(let (split-name method result match)
(when methods
- (save-excursion
- (set-buffer gnus-original-article-buffer)
+ (with-current-buffer gnus-original-article-buffer
(save-restriction
(nnheader-narrow-to-headers)
(while (and methods (not split-name))
(nreverse split-name)))
(defun gnus-valid-move-group-p (group)
- (and (boundp group)
+ (and (symbolp group)
+ (boundp group)
(symbol-name group)
(symbol-value group)
(gnus-get-function (gnus-find-method-for-group
(format "these %d articles" (length articles))
"this article")))
(to-newsgroup
- (cond
- ((null split-name)
- (gnus-completing-read-with-default
- default prom
- gnus-active-hashtb
- 'gnus-valid-move-group-p
- nil prefix
- 'gnus-group-history))
- ((= 1 (length split-name))
- (gnus-completing-read-with-default
- (car split-name) prom
- gnus-active-hashtb
- 'gnus-valid-move-group-p
- nil nil
- 'gnus-group-history))
- (t
- (gnus-completing-read-with-default
- nil prom
- (mapcar 'list (nreverse split-name))
- nil nil nil
- 'gnus-group-history))))
- (to-method (gnus-server-to-method (gnus-group-method to-newsgroup))))
+ (cond
+ ((null split-name)
+ (gnus-group-completing-read
+ prom
+ (gnus-remove-if-not 'gnus-valid-move-group-p gnus-active-hashtb t)
+ nil prefix nil default))
+ ((= 1 (length split-name))
+ (gnus-group-completing-read
+ prom
+ (gnus-remove-if-not 'gnus-valid-move-group-p gnus-active-hashtb t)
+ nil prefix 'gnus-group-history (car split-name)))
+ (t
+ (gnus-completing-read
+ prom (nreverse split-name) nil nil 'gnus-group-history))))
+ (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))
+ encoded)
(when to-newsgroup
(if (or (string= to-newsgroup "")
(string= to-newsgroup prefix))
(setq to-newsgroup default))
(unless to-newsgroup
(error "No group name entered"))
- (or (gnus-active to-newsgroup)
- (gnus-activate-group to-newsgroup nil nil to-method)
+ (setq encoded (mm-encode-coding-string
+ to-newsgroup
+ (gnus-group-name-charset to-method to-newsgroup)))
+ (or (gnus-active encoded)
+ (gnus-activate-group encoded nil nil to-method)
(if (gnus-y-or-n-p (format "No such group: %s. Create it? "
to-newsgroup))
- (or (and (gnus-request-create-group to-newsgroup to-method)
- (gnus-activate-group
- to-newsgroup nil nil to-method)
- (gnus-subscribe-group to-newsgroup))
+ (or (and (gnus-request-create-group encoded to-method)
+ (gnus-activate-group encoded nil nil to-method)
+ (gnus-subscribe-group encoded))
(error "Couldn't create group %s" to-newsgroup)))
- (error "No such group: %s" to-newsgroup)))
- to-newsgroup))
+ (error "No such group: %s" to-newsgroup))
+ encoded)))
(defvar gnus-summary-save-parts-counter)
+(declare-function mm-uu-dissect "mm-uu" (&optional noheader mime-type))
(defun gnus-summary-save-parts (type dir n &optional reverse)
"Save parts matching TYPE to DIR.
current-prefix-arg))
(gnus-summary-iterate n
(let ((gnus-display-mime-function nil)
+ gnus-article-prepare-hook
+ gnus-article-decode-hook
+ gnus-display-mime-function
+ gnus-break-pages
(gnus-inhibit-treatment t))
(gnus-summary-select-article))
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(let ((handles (or gnus-article-mime-handles
(mm-dissect-buffer nil gnus-article-loose-mime)
(and gnus-article-emulate-mime
;; Summary extract commands
(defun gnus-summary-insert-pseudos (pslist &optional not-view)
- (let ((buffer-read-only nil)
+ (let ((inhibit-read-only t)
(article (gnus-summary-article-number))
after-article b e)
(unless (gnus-summary-goto-subject article)
;; We have found the header.
header
;; We have to really fetch the header to this article.
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(when (setq where (gnus-request-head id group))
(nnheader-fold-continuation-lines)
(goto-char (point-max))
;; a different group (or server), we fudge some bogus
;; article numbers for this article.
(mail-header-set-number header gnus-reffed-article-number))
- (save-excursion
- (set-buffer gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
(decf gnus-reffed-article-number)
(gnus-remove-header (mail-header-number header))
(push header gnus-newsgroup-headers)
(save-excursion
(let (setmarkundo)
;; Propagate the read marks to the backend.
- (when (gnus-check-backend-function 'request-set-mark group)
+ (when (and gnus-propagate-marks
+ (gnus-check-backend-function 'request-set-mark group))
(let ((del (gnus-remove-from-range (gnus-info-read info) read))
(add (gnus-remove-from-range read (gnus-info-read info))))
(when (or add del)
(when gnus-suppress-duplicates
(gnus-dup-suppress-articles))
- ;; We might want to build some more threads first.
- (when (and gnus-fetch-old-headers
- (eq gnus-headers-retrieved-by 'nov))
- (if (eq gnus-fetch-old-headers 'invisible)
- (gnus-build-all-threads)
- (gnus-build-old-threads)))
+ (if (and gnus-fetch-old-headers
+ (eq gnus-headers-retrieved-by 'nov))
+ ;; We might want to build some more threads first.
+ (if (eq gnus-fetch-old-headers 'invisible)
+ (gnus-build-all-threads)
+ (gnus-build-old-threads))
+ ;; Mark the inserted articles that are unread as unread.
+ (setq gnus-newsgroup-unreads
+ (gnus-sorted-nunion
+ gnus-newsgroup-unreads
+ (gnus-sorted-nintersection
+ (gnus-list-of-unread-articles gnus-newsgroup-name)
+ articles)))
+ ;; Mark the inserted articles as selected so that the information
+ ;; of the marks having been changed by a user may be updated when
+ ;; exiting this group. See `gnus-summary-update-info'.
+ (dolist (art articles)
+ (setq gnus-newsgroup-unselected (delq art gnus-newsgroup-unselected))))
;; Let the Gnus agent mark articles as read.
(when gnus-agent
(gnus-agent-get-undownloaded-list))
(read-string
(format
"How many articles from %s (%s %d): "
- (gnus-limit-string
- (gnus-group-decoded-name gnus-newsgroup-name) 35)
+ (gnus-group-decoded-name gnus-newsgroup-name)
(if initial "max" "default")
len)
(if initial
(interactive)
(prog1
(let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
- (old-active gnus-newsgroup-active)
+ (old-high gnus-newsgroup-highest)
(nnmail-fetched-sources (list t))
i new)
(setq gnus-newsgroup-active
- (gnus-activate-group gnus-newsgroup-name 'scan))
- (setq i (cdr gnus-newsgroup-active))
- (while (> i (cdr old-active))
+ (gnus-copy-sequence
+ (gnus-activate-group gnus-newsgroup-name 'scan)))
+ (setq i (cdr gnus-newsgroup-active)
+ gnus-newsgroup-highest i)
+ (while (> i old-high)
(push i new)
(decf i))
(if (not new)
(gnus-summary-limit (gnus-sorted-nunion old new))))
(gnus-summary-position-point)))
+;;; Bookmark support for Gnus.
+(declare-function bookmark-make-record-default
+ "bookmark" (&optional no-file no-context posn))
+(declare-function bookmark-prop-get "bookmark" (bookmark prop))
+(declare-function bookmark-default-handler "bookmark" (bmk))
+(declare-function bookmark-get-bookmark-record "bookmark" (bmk))
+(defvar bookmark-yank-point)
+(defvar bookmark-current-buffer)
+
+(defun gnus-summary-bookmark-make-record ()
+ "Make a bookmark entry for a Gnus summary buffer."
+ (let (pos buf)
+ (unless (and (derived-mode-p 'gnus-summary-mode) gnus-article-current)
+ (save-restriction ; FIXME is it necessary to widen?
+ (widen) (setq pos (point))) ; Set position in gnus-article buffer.
+ (setq buf "art") ; We are recording bookmark from article buffer.
+ (setq bookmark-yank-point (point))
+ (setq bookmark-current-buffer (current-buffer))
+ (gnus-article-show-summary)) ; Go back in summary buffer.
+ ;; We are now recording bookmark from summary buffer.
+ (unless buf (setq buf "sum"))
+ (let* ((subject (elt (gnus-summary-article-header) 1))
+ (grp (car gnus-article-current))
+ (art (cdr gnus-article-current))
+ (head (gnus-summary-article-header art))
+ (id (mail-header-id head)))
+ `(,subject
+ ,@(condition-case nil
+ (bookmark-make-record-default 'no-file 'no-context pos)
+ (wrong-number-of-arguments
+ (bookmark-make-record-default 'point-only)))
+ (location . ,(format "Gnus-%s %s:%d:%s" buf grp art id))
+ (group . ,grp) (article . ,art)
+ (message-id . ,id) (handler . gnus-summary-bookmark-jump)))))
+
+;;;###autoload
+(defun gnus-summary-bookmark-jump (bookmark)
+ "Handler function for record returned by `gnus-summary-bookmark-make-record'.
+BOOKMARK is a bookmark name or a bookmark record."
+ (let ((group (bookmark-prop-get bookmark 'group))
+ (article (bookmark-prop-get bookmark 'article))
+ (id (bookmark-prop-get bookmark 'message-id))
+ (buf (car (split-string (bookmark-prop-get bookmark 'location)))))
+ (gnus-fetch-group group (list article))
+ (gnus-summary-insert-cached-articles)
+ (gnus-summary-goto-article id nil 'force)
+ ;; FIXME we have to wait article buffer is ready (only large buffer)
+ ;; Is there a better solution to know that?
+ ;; If we don't wait `bookmark-default-handler' will have no chance
+ ;; to set position. However there is no error, just wrong pos.
+ (sit-for 1)
+ (when (string= buf "Gnus-art")
+ (other-window 1))
+ (bookmark-default-handler
+ `(""
+ (buffer . ,(current-buffer))
+ . ,(bookmark-get-bookmark-record bookmark)))))
+
(gnus-summary-make-all-marking-commands)
(gnus-ems-redefine)
;; coding: iso-8859-1
;; End:
-;; arch-tag: 17c6748f-6d00-4d36-bf01-835c42f31235
;;; gnus-sum.el ends here
projects / gnus / blobdiff