;;; gnus-sum.el --- summary mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile
+ (require 'cl)
+ (defvar tool-bar-mode))
(require 'gnus)
(require 'gnus-group)
(require 'gnus-int)
(require 'gnus-undo)
(require 'gnus-util)
+(require 'gmm-utils)
(require 'mm-decode)
(require 'nnoo)
(autoload 'gnus-cache-write-active "gnus-cache")
(autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t)
(autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t)
+(autoload 'gnus-pick-line-number "gnus-salt" nil t)
(autoload 'mm-uu-dissect "mm-uu")
(autoload 'gnus-article-outlook-deuglify-article "deuglify"
"Deuglify broken Outlook (Express) articles and redisplay."
(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 read (or
-just marked as read) article, the old article will not normally be
-displayed in the Summary buffer. If this variable is non-nil, Gnus
-will attempt to grab the headers to the old articles, and thereby
-build complete threads. If it has the value `some', only enough
-headers to connect otherwise loose threads will be displayed. This
-variable can also be a number. In that case, no more than that number
-of old headers will be fetched. If it has the value `invisible', all
+If an unread article in the group refers to an older, already
+read (or just marked as read) article, the old article will not
+normally be displayed in the Summary buffer. If this variable is
+t, Gnus will attempt to grab the headers to the old articles, and
+thereby build complete threads. If it has the value `some', all
+old headers will be fetched but only enough headers to connect
+otherwise loose threads will be displayed. This variable can
+also be a number. In that case, no more than that number of old
+headers will be fetched. If it has the value `invisible', all
old headers will be fetched, but none will be displayed.
-The server has to support NOV for any of this to work."
+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."
:group 'gnus-thread
:type '(choice (const :tag "off" nil)
+ (const :tag "on" t)
(const some)
+ (const invisible)
number
(sexp :menu-tag "other" t)))
(defcustom gnus-summary-make-false-root-always nil
"Always make a false dummy root."
+ :version "22.1"
:group 'gnus-thread
:type 'boolean)
"*Default threshold for a high scored article.
An article will be highlighted as high scored if its score is greater
than this score."
+ :version "22.1"
:group 'gnus-score-default
:type 'integer)
"*Default threshold for a low scored article.
An article will be highlighted as low scored if its score is smaller
than this score."
+ :version "22.1"
:group 'gnus-score-default
:type 'integer)
"*If non-nil, hide all threads initially.
This can be a predicate specifier which says which threads to hide.
If threads are hidden, you have to run the command
-`gnus-summary-show-thread' by hand or use `gnus-select-article-hook'
-to expose hidden threads."
+`gnus-summary-show-thread' by hand or select an article."
:group 'gnus-thread
- :type 'boolean)
+ :type '(radio (sexp :format "Non-nil\n"
+ :match (lambda (widget value)
+ (not (or (consp value) (functionp value))))
+ :value t)
+ (const nil)
+ (sexp :tag "Predicate specifier")))
(defcustom gnus-thread-hide-killed t
"*If non-nil, hide killed threads automatically."
first subject), `unread' (place point on the subject line of the first
unread article), `best' (place point on the subject line of the
higest-scored article), `unseen' (place point on the subject line of
-the first unseen article), 'unseen-or-unread' (place point on the subject
+the first unseen article), `unseen-or-unread' (place 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 article), or a function to be called to
place point on some subject line."
+ :version "22.1"
:group 'gnus-group-select
:type '(choice (const best)
(const unread)
(defcustom gnus-auto-select-next t
"*If non-nil, offer to go to the next group from the end of the previous.
If the value is t and the next newsgroup is empty, Gnus will exit
-summary mode and go back to group mode. If the value is neither nil
-nor t, Gnus will select the following unread newsgroup. In
+summary mode and go back to group mode. If the value is neither nil
+nor t, Gnus will select the following unread newsgroup. In
particular, if the value is the symbol `quietly', the next unread
newsgroup will be selected without any confirmation, and if it is
`almost-quietly', the next group will be selected without any
confirmation if you are located on the last article in the group.
-Finally, if this variable is `slightly-quietly', the `Z n' command
+Finally, if this variable is `slightly-quietly', the `\\<gnus-summary-mode-map>\\[gnus-summary-catchup-and-goto-next-group]' command
will go to the next group without confirmation."
:group 'gnus-summary-maneuvering
:type '(choice (const :tag "off" nil)
:group 'gnus-summary-maneuvering
:type 'boolean)
+(defcustom gnus-auto-goto-ignores 'unfetched
+ "*Says how to handle unfetched articles when maneuvering.
+
+This variable can either be the symbols nil (maneuver to any
+article), `undownloaded' (maneuvering while unplugged ignores articles
+that have not been fetched), `always-undownloaded' (maneuvering always
+ignores articles that have not been fetched), `unfetched' (maneuvering
+ignores articles whose headers have not been fetched).
+
+NOTE: The list of unfetched articles will always be nil when plugged
+and, when unplugged, a subset of the undownloaded article list."
+ :version "22.1"
+ :group 'gnus-summary-maneuvering
+ :type '(choice (const :tag "None" nil)
+ (const :tag "Undownloaded when unplugged" undownloaded)
+ (const :tag "Undownloaded" always-undownloaded)
+ (const :tag "Unfetched" unfetched)))
+
(defcustom gnus-summary-check-current nil
"*If non-nil, consider the current article when moving.
The \"unread\" movement commands will stay on the same line if the
:group 'gnus-summary-maneuvering
:type 'boolean)
-(defcustom gnus-auto-center-summary t
+(defcustom gnus-auto-center-summary 2
"*If non-nil, always center the current summary buffer.
In particular, if `vertical' do only vertical recentering. If non-nil
and non-`vertical', do both horizontal and vertical recentering."
(integer :tag "height")
(sexp :menu-tag "both" t)))
+(defvar gnus-auto-center-group t
+ "*If non-nil, always center the group buffer.")
+
(defcustom gnus-show-all-headers nil
"*If non-nil, don't hide any headers."
:group 'gnus-article-hiding
(cons :value ("" "") regexp (repeat string))
(sexp :value nil))))
+(defcustom gnus-move-group-prefix-function 'gnus-group-real-prefix
+ "Function used to compute default prefix for article move/copy/etc prompts.
+The function should take one argument, a group name, and return a
+string with the suggested prefix."
+ :group 'gnus-summary-mail
+ :type 'function)
+
+;; FIXME: Although the custom type is `character' for the following variables,
+;; using multibyte characters (Latin-1, UTF-8) doesn't work. -- rs
+
(defcustom gnus-unread-mark ? ;Whitespace
"*Mark used for unread articles."
:group 'gnus-summary-marks
(defcustom gnus-spam-mark ?$
"*Mark used for spam articles."
+ :version "22.1"
:group 'gnus-summary-marks
:type 'character)
(defcustom gnus-forwarded-mark ?F
"*Mark used for articles that have been forwarded."
+ :version "22.1"
:group 'gnus-summary-marks
:type 'character)
(defcustom gnus-recent-mark ?N
"*Mark used for articles that are recent."
+ :version "22.1"
:group 'gnus-summary-marks
:type 'character)
(defcustom gnus-unseen-mark ?.
"*Mark used for articles that haven't been seen."
+ :version "22.1"
:group 'gnus-summary-marks
:type 'character)
(defcustom gnus-no-mark ? ;Whitespace
"*Mark used for articles that have no other secondary mark."
+ :version "22.1"
:group 'gnus-summary-marks
:type 'character)
(defcustom gnus-undownloaded-mark ?-
"*Mark used for articles that weren't downloaded."
+ :version "22.1"
:group 'gnus-summary-marks
:type 'character)
:group 'gnus-score-default
:type 'integer)
+(defun gnus-widget-reversible-match (widget value)
+ "Ignoring WIDGET, convert VALUE to internal form.
+VALUE should have the form `FOO' or `(not FOO)', where FOO is an symbol."
+ ;; (debug value)
+ (or (symbolp value)
+ (and (listp value)
+ (eq (length value) 2)
+ (eq (nth 0 value) 'not)
+ (symbolp (nth 1 value)))))
+
+(defun gnus-widget-reversible-to-internal (widget value)
+ "Ignoring WIDGET, convert VALUE to internal form.
+VALUE should have the form `FOO' or `(not FOO)', where FOO is an atom.
+FOO is converted to (FOO nil) and (not FOO) is converted to (FOO t)."
+ ;; (debug value)
+ (if (atom value)
+ (list value nil)
+ (list (nth 1 value) t)))
+
+(defun gnus-widget-reversible-to-external (widget value)
+ "Ignoring WIDGET, convert VALUE to external form.
+VALUE should have the form `(FOO nil)' or `(FOO t)', where FOO is an atom.
+\(FOO nil) is converted to FOO and (FOO t) is converted to (not FOO)."
+ ;; (debug value)
+ (if (nth 1 value)
+ (list 'not (nth 0 value))
+ (nth 0 value)))
+
+(define-widget 'gnus-widget-reversible 'group
+ "A `group' that convert values."
+ :match 'gnus-widget-reversible-match
+ :value-to-internal 'gnus-widget-reversible-to-internal
+ :value-to-external 'gnus-widget-reversible-to-external)
+
(defcustom gnus-article-sort-functions '(gnus-article-sort-by-number)
"*List of functions used for sorting articles in the summary buffer.
very similar. (Sorting by date means sorting by the time the message
was sent, sorting by number means sorting by arrival time.)
+Each item can also be a list `(not F)' where F is a function;
+this reverses the sort order.
+
Ready-made functions include `gnus-article-sort-by-number',
`gnus-article-sort-by-author', `gnus-article-sort-by-subject',
`gnus-article-sort-by-date', `gnus-article-sort-by-random'
When threading is turned on, the variable `gnus-thread-sort-functions'
controls how articles are sorted."
:group 'gnus-summary-sort
- :type '(repeat (choice (function-item gnus-article-sort-by-number)
- (function-item gnus-article-sort-by-author)
- (function-item gnus-article-sort-by-subject)
- (function-item gnus-article-sort-by-date)
- (function-item gnus-article-sort-by-score)
- (function-item gnus-article-sort-by-random)
- (function :tag "other"))))
+ :type '(repeat (gnus-widget-reversible
+ (choice (function-item gnus-article-sort-by-number)
+ (function-item gnus-article-sort-by-author)
+ (function-item gnus-article-sort-by-subject)
+ (function-item gnus-article-sort-by-date)
+ (function-item gnus-article-sort-by-score)
+ (function-item gnus-article-sort-by-random)
+ (function :tag "other"))
+ (boolean :tag "Reverse order"))))
+
(defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number)
"*List of functions used for sorting threads in the summary buffer.
very similar. (Sorting by date means sorting by the time the message
was sent, sorting by number means sorting by arrival time.)
+Each list item can also be a list `(not F)' where F is a
+function; this specifies reversed sort order.
+
Ready-made functions include `gnus-thread-sort-by-number',
-`gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
-`gnus-thread-sort-by-date', `gnus-thread-sort-by-score',
-`gnus-thread-sort-by-most-recent-number',
-`gnus-thread-sort-by-most-recent-date',
-`gnus-thread-sort-by-random', and
-`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').
+`gnus-thread-sort-by-author', `gnus-thread-sort-by-recipient'
+`gnus-thread-sort-by-subject', `gnus-thread-sort-by-date',
+`gnus-thread-sort-by-score', `gnus-thread-sort-by-most-recent-number',
+`gnus-thread-sort-by-most-recent-date', `gnus-thread-sort-by-random',
+and `gnus-thread-sort-by-total-score' (see
+`gnus-thread-score-function').
When threading is turned off, the variable
`gnus-article-sort-functions' controls how articles are sorted."
:group 'gnus-summary-sort
- :type '(repeat (choice (function-item gnus-thread-sort-by-number)
- (function-item gnus-thread-sort-by-author)
- (function-item gnus-thread-sort-by-subject)
- (function-item gnus-thread-sort-by-date)
- (function-item gnus-thread-sort-by-score)
- (function-item gnus-thread-sort-by-total-score)
- (function-item gnus-thread-sort-by-random)
- (function :tag "other"))))
+ :type '(repeat
+ (gnus-widget-reversible
+ (choice (function-item gnus-thread-sort-by-number)
+ (function-item gnus-thread-sort-by-author)
+ (function-item gnus-thread-sort-by-recipient)
+ (function-item gnus-thread-sort-by-subject)
+ (function-item gnus-thread-sort-by-date)
+ (function-item gnus-thread-sort-by-score)
+ (function-item gnus-thread-sort-by-most-recent-number)
+ (function-item gnus-thread-sort-by-most-recent-date)
+ (function-item gnus-thread-sort-by-random)
+ (function-item gnus-thread-sort-by-total-score)
+ (function :tag "other"))
+ (boolean :tag "Reverse order"))))
(defcustom gnus-thread-score-function '+
"*Function used for calculating the total score of a thread.
:group 'gnus-summary
:type 'hook)
+(defcustom gnus-summary-article-move-hook nil
+ "*A hook called after an article is moved, copied, respooled, or crossposted."
+ :version "22.1"
+ :group 'gnus-summary
+ :type 'hook)
+
+(defcustom gnus-summary-article-delete-hook nil
+ "*A hook called after an article is deleted."
+ :version "22.1"
+ :group 'gnus-summary
+ :type 'hook)
+
+(defcustom gnus-summary-article-expire-hook nil
+ "*A hook called after an article is expired."
+ :version "22.1"
+ :group 'gnus-summary
+ :type 'hook)
+
(defcustom gnus-summary-display-arrow
(and (fboundp 'display-graphic-p)
(display-graphic-p))
"*If non-nil, display an arrow highlighting the current article."
- :version "21.1"
+ :version "22.1"
:group 'gnus-summary
:type 'boolean)
-(defcustom gnus-summary-selected-face 'gnus-summary-selected-face
+(defcustom gnus-summary-selected-face 'gnus-summary-selected
"Face used for highlighting the current article in the summary buffer."
:group 'gnus-summary-visual
:type 'face)
(defcustom gnus-summary-highlight
'(((eq mark gnus-canceled-mark)
- . gnus-summary-cancelled-face)
+ . gnus-summary-cancelled)
((and uncached (> score default-high))
- . gnus-summary-high-undownloaded-face)
+ . gnus-summary-high-undownloaded)
((and uncached (< score default-low))
- . gnus-summary-low-undownloaded-face)
+ . gnus-summary-low-undownloaded)
(uncached
- . gnus-summary-normal-undownloaded-face)
+ . gnus-summary-normal-undownloaded)
((and (> score default-high)
(or (eq mark gnus-dormant-mark)
(eq mark gnus-ticked-mark)))
- . gnus-summary-high-ticked-face)
+ . gnus-summary-high-ticked)
((and (< score default-low)
(or (eq mark gnus-dormant-mark)
(eq mark gnus-ticked-mark)))
- . gnus-summary-low-ticked-face)
+ . gnus-summary-low-ticked)
((or (eq mark gnus-dormant-mark)
(eq mark gnus-ticked-mark))
- . gnus-summary-normal-ticked-face)
+ . gnus-summary-normal-ticked)
((and (> score default-high) (eq mark gnus-ancient-mark))
- . gnus-summary-high-ancient-face)
+ . gnus-summary-high-ancient)
((and (< score default-low) (eq mark gnus-ancient-mark))
- . gnus-summary-low-ancient-face)
+ . gnus-summary-low-ancient)
((eq mark gnus-ancient-mark)
- . gnus-summary-normal-ancient-face)
+ . gnus-summary-normal-ancient)
((and (> score default-high) (eq mark gnus-unread-mark))
- . gnus-summary-high-unread-face)
+ . gnus-summary-high-unread)
((and (< score default-low) (eq mark gnus-unread-mark))
- . gnus-summary-low-unread-face)
+ . gnus-summary-low-unread)
((eq mark gnus-unread-mark)
- . gnus-summary-normal-unread-face)
+ . gnus-summary-normal-unread)
((> score default-high)
- . gnus-summary-high-read-face)
+ . gnus-summary-high-read)
((< score default-low)
- . gnus-summary-low-read-face)
+ . gnus-summary-low-read)
(t
- . gnus-summary-normal-read-face))
+ . gnus-summary-normal-read))
"*Controls the highlighting of summary buffer lines.
A list of (FORM . FACE) pairs. When deciding how a a particular
default-high: The default score for high scored articles.
default-low: The default score for low scored articles.
below: The score below which articles are automatically marked as read.
-mark: The articles mark."
+mark: The article's mark.
+uncached: Non-nil if the article is uncached."
:group 'gnus-summary-visual
:type '(repeat (cons (sexp :tag "Form" nil)
face)))
:type '(repeat symbol))
(defcustom gnus-ignored-from-addresses
- (and user-mail-address (regexp-quote user-mail-address))
+ (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."
:version "21.1"
:group 'gnus-summary
:type 'regexp)
+(defcustom gnus-summary-to-prefix "-> "
+ "*String prefixed to the To field in the summary line when
+using `gnus-ignored-from-addresses'."
+ :version "22.1"
+ :group 'gnus-summary
+ :type 'string)
+
+(defcustom gnus-summary-newsgroup-prefix "=> "
+ "*String prefixed to the Newsgroup field in the summary
+line when using `gnus-ignored-from-addresses'."
+ :version "22.1"
+ :group 'gnus-summary
+ :type 'string)
+
(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown)
"List of charsets that should be ignored.
When these charsets are used in the \"charset\" parameter, the
integer))
(defcustom gnus-summary-save-parts-default-mime "image/.*"
- "*A regexp to match MIME parts when saving multiple parts of a message
-with gnus-summary-save-parts (X m). This regexp will be used by default
-when prompting the user for which type of files to save."
+ "*A regexp to match MIME parts when saving multiple parts of a
+message with `gnus-summary-save-parts' (\\<gnus-summary-mode-map>\\[gnus-summary-save-parts]).
+This regexp will be used by default when prompting the user for which
+type of files to save."
:group 'gnus-summary
:type 'regexp)
(defcustom gnus-read-all-available-headers nil
"Whether Gnus should parse all headers made available to it.
-This is mostly relevant for slow backends where the user may
+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."
+ :version "22.1"
:group 'gnus-summary
:type '(choice boolean regexp))
(defcustom gnus-summary-muttprint-program "muttprint"
"Command (and optional arguments) used to run Muttprint."
- :version "21.3"
+ :version "22.1"
:group 'gnus-summary
:type 'string)
-(defcustom gnus-article-loose-mime nil
+(defcustom gnus-article-loose-mime t
"If non-nil, don't require MIME-Version header.
Some brain-damaged MUA/MTA, e.g. Lotus Domino 5.0.6 clients, does not
-supply the MIME-Version header or deliberately strip it From the mail.
-Set it to non-nil, Gnus will treat some articles as MIME even if
-the MIME-Version header is missed."
- :version "21.3"
+supply the MIME-Version header or deliberately strip it from the mail.
+If non-nil (the default), Gnus will treat some articles as MIME
+even if the MIME-Version header is missing."
+ :version "22.1"
:type 'boolean
- :group 'gnus-article)
+ :group 'gnus-article-mime)
(defcustom gnus-article-emulate-mime t
"If non-nil, use MIME emulation for uuencode and the like.
This means that Gnus will search message bodies for text that look
like uuencoded bits, yEncoded bits, and so on, and present that using
the normal Gnus MIME machinery."
+ :version "22.1"
:type 'boolean
- :group 'gnus-article)
+ :group 'gnus-article-mime)
;;; Internal variables
"Function called to sort the articles within a thread after it has been gathered together.")
(defvar gnus-summary-save-parts-type-history nil)
-(defvar gnus-summary-save-parts-last-directory nil)
+(defvar gnus-summary-save-parts-last-directory mm-default-directory)
;; Avoid highlighting in kill files.
(defvar gnus-summary-inhibit-highlight nil)
(?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
(?i gnus-tmp-score ?d)
(?z gnus-tmp-score-char ?c)
- (?l (bbb-grouplens-score gnus-tmp-header) ?s)
(?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
(?U gnus-tmp-unread ?c)
(?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header gnus-tmp-from)
(defvar gnus-newsgroup-data-reverse nil)
(defvar gnus-newsgroup-limit nil)
(defvar gnus-newsgroup-limits nil)
+(defvar gnus-summary-use-undownloaded-faces nil)
(defvar gnus-newsgroup-unreads nil
"Sorted list of unread articles in the current newsgroup.")
"Sorted list of articles in the current newsgroup that can be processed.")
(defvar gnus-newsgroup-unfetched nil
- "Sorted list of articles in the current newsgroup whose headers have not been fetched into the agent.")
+ "Sorted list of articles in the current newsgroup whose headers have
+not been fetched into the agent.
+
+This list will always be a subset of gnus-newsgroup-undownloaded.")
(defvar gnus-newsgroup-undownloaded nil
- "List of articles in the current newsgroup that haven't been downloaded..")
+ "List of articles in the current newsgroup that haven't been downloaded.")
(defvar gnus-newsgroup-unsendable nil
"List of articles in the current newsgroup that won't be sent.")
(defvar gnus-article-before-search nil)
-(defconst gnus-summary-local-variables
+(defvar gnus-summary-local-variables
'(gnus-newsgroup-name
gnus-newsgroup-begin gnus-newsgroup-end
gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
gnus-cache-removable-articles gnus-newsgroup-cached
gnus-newsgroup-data gnus-newsgroup-data-reverse
gnus-newsgroup-limit gnus-newsgroup-limits
- gnus-newsgroup-charset gnus-newsgroup-display)
+ gnus-newsgroup-charset gnus-newsgroup-display
+ gnus-summary-use-undownloaded-faces)
"Variables that are buffer-local to the summary buffers.")
(defvar gnus-newsgroup-variables nil
"A list of variables that have separate values in different newsgroups.
A list of newsgroup (summary buffer) local variables, or cons of
-variables and their default values (when the default values are not
-nil), that should be made global while the summary buffer is active.
+variables and their default expressions to be evalled (when the default
+values are not nil), that should be made global while the summary buffer
+is active.
+
+Note: The default expressions will be evaluated (using function `eval')
+before assignment to the local variable rather than just assigned to it.
+If the default expression is the symbol `global', that symbol will not
+be evaluated but the global value of the local variable will be used
+instead.
+
These variables can be used to set variables in the group parameters
-while still allowing them to affect operations done in other
-buffers. For example:
+while still allowing them to affect operations done in other buffers.
+For example:
\(setq gnus-newsgroup-variables
'(message-use-followup-to
")
;; Byte-compiler warning.
-;(eval-when-compile (defvar gnus-article-mode-map))
(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-agent)
(require 'gnus-art)))
;; MIME stuff.
(defun gnus-simplify-whitespace (str)
"Remove excessive whitespace from STR."
- (let ((mystr str))
- ;; Multiple spaces.
- (while (string-match "[ \t][ \t]+" mystr)
- (setq mystr (concat (substring mystr 0 (match-beginning 0))
- " "
- (substring mystr (match-end 0)))))
- ;; Leading spaces.
- (when (string-match "^[ \t]+" mystr)
- (setq mystr (substring mystr (match-end 0))))
- ;; Trailing spaces.
- (when (string-match "[ \t]+$" mystr)
- (setq mystr (substring mystr 0 (match-beginning 0))))
- mystr))
+ ;; Multiple spaces.
+ (while (string-match "[ \t][ \t]+" str)
+ (setq str (concat (substring str 0 (match-beginning 0))
+ " "
+ (substring str (match-end 0)))))
+ ;; Leading spaces.
+ (when (string-match "^[ \t]+" str)
+ (setq str (substring str (match-end 0))))
+ ;; Trailing spaces.
+ (when (string-match "[ \t]+$" str)
+ (setq str (substring str 0 (match-beginning 0))))
+ str)
(defun gnus-simplify-all-whitespace (str)
"Remove all whitespace from STR."
- (let ((mystr str))
- (while (string-match "[ \t\n]+" mystr)
- (setq mystr (replace-match "" nil nil mystr)))
- mystr))
+ (while (string-match "[ \t\n]+" str)
+ (setq str (replace-match "" nil nil str)))
+ str)
(defsubst gnus-simplify-subject-re (subject)
"Remove \"Re:\" from subject lines."
(buffer-string))))
(defsubst gnus-simplify-subject-fully (subject)
- "Simplify a subject string according to gnus-summary-gather-subject-limit."
+ "Simplify a subject string according to `gnus-summary-gather-subject-limit'."
(cond
(gnus-simplify-subject-functions
(gnus-map-function gnus-simplify-subject-functions subject))
(defsubst gnus-subject-equal (s1 s2 &optional simple-first)
"Check whether two subjects are equal.
-If optional argument simple-first is t, first argument is already
+If optional argument SIMPLE-FIRST is t, first argument is already
simplified."
(cond
((null simple-first)
"\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-i" gnus-summary-sort-by-score
"Q" gnus-summary-exit-no-update
"\C-c\C-i" gnus-info-find-node
gnus-mouse-2 gnus-mouse-pick-article
+ [follow-link] mouse-face
"m" gnus-summary-mail-other-window
"a" gnus-summary-post-news
"i" gnus-summary-news-other-window
"c" gnus-summary-limit-exclude-childless-dormant
"C" gnus-summary-limit-mark-excluded-as-read
"o" gnus-summary-insert-old-articles
- "N" gnus-summary-insert-new-articles)
+ "N" gnus-summary-insert-new-articles
+ "r" gnus-summary-limit-to-replied
+ "R" gnus-summary-limit-to-recipient)
(gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
"n" gnus-summary-next-unread-article
"Q" gnus-summary-exit
"Z" gnus-summary-exit
"n" gnus-summary-catchup-and-goto-next-group
+ "p" gnus-summary-catchup-and-goto-prev-group
"R" gnus-summary-reselect-current-group
"G" gnus-summary-rescan-group
"N" gnus-summary-next-group
"q" gnus-article-de-quoted-unreadable
"6" gnus-article-de-base64-unreadable
"Z" gnus-article-decode-HZ
+ "A" gnus-article-treat-ansi-sequences
"h" gnus-article-wash-html
"u" gnus-article-unsplit-urls
"s" gnus-summary-force-verify-and-decrypt
"v" gnus-summary-verbose-headers
"a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive
"p" gnus-article-verify-x-pgp-sig
- "d" gnus-article-treat-dumbquotes)
+ "d" gnus-article-treat-dumbquotes
+ "i" gnus-summary-idna-message)
(gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map)
;; mnemonic: deuglif*Y*
"m" gnus-summary-repair-multipart
"v" gnus-article-view-part
"o" gnus-article-save-part
+ "O" gnus-article-save-part-and-strip
+ "r" gnus-article-replace-part
+ "d" gnus-article-delete-part
+ "j" gnus-article-jump-to-part
"c" gnus-article-copy-part
"C" gnus-article-view-part-as-charset
"e" gnus-article-view-part-externally
["View MIME buttons" gnus-summary-display-buttonized t]
["View all" gnus-mime-view-all-parts t]
["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t]
- ["Encrypt body" gnus-article-encrypt-body t]
- ["Extract all parts" gnus-summary-save-parts t])
+ ["Encrypt body" gnus-article-encrypt-body
+ :active (not (gnus-group-read-only-p))
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Encrypt the message body on disk"))]
+ ["Extract all parts..." gnus-summary-save-parts t]
+ ("Multipart"
+ ["Repair multipart" gnus-summary-repair-multipart t]
+ ["Pipe part..." gnus-article-pipe-part t]
+ ["Inline part" gnus-article-inline-part t]
+ ["Encrypt body" gnus-article-encrypt-body
+ :active (not (gnus-group-read-only-p))
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Encrypt the message body on disk"))]
+ ["View part externally" gnus-article-view-part-externally t]
+ ["View part with charset..." gnus-article-view-part-as-charset t]
+ ["Copy part" gnus-article-copy-part t]
+ ["Save part..." gnus-article-save-part t]
+ ["View part" gnus-article-view-part t]))
("Date"
["Local" gnus-article-date-local t]
["ISO8601" gnus-article-date-iso8601 t]
,@(gnus-summary-menu-split
(mapcar
(lambda (cs)
- ;; Since easymenu under FSF Emacs doesn't allow lambda
- ;; forms for menu commands, we should provide intern'ed
- ;; function symbols.
+ ;; Since easymenu under Emacs doesn't allow
+ ;; lambda forms for menu commands, we should
+ ;; provide intern'ed function symbols.
(let ((command (intern (format "\
gnus-summary-show-article-from-menu-as-charset-%s" cs))))
(fset command
["Word wrap" gnus-article-fill-cited-article t]
["Fill long lines" gnus-article-fill-long-lines t]
["Capitalize sentences" gnus-article-capitalize-sentences t]
- ["CR" gnus-article-remove-cr t]
+ ["Remove CR" gnus-article-remove-cr t]
["Quoted-Printable" gnus-article-de-quoted-unreadable t]
["Base64" gnus-article-de-base64-unreadable t]
["Rot 13" gnus-summary-caesar-message
,@(if (featurep 'xemacs) '(t)
'(:help "\"Caesar rotate\" article by 13"))]
+ ["De-IDNA" gnus-summary-idna-message t]
["Morse decode" gnus-summary-morse-message t]
["Unix pipe..." gnus-summary-pipe-message t]
["Add buttons" gnus-article-add-buttons t]
["Unfold headers" gnus-article-treat-unfold-headers t]
["Fold newsgroups" gnus-article-treat-fold-newsgroups t]
["Html" gnus-article-wash-html t]
- ["URLs" gnus-article-unsplit-urls t]
+ ["Unsplit URLs" gnus-article-unsplit-urls t]
["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t]
- ["HZ" gnus-article-decode-HZ t]
+ ["Decode HZ" gnus-article-decode-HZ t]
+ ["ANSI sequences" gnus-article-treat-ansi-sequences t]
("(Outlook) Deuglify"
["Unwrap lines" gnus-article-outlook-unwrap-lines t]
["Repair attribution" gnus-article-outlook-repair-attribution t]
gnus-article-outlook-deuglify-article t])
)
("Output"
- ["Save in default format" gnus-summary-save-article
+ ["Save in default format..." gnus-summary-save-article
,@(if (featurep 'xemacs) '(t)
'(:help "Save article using default method"))]
- ["Save in file" gnus-summary-save-article-file
+ ["Save in file..." gnus-summary-save-article-file
,@(if (featurep 'xemacs) '(t)
'(:help "Save article in file"))]
- ["Save in Unix mail format" gnus-summary-save-article-mail t]
- ["Save in MH folder" gnus-summary-save-article-folder t]
- ["Save in VM folder" gnus-summary-save-article-vm t]
- ["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]
+ ["Save in Unix mail format..." gnus-summary-save-article-mail t]
+ ["Save in MH folder..." gnus-summary-save-article-folder t]
+ ["Save in VM folder..." gnus-summary-save-article-vm t]
+ ["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 t])
- ("Backend"
+ ["Print with Muttprint..." gnus-summary-muttprint t]
+ ["Print" gnus-summary-print-article
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Generate and print a PostScript image"))])
+ ("Copy, move,... (Backend)"
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Copying, moving, expiring articles..."))
["Respool article..." gnus-summary-respool-article t]
["Move article..." gnus-summary-move-article
(gnus-check-backend-function
["Crosspost article..." gnus-summary-crosspost-article
(gnus-check-backend-function
'request-replace-article gnus-newsgroup-name)]
- ["Import file..." gnus-summary-import-article t]
- ["Create article..." gnus-summary-create-article t]
+ ["Import file..." gnus-summary-import-article
+ (gnus-check-backend-function
+ 'request-accept-article gnus-newsgroup-name)]
+ ["Create article..." gnus-summary-create-article
+ (gnus-check-backend-function
+ 'request-accept-article gnus-newsgroup-name)]
["Check if posted" gnus-summary-article-posted-p t]
["Edit article" gnus-summary-edit-article
(not (gnus-group-read-only-p))]
`("Post"
["Send a message (mail or news)" gnus-summary-post-news
,@(if (featurep 'xemacs) '(t)
- '(:help "Post an article"))]
+ '(:help "Compose a new message (mail or news)"))]
["Followup" gnus-summary-followup
,@(if (featurep 'xemacs) '(t)
'(:help "Post followup to this article"))]
["Catchup all" gnus-summary-catchup-all t]
["Catchup to here" gnus-summary-catchup-to-here t]
["Catchup from here" gnus-summary-catchup-from-here t]
- ["Catchup region" gnus-summary-mark-region-as-read
+ ["Catchup region" gnus-summary-mark-region-as-read
(gnus-mark-active-p)]
["Mark excluded" gnus-summary-limit-mark-excluded-as-read t])
("Mark Various"
["Marks..." gnus-summary-limit-to-marks t]
["Subject..." gnus-summary-limit-to-subject t]
["Author..." gnus-summary-limit-to-author t]
+ ["Recipient..." gnus-summary-limit-to-recipient 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]
+ ["Replied" gnus-summary-limit-to-replied t]
["Non-dormant" gnus-summary-limit-exclude-dormant t]
["Next articles" gnus-summary-limit-to-articles t]
["Pop limit" gnus-summary-pop-limit t]
["Set mark" gnus-summary-mark-as-processable t]
["Remove mark" gnus-summary-unmark-as-processable t]
["Remove all marks" gnus-summary-unmark-all-processable t]
+ ["Invert marks" gnus-uu-invert-processable t]
["Mark above" gnus-uu-mark-over t]
["Mark series" gnus-uu-mark-series t]
["Mark region" gnus-uu-mark-region (gnus-mark-active-p)]
["Kill" gnus-summary-kill-process-mark t]
["Yank" gnus-summary-yank-process-mark
gnus-newsgroup-process-stack]
- ["Save" gnus-summary-save-process-mark t]))
+ ["Save" gnus-summary-save-process-mark t]
+ ["Run command on marked..." gnus-summary-universal-argument t]))
("Scroll article"
["Page forward" gnus-summary-next-page
,@(if (featurep 'xemacs) '(t)
("Sort"
["Sort by number" gnus-summary-sort-by-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 score" gnus-summary-sort-by-score t]
["See old articles" gnus-summary-insert-old-articles t]
["See new articles" gnus-summary-insert-new-articles t]
["Filter articles..." gnus-summary-execute-command t]
- ["Run command on subjects..." gnus-summary-universal-argument t]
+ ["Run command on articles..." gnus-summary-universal-argument t]
["Search articles forward..." gnus-summary-search-article-forward t]
["Search articles backward..." gnus-summary-search-article-backward t]
["Toggle line truncation" gnus-summary-toggle-truncation t]
'(:help "Mark unread articles in this group as read, then exit"))]
["Catchup all and exit" gnus-summary-catchup-all-and-exit t]
["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t]
+ ["Catchup and goto prev" gnus-summary-catchup-and-goto-prev-group t]
["Exit group" gnus-summary-exit
,@(if (featurep 'xemacs) '(t)
'(:help "Exit current group, return to group selection mode"))]
(defvar gnus-summary-tool-bar-map nil)
-;; Emacs 21 tool bar. Should be no-op otherwise.
-(defun gnus-summary-make-tool-bar ()
- (if (and (fboundp 'tool-bar-add-item-from-menu)
- (default-value 'tool-bar-mode)
- (not gnus-summary-tool-bar-map))
- (setq gnus-summary-tool-bar-map
- (let ((tool-bar-map (make-sparse-keymap))
- (load-path (mm-image-load-path)))
- (tool-bar-add-item-from-menu
- 'gnus-summary-prev-unread "prev-ur" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-next-unread "next-ur" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-post-news "post" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-followup-with-original "fuwo" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-followup "followup" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-reply-with-original "reply-wo" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-reply "reply" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-caesar-message "rot13" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-uu-decode-uu "uu-decode" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-save-article-file "save-aif" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-save-article "save-art" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-uu-post-news "uu-post" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-catchup "catchup" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-catchup-and-exit "cu-exit" gnus-summary-mode-map)
- (tool-bar-add-item-from-menu
- 'gnus-summary-exit "exit-summ" gnus-summary-mode-map)
- tool-bar-map)))
- (if gnus-summary-tool-bar-map
- (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map)))
+;; Note: The :set function in the `gnus-summary-tool-bar*' variables will only
+;; affect _new_ message buffers. We might add a function that walks thru all
+;; summary-mode buffers and force the update.
+(defun gnus-summary-tool-bar-update (&optional symbol value)
+ "Update summary mode toolbar.
+Setter function for custom variables."
+ (setq-default gnus-summary-tool-bar-map nil)
+ (when symbol
+ ;; When used as ":set" function:
+ (set-default symbol value))
+ (when (gnus-buffer-live-p gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
+ (gnus-summary-make-tool-bar))))
+
+(defcustom gnus-summary-tool-bar (if (eq gmm-tool-bar-style 'gnome)
+ 'gnus-summary-tool-bar-gnome
+ 'gnus-summary-tool-bar-retro)
+ "Specifies the Gnus summary tool bar.
+
+It can be either a list or a symbol refering to a list. See
+`gmm-tool-bar-from-list' for the format of the list. The
+default key map is `gnus-summary-mode-map'.
+
+Pre-defined symbols include `gnus-summary-tool-bar-gnome' and
+`gnus-summary-tool-bar-retro'."
+ :type '(choice (const :tag "GNOME style" gnus-summary-tool-bar-gnome)
+ (const :tag "Retro look" gnus-summary-tool-bar-retro)
+ (repeat :tag "User defined list" gmm-tool-bar-item)
+ (symbol))
+ :version "23.0" ;; No Gnus
+ :initialize 'custom-initialize-default
+ :set 'gnus-summary-tool-bar-update
+ :group 'gnus-summary)
+
+(defcustom gnus-summary-tool-bar-gnome
+ '((gnus-summary-post-news "mail/compose" nil)
+ (gnus-summary-insert-new-articles "mail/inbox" nil
+ :visible (or (not gnus-agent)
+ gnus-plugged))
+ (gnus-summary-reply-with-original "mail/reply")
+ (gnus-summary-reply "mail/reply" nil :visible nil)
+ (gnus-summary-followup-with-original "mail/reply-all")
+ (gnus-summary-followup "mail/reply-all" nil :visible nil)
+ (gnus-summary-mail-forward "mail/forward")
+ (gnus-summary-save-article "mail/save")
+ (gnus-summary-search-article-forward "search" nil :visible nil)
+ (gnus-summary-print-article "print")
+ (gnus-summary-tick-article-forward "flag-followup" nil :visible nil)
+ ;; Some new commands that may need more suitable icons:
+ (gnus-summary-save-newsrc "save" nil :visible nil)
+ ;; (gnus-summary-show-article "stock_message-display" nil :visible nil)
+ (gnus-summary-prev-article "left-arrow")
+ (gnus-summary-next-article "right-arrow")
+ (gnus-summary-next-page "next-page")
+ ;; (gnus-summary-enter-digest-group "right_arrow" nil :visible nil)
+ ;;
+ ;; Maybe some sort-by-... could be added:
+ ;; (gnus-summary-sort-by-author "sort-a-z" nil :visible nil)
+ ;; (gnus-summary-sort-by-date "sort-1-9" nil :visible nil)
+ (gnus-summary-mark-as-expirable
+ "delete" nil
+ :visible (gnus-check-backend-function 'request-expire-articles
+ gnus-newsgroup-name))
+ (gnus-summary-mark-as-spam
+ "mail/spam" t
+ :visible (and (fboundp 'spam-group-ham-contents-p)
+ (spam-group-ham-contents-p gnus-newsgroup-name))
+ :help "Mark as spam")
+ (gnus-summary-mark-as-read-forward
+ "mail/not-spam" nil
+ :visible (and (fboundp 'spam-group-spam-contents-p)
+ (spam-group-spam-contents-p gnus-newsgroup-name)))
+ ;;
+ (gnus-summary-exit "exit")
+ (gmm-customize-mode "preferences" t :help "Edit mode preferences")
+ (gnus-info-find-node "help"))
+ "List of functions for the summary tool bar (GNOME style).
+
+See `gmm-tool-bar-from-list' for the format of the list."
+ :type '(repeat gmm-tool-bar-item)
+ :version "23.0" ;; No Gnus
+ :initialize 'custom-initialize-default
+ :set 'gnus-summary-tool-bar-update
+ :group 'gnus-summary)
+
+(defcustom gnus-summary-tool-bar-retro
+ '((gnus-summary-prev-unread-article "gnus/prev-ur")
+ (gnus-summary-next-unread-article "gnus/next-ur")
+ (gnus-summary-post-news "gnus/post")
+ (gnus-summary-followup-with-original "gnus/fuwo")
+ (gnus-summary-followup "gnus/followup")
+ (gnus-summary-reply-with-original "gnus/reply-wo")
+ (gnus-summary-reply "gnus/reply")
+ (gnus-summary-caesar-message "gnus/rot13")
+ (gnus-uu-decode-uu "gnus/uu-decode")
+ (gnus-summary-save-article-file "gnus/save-aif")
+ (gnus-summary-save-article "gnus/save-art")
+ (gnus-uu-post-news "gnus/uu-post")
+ (gnus-summary-catchup "gnus/catchup")
+ (gnus-summary-catchup-and-exit "gnus/cu-exit")
+ (gnus-summary-exit "gnus/exit-summ")
+ ;; Some new command that may need more suitable icons:
+ (gnus-summary-print-article "gnus/print" nil :visible nil)
+ (gnus-summary-mark-as-expirable "gnus/close" nil :visible nil)
+ (gnus-summary-save-newsrc "gnus/save" nil :visible nil)
+ ;; (gnus-summary-enter-digest-group "gnus/right_arrow" nil :visible nil)
+ (gnus-summary-search-article-forward "gnus/search" nil :visible nil)
+ ;; (gnus-summary-insert-new-articles "gnus/paste" nil :visible nil)
+ ;; (gnus-summary-toggle-threads "gnus/open" nil :visible nil)
+ ;;
+ (gnus-info-find-node "gnus/help" nil :visible nil))
+ "List of functions for the summary tool bar (retro look).
+
+See `gmm-tool-bar-from-list' for the format of the list."
+ :type '(repeat gmm-tool-bar-item)
+ :version "23.0" ;; No Gnus
+ :initialize 'custom-initialize-default
+ :set 'gnus-summary-tool-bar-update
+ :group 'gnus-summary)
+
+(defcustom gnus-summary-tool-bar-zap-list t
+ "List of icon items from the global tool bar.
+These items are not displayed in the Gnus summary mode tool bar.
+
+See `gmm-tool-bar-from-list' for the format of the list."
+ :type 'gmm-tool-bar-zap-list
+ :version "23.0" ;; No Gnus
+ :initialize 'custom-initialize-default
+ :set 'gnus-summary-tool-bar-update
+ :group 'gnus-summary)
+
+(defvar image-load-path)
+
+(defun gnus-summary-make-tool-bar (&optional force)
+ "Make a summary mode tool bar from `gnus-summary-tool-bar'.
+When FORCE, rebuild the tool bar."
+ (when (and (not (featurep 'xemacs))
+ (boundp 'tool-bar-mode)
+ tool-bar-mode
+ (or (not gnus-summary-tool-bar-map) force))
+ (let* ((load-path
+ (gmm-image-load-path-for-library "gnus"
+ "mail/save.xpm"
+ nil t))
+ (image-load-path (cons (car load-path)
+ (when (boundp 'image-load-path)
+ image-load-path)))
+ (map (gmm-tool-bar-from-list gnus-summary-tool-bar
+ gnus-summary-tool-bar-zap-list
+ 'gnus-summary-mode-map)))
+ (when map
+ ;; Need to set `gnus-summary-tool-bar-map' because `gnus-article-mode'
+ ;; uses it's value.
+ (setq gnus-summary-tool-bar-map map))))
+ (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))
(defun gnus-score-set-default (var value)
"A version of set that updates the GNU Emacs menu-bar."
respectively.
You can also post articles and send mail from this buffer. To
-follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author
+follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author
of an article, type `\\[gnus-summary-reply]'.
There are approx. one gazillion commands you can execute in this
\\{gnus-summary-mode-map}"
(interactive)
(kill-all-local-variables)
+ (let ((gnus-summary-local-variables gnus-newsgroup-variables))
+ (gnus-summary-make-local-variables))
+ (gnus-summary-make-local-variables)
+ (setq gnus-newsgroup-name group)
(when (gnus-visual-p 'summary-menu 'menu)
(gnus-summary-make-menu-bar)
(gnus-summary-make-tool-bar))
- (gnus-summary-make-local-variables)
- (let ((gnus-summary-local-variables gnus-newsgroup-variables))
- (gnus-summary-make-local-variables))
(gnus-make-thread-indent-array)
(gnus-simplify-mode-line)
(setq major-mode 'gnus-summary-mode)
(make-local-variable 'minor-mode-alist)
(use-local-map gnus-summary-mode-map)
(buffer-disable-undo)
- (setq buffer-read-only t) ;Disable modification
+ (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 `...'
(gnus-summary-set-display-table)
(gnus-set-default-directory)
- (setq gnus-newsgroup-name group)
(make-local-variable 'gnus-summary-line-format)
(make-local-variable 'gnus-summary-line-format-spec)
(make-local-variable 'gnus-summary-dummy-line-format)
(make-local-variable 'gnus-summary-dummy-line-format-spec)
(make-local-variable 'gnus-summary-mark-positions)
- (make-local-hook 'pre-command-hook)
+ (gnus-make-local-hook 'pre-command-hook)
(add-hook 'pre-command-hook 'gnus-set-global-variables nil t)
- (gnus-run-hooks 'gnus-summary-mode-hook)
+ (gnus-run-mode-hooks 'gnus-summary-mode-hook)
(turn-on-gnus-mailing-list-mode)
(mm-enable-multibyte)
(gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy)
(let ((locals gnus-summary-local-variables))
(while locals
(if (consp (car locals))
- (and (vectorp (caar locals))
+ (and (symbolp (caar locals))
(set (caar locals) nil))
- (and (vectorp (car locals))
+ (and (symbolp (car locals))
(set (car locals) nil)))
(setq locals (cdr locals)))))
(setq gnus-newsgroup-data (nconc list gnus-newsgroup-data))
(when offset
(gnus-data-update-list odata offset)))
- ;; Find the last element in the list to be spliced into the main
+ ;; Find the last element in the list to be spliced into the main
;; list.
- (while (cdr list)
- (setq list (cdr list)))
+ (setq list (last list))
(if (not data)
(progn
(setcdr list gnus-newsgroup-data)
(aset table ?\r nil)
;; We keep TAB as well.
(aset table ?\t nil)
- ;; We nix out any glyphs over 126 that are not set already.
- (let ((i 256))
+ ;; 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))
+ 160
+ 256)))
(while (>= (setq i (1- i)) 127)
;; Only modify if the entry is nil.
(unless (aref table i)
(point)
(current-buffer))))))
-(defun gnus-summary-buffer-name (group)
- "Return the summary buffer name of GROUP."
- (concat "*Summary " (gnus-group-decoded-name group) "*"))
-
(defun gnus-summary-setup-buffer (group)
"Initialize summary buffer."
(let ((buffer (gnus-summary-buffer-name group))
(push (eval (car locals)) vlist))
(setq locals (cdr locals)))
(setq vlist (nreverse vlist)))
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(setq gnus-newsgroup-name name
gnus-newsgroup-marked marked
gnus-newsgroup-spam-marked spam
(save-excursion
(when (gnus-buffer-exists-p gnus-summary-buffer)
(set-buffer gnus-summary-buffer))
- (let ((gnus-replied-mark 129)
- (gnus-score-below-mark 130)
- (gnus-score-over-mark 130)
- (gnus-undownloaded-mark 131)
- (spec gnus-summary-line-format-spec)
- gnus-visual pos)
+ (let ((spec gnus-summary-line-format-spec)
+ pos)
(save-excursion
(gnus-set-work-buffer)
- (let ((gnus-summary-line-format-spec spec)
- (gnus-newsgroup-downloadable '(0)))
- (gnus-summary-insert-line
- [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil]
- 0 nil t 128 t nil "" nil 1)
+ (let ((gnus-tmp-unread ?Z)
+ (gnus-replied-mark ?Z)
+ (gnus-score-below-mark ?Z)
+ (gnus-score-over-mark ?Z)
+ (gnus-undownloaded-mark ?Z)
+ (gnus-summary-line-format-spec spec)
+ (gnus-newsgroup-downloadable '(0))
+ (header [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil])
+ case-fold-search ignores)
+ ;; Here, all marks are bound to Z.
+ (gnus-summary-insert-line header
+ 0 nil t gnus-tmp-unread t nil "" nil 1)
(goto-char (point-min))
- (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
- (- (point) (point-min) 1)))))
+ ;; Memorize the positions of the same characters as dummy marks.
+ (while (re-search-forward "[A-D]" nil t)
+ (push (point) ignores))
+ (erase-buffer)
+ ;; We use A-D as dummy marks in order to know column positions
+ ;; where marks should be inserted.
+ (setq gnus-tmp-unread ?A
+ gnus-replied-mark ?B
+ gnus-score-below-mark ?C
+ gnus-score-over-mark ?C
+ gnus-undownloaded-mark ?D)
+ (gnus-summary-insert-line header
+ 0 nil t gnus-tmp-unread t nil "" nil 1)
+ ;; Ignore characters which aren't dummy marks.
+ (dolist (p ignores)
+ (delete-region (goto-char (1- p)) p)
+ (insert ?Z))
+ (goto-char (point-min))
+ (setq pos (list (cons 'unread
+ (and (search-forward "A" nil t)
+ (- (point) (point-min) 1)))))
(goto-char (point-min))
- (push (cons 'replied (and (search-forward "\201" nil t)
+ (push (cons 'replied (and (search-forward "B" nil t)
(- (point) (point-min) 1)))
pos)
(goto-char (point-min))
- (push (cons 'score (and (search-forward "\202" nil t)
+ (push (cons 'score (and (search-forward "C" nil t)
(- (point) (point-min) 1)))
pos)
(goto-char (point-min))
- (push (cons 'download
- (and (search-forward "\203" nil t)
- (- (point) (point-min) 1)))
+ (push (cons 'download (and (search-forward "D" nil t)
+ (- (point) (point-min) 1)))
pos)))
(setq gnus-summary-mark-positions pos))))
; 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
- (save-excursion (set-buffer gnus-summary-buffer)
- gnus-newsgroup-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)
newsgroups)
(cond
((setq to (cdr (assq 'To extra-headers)))
- (concat "-> "
+ (concat gnus-summary-to-prefix
(inline
(gnus-summary-extract-address-component
(funcall gnus-decode-encoded-word-function to)))))
- ((setq newsgroups (cdr (assq 'Newsgroups extra-headers)))
- (concat "=> " newsgroups)))))
+ ((setq newsgroups
+ (or
+ (cdr (assq 'Newsgroups extra-headers))
+ (and
+ (memq 'Newsgroups gnus-extra-headers)
+ (eq (car (gnus-find-method-for-group
+ gnus-newsgroup-name)) 'nntp)
+ (gnus-group-real-name gnus-newsgroup-name))))
+ (concat gnus-summary-newsgroup-prefix newsgroups)))))
(inline (gnus-summary-extract-address-component gnus-tmp-from)))))
(defun gnus-summary-insert-line (gnus-tmp-header
gnus-unseen-mark)
(t gnus-no-mark)))
(gnus-tmp-downloaded
- (cond (undownloaded
+ (cond (undownloaded
gnus-undownloaded-mark)
(gnus-newsgroup-agentized
gnus-downloaded-mark)
(setq gnus-tmp-lines -1))
(if (= gnus-tmp-lines -1)
(setq gnus-tmp-lines "?")
- (setq gnus-tmp-lines (number-to-string 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))
(defsubst gnus-summary-line-message-size (head)
"Return pretty-printed version of message size.
This function is intended to be used in
-`gnus-summary-line-format-alist', which see."
+`gnus-summary-line-format-alist'."
(let ((c (or (mail-header-chars head) -1)))
(cond ((< c 0) "n/a") ; chars not available
((< c (* 1000 10)) (format "%1.1fk" (/ c 1024.0)))
(defun gnus-summary-set-local-parameters (group)
"Go through the local params of GROUP and set all variable specs in that list."
- (let ((params (gnus-group-find-parameter group))
- (vars '(quit-config)) ; Ignore quit-config.
- elem)
- (while params
- (setq elem (car params)
- params (cdr params))
+ (let ((vars '(quit-config))) ; Ignore quit-config.
+ (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.
(gnus-active gnus-newsgroup-name)))
;; You can change the summary buffer in some way with this hook.
(gnus-run-hooks 'gnus-select-group-hook)
- (gnus-update-format-specifications
- nil 'summary 'summary-mode 'summary-dummy)
- (gnus-update-summary-mark-positions)
+ (when (memq 'summary (gnus-update-format-specifications
+ nil 'summary 'summary-mode 'summary-dummy))
+ ;; The format specification for the summary line was updated,
+ ;; so we need to update the mark positions as well.
+ (gnus-update-summary-mark-positions))
;; Do score processing.
(when gnus-use-scoring
(gnus-possibly-score-headers))
(when gnus-build-sparse-threads
(gnus-build-sparse-threads))
;; Find the initial limit.
- (if gnus-show-threads
- (if show-all
- (let ((gnus-newsgroup-dormant nil))
- (gnus-summary-initial-limit show-all))
+ (if show-all
+ (let ((gnus-newsgroup-dormant nil))
(gnus-summary-initial-limit show-all))
- ;; When unthreaded, all articles are always shown.
- (setq gnus-newsgroup-limit
- (mapcar
- (lambda (header) (mail-header-number header))
- gnus-newsgroup-headers)))
+ (gnus-summary-initial-limit show-all))
;; Generate the summary buffer.
(unless no-display
(gnus-summary-prepare))
(gnus-summary-position-point)
(gnus-configure-windows 'summary 'force)
(gnus-set-mode-line 'summary))
- (when (get-buffer-window gnus-group-buffer t)
+ (when (and gnus-auto-center-group
+ (get-buffer-window gnus-group-buffer t))
;; Gotta use windows, because recenter does weird stuff if
;; the current buffer ain't the displayed window.
(let ((owin (selected-window)))
((eq gnus-auto-select-subject 'first)
;; Do nothing.
)
- ((gnus-functionp gnus-auto-select-subject)
+ ((functionp gnus-auto-select-subject)
(funcall gnus-auto-select-subject))))
(defun gnus-summary-prepare ()
(gnus-run-hooks 'gnus-summary-prepare-hook)))
(defsubst gnus-general-simplify-subject (subject)
- "Simply subject by the same rules as gnus-gather-threads-by-subject."
+ "Simplify subject by the same rules as `gnus-gather-threads-by-subject'."
(setq subject
(cond
;; Truncate the subject.
(setq heads nil)))))
gnus-newsgroup-dependencies)))
+(defsubst gnus-remove-odd-characters (string)
+ "Translate STRING into something that doesn't contain weird characters."
+ (mm-subst-char-in-string
+ ?\r ?\-
+ (mm-subst-char-in-string ?\n ?\- string t) t))
+
;; This function has to be called with point after the article number
;; on the beginning of the line.
(defsubst gnus-nov-parse-line (number dependencies &optional force-new)
- (let ((eol (gnus-point-at-eol))
+ (let ((eol (point-at-eol))
(buffer (current-buffer))
header references in-reply-to)
(make-full-mail-header
number ; number
(condition-case () ; subject
- (funcall gnus-decode-encoded-word-function
- (setq x (nnheader-nov-field)))
+ (gnus-remove-odd-characters
+ (funcall gnus-decode-encoded-word-function
+ (setq x (nnheader-nov-field))))
(error x))
(condition-case () ; from
- (funcall gnus-decode-encoded-word-function
- (setq x (nnheader-nov-field)))
+ (gnus-remove-odd-characters
+ (funcall gnus-decode-encoded-word-function
+ (setq x (nnheader-nov-field))))
(error x))
(nnheader-nov-field) ; date
- (nnheader-nov-read-message-id) ; id
+ (nnheader-nov-read-message-id number) ; id
(setq references (nnheader-nov-field)) ; refs
(nnheader-nov-read-integer) ; chars
(nnheader-nov-read-integer) ; lines
(setq article (read (current-buffer))
header (gnus-nov-parse-line article dependencies)))
(when header
- (save-excursion
- (set-buffer gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
(push header gnus-newsgroup-headers)
(if (memq (setq article (mail-header-number header))
gnus-newsgroup-unselected)
(forward-line 1)))))))
(defun gnus-summary-update-article-line (article header)
- "Update the line for ARTICLE using HEADERS."
+ "Update the line for ARTICLE using HEADER."
(let* ((id (mail-header-id header))
(thread (gnus-id-to-thread id)))
(unless thread
(let ((inserted (- (point)
(progn
(gnus-summary-insert-line
- header level nil
+ header level nil
(memq article gnus-newsgroup-undownloaded)
(gnus-article-mark article)
(memq article gnus-newsgroup-replied)
(point)))))
(when (cdr datal)
(gnus-data-update-list
- (cdr datal)
+ (cdr datal)
(- (gnus-data-pos data) (gnus-data-pos (cadr datal)) inserted)))))))
(defun gnus-summary-update-article (article &optional iheader)
(setq thread (list (car (gnus-id-to-thread id))))
;; Get the thread this article is part of.
(setq thread (gnus-remove-thread id)))
- (setq old-pos (gnus-point-at-bol))
+ (setq old-pos (point-at-bol))
(setq current (save-excursion
(and (re-search-backward "[\r\n]" nil t)
(gnus-summary-article-number))))
(gnus-summary-show-thread)
(gnus-data-remove
number
- (- (gnus-point-at-bol)
+ (- (point-at-bol)
(prog1
- (1+ (gnus-point-at-eol))
+ (1+ (point-at-eol))
(gnus-delete-line)))))))
(defun gnus-sort-threads-1 (threads func)
(gnus-article-sort-by-author
(gnus-thread-header h1) (gnus-thread-header h2)))
+(defsubst gnus-article-sort-by-recipient (h1 h2)
+ "Sort articles by recipient."
+ (string-lessp
+ (let ((extract (funcall
+ gnus-extract-address-components
+ (or (cdr (assq 'To (mail-header-extra h1))) ""))))
+ (or (car extract) (cadr extract)))
+ (let ((extract (funcall
+ gnus-extract-address-components
+ (or (cdr (assq 'To (mail-header-extra h2))) ""))))
+ (or (car extract) (cadr extract)))))
+
+(defun gnus-thread-sort-by-recipient (h1 h2)
+ "Sort threads by root recipient."
+ (gnus-article-sort-by-recipient
+ (gnus-thread-header h1) (gnus-thread-header h2)))
+
(defsubst gnus-article-sort-by-subject (h1 h2)
"Sort articles by root subject."
(string-lessp
(mapcar
(lambda (header)
(setq previous-time
- (time-to-seconds
- (condition-case ()
- (mail-header-parse-date (mail-header-date header))
- (error 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)
(defcustom gnus-sum-thread-tree-root "> "
"With %B spec, used for the root of a thread.
If nil, use subject instead."
- :type 'string
+ :version "22.1"
+ :type '(radio (const :format "%v " nil) string)
+ :group 'gnus-thread)
+
+(defcustom gnus-sum-thread-tree-false-root "> "
+ "With %B spec, used for a false root of a thread.
+If nil, use subject instead."
+ :version "22.1"
+ :type '(radio (const :format "%v " nil) string)
:group 'gnus-thread)
+
(defcustom gnus-sum-thread-tree-single-indent ""
"With %B spec, used for a thread with just one message.
If nil, use subject instead."
- :type 'string
+ :version "22.1"
+ :type '(radio (const :format "%v " nil) string)
:group 'gnus-thread)
+
(defcustom gnus-sum-thread-tree-vertical "| "
"With %B spec, used for drawing a vertical line."
+ :version "22.1"
:type 'string
:group 'gnus-thread)
+
(defcustom gnus-sum-thread-tree-indent " "
"With %B spec, used for indenting."
+ :version "22.1"
:type 'string
:group 'gnus-thread)
+
(defcustom gnus-sum-thread-tree-leaf-with-other "+-> "
"With %B spec, used for a leaf with brothers."
+ :version "22.1"
:type 'string
:group 'gnus-thread)
+
(defcustom gnus-sum-thread-tree-single-leaf "\\-> "
"With %B spec, used for a leaf without brothers."
+ :version "22.1"
:type 'string
:group 'gnus-thread)
gnus-unseen-mark)
(t gnus-no-mark))
gnus-tmp-downloaded
- (cond ((memq number gnus-newsgroup-undownloaded)
+ (cond ((memq number gnus-newsgroup-undownloaded)
gnus-undownloaded-mark)
(gnus-newsgroup-agentized
gnus-downloaded-mark)
(substring gnus-tmp-from
(1+ (match-beginning 0)) (1- (match-end 0))))
(t gnus-tmp-from))
+
+ ;; Do the %B string
gnus-tmp-thread-tree-header-string
(cond
((not gnus-show-threads) "")
((zerop gnus-tmp-level)
- (if (cdar thread)
- (or gnus-sum-thread-tree-root subject)
- (or gnus-sum-thread-tree-single-indent subject)))
+ (cond ((cdar thread)
+ (or gnus-sum-thread-tree-root subject))
+ (gnus-tmp-new-adopts
+ (or gnus-sum-thread-tree-false-root subject))
+ (t
+ (or gnus-sum-thread-tree-single-indent subject))))
(t
(concat (apply 'concat
(mapcar (lambda (item)
(when (nth 1 thread)
(push (list (max 0 gnus-tmp-level)
- (copy-list tree-stack)
+ (copy-sequence tree-stack)
(nthcdr 1 thread))
stack))
(push (if (nth 1 thread) 1 0) tree-stack)
gnus-list-identifiers))
changed subject)
(when regexp
+ (setq regexp (concat "^\\(?:R[Ee]: +\\)*\\(" regexp " *\\)"))
(dolist (header gnus-newsgroup-headers)
(setq subject (mail-header-subject header)
changed nil)
- (while (string-match
- (concat "^\\(R[Ee]: +\\)*\\(" regexp " *\\)")
- subject)
+ (while (string-match regexp subject)
(setq subject
- (concat (substring subject 0 (match-beginning 2))
+ (concat (substring subject 0 (match-beginning 1))
(substring subject (match-end 0)))
changed t))
- (when (and changed
- (string-match
- "^\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" subject))
- (setq subject
- (concat (substring subject 0 (match-beginning 1))
- (substring subject (match-end 1)))))
(when changed
+ (when (string-match "^\\(\\(?:R[Ee]: +\\)+\\)R[Ee]: +" subject)
+ (setq subject
+ (concat (substring subject 0 (match-beginning 1))
+ (substring subject (match-end 1)))))
(mail-header-set-subject header subject))))))
(defun gnus-fetch-headers (articles)
"Select newsgroup GROUP.
If READ-ALL is non-nil, all articles in the group are selected.
If SELECT-ARTICLES, only select those articles from GROUP."
- (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
+ (let* ((entry (gnus-group-entry group))
;;!!! Dirty hack; should be removed.
(gnus-summary-ignore-duplicates
(if (eq (car (gnus-find-method-for-group group)) 'nnvirtual)
(gnus-activate-group group) ; Or we can activate it...
(progn ; Or we bug out.
(when (equal major-mode 'gnus-summary-mode)
- (kill-buffer (current-buffer)))
+ (gnus-kill-buffer (current-buffer)))
(error "Couldn't activate group %s: %s"
group (gnus-status-message group))))
(unless (gnus-request-group group t)
(when (equal major-mode 'gnus-summary-mode)
- (kill-buffer (current-buffer)))
+ (gnus-kill-buffer (current-buffer)))
(error "Couldn't request group %s: %s"
group (gnus-status-message group)))
+ (when gnus-agent
+ (gnus-agent-possibly-alter-active group (gnus-active group) info)
+
+ (setq gnus-summary-use-undownloaded-faces
+ (gnus-agent-find-parameter
+ group
+ 'agent-enable-undownloaded-faces)))
+
(setq gnus-newsgroup-name group
gnus-newsgroup-unselected nil
gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
(defun gnus-articles-to-read (group &optional read-all)
"Find out what articles the user wants to read."
- (let* ((display (gnus-group-find-parameter group 'display))
- (articles
+ (let* ((articles
;; Select all articles if `read-all' is non-nil, or if there
;; are no unread articles.
(if (or read-all
'list))
(defun gnus-article-unpropagatable-p (mark)
- "Return whether MARK should be propagated to backend."
+ "Return whether MARK should be propagated to back end."
(memq mark gnus-article-unpropagated-mark-lists))
(defun gnus-adjust-marked-articles (info)
(min (car active))
(max (cdr active))
(types gnus-article-mark-lists)
- marks var articles article mark mark-type)
+ marks var articles article mark mark-type
+ bgn end)
(dolist (marks marked-lists)
(setq mark (car marks)
;; We set the variable according to the type of the marks list,
;; and then adjust the marks to a subset of the active articles.
(cond
- ;; Adjust "simple" lists.
+ ;; Adjust "simple" lists - compressed yet unsorted
((eq mark-type 'list)
- (set var (setq articles (gnus-uncompress-range (cdr marks))))
- (when (memq mark '(tick dormant expire reply save))
- (while articles
- (when (or (< (setq article (pop articles)) min) (> article max))
- (set var (delq article (symbol-value var)))))))
+ ;; Simultaneously uncompress and clip to active range
+ ;; See gnus-uncompress-range for a description of possible marks
+ (let (l lh)
+ (if (not (cadr marks))
+ (set var nil)
+ (setq articles (if (numberp (cddr marks))
+ (list (cdr marks))
+ (cdr marks))
+ lh (cons nil nil)
+ l lh)
+
+ (while (setq article (pop articles))
+ (cond ((consp article)
+ (setq bgn (max (car article) min)
+ end (min (cdr article) max))
+ (while (<= bgn end)
+ (setq l (setcdr l (cons bgn nil))
+ bgn (1+ bgn))))
+ ((and (<= min article)
+ (>= max article))
+ (setq l (setcdr l (cons article nil))))))
+ (set var (cdr lh)))))
;; Adjust assocs.
((eq mark-type 'tuple)
(set var (setq articles (cdr marks)))
(match-end 1)))
(substring xrefs (match-beginning 1) (match-end 1))))
(setq number
- (string-to-int (substring xrefs (match-beginning 2)
+ (string-to-number (substring xrefs (match-beginning 2)
(match-end 2))))
(if (setq entry (gnus-gethash group xref-hashtb))
(setcdr entry (cons number (cdr entry)))
(defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
"Look through all the headers and mark the Xrefs as read."
(let ((virtual (gnus-virtual-group-p from-newsgroup))
- name entry info xref-hashtb idlist method nth4)
+ name info xref-hashtb idlist method nth4)
(save-excursion
(set-buffer gnus-group-buffer)
(when (setq xref-hashtb
(setq idlist (symbol-value group))
;; Dead groups are not updated.
(and (prog1
- (setq entry (gnus-gethash name gnus-newsrc-hashtb)
- info (nth 2 entry))
+ (setq info (gnus-get-info name))
(when (stringp (setq nth4 (gnus-info-method info)))
(setq nth4 (gnus-server-to-method nth4))))
;; Only do the xrefs if the group has the same
xref-hashtb)))))
(defun gnus-compute-read-articles (group articles)
- (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
+ (let* ((entry (gnus-group-entry group))
(info (nth 2 entry))
(active (gnus-active group))
ninfo)
(defun gnus-group-make-articles-read (group articles)
"Update the info of GROUP to say that ARTICLES are read."
(let* ((num 0)
- (entry (gnus-gethash group gnus-newsrc-hashtb))
+ (entry (gnus-group-entry group))
(info (nth 2 entry))
(active (gnus-active group))
range)
(when entry
(setq range (gnus-compute-read-articles group articles))
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(gnus-undo-register
`(progn
(gnus-info-set-marks ',info ',(gnus-info-marks info) t)
(let ((cur nntp-server-buffer)
(dependencies
(or dependencies
- (save-excursion (set-buffer gnus-summary-buffer)
- gnus-newsgroup-dependencies)))
- headers id end ref
+ (with-current-buffer gnus-summary-buffer
+ gnus-newsgroup-dependencies)))
+ headers id end ref number
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
(save-excursion (condition-case nil
;; 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)
+ (ietf-drums-unfold-fws)
(gnus-run-hooks 'gnus-parse-headers-hook)
(let ((case-fold-search t)
in-reply-to header p lines chars)
(vector
;; Number.
(prog1
- (read cur)
+ (setq number (read cur))
(end-of-line)
(setq p (point))
(narrow-to-region (point)
(match-end 1))
;; If there was no message-id, we just fake one
;; to make subsequent routines simpler.
- (nnheader-generate-fake-message-id))))
+ (nnheader-generate-fake-message-id number))))
;; References.
(progn
(goto-char p)
(allp (cond
((eq gnus-read-all-available-headers t)
t)
- ((stringp gnus-read-all-available-headers)
+ ((and (stringp gnus-read-all-available-headers)
+ group)
(string-match gnus-read-all-available-headers group))
(t
nil)))
(defun gnus-article-get-xrefs ()
"Fill in the Xref value in `gnus-current-headers', if necessary.
This is meant to be called in `gnus-article-internal-prepare-hook'."
- (let ((headers (save-excursion (set-buffer gnus-summary-buffer)
- gnus-current-headers)))
+ (let ((headers (with-current-buffer gnus-summary-buffer
+ gnus-current-headers)))
(or (not gnus-use-cross-reference)
(not headers)
(and (mail-header-xref headers)
(looking-at "Xref:"))
(search-forward "\nXref:" nil t))
(goto-char (1+ (match-end 0)))
- (setq xref (buffer-substring (point)
- (progn (end-of-line) (point))))
+ (setq xref (buffer-substring (point) (point-at-eol)))
(mail-header-set-xref headers xref)))))))
(defun gnus-summary-insert-subject (id &optional old-header use-old-header)
(goto-char (gnus-data-pos d))
(gnus-data-remove
number
- (- (gnus-point-at-bol)
+ (- (point-at-bol)
(prog1
- (1+ (gnus-point-at-eol))
+ (1+ (point-at-eol))
(gnus-delete-line))))))
+ ;; Remove list identifiers from subject.
+ (when gnus-list-identifiers
+ (let ((gnus-newsgroup-headers (list header)))
+ (gnus-summary-remove-list-identifiers)))
(when old-header
(mail-header-set-number header (mail-header-number old-header)))
(setq gnus-newsgroup-sparse
(let ((max (max (point) (mark)))
articles article)
(save-excursion
- (goto-char (min (min (point) (mark))))
+ (goto-char (min (point) (mark)))
(while
(and
(push (setq article (gnus-summary-article-number)) articles)
(defun gnus-summary-process-mark-set (set)
"Make SET into the current process marked articles."
(gnus-summary-unmark-all-processable)
- (while set
- (gnus-summary-set-process-mark (pop set))))
+ (mapc 'gnus-summary-set-process-mark set))
;;; Searching and stuff
(defun gnus-summary-best-group (&optional exclude-group)
"Find the name of the best unread group.
If EXCLUDE-GROUP, do not go to this group."
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(save-excursion
(gnus-group-best-unread-group exclude-group))))
(defun gnus-summary-find-next (&optional unread article backward)
- (if backward (gnus-summary-find-prev)
+ (if backward
+ (gnus-summary-find-prev unread article)
(let* ((dummy (gnus-summary-article-intangible-p))
(article (or article (gnus-summary-article-number)))
(data (gnus-data-find-list article))
(if unread
(progn
(while data
- (unless (memq (gnus-data-number (car data))
- gnus-newsgroup-unfetched)
+ (unless (memq (gnus-data-number (car data))
+ (cond
+ ((eq gnus-auto-goto-ignores
+ 'always-undownloaded)
+ gnus-newsgroup-undownloaded)
+ (gnus-plugged
+ nil)
+ ((eq gnus-auto-goto-ignores
+ 'unfetched)
+ gnus-newsgroup-unfetched)
+ ((eq gnus-auto-goto-ignores
+ 'undownloaded)
+ gnus-newsgroup-undownloaded)))
(when (gnus-data-unread-p (car data))
(setq result (car data)
data nil)))
(if unread
(progn
(while data
- (unless (memq (gnus-data-number (car data)) gnus-newsgroup-unfetched)
+ (unless (memq (gnus-data-number (car data))
+ (cond
+ ((eq gnus-auto-goto-ignores
+ 'always-undownloaded)
+ gnus-newsgroup-undownloaded)
+ (gnus-plugged
+ nil)
+ ((eq gnus-auto-goto-ignores
+ 'unfetched)
+ gnus-newsgroup-unfetched)
+ ((eq gnus-auto-goto-ignores
+ 'undownloaded)
+ gnus-newsgroup-undownloaded)))
(when (gnus-data-unread-p (car data))
(setq result (car data)
data nil)))
If `gnus-auto-center-summary' is nil, or the article buffer isn't
displayed, no centering will be performed."
;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
-;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
+ ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
(interactive)
- (let* ((top (cond ((< (window-height) 4) 0)
- ((< (window-height) 7) 1)
- (t (if (numberp gnus-auto-center-summary)
- gnus-auto-center-summary
- 2))))
- (height (1- (window-height)))
- (bottom (save-excursion (goto-char (point-max))
- (forward-line (- height))
- (point)))
- (window (get-buffer-window (current-buffer))))
- ;; The user has to want it.
- (when gnus-auto-center-summary
+ ;; The user has to want it.
+ (when gnus-auto-center-summary
+ (let* ((top (cond ((< (window-height) 4) 0)
+ ((< (window-height) 7) 1)
+ (t (if (numberp gnus-auto-center-summary)
+ gnus-auto-center-summary
+ (/ (1- (window-height)) 2)))))
+ (height (1- (window-height)))
+ (bottom (save-excursion (goto-char (point-max))
+ (forward-line (- 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
+ ;; 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))))
(defun gnus-list-of-unread-articles (group)
(let* ((read (gnus-info-read (gnus-get-info group)))
(active (or (gnus-active group) (gnus-activate-group group)))
- (last (cdr active))
+ (last (or (cdr active)
+ (error "Group %s couldn't be activated " group)))
first nlast unread)
;; If none are read, then all are unread.
(if (not read)
(while read
(when first
(while (< first nlast)
- (push first unread)
- (setq first (1+ first))))
+ (setq unread (cons first unread)
+ first (1+ first))))
(setq first (1+ (if (atom (car read)) (car read) (cdar read))))
(setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
(setq read (cdr read)))))
;; And add the last unread articles.
(while (<= first last)
- (push first unread)
- (setq first (1+ first)))
+ (setq unread (cons first unread)
+ first (1+ first)))
;; Return the list of unread articles.
(delq 0 (nreverse unread))))
(cdr (assq 'dormant marked)))
(cdr (assq 'tick marked))))))
+;; This function returns a sequence of article numbers based on the
+;; difference between the ranges of read articles in this group and
+;; the range of active articles.
+(defun gnus-sequence-of-unread-articles (group)
+ (let* ((read (gnus-info-read (gnus-get-info group)))
+ (active (or (gnus-active group) (gnus-activate-group group)))
+ (last (cdr active))
+ first nlast unread)
+ ;; If none are read, then all are unread.
+ (if (not read)
+ (setq first (car active))
+ ;; 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))
+ (progn (setq read (list read))
+ nil)))
+ (setq first (max (car active) (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)))
+ (while read
+ (when first
+ (push (cons first nlast) unread))
+ (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
+ (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
+ (setq read (cdr read)))))
+ ;; And add the last unread articles.
+ (cond ((not (and first last))
+ nil)
+ ((< first last)
+ (push (cons first last) unread))
+ ((= first last)
+ (push first unread)))
+ ;; Return the sequence of unread articles.
+ (delq 0 (nreverse unread))))
+
;; Various summary commands
(defun gnus-summary-select-article-buffer ()
(defun gnus-summary-toggle-truncation (&optional arg)
"Toggle truncation of summary lines.
-With arg, turn line truncation on if arg is positive."
+With ARG, turn line truncation on if ARG is positive."
(interactive "P")
(setq truncate-lines
(if (null arg) (not truncate-lines)
(> (prefix-numeric-value arg) 0)))
(redraw-display))
-(defun gnus-summary-find-uncancelled ()
- "Return the number of an uncancelled article.
+(defun gnus-summary-find-for-reselect ()
+ "Return the number of an article to stay on across a reselect.
The current article is considered, then following articles, then previous
-articles. If all articles are cancelled then return a dummy 0."
+articles. An article is sought which is not cancelled and isn't a temporary
+insertion from another group. If there's no such then return a dummy 0."
(let (found)
(dolist (rev '(nil t))
(unless found ; don't demand the reverse list if we don't need it
(let ((data (gnus-data-find-list
(gnus-summary-article-number) (gnus-data-list rev))))
(while (and data (not found))
- (if (not (eq gnus-canceled-mark (gnus-data-mark (car data))))
+ (if (and (< 0 (gnus-data-number (car data)))
+ (not (eq gnus-canceled-mark (gnus-data-mark (car data)))))
(setq found (gnus-data-number (car data))))
(setq data (cdr data))))))
(or found 0)))
(interactive "P")
(when (gnus-ephemeral-group-p gnus-newsgroup-name)
(error "Ephemeral groups can't be reselected"))
- (let ((current-subject (gnus-summary-find-uncancelled))
+ (let ((current-subject (gnus-summary-find-for-reselect))
(group gnus-newsgroup-name))
(setq gnus-newsgroup-begin nil)
- (gnus-summary-exit)
+ (gnus-summary-exit nil 'leave-hidden)
;; We have to adjust the point of group mode buffer because
;; point was moved to the next unread newsgroup by exiting.
(gnus-summary-jump-to-group group)
(setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
(let ((headers gnus-newsgroup-headers))
;; Set the new ranges of read articles.
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(gnus-undo-force-boundary))
(gnus-update-read-articles
group (gnus-sorted-union
(gnus-save-newsrc-file)
(gnus-dribble-save)))
-(defun gnus-summary-exit (&optional temporary)
+(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-summary-clear-local-variables))
(when (get-buffer gnus-article-buffer)
(bury-buffer gnus-article-buffer))
- ;; We clear the global counterparts of the buffer-local
- ;; variables as well, just to be on the safe side.
- (set-buffer gnus-group-buffer)
- (gnus-summary-clear-local-variables)
- (let ((gnus-summary-local-variables gnus-newsgroup-variables))
- (gnus-summary-clear-local-variables))
;; Return to group mode buffer.
(when (eq mode 'gnus-summary-mode)
(gnus-kill-buffer buf)))
(setq gnus-current-select-method gnus-select-method)
- (pop-to-buffer gnus-group-buffer)
- (if (not quit-config)
- (progn
- (goto-char group-point)
- (gnus-configure-windows 'group 'force))
- (gnus-handle-ephemeral-exit quit-config))
+ (set-buffer gnus-group-buffer)
+ (if quit-config
+ (gnus-handle-ephemeral-exit quit-config)
+ (goto-char group-point)
+ ;; If gnus-group-buffer is already displayed, make sure we also move
+ ;; the cursor in the window that displays it.
+ (let ((win (get-buffer-window (current-buffer) 0)))
+ (if win (set-window-point win (point))))
+ (unless leave-hidden
+ (gnus-configure-windows 'group 'force)))
;; Clear the current group name.
(unless quit-config
(setq gnus-newsgroup-name nil)))))
(interactive)
(let* ((group gnus-newsgroup-name)
(gnus-group-is-exiting-p t)
+ (gnus-group-is-exiting-without-update-p t)
(quit-config (gnus-group-quit-config group)))
(when (or no-questions
gnus-expert-user
(gnus-y-or-n-p "Discard changes to this group and exit? "))
(gnus-async-halt-prefetch)
- (mapcar 'funcall
- (delq 'gnus-summary-expire-articles
- (copy-sequence gnus-summary-prepare-exit-hook)))
+ (run-hooks 'gnus-summary-prepare-exit-hook)
(when (gnus-buffer-live-p gnus-article-buffer)
(save-excursion
(set-buffer gnus-article-buffer)
(gnus-summary-clear-local-variables)
(let ((gnus-summary-local-variables gnus-newsgroup-variables))
(gnus-summary-clear-local-variables))
- (set-buffer gnus-group-buffer)
- (gnus-summary-clear-local-variables)
- (let ((gnus-summary-local-variables gnus-newsgroup-variables))
- (gnus-summary-clear-local-variables))
- (when (get-buffer gnus-summary-buffer)
- (kill-buffer gnus-summary-buffer)))
+ (gnus-kill-buffer gnus-summary-buffer))
(unless gnus-single-article-buffer
(setq gnus-article-current nil))
(when gnus-use-trees
(progn
;; The current article may be from the ephemeral group
;; thus it is best that we reload this article
- (gnus-summary-show-article)
+ ;;
+ ;; If we're exiting from a large digest, this can be
+ ;; extremely slow. So, it's better not to reload it. -- jh.
+ ;;(gnus-summary-show-article)
(if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode))
(gnus-configure-windows 'pick 'force)
(gnus-configure-windows (cdr quit-config) 'force)))
(if (null arg) (not gnus-dead-summary-mode)
(> (prefix-numeric-value arg) 0)))
(when gnus-dead-summary-mode
- (gnus-add-minor-mode
+ (add-minor-mode
'gnus-dead-summary-mode " Dead" gnus-dead-summary-mode-map))))
(defun gnus-deaden-summary ()
;; Kill any previous dead summary buffer.
(when (and gnus-dead-summary
(buffer-name gnus-dead-summary))
- (save-excursion
- (set-buffer gnus-dead-summary)
+ (with-current-buffer gnus-dead-summary
(when gnus-dead-summary-mode
(kill-buffer (current-buffer)))))
;; Make this the current dead summary.
(save-excursion
(when (and (buffer-name buffer)
(not gnus-single-article-buffer))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(gnus-kill-buffer gnus-article-buffer)
(gnus-kill-buffer gnus-original-article-buffer)))
(cond
(when current-prefix-arg
(completing-read
"FAQ dir: " (and (listp gnus-group-faq-directory)
- (mapcar (lambda (file) (list file))
+ (mapcar 'list
gnus-group-faq-directory))))))
(let (gnus-faq-buffer)
(when (setq gnus-faq-buffer
(defun gnus-summary-next-group (&optional no-article target-group backward)
"Exit current newsgroup and then select next unread newsgroup.
If prefix argument NO-ARTICLE is non-nil, no article is selected
-initially. If NEXT-GROUP, go to this group. If BACKWARD, go to
+initially. If TARGET-GROUP, go to this group. If BACKWARD, go to
previous group instead."
(interactive "P")
;; Stop pre-fetching.
(let ((current-group gnus-newsgroup-name)
(current-buffer (current-buffer))
entered)
+ ;; First we semi-exit this group to update Xrefs and all variables.
+ ;; We can't do a real exit, because the window conf must remain
+ ;; the same in case the user is prompted for info, and we don't
+ ;; want the window conf to change before that...
+ (gnus-summary-exit t)
(while (not entered)
;; Then we find what group we are supposed to enter.
(set-buffer gnus-group-buffer)
(let ((unreads (gnus-group-group-unread)))
(if (and (or (eq t unreads)
(and unreads (not (zerop unreads))))
- (progn
- ;; Now we semi-exit this group to update Xrefs
- ;; and all variables. We can't do a real exit,
- ;; because the window conf must remain the same
- ;; in case the user is prompted for info, and we
- ;; don't want the window conf to change before
- ;; that...
- (when (gnus-buffer-live-p current-buffer)
- (set-buffer current-buffer)
- (gnus-summary-exit t))
- (gnus-summary-read-group
- target-group nil no-article
- (and (buffer-name current-buffer) current-buffer)
- nil backward)))
+ (gnus-summary-read-group
+ target-group nil no-article
+ (and (buffer-name current-buffer) current-buffer)
+ nil backward))
(setq entered t)
(setq current-group target-group
target-group nil)))))))
"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 UNSEED is non-nil, the article should be unseen.
+If UNSEEN is non-nil, the article should be unseen.
Returns the article selected or nil if there are no matching articles."
(interactive "P")
(cond
(and unseen
(memq num gnus-newsgroup-unseen)))))))
(setq data (cdr data)))
- (prog1
+ (prog1
(if data
(progn
(goto-char (gnus-data-pos (car data)))
(gnus-summary-goto-subject article t)))
(gnus-summary-limit (append articles gnus-newsgroup-limit))
(gnus-summary-position-point))
-
+
(defun gnus-summary-goto-subject (article &optional force silent)
"Go the subject line of ARTICLE.
If FORCE, also allow jumping to articles not currently shown."
(interactive)
(let ((mm-verify-option 'known)
(mm-decrypt-option 'known)
+ (gnus-article-emulate-mime t)
(gnus-buttonized-mime-types (append (list "multipart/signed"
"multipart/encrypted")
gnus-buttonized-mime-types)))
(gnus-summary-jump-to-group gnus-newsgroup-name))
(let ((cmd last-command-char)
(point
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(point)))
(group
(if (eq gnus-keep-same-level 'best)
(if (and group
(not (gnus-ephemeral-group-p gnus-newsgroup-name)))
(format " (Type %s for %s [%s])"
- (single-key-description cmd) group
- (car (gnus-gethash group gnus-newsrc-hashtb)))
+ (single-key-description cmd)
+ (gnus-group-decoded-name group)
+ (gnus-group-unread group))
(format " (Type %s to exit %s)"
(single-key-description cmd)
- gnus-newsgroup-name))))
+ (gnus-group-decoded-name gnus-newsgroup-name)))))
;; Confirm auto selection.
(setq key (car (setq keve (gnus-read-event-char prompt)))
ended t)
selecting the next article when reaching the end of the current
article.
-If STOP is non-nil, just stop when reaching the end of the message."
+If STOP is non-nil, just stop when reaching the end of the message.
+
+Also see the variable `gnus-article-skip-boring'."
(interactive "P")
(setq gnus-summary-buffer (current-buffer))
(gnus-set-global-variables)
(gnus-summary-display-article article)
(when article-window
(gnus-eval-in-buffer-window gnus-article-buffer
- (setq endp (gnus-article-next-page lines)))
+ (setq endp (or (gnus-article-next-page lines)
+ (gnus-article-only-boring-p))))
(when endp
(cond (stop
(gnus-message 3 "End of message"))
t))
(prog1
(if (and (stringp article)
- (string-match "@" article))
+ (string-match "@\\|%40" article))
(gnus-summary-refer-article article)
(when (stringp article)
(setq article (string-to-number article)))
current-prefix-arg))
(gnus-summary-limit-to-subject from "from" not-matching))
+(defun gnus-summary-limit-to-recipient (recipient &optional not-matching)
+ "Limit the summary buffer to articles with the given RECIPIENT.
+
+If NOT-MATCHING, exclude RECIPIENT.
+
+To and Cc headers are checked. You need to include them in
+`nnmail-extra-headers'."
+ ;; Unlike `rmail-summary-by-recipients', doesn't include From.
+ (interactive
+ (list (read-string (format "%s recipient (regexp): "
+ (if current-prefix-arg "Exclude" "Limit to")))
+ current-prefix-arg))
+ (when (not (equal "" recipient))
+ (prog1 (let* ((to
+ (if (memq 'To nnmail-extra-headers)
+ (gnus-summary-find-matching
+ (cons 'extra 'To) recipient 'all nil nil
+ not-matching)
+ (gnus-message
+ 1 "`To' isn't present in `nnmail-extra-headers'")
+ (sit-for 1)
+ nil))
+ (cc
+ (if (memq 'Cc nnmail-extra-headers)
+ (gnus-summary-find-matching
+ (cons 'extra 'Cc) recipient 'all nil nil
+ not-matching)
+ (gnus-message
+ 1 "`Cc' isn't present in `nnmail-extra-headers'")
+ (sit-for 1)
+ nil))
+ (articles
+ (if not-matching
+ ;; We need the numbers that are in both lists:
+ (mapcar (lambda (a)
+ (and (memq a to) a))
+ cc)
+ (nconc to cc))))
+ (unless articles
+ (error "Found no matches for \"%s\"" recipient))
+ (gnus-summary-limit articles))
+ (gnus-summary-position-point))))
+
(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
(if (numberp days)
(progn
(setq days-got t)
- (if (< days 0)
- (progn
- (setq younger (not younger))
- (setq days (* days -1)))))
+ (when (< days 0)
+ (setq younger (not younger))
+ (setq days (* days -1))))
(message "Please enter a number.")
(sleep-for 1)))
(list days younger)))
(gnus-completing-read-with-default
(symbol-name (car gnus-extra-headers))
(if current-prefix-arg
- "Exclude extra header:"
- "Limit extra header:")
+ "Exclude extra header"
+ "Limit extra header")
(mapcar (lambda (x)
(cons (symbol-name x) x))
gnus-extra-headers)
gnus-duplicate-mark gnus-souped-mark)
'reverse)))
+(defun gnus-summary-limit-to-replied (&optional unreplied)
+ "Limit the summary buffer to replied articles.
+If UNREPLIED (the prefix), limit to unreplied articles."
+ (interactive "P")
+ (if unreplied
+ (gnus-summary-limit
+ (gnus-set-difference gnus-newsgroup-articles
+ gnus-newsgroup-replied))
+ (gnus-summary-limit gnus-newsgroup-replied))
+ (gnus-summary-position-point))
+
(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-position-point))))
(defun gnus-summary-insert-dormant-articles ()
- "Insert all the dormat articles for this group into the current buffer."
+ "Insert all the dormant articles for this group into the current buffer."
(interactive)
(let ((gnus-verbose (max 6 gnus-verbose)))
(if (not gnus-newsgroup-dormant)
thread)
(defun gnus-cut-threads (threads)
- "Cut off all uninteresting articles from the beginning of threads."
+ "Cut off all uninteresting articles from the beginning of THREADS."
(when (or (eq gnus-fetch-old-headers 'some)
(eq gnus-fetch-old-headers 'invisible)
(numberp gnus-fetch-old-headers)
(and gnus-newsgroup-display
(not (funcall gnus-newsgroup-display)))
;; Check NoCeM things.
- (if (and gnus-use-nocem
- (gnus-nocem-unwanted-article-p
- (mail-header-id (car thread))))
- (progn
- (setq gnus-newsgroup-unreads
- (delq number gnus-newsgroup-unreads))
- t))))
+ (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)))
;; Nope, invisible article.
0
;; Ok, this article is to be visible, so we add it to the limit
(set-buffer gnus-original-article-buffer)
(nnheader-narrow-to-headers)
(unless (setq ref (message-fetch-field "references"))
- (setq ref (message-fetch-field "in-reply-to")))
+ (when (setq ref (message-fetch-field "in-reply-to"))
+ (setq ref (gnus-extract-message-id-from-in-reply-to ref))))
(widen))
(setq ref
;; It's not the current article, so we take a bet on
(let ((id (mail-header-id (gnus-summary-article-header)))
(limit (if limit (prefix-numeric-value limit)
gnus-refer-thread-limit)))
- ;; We want to fetch LIMIT *old* headers, but we also have to
- ;; re-fetch all the headers in the current buffer, because many of
- ;; them may be undisplayed. So we adjust LIMIT.
- (when (numberp limit)
- (incf limit (- gnus-newsgroup-end gnus-newsgroup-begin)))
(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 (gnus-retrieve-headers
- (list gnus-newsgroup-end) gnus-newsgroup-name limit)
+ (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 backends that don't support NOV"))
+ (error "Can't fetch thread from back ends that don't support NOV"))
(gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name))
(gnus-summary-limit-include-thread id)))
(interactive "sMessage-ID: ")
(when (and (stringp message-id)
(not (zerop (length message-id))))
+ (setq message-id (gnus-replace-in-string message-id " " ""))
;; Construct the correct Message-ID if necessary.
;; Suggested by tale@pawl.rpi.edu.
(unless (string-match "^<" message-id)
(setq message-id (concat "<" message-id)))
(unless (string-match ">$" message-id)
(setq message-id (concat message-id ">")))
+ ;; People often post MIDs from URLs, so unhex it:
+ (unless (string-match "@" message-id)
+ (setq message-id (gnus-url-unhex-string message-id)))
(let* ((header (gnus-id-to-header message-id))
(sparse (and header
(gnus-summary-article-sparse-p
;; We fetch the article.
(catch 'found
(dolist (gnus-override-method (gnus-refer-article-methods))
- (gnus-check-server gnus-override-method)
- ;; Fetch the header, and display the article.
- (when (setq number (gnus-summary-insert-subject message-id))
+ (when (and (gnus-check-server gnus-override-method)
+ ;; Fetch the header,
+ (setq number (gnus-summary-insert-subject message-id)))
+ ;; and display the article.
(gnus-summary-select-article nil nil nil number)
(throw 'found t)))
(gnus-message 3 "Couldn't fetch article %s" message-id)))))))
to guess what the document format is."
(interactive "P")
(let ((conf gnus-current-window-configuration))
- (save-excursion
- (gnus-summary-select-article))
+ (save-window-excursion
+ (save-excursion
+ (let (gnus-article-prepare-hook
+ gnus-display-mime-function
+ gnus-break-pages)
+ (gnus-summary-select-article))))
(setq gnus-current-window-configuration conf)
(let* ((name (format "%s-%d"
(gnus-group-prefixed-name
gnus-newsgroup-name (list 'nndoc ""))
- (save-excursion
- (set-buffer gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
gnus-current-article)))
(ogroup gnus-newsgroup-name)
(params (append (gnus-info-params (gnus-get-info ogroup))
(list (cons 'to-group ogroup))
+ (list (cons 'parent-group ogroup))
(list (cons 'save-article-group ogroup))))
(case-fold-search t)
(buf (current-buffer))
documents as newsgroups.
Obeys the standard process/prefix convention."
(interactive "P")
- (let* ((articles (gnus-summary-work-articles n))
- (ogroup gnus-newsgroup-name)
+ (let* ((ogroup gnus-newsgroup-name)
(params (append (gnus-info-params (gnus-get-info ogroup))
(list (cons 'to-group ogroup))))
- article group egroup groups vgroup)
- (while (setq article (pop articles))
+ group egroup groups vgroup)
+ (dolist (article (gnus-summary-work-articles n))
(setq group (format "%s-%d" gnus-newsgroup-name article))
(gnus-summary-remove-process-mark article)
(when (gnus-summary-display-article article)
;; the wrong guess.
(message-narrow-to-head)
(goto-char (point-min))
- (delete-matching-lines "^\\(Path\\):\\|^From ")
+ (delete-matching-lines "^Path:\\|^From ")
(widen)
(if (setq egroup
(gnus-group-read-ephemeral-group
(let ((gnus-last-article gnus-last-article))
(if (gnus-summary-search-article regexp backward)
(gnus-summary-show-thread)
- (error "Search failed: \"%s\"" regexp))))
+ (signal 'search-failed (list regexp)))))
(defun gnus-summary-search-article-backward (regexp)
"Search for an article containing REGEXP backward."
(gnus-use-article-prefetch nil)
(gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay.
(gnus-use-trees nil) ;Inhibit updating tree buffer.
+ (gnus-visual nil)
+ (gnus-keep-backlog nil)
+ (gnus-break-pages nil)
+ (gnus-summary-display-arrow nil)
+ (gnus-updated-mode-lines nil)
+ (gnus-auto-center-summary nil)
(sum (current-buffer))
(gnus-display-mime-function nil)
(found nil)
(gnus-eval-in-buffer-window gnus-article-buffer
(widen)
(goto-char (point-min))
- (when gnus-page-broken
+ (when gnus-break-pages
(gnus-narrow-to-page))))
(defun gnus-summary-end-of-article ()
(widen)
(goto-char (point-max))
(recenter -3)
- (when gnus-page-broken
+ (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)
"[()]" "\\\\\\&"))
(defun gnus-summary-print-article (&optional filename n)
- "Generate and print a PostScript image of the N next (mail) articles.
+ "Generate and print a PostScript image of the process-marked (mail) articles.
+
+If used interactively, print the current article if none are
+process-marked. With prefix arg, prompt the user for the name of the
+file to save in.
-If N is negative, print the N previous articles. If N is nil and articles
-have been marked with the process mark, print these instead.
+When used from Lisp, accept two optional args FILENAME and N. N means
+to print the next N articles. If N is negative, print the N previous
+articles. If N is nil and articles have been marked with the process
+mark, print these instead.
If the optional first argument FILENAME is nil, send the image to the
printer. If FILENAME is a string, save the PostScript image in a file with
(progn
(copy-to-buffer buffer (point-min) (point-max))
(set-buffer buffer)
- (gnus-article-delete-invisible-text)
(gnus-remove-text-with-property 'gnus-decoration)
(when (gnus-visual-p 'article-highlight 'highlight)
;; Copy-to-buffer doesn't copy overlay. So redo
;; highlight.
(let ((gnus-article-buffer buffer))
(gnus-article-highlight-citation t)
- (gnus-article-highlight-signature)))
+ (gnus-article-highlight-signature)
+ (gnus-article-emphasize)
+ (gnus-article-delete-invisible-text)))
(let ((ps-left-header
(list
(concat "("
defined in `gnus-summary-show-article-charset-alist', or the charset
input.
If ARG (the prefix) is non-nil and not a number, show the raw article
-without any article massaging functions being run. Normally, the key strokes
-are `C-u g'."
+without any article massaging functions being run. Normally, the key
+strokes are `C-u g'."
(interactive "P")
(cond
((numberp arg)
(or (cdr (assq arg gnus-summary-show-article-charset-alist))
(mm-read-coding-system
"View as charset: " ;; actually it is coding system.
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(mm-detect-coding-region (point) (point-max))))))
(gnus-newsgroup-ignored-charsets 'gnus-all))
(gnus-summary-select-article nil 'force)
(inhibit-point-motion-hooks t)
(hidden (if (numberp arg)
(>= arg 0)
- (gnus-article-hidden-text-p 'headers)))
+ (or (not (looking-at "[^ \t\n]+:"))
+ (gnus-article-hidden-text-p 'headers))))
s e)
(delete-region (point-min) (point-max))
(with-current-buffer gnus-original-article-buffer
(1- (point))
(point-max))))
(insert-buffer-substring gnus-original-article-buffer s e)
- (article-decode-encoded-words)
+ (run-hooks 'gnus-article-decode-hook)
(if hidden
(let ((gnus-treat-hide-headers nil)
(gnus-treat-hide-boring-headers nil))
(widen)
(if window
(set-window-start window (goto-char (point-min))))
- (setq gnus-page-broken
- (when gnus-break-pages
- (gnus-narrow-to-page)
- t))
+ (if gnus-break-pages
+ (gnus-narrow-to-page)
+ (when (gnus-visual-p 'page-marker)
+ (let ((buffer-read-only nil))
+ (gnus-remove-text-with-property 'gnus-prev)
+ (gnus-remove-text-with-property 'gnus-next))))
(gnus-set-mode-line 'article)))))
(defun gnus-summary-show-all-headers ()
(let ((start (window-start))
buffer-read-only)
(message-caesar-buffer-body arg)
- (set-window-start (get-buffer-window (current-buffer)) start))))))
+ (set-window-start (get-buffer-window (current-buffer)) start)))))
+ ;; Create buttons and stuff...
+ (gnus-treat-article nil))
+
+(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/')
+installed for this command to work."
+ (interactive "P")
+ (if (not (and (condition-case nil (require 'idna)
+ (file-error))
+ (mm-coding-system-p 'utf-8)
+ (executable-find (symbol-value 'idna-program))))
+ (gnus-message
+ 5 "GNU Libidn not installed properly (`idn' or `idna.el' missing)")
+ (gnus-summary-select-article)
+ (let ((mail-header-separator ""))
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (save-restriction
+ (widen)
+ (let ((start (window-start))
+ buffer-read-only)
+ (while (re-search-forward "\\(xn--[-0-9a-z]+\\)" nil t)
+ (replace-match (idna-to-unicode (match-string 1))))
+ (set-window-start (get-buffer-window (current-buffer)) start)))))))
(autoload 'unmorse-region "morse"
"Convert morse coded text in region to ordinary ASCII text."
(when (message-goto-body)
(gnus-narrow-to-body))
(goto-char (point-min))
- (while (re-search-forward "·" (point-max) t)
+ (while (search-forward "·" (point-max) t)
(replace-match "."))
(unmorse-region (point-min) (point-max))
(widen)
(let ((articles (gnus-summary-work-articles n))
(prefix (if (gnus-check-backend-function
'request-move-article gnus-newsgroup-name)
- (gnus-group-real-prefix gnus-newsgroup-name)
+ (funcall gnus-move-group-prefix-function
+ gnus-newsgroup-name)
""))
(names '((move "Move" "Moving")
(copy "Copy" "Copying")
(crosspost "Crosspost" "Crossposting")))
(copy-buf (save-excursion
(nnheader-set-temp-buffer " *copy article*")))
- art-group to-method new-xref article to-groups)
+ art-group to-method new-xref article to-groups articles-to-update-marks)
(unless (assq action names)
(error "Unknown action %s" action))
;; Read the newsgroup name.
((eq action 'move)
;; Remove this article from future suppression.
(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)))
(gnus-request-move-article
article ; Article to move
gnus-newsgroup-name ; From newsgroup
(list 'gnus-request-accept-article
to-newsgroup (list 'quote select-method)
(not articles) t) ; Accept form
- (not articles))) ; Only save nov last time
+ (not articles) ; Only save nov last time
+ move-is-internal))) ; is this move internal?
;; Copy the article.
((eq action 'copy)
(save-excursion
(set-buffer copy-buf)
(when (gnus-request-article-this-buffer article gnus-newsgroup-name)
+ (save-restriction
+ (nnheader-narrow-to-headers)
+ (dolist (hdr gnus-copy-article-ignored-headers)
+ (message-remove-header hdr t)))
(gnus-request-accept-article
to-newsgroup select-method (not articles) t))))
;; Crosspost the article.
((eq art-group 'junk)
(when (eq action 'move)
(gnus-summary-mark-article article gnus-canceled-mark)
- (gnus-message 4 "Deleted article %s" article)))
+ (gnus-message 4 "Deleted article %s" article)
+ ;; run the delete hook
+ (run-hook-with-args 'gnus-summary-article-delete-hook
+ action
+ (gnus-data-header
+ (assoc article (gnus-data-list nil)))
+ gnus-newsgroup-name nil
+ select-method)))
(t
(let* ((pto-group (gnus-group-prefixed-name
(car art-group) to-method))
- (entry
- (gnus-gethash pto-group gnus-newsrc-hashtb))
- (info (nth 2 entry))
+ (info (gnus-get-info pto-group))
(to-group (gnus-info-group info))
to-marks)
;; Update the group that has been moved to.
(list (cdr art-group)))))
;; See whether the article is to be put in the cache.
- (let ((marks gnus-article-mark-lists)
+ (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)))
;; Enter the article into the cache in the new group,
(gnus-request-article-this-buffer article gnus-newsgroup-name)
(nnheader-replace-header "Xref" new-xref)
(gnus-request-replace-article
- article gnus-newsgroup-name (current-buffer)))))
+ article gnus-newsgroup-name (current-buffer))))
+
+ ;; run the move/copy/crosspost/respool hook
+ (run-hook-with-args 'gnus-summary-article-move-hook
+ action
+ (gnus-data-header
+ (assoc article (gnus-data-list nil)))
+ gnus-newsgroup-name
+ to-newsgroup
+ select-method))
;;;!!!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))))
- (gnus-summary-remove-process-mark article))
+ (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)
(let ((gnus-group-marked to-groups))
(gnus-group-get-new-news-this-group nil t)))
-
+
(gnus-kill-buffer copy-buf)
(gnus-summary-position-point)
(gnus-set-mode-line 'summary)))
(defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
- "Move the current article to a different newsgroup.
-If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
+ "Copy the current article to some other group.
+If TO-NEWSGROUP is string, do not prompt for a newsgroup to copy to.
When called interactively, if TO-NEWSGROUP is nil, use the value of
the variable `gnus-move-split-methods' for finding a default target
newsgroup.
:group 'gnus-summary-mail)
(defcustom gnus-summary-display-while-building nil
- "If not-nil, show and update the summary buffer as it's being built.
+ "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
gnus-newsgroup-name)))))
(method
(gnus-completing-read-with-default
- methname "What backend do you want to use when respooling?"
+ methname "Backend to use when respooling"
methods nil t nil 'gnus-mail-method-history))
ms)
(cond
(defun gnus-summary-expire-articles (&optional now)
"Expire all articles that are marked as expirable in the current group."
(interactive)
- (when (gnus-check-backend-function
- 'request-expire-articles gnus-newsgroup-name)
+ (when (and (not gnus-group-is-exiting-without-update-p)
+ (gnus-check-backend-function
+ 'request-expire-articles gnus-newsgroup-name))
;; This backend supports expiry.
(let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
(expirable (if total
(dolist (article expirable)
(when (and (not (memq article es))
(gnus-data-find article))
- (gnus-summary-mark-article article gnus-canceled-mark))))))
+ (gnus-summary-mark-article article gnus-canceled-mark)
+ (run-hook-with-args 'gnus-summary-article-expire-hook
+ 'delete
+ (gnus-data-header
+ (assoc article (gnus-data-list nil)))
+ gnus-newsgroup-name
+ nil
+ nil))))))
(gnus-message 6 "Expiring articles...done")))))
(defun gnus-summary-expire-articles-now ()
This command actually deletes articles. This is not a marking
command. The article will disappear forever from your life, never to
return.
+
If N is negative, delete backwards.
If N is nil and articles have been marked with the process mark,
-delete these instead."
+delete these instead.
+
+If `gnus-novice-user' is non-nil you will be asked for
+confirmation before the articles are deleted."
(interactive "P")
(unless (gnus-check-backend-function 'request-expire-articles
gnus-newsgroup-name)
;; 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)))
`(lambda ()
(let ((mbl mml-buffer-list))
(setq mml-buffer-list nil)
- (mime-to-mml ,'current-handles)
+ (let ((rfc2047-quote-decoded-words-containing-tspecials t))
+ (mime-to-mml ,'current-handles))
(let ((mbl1 mml-buffer-list))
(setq mml-buffer-list mbl)
(set (make-local-variable 'mml-buffer-list) mbl1))
- (make-local-hook 'kill-buffer-hook)
+ (gnus-make-local-hook 'kill-buffer-hook)
(add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))))
`(lambda (no-highlight)
(let ((mail-parse-charset ',gnus-newsgroup-charset)
(save-excursion
(save-restriction
(message-narrow-to-head)
- (let ((head (buffer-string))
+ (let ((head (buffer-substring-no-properties
+ (point-min) (point-max)))
header)
(with-temp-buffer
(insert (format "211 %d Article retrieved.\n"
(gnus-summary-select-article)
(save-excursion
(set-buffer gnus-original-article-buffer)
- (save-restriction
- (message-narrow-to-head)
- (let ((groups (nnmail-article-group 'identity trace)))
- (unless silent
- (if groups
- (message "This message would go to %s"
- (mapconcat 'car groups ", "))
- (message "This message would go to no groups"))
- groups))))))
+ (let ((groups (nnmail-article-group 'identity trace)))
+ (unless silent
+ (if groups
+ (message "This message would go to %s"
+ (mapconcat 'car groups ", "))
+ (message "This message would go to no groups"))
+ groups)))))
(defun gnus-summary-respool-trace ()
"Trace where the respool algorithm would put this article.
;; (article-number . line-number-in-body).
(push
(cons article
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(count-lines
(min (point)
(save-excursion
(gnus-summary-goto-subject article)
(gnus-summary-update-secondary-mark article)))
-(defun gnus-summary-remove-process-mark (article)
- "Remove the process mark from ARTICLE and update the summary line."
- (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
- (when (gnus-summary-goto-subject article)
- (gnus-summary-show-thread)
- (gnus-summary-goto-subject article)
- (gnus-summary-update-secondary-mark article)))
+(defun gnus-summary-remove-process-mark (&rest articles)
+ "Remove the process mark from ARTICLES and update the summary line."
+ (dolist (article articles)
+ (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
+ (when (gnus-summary-goto-subject article)
+ (gnus-summary-show-thread)
+ (gnus-summary-goto-subject article)
+ (gnus-summary-update-secondary-mark article)))
+ t)
(defun gnus-summary-set-saved-mark (article)
"Set the process mark on ARTICLE and update the summary line."
t)
(defun gnus-summary-update-download-mark (article)
- "Update the secondary (read, process, cache) mark."
+ "Update the download mark."
(gnus-summary-update-mark
- (cond ((memq article gnus-newsgroup-undownloaded)
+ (cond ((memq article gnus-newsgroup-undownloaded)
gnus-undownloaded-mark)
(gnus-newsgroup-agentized
gnus-downloaded-mark)
(defun gnus-summary-update-mark (mark type)
(let ((forward (cdr (assq type gnus-summary-mark-positions)))
(buffer-read-only nil))
- (re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit)
+ (re-search-backward "[\n\r]" (point-at-bol) 'move-to-limit)
(when forward
(when (looking-at "\r")
(incf forward))
(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 ()
+(defun gnus-summary-mark-read-and-unread-as-read (&optional new-mark)
+ "Intended to be used by `gnus-summary-mark-article-hook'."
+ (let ((mark (gnus-summary-article-mark)))
+ (when (or (gnus-unread-mark-p mark)
+ (gnus-read-mark-p mark))
+ (gnus-summary-mark-article gnus-current-article
+ (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'."
(let ((mark (gnus-summary-article-mark)))
(when (or (gnus-unread-mark-p mark)
(gnus-read-mark-p mark))
- (gnus-summary-mark-article gnus-current-article gnus-read-mark))))
+ (gnus-summary-mark-article (gnus-summary-article-number)
+ (or new-mark gnus-read-mark)))))
(defun gnus-summary-mark-unread-as-ticked ()
"Intended to be used by `gnus-summary-mark-article-hook'."
If prefix argument ALL is non-nil, ticked and dormant articles will
also be marked as read.
If QUIETLY is non-nil, no questions will be asked.
+
If TO-HERE is non-nil, it should be a point in the buffer. All
-articles before (after, if REVERSE is set) this point will be marked as read.
+articles before (after, if REVERSE is set) this point will be marked
+as read.
+
Note that this function will only catch up the unread article
in the current summary buffer limitation.
+
The number of articles marked as read is returned."
(interactive "P")
(prog1
(if (and to-here reverse)
(progn
(goto-char to-here)
- (while (and
- (gnus-summary-mark-article-as-read gnus-catchup-mark)
- (gnus-summary-find-next (not all)))))
+ (gnus-summary-mark-current-read-and-unread-as-read
+ gnus-catchup-mark)
+ (while (gnus-summary-find-next (not all))
+ (gnus-summary-mark-article-as-read gnus-catchup-mark)))
(when (gnus-summary-first-subject (not all))
(while (and
(if to-here (< (point) to-here) t)
(gnus-summary-position-point))
(defun gnus-summary-catchup-from-here (&optional all)
- "Mark all unticked articles after the current one as read.
+ "Mark all unticked articles after (and including) the current one as read.
If ALL is non-nil, also mark ticked and dormant articles as read."
(interactive "P")
(save-excursion
;; We check that there are unread articles.
(when (or all (gnus-summary-find-next))
(gnus-summary-catchup all t beg nil t)))))
-
(gnus-summary-position-point))
+
(defun gnus-summary-catchup-all (&optional quietly)
"Mark all articles in this newsgroup as read.
This command is dangerous. Normally, you want \\[gnus-summary-catchup]
(gnus-summary-catchup all))
(gnus-summary-next-group))
+(defun gnus-summary-catchup-and-goto-prev-group (&optional all)
+ "Mark all articles in this group as read and select the previous group.
+If given a prefix, mark all articles, unread as well as ticked, as
+read."
+ (interactive "P")
+ (save-excursion
+ (gnus-summary-catchup all))
+ (gnus-summary-next-group nil nil t))
+
;;;
;;; with article
;;;
(interactive)
(let ((buffer-read-only nil)
(orig (point))
- ;; first goto end then to beg, to have point at beg after let
- (end (progn (end-of-line) (point)))
+ (end (point-at-eol))
+ ;; Leave point at bol
(beg (progn (beginning-of-line) (point))))
(prog1
;; Any hidden lines here?
gnus-thread-hide-subtree)
(gnus-summary-hide-all-threads
(if (or (consp gnus-thread-hide-subtree)
- (gnus-functionp gnus-thread-hide-subtree))
+ (functionp gnus-thread-hide-subtree))
(gnus-make-predicate gnus-thread-hide-subtree)
nil))))
(defun gnus-map-articles (predicate articles)
"Map PREDICATE over ARTICLES and return non-nil if any predicate is non-nil."
(apply 'gnus-or (mapcar predicate
- (mapcar 'gnus-summary-article-header articles))))
+ (mapcar (lambda (number)
+ (gnus-summary-article-header number))
+ articles))))
(defun gnus-summary-hide-all-threads (&optional predicate)
"Hide all thread subtrees.
(interactive "P")
(gnus-summary-sort 'author reverse))
+(defun gnus-summary-sort-by-recipient (&optional reverse)
+ "Sort the summary buffer by recipient name alphabetically.
+If `case-fold-search' is non-nil, case of letters is ignored.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'recipient reverse))
+
(defun gnus-summary-sort-by-subject (&optional reverse)
"Sort the summary buffer by subject alphabetically. `Re:'s are ignored.
If `case-fold-search' is non-nil, case of letters is ignored.
;; Regular expression.
(ignore-errors
(re-search-forward match nil t)))
- ((gnus-functionp match)
+ ((functionp match)
;; Function.
(save-restriction
(widen)
(let* ((split-name (gnus-get-split-value gnus-move-split-methods))
(minibuffer-confirm-incomplete nil) ; XEmacs
(prom
- (format "%s %s to:"
+ (format "%s %s to"
prompt
(if (> (length articles) 1)
(format "these %d articles" (length articles))
(t
(gnus-completing-read-with-default
nil prom
- (mapcar (lambda (el) (list el))
- (nreverse split-name))
+ (mapcar 'list (nreverse split-name))
nil nil nil
'gnus-group-history))))
(to-method (gnus-server-to-method (gnus-group-method to-newsgroup))))
(not (string-match type (mm-handle-media-type handle)))
(string-match type (mm-handle-media-type handle)))
(let ((file (expand-file-name
- (file-name-nondirectory
- (or
- (mail-content-type-get
- (mm-handle-disposition handle) 'filename)
- (concat gnus-newsgroup-name
- "." (number-to-string
- (cdr gnus-article-current)))))
+ (gnus-map-function
+ mm-file-name-rewrite-functions
+ (file-name-nondirectory
+ (or
+ (mail-content-type-get
+ (mm-handle-disposition handle) 'filename)
+ (mail-content-type-get
+ (mm-handle-type handle) 'name)
+ (concat gnus-newsgroup-name
+ "." (number-to-string
+ (cdr gnus-article-current))))))
dir)))
(unless (file-exists-p file)
(mm-save-part-to-file handle file))))))
(lambda (f)
(if (equal f " ")
f
- (mm-quote-arg f)))
+ (shell-quote-argument f)))
files " ")))))
(setq ps (cdr ps)))))
(if (and gnus-view-pseudos (not not-view))
(not (gnus-summary-article-sparse-p (mail-header-number header))))
;; We have found the header.
header
- ;; If this is a sparse article, we have to nix out its
- ;; previous entry in the thread hashtb.
- (when (and header
- (gnus-summary-article-sparse-p (mail-header-number header)))
- (let* ((parent (gnus-parent-id (mail-header-references header)))
- (thread (and parent (gnus-id-to-thread parent))))
- (when thread
- (delq (assq header thread) thread))))
;; We have to really fetch the header to this article.
(save-excursion
(set-buffer nntp-server-buffer)
;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
(when gnus-summary-selected-face
(save-excursion
- (let* ((beg (progn (beginning-of-line) (point)))
- (end (progn (end-of-line) (point)))
+ (let* ((beg (point-at-bol))
+ (end (point-at-eol))
;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
(from (if (get-text-property beg gnus-mouse-face-prop)
beg
(defvar gnus-summary-highlight-line-trigger nil)
(defun gnus-summary-highlight-line-0 ()
- (if (and (eq gnus-summary-highlight-line-trigger
+ (if (and (eq gnus-summary-highlight-line-trigger
gnus-summary-highlight)
gnus-summary-highlight-line-cached)
gnus-summary-highlight-line-cached
(c cond)
(list gnus-summary-highlight))
(while list
- (setcdr c (cons (list (caar list) (list 'quote (cdar list))) nil))
+ (setcdr c (cons (list (caar list) (list 'quote (cdar list)))
+ nil))
(setq c (cdr c)
list (cdr list)))
(gnus-byte-compile (list 'lambda nil cond))))))
(defun gnus-summary-highlight-line ()
"Highlight current line according to `gnus-summary-highlight'."
- (let* ((beg (gnus-point-at-bol))
+ (let* ((beg (point-at-bol))
(article (or (gnus-summary-article-number) gnus-current-article))
(score (or (cdr (assq article
gnus-newsgroup-scored))
(default gnus-summary-default-score)
(default-high gnus-summary-default-high-score)
(default-low gnus-summary-default-low-score)
- (uncached (memq article gnus-newsgroup-undownloaded))
- (downloaded (not uncached)))
+ (uncached (and gnus-summary-use-undownloaded-faces
+ (memq article gnus-newsgroup-undownloaded)
+ (not (memq article gnus-newsgroup-cached)))))
(let ((face (funcall (gnus-summary-highlight-line-0))))
(unless (eq face (get-text-property beg 'face))
(gnus-put-text-property-excluding-characters-with-faces
- beg (gnus-point-at-eol) 'face
+ beg (point-at-eol) 'face
(setq face (if (boundp face) (symbol-value face) face)))
(when gnus-summary-highlight-line-function
(funcall gnus-summary-highlight-line-function article face))))))
(defun gnus-update-read-articles (group unread &optional compute)
"Update the list of read articles in GROUP.
UNREAD is a sorted list."
- (let* ((active (or gnus-newsgroup-active (gnus-active group)))
- (entry (gnus-gethash group gnus-newsrc-hashtb))
- (info (nth 2 entry))
- (prev 1)
- read)
+ (let ((active (or gnus-newsgroup-active (gnus-active group)))
+ (info (gnus-get-info group))
+ (prev 1)
+ read)
(if (or (not info) (not active))
;; There is no info on this group if it was, in fact,
;; killed. Gnus stores no information on killed groups, so
(dolist (buffer (buffer-list))
(when (and (setq buffer (buffer-name buffer))
(string-match "Summary" buffer)
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
;; We check that this is, indeed, a summary buffer.
(and (eq major-mode 'gnus-summary-mode)
;; Also make sure this isn't bogus.
(insert "Mime-Version: 1.0\n")
(widen)
(when (search-forward "\n--" nil t)
- (let ((separator (buffer-substring (point) (gnus-point-at-eol))))
+ (let ((separator (buffer-substring (point) (point-at-eol))))
(message-narrow-to-head)
(message-remove-header "Content-Type")
(goto-char (point-max))
(mail-header-number h))
gnus-newsgroup-headers)))
(setq gnus-newsgroup-headers
- (merge 'list
- gnus-newsgroup-headers
- (gnus-fetch-headers articles)
- 'gnus-article-sort-by-number))
+ (gnus-merge 'list
+ gnus-newsgroup-headers
+ (gnus-fetch-headers articles)
+ 'gnus-article-sort-by-number))
;; Suppress duplicates?
(when gnus-suppress-duplicates
(gnus-dup-suppress-articles))
(push i new)
(decf i))
(if (not new)
- (message "No gnus is bad news.")
+ (message "No gnus is bad news")
(gnus-summary-insert-articles new)
(setq gnus-newsgroup-unreads
(gnus-sorted-nunion gnus-newsgroup-unreads new))
(run-hooks 'gnus-sum-load-hook)
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
+;; arch-tag: 17c6748f-6d00-4d36-bf01-835c42f31235
;;; gnus-sum.el ends here