;;; gnus-sum.el --- summary mode commands for Gnus
-;; Copyright (C) 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Keywords: news
;;; Code:
+(eval-when-compile (require 'cl))
+
(require 'gnus)
(require 'gnus-group)
(require 'gnus-spec)
(require 'gnus-range)
(require 'gnus-int)
(require 'gnus-undo)
-
-(defgroup gnus-summary nil
- "Summary buffers."
- :group 'gnus)
+(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
(defcustom gnus-kill-summary-on-exit t
"*If non-nil, kill the summary buffer when you exit from it.
If nil, the summary will become a \"*Dead Summary*\" buffer, and
it will be killed sometime later."
- :group 'gnus-summary
+ :group 'gnus-summary-exit
:type 'boolean)
(defcustom gnus-fetch-old-headers nil
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.
+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
+old headers will be fetched, but none will be displayed.
The server has to support NOV for any of this to work."
- :group 'gnus-summary
+ :group 'gnus-thread
:type '(choice (const :tag "off" nil)
(const some)
number
(sexp :menu-tag "other" t)))
+(defcustom gnus-refer-thread-limit 200
+ "*The number of old headers to fetch when doing \\<gnus-summary-mode-map>\\[gnus-summary-refer-thread].
+If t, fetch all the available old headers."
+ :group 'gnus-thread
+ :type '(choice number
+ (sexp :menu-tag "other" t)))
+
(defcustom gnus-summary-make-false-root 'adopt
"*nil means that Gnus won't gather loose threads.
If the root of a thread has expired or been read in a previous
If this variable is `empty', the \"children\" are printed with empty
subject fields. (Or rather, they will be printed with a string
given by the `gnus-summary-same-subject' variable.)"
- :group 'gnus-summary
+ :group 'gnus-thread
:type '(choice (const :tag "off" nil)
(const none)
(const dummy)
As loose thread gathering is done on subjects only, that means that
there can be many false gatherings performed. By rooting out certain
common subjects, gathering might become saner."
- :group 'gnus-summary
+ :group 'gnus-thread
:type 'regexp)
(defcustom gnus-summary-gather-subject-limit nil
If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
comparing subjects."
- :group 'gnus-summary
+ :group 'gnus-thread
:type '(choice (const :tag "off" nil)
(const fuzzy)
(sexp :menu-tag "on" t)))
+(defcustom gnus-simplify-subject-functions nil
+ "List of functions taking a string argument that simplify subjects.
+The functions are applied recursively.
+
+Useful functions to put in this list include: `gnus-simplify-subject-re',
+`gnus-simplify-subject-fuzzy' and `gnus-simplify-whitespace'."
+ :group 'gnus-thread
+ :type '(repeat function))
+
(defcustom gnus-simplify-ignored-prefixes nil
"*Regexp, matches for which are removed from subject lines when simplifying fuzzily."
- :group 'gnus-summary
+ :group 'gnus-thread
:type '(choice (const :tag "off" nil)
regexp))
If `some', only fill in the gaps that are needed to tie loose threads
together. If `more', fill in all leaf nodes that Gnus can find. If
non-nil and non-`some', fill in all gaps that Gnus manages to guess."
- :group 'gnus-summary
+ :group 'gnus-thread
:type '(choice (const :tag "off" nil)
(const some)
(const more)
(sexp :menu-tag "all" t)))
-(defcustom gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject
- "Function used for gathering loose threads.
+(defcustom gnus-summary-thread-gathering-function
+ 'gnus-gather-threads-by-subject
+ "*Function used for gathering loose threads.
There are two pre-defined functions: `gnus-gather-threads-by-subject',
which only takes Subjects into consideration; and
`gnus-gather-threads-by-references', which compared the References
headers of the articles to find matches."
- :group 'gnus-summary
- :type '(set (function-item gnus-gather-threads-by-subject)
- (function-item gnus-gather-threads-by-references)
- (function :tag "other")))
+ :group 'gnus-thread
+ :type '(radio (function-item gnus-gather-threads-by-subject)
+ (function-item gnus-gather-threads-by-references)
+ (function :tag "other")))
-;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
(defcustom gnus-summary-same-subject ""
"*String indicating that the current article has the same subject as the previous.
This variable will only be used if the value of
`gnus-summary-make-false-root' is `empty'."
- :group 'gnus-summary
+ :group 'gnus-summary-format
:type 'string)
(defcustom gnus-summary-goto-unread t
If `never', commands that usually go to the next unread article, will
go to the next article, whether it is read or not.
If nil, only the marking commands will go to the next (un)read article."
- :group 'gnus-summary
+ :group 'gnus-summary-marks
+ :link '(custom-manual "(gnus)Setting Marks")
:type '(choice (const :tag "off" nil)
(const never)
(sexp :menu-tag "on" t)))
(defcustom gnus-summary-default-score 0
"*Default article score level.
+All scores generated by the score files will be added to this score.
If this variable is nil, scoring will be disabled."
- :group 'gnus-summary
+ :group 'gnus-score-default
:type '(choice (const :tag "disable")
integer))
"*Fuzziness factor for the zcore in the summary buffer.
Articles with scores closer than this to `gnus-summary-default-score'
will not be marked."
- :group 'gnus-summary
+ :group 'gnus-summary-format
:type 'integer)
(defcustom gnus-simplify-subject-fuzzy-regexp nil
This can either be a regular expression or list of regular expressions
that will be removed from subject strings if fuzzy subject
simplification is selected."
- :group 'gnus-summary
+ :group 'gnus-thread
:type '(repeat regexp))
(defcustom gnus-show-threads t
"*If non-nil, display threads in summary mode."
- :group 'gnus-summary
+ :group 'gnus-thread
:type 'boolean)
(defcustom gnus-thread-hide-subtree nil
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."
- :group 'gnus-summary
+ :group 'gnus-thread
:type 'boolean)
(defcustom gnus-thread-hide-killed t
"*If non-nil, hide killed threads automatically."
- :group 'gnus-summary
+ :group 'gnus-thread
:type 'boolean)
(defcustom gnus-thread-ignore-subject nil
"*If non-nil, ignore subjects and do all threading based on the Reference header.
If nil, which is the default, articles that have different subjects
from their parents will start separate threads."
- :group 'gnus-summary
+ :group 'gnus-thread
:type 'boolean)
(defcustom gnus-thread-operation-ignore-subject t
subjects will not be included in the operation in question. If this
variable is `fuzzy', only articles that have subjects that are fuzzily
equal will be included."
- :group 'gnus-summary
+ :group 'gnus-thread
:type '(choice (const :tag "off" nil)
(const fuzzy)
(sexp :tag "on" t)))
(defcustom gnus-thread-indent-level 4
"*Number that says how much each sub-thread should be indented."
- :group 'gnus-summary
+ :group 'gnus-thread
:type 'integer)
(defcustom gnus-auto-extend-newsgroup t
"*If non-nil, extend newsgroup forward and backward when requested."
- :group 'gnus-summary
+ :group 'gnus-summary-choose
:type 'boolean)
(defcustom gnus-auto-select-first t
If you want to prevent automatic selection of the first unread article
in some newsgroups, set the variable to nil in
`gnus-select-group-hook'."
- :group 'gnus-summary
+ :group 'gnus-group-select
:type '(choice (const :tag "none" nil)
(const best)
(sexp :menu-tag "first" t)))
confirmation if you are located on the last article in the group.
Finally, if this variable is `slightly-quietly', the `Z n' command
will go to the next group without confirmation."
- :group 'gnus-summary
+ :group 'gnus-summary-maneuvering
:type '(choice (const :tag "off" nil)
(const quietly)
(const almost-quietly)
(defcustom gnus-auto-select-same nil
"*If non-nil, select the next article with the same subject."
- :group 'gnus-summary
+ :group 'gnus-summary-maneuvering
:type 'boolean)
(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
current article is unread."
- :group 'gnus-summary
+ :group 'gnus-summary-maneuvering
:type 'boolean)
(defcustom gnus-auto-center-summary t
"*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."
- :group 'gnus-summary
+ :group 'gnus-summary-maneuvering
:type '(choice (const :tag "none" nil)
(const vertical)
(sexp :menu-tag "both" t)))
(defcustom gnus-show-all-headers nil
"*If non-nil, don't hide any headers."
- :group 'gnus-summary
+ :group 'gnus-article-hiding
+ :group 'gnus-article-headers
:type 'boolean)
+(defcustom gnus-summary-ignore-duplicates nil
+ "*If non-nil, ignore articles with identical Message-ID headers."
+ :group 'gnus-summary
+ :type 'boolean)
+
(defcustom gnus-single-article-buffer t
"*If non-nil, display all articles in the same buffer.
If nil, each group will get its own article buffer."
- :group 'gnus-summary
+ :group 'gnus-article-various
:type 'boolean)
(defcustom gnus-break-pages t
"*If non-nil, do page breaking on articles.
The page delimiter is specified by the `gnus-page-delimiter'
variable."
- :group 'gnus-summary
+ :group 'gnus-article-various
:type 'boolean)
(defcustom gnus-show-mime nil
"*If non-nil, do mime processing of articles.
The articles will simply be fed to the function given by
`gnus-show-mime-method'."
- :group 'gnus-summary
+ :group 'gnus-article-mime
:type 'boolean)
(defcustom gnus-move-split-methods nil
"*Variable used to suggest where articles are to be moved to.
It uses the same syntax as the `gnus-split-methods' variable."
- :group 'gnus-summary
- :type '(repeat (choice (list function)
- (cons regexp (repeat string))
- sexp)))
-
-;; Mark variables suggested by Thomas Michanek
-;; <Thomas.Michanek@telelogic.se>.
-
-(defgroup gnus-summary-marks nil
- "Marks used in summary buffers."
- :group 'gnus-summary)
+ :group 'gnus-summary-mail
+ :type '(repeat (choice (list :value (fun) function)
+ (cons :value ("" "") regexp (repeat string))
+ (sexp :value nil))))
(defcustom gnus-unread-mark ?
"*Mark used for unread articles."
:group 'gnus-summary-marks
:type 'character)
+(defcustom gnus-undownloaded-mark ?@
+ "*Mark used for articles that weren't downloaded."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-downloadable-mark ?%
+ "*Mark used for articles that are to be downloaded."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-unsendable-mark ?=
+ "*Mark used for articles that won't be sent."
+ :group 'gnus-summary-marks
+ :type 'character)
+
(defcustom gnus-score-over-mark ?+
"*Score mark used for articles with high scores."
:group 'gnus-summary-marks
(defcustom gnus-view-pseudo-asynchronously nil
"*If non-nil, Gnus will view pseudo-articles asynchronously."
- :group 'gnus-summary
+ :group 'gnus-extract-view
:type 'boolean)
(defcustom gnus-view-pseudos nil
"*If `automatic', pseudo-articles will be viewed automatically.
If `not-confirm', pseudos will be viewed automatically, and the user
will not be asked to confirm the command."
- :group 'gnus-summary
+ :group 'gnus-extract-view
:type '(choice (const :tag "off" nil)
(const automatic)
(const not-confirm)))
"*If non-nil, one pseudo-article will be created for each file to be viewed.
If nil, all files that use the same viewing command will be given as a
list of parameters to that command."
- :group 'gnus-summary
+ :group 'gnus-extract-view
:type 'boolean)
(defcustom gnus-insert-pseudo-articles t
"*If non-nil, insert pseudo-articles when decoding articles."
- :group 'gnus-summary
+ :group 'gnus-extract-view
:type 'boolean)
(defcustom gnus-summary-dummy-line-format
- "* %(: :%) %S\n"
+ " %(: :%) %S\n"
"*The format specification for the dummy roots in the summary buffer.
It works along the same lines as a normal formatting string,
with some simple extensions.
%S The subject"
- :group 'gnus-summary
+ :group 'gnus-threading
:type 'string)
(defcustom gnus-summary-mode-line-format "Gnus: %%b [%A] %Z"
%d Number of dormant articles
%r Number of articles that have been marked as read in this session
%E Number of articles expunged by the score files"
- :group 'gnus-summary
+ :group 'gnus-summary-format
:type 'string)
(defcustom gnus-summary-mark-below 0
"*Mark all articles with a score below this variable as read.
This variable is local to each summary buffer and usually set by the
score file."
- :group 'gnus-summary
+ :group 'gnus-score-default
:type 'integer)
(defcustom gnus-article-sort-functions '(gnus-article-sort-by-number)
"*List of functions used for sorting articles in the summary buffer.
This variable is only used when not using a threaded display."
- :group 'gnus-summary
+ :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)
`gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
`gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function')."
- :group 'gnus-summary
+ :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)
subthread and should then return the score of the thread.
Some functions you can use are `+', `max', or `min'."
- :group 'gnus-summary
+ :group 'gnus-summary-sort
:type 'function)
(defcustom gnus-summary-expunge-below nil
- "All articles that have a score less than this variable will be expunged."
- :group 'gnus-summary
+ "All articles that have a score less than this variable will be expunged.
+This variable is local to the summary buffers."
+ :group 'gnus-score-default
:type '(choice (const :tag "off" nil)
integer))
(defcustom gnus-thread-expunge-below nil
"All threads that have a total score less than this variable will be expunged.
See `gnus-thread-score-function' for en explanation of what a
-\"thread score\" is."
- :group 'gnus-summary
+\"thread score\" is.
+
+This variable is local to the summary buffers."
+ :group 'gnus-treading
+ :group 'gnus-score-default
:type '(choice (const :tag "off" nil)
integer))
(defcustom gnus-summary-mode-hook nil
"*A hook for Gnus summary mode.
This hook is run before any variables are set in the summary buffer."
- :group 'gnus-summary
+ :group 'gnus-summary-various
:type 'hook)
(defcustom gnus-summary-menu-hook nil
"*Hook run after the creation of the summary mode menu."
- :group 'gnus-summary
+ :group 'gnus-summary-visual
:type 'hook)
(defcustom gnus-summary-exit-hook nil
- "*A hook called on exit from the summary buffer."
- :group 'gnus-summary
+ "*A hook called on exit from the summary buffer.
+It will be called with point in the group buffer."
+ :group 'gnus-summary-exit
:type 'hook)
(defcustom gnus-summary-prepare-hook nil
"*A hook called after the summary buffer has been generated.
If you want to modify the summary buffer, you can use this hook."
- :group 'gnus-summary
+ :group 'gnus-summary-various
+ :type 'hook)
+
+(defcustom gnus-summary-prepared-hook nil
+ "*A hook called as the last thing after the summary buffer has been generated."
+ :group 'gnus-summary-various
:type 'hook)
(defcustom gnus-summary-generate-hook nil
"*A hook run just before generating the summary buffer.
This hook is commonly used to customize threading variables and the
like."
- :group 'gnus-summary
+ :group 'gnus-summary-various
:type 'hook)
(defcustom gnus-select-group-hook nil
(gnus-simplify-subject
(mail-header-subject header) 're-only)))
gnus-newsgroup-headers))))"
- :group 'gnus-summary
+ :group 'gnus-group-select
:type 'hook)
(defcustom gnus-select-article-hook nil
"*A hook called when an article is selected."
- :group 'gnus-summary
+ :group 'gnus-summary-choose
:type 'hook)
(defcustom gnus-visual-mark-article-hook
"*Hook run after selecting an article in the summary buffer.
It is meant to be used for highlighting the article in some way. It
is not run if `gnus-visual' is nil."
- :group 'gnus-summary
+ :group 'gnus-summary-visual
:type 'hook)
-(defcustom gnus-parse-headers-hook
- (list 'gnus-decode-rfc1522)
+(defcustom gnus-structured-field-decoder 'identity
+ "Function to decode non-ASCII characters in structured field for summary."
+ :group 'gnus-various
+ :type 'function)
+
+(defcustom gnus-unstructured-field-decoder 'identity
+ "Function to decode non-ASCII characters in unstructured field for summary."
+ :group 'gnus-various
+ :type 'function)
+
+(defcustom gnus-parse-headers-hook
+ (list 'gnus-hack-decode-rfc1522 'gnus-decode-rfc1522)
"*A hook called before parsing the headers."
- :group 'gnus-summary
+ :group 'gnus-various
:type 'hook)
(defcustom gnus-exit-group-hook nil
"*A hook called when exiting (not quitting) summary mode."
- :group 'gnus-summary
+ :group 'gnus-various
:type 'hook)
(defcustom gnus-summary-update-hook
The default function `gnus-summary-highlight-line' will
highlight the line according to the `gnus-summary-highlight'
variable."
- :group 'gnus-summary
+ :group 'gnus-summary-visual
:type 'hook)
(defcustom gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read)
"*A hook called when an article is selected for the first time.
The hook is intended to mark an article as read (or unread)
automatically when it is selected."
- :group 'gnus-summary
+ :group 'gnus-summary-choose
:type 'hook)
(defcustom gnus-group-no-more-groups-hook nil
"*A hook run when returning to group mode having no more (unread) groups."
- :group 'gnus-summary
+ :group 'gnus-group-select
:type 'hook)
-(defface gnus-summary-selected-face '((t
- (:underline t)))
- "Face used for selected articles.")
+(defcustom gnus-ps-print-hook nil
+ "*A hook run before ps-printing something from Gnus."
+ :group 'gnus-summary
+ :type 'hook)
(defcustom gnus-summary-selected-face 'gnus-summary-selected-face
"Face used for highlighting the current article in the summary buffer."
- :group 'gnus-summary
+ :group 'gnus-summary-visual
:type 'face)
-(defface gnus-summary-cancelled-face
- '((((class color))
- (:foreground "yellow" :background "black")))
- "Face used for cancelled articles.")
-
-(defface gnus-summary-high-ticked-face
- '((((class color)
- (background dark))
- (:foreground "pink" :bold t))
- (((class color)
- (background light))
- (:foreground "firebrick" :bold t))
- (t
- (:bold t)))
- "Face used for high interest ticked articles.")
-
-(defface gnus-summary-low-ticked-face
- '((((class color)
- (background dark))
- (:foreground "pink" :italic t))
- (((class color)
- (background light))
- (:foreground "firebrick" :italic t))
- (t
- (:italic t)))
- "Face used for low interest ticked articles.")
-
-(defface gnus-summary-normal-ticked-face
- '((((class color)
- (background dark))
- (:foreground "pink"))
- (((class color)
- (background light))
- (:foreground "firebrick"))
- (t
- ()))
- "Face used for normal interest ticked articles.")
-
-(defface gnus-summary-high-ancient-face
- '((((class color)
- (background dark))
- (:foreground "SkyBlue" :bold t))
- (((class color)
- (background light))
- (:foreground "RoyalBlue" :bold t))
- (t
- (:bold t)))
- "Face used for high interest ancient articles.")
-
-(defface gnus-summary-low-ancient-face
- '((((class color)
- (background dark))
- (:foreground "SkyBlue" :italic t))
- (((class color)
- (background light))
- (:foreground "RoyalBlue" :italic t))
- (t
- (:italic t)))
- "Face used for low interest ancient articles.")
-
-(defface gnus-summary-normal-ancient-face
- '((((class color)
- (background dark))
- (:foreground "SkyBlue"))
- (((class color)
- (background light))
- (:foreground "RoyalBlue"))
- (t
- ()))
- "Face used for normal interest ancient articles.")
-
-(defface gnus-summary-high-unread-face
- '((t
- (:bold t)))
- "Face used for high interest unread articles.")
-
-(defface gnus-summary-low-unread-face
- '((t
- (:italic t)))
- "Face used for low interest unread articles.")
-
-(defface gnus-summary-normal-unread-face
- '((t
- ()))
- "Face used for normal interest unread articles.")
-
-(defface gnus-summary-high-read-face
- '((((class color)
- (background dark))
- (:foreground "PaleGreen"
- :bold t))
- (((class color)
- (background light))
- (:foreground "DarkGreen"
- :bold t))
- (t
- (:bold t)))
- "Face used for high interest read articles.")
-
-(defface gnus-summary-low-read-face
- '((((class color)
- (background dark))
- (:foreground "PaleGreen"
- :italic t))
- (((class color)
- (background light))
- (:foreground "DarkGreen"
- :italic t))
- (t
- (:italic t)))
- "Face used for low interest read articles.")
-
-(defface gnus-summary-normal-read-face
- '((((class color)
- (background dark))
- (:foreground "PaleGreen"))
- (((class color)
- (background light))
- (:foreground "DarkGreen"))
- (t
- ()))
- "Face used for normal interest read articles.")
-
-(defcustom gnus-summary-highlight
+(defcustom gnus-summary-highlight
'(((= mark gnus-canceled-mark)
. gnus-summary-cancelled-face)
((and (> score default)
. gnus-summary-high-unread-face)
((and (< score default) (= mark gnus-unread-mark))
. gnus-summary-low-unread-face)
- ((and (= mark gnus-unread-mark))
+ ((= mark gnus-unread-mark)
+ . gnus-summary-normal-unread-face)
+ ((and (> score default) (memq mark (list gnus-downloadable-mark
+ gnus-undownloaded-mark)))
+ . gnus-summary-high-unread-face)
+ ((and (< score default) (memq mark (list gnus-downloadable-mark
+ gnus-undownloaded-mark)))
+ . gnus-summary-low-unread-face)
+ ((memq mark (list gnus-downloadable-mark gnus-undownloaded-mark))
. gnus-summary-normal-unread-face)
- ((> score default)
+ ((> score default)
. gnus-summary-high-read-face)
- ((< score default)
+ ((< score default)
. gnus-summary-low-read-face)
- (t
+ (t
. gnus-summary-normal-read-face))
- "Controls the highlighting of summary buffer lines.
+ "*Controls the highlighting of summary buffer lines.
A list of (FORM . FACE) pairs. When deciding how a a particular
summary line should be displayed, each form is evaluated. The content
score: The articles score
default: The default article score.
-below: The score below which articles are automatically marked as read.
+below: The score below which articles are automatically marked as read.
mark: The articles mark."
- :group 'gnus-summary
+ :group 'gnus-summary-visual
:type '(repeat (cons (sexp :tag "Form" nil)
face)))
+(defcustom gnus-alter-header-function nil
+ "Function called to allow alteration of article header structures.
+The function is called with one parameter, the article header vector,
+which it may alter in any way.")
+
;;; Internal variables
(defvar gnus-scores-exclude-files nil)
-
-(defvar gnus-summary-display-table
- ;; Change the display table. Odd characters have a tendency to mess
- ;; up nicely formatted displays - we make all possible glyphs
- ;; display only a single character.
-
- ;; We start from the standard display table, if any.
- (let ((table (or (copy-sequence standard-display-table)
- (make-display-table)))
- ;; Nix out all the control chars...
- (i 32))
- (while (>= (setq i (1- i)) 0)
- (aset table i [??]))
- ;; ... but not newline and cr, of course. (cr is necessary for the
- ;; selective display).
- (aset table ?\n nil)
- (aset table ?\r nil)
- ;; We nix out any glyphs over 126 that are not set already.
- (let ((i 256))
- (while (>= (setq i (1- i)) 127)
- ;; Only modify if the entry is nil.
- (or (aref table i)
- (aset table i [??]))))
- table)
- "Display table used in summary mode buffers.")
+(defvar gnus-page-broken nil)
(defvar gnus-original-article nil)
(defvar gnus-article-internal-prepare-hook nil)
(defvar gnus-newsgroup-processable nil
"List of articles in the current newsgroup that can be processed.")
+(defvar gnus-newsgroup-downloadable nil
+ "List of articles in the current newsgroup that can be processed.")
+
+(defvar gnus-newsgroup-undownloaded nil
+ "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-newsgroup-bookmarks nil
"List of articles in the current newsgroup that have bookmarks.")
gnus-newsgroup-reads gnus-newsgroup-saved
gnus-newsgroup-replied gnus-newsgroup-expirable
gnus-newsgroup-processable gnus-newsgroup-killed
+ gnus-newsgroup-downloadable gnus-newsgroup-undownloaded
+ gnus-newsgroup-unsendable
gnus-newsgroup-bookmarks gnus-newsgroup-dormant
gnus-newsgroup-headers gnus-newsgroup-threads
gnus-newsgroup-prepared gnus-summary-highlight-line-function
;; Subject simplification.
+(defun gnus-simplify-whitespace (str)
+ "Remove excessive whitespace."
+ (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))
+
(defsubst gnus-simplify-subject-re (subject)
"Remove \"Re:\" from subject lines."
(if (string-match "^[Rr][Ee]: *" subject)
;; Remove any leading "re:"s, any trailing paren phrases, and simplify
;; all whitespace.
-;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
+(defsubst gnus-simplify-buffer-fuzzy-step (regexp &optional newtext)
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (replace-match (or newtext ""))))
+
(defun gnus-simplify-buffer-fuzzy ()
- (let ((case-fold-search t))
- (goto-char (point-min))
- (while (search-forward "\t" nil t)
- (replace-match " " t t))
- (goto-char (point-min))
- (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" nil t)
- (goto-char (match-beginning 0))
- (while (or
- (looking-at "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
- (looking-at "^[[].*: .*[]]$"))
- (goto-char (point-min))
- (while (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *"
- nil t)
- (replace-match "" t t))
- (goto-char (point-min))
- (while (re-search-forward "^[[].*: .*[]]$" nil t)
- (goto-char (match-end 0))
- (delete-char -1)
- (delete-region
- (progn (goto-char (match-beginning 0)))
- (re-search-forward ":"))))
- (goto-char (point-min))
- (while (re-search-forward " *[[{(][^()\n]*[]})] *$" nil t)
- (replace-match "" t t))
- (goto-char (point-min))
- (while (re-search-forward " +" nil t)
- (replace-match " " t t))
- (goto-char (point-min))
- (while (re-search-forward " $" nil t)
- (replace-match "" t t))
- (goto-char (point-min))
- (while (re-search-forward "^ +" nil t)
- (replace-match "" t t))
- (goto-char (point-min))
- (when gnus-simplify-subject-fuzzy-regexp
- (if (listp gnus-simplify-subject-fuzzy-regexp)
- (let ((list gnus-simplify-subject-fuzzy-regexp))
- (while list
- (goto-char (point-min))
- (while (re-search-forward (car list) nil t)
- (replace-match "" t t))
- (setq list (cdr list))))
- (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
- (replace-match "" t t))))))
+ "Simplify string in the buffer fuzzily.
+The string in the accessible portion of the current buffer is simplified.
+It is assumed to be a single-line subject.
+Whitespace is generally cleaned up, and miscellaneous leading/trailing
+matter is removed. Additional things can be deleted by setting
+gnus-simplify-subject-fuzzy-regexp."
+ (let ((case-fold-search t)
+ (modified-tick))
+ (gnus-simplify-buffer-fuzzy-step "\t" " ")
+
+ (while (not (eq modified-tick (buffer-modified-tick)))
+ (setq modified-tick (buffer-modified-tick))
+ (cond
+ ((listp gnus-simplify-subject-fuzzy-regexp)
+ (mapcar 'gnus-simplify-buffer-fuzzy-step
+ gnus-simplify-subject-fuzzy-regexp))
+ (gnus-simplify-subject-fuzzy-regexp
+ (gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp)))
+ (gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *")
+ (gnus-simplify-buffer-fuzzy-step
+ "^ *\\(re\\|fw\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
+ (gnus-simplify-buffer-fuzzy-step "^[[].*:\\( .*\\)[]]$" "\\1"))
+
+ (gnus-simplify-buffer-fuzzy-step " *[[{(][^()\n]*[]})] *$")
+ (gnus-simplify-buffer-fuzzy-step " +" " ")
+ (gnus-simplify-buffer-fuzzy-step " $")
+ (gnus-simplify-buffer-fuzzy-step "^ +")))
(defun gnus-simplify-subject-fuzzy (subject)
- "Simplify a subject string fuzzily."
+ "Simplify a subject string fuzzily.
+See `gnus-simplify-buffer-fuzzy' for details."
(save-excursion
(gnus-set-work-buffer)
(let ((case-fold-search t))
+ ;; Remove uninteresting prefixes.
+ (when (and gnus-simplify-ignored-prefixes
+ (string-match gnus-simplify-ignored-prefixes subject))
+ (setq subject (substring subject (match-end 0))))
(insert subject)
(inline (gnus-simplify-buffer-fuzzy))
(buffer-string))))
(defsubst gnus-simplify-subject-fully (subject)
- "Simplify a subject string according to the user's wishes."
+ "Simplify a subject string according to gnus-summary-gather-subject-limit."
(cond
+ (gnus-simplify-subject-functions
+ (gnus-map-function gnus-simplify-subject-functions subject))
((null gnus-summary-gather-subject-limit)
(gnus-simplify-subject-re subject))
((eq gnus-summary-gather-subject-limit 'fuzzy)
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 simplified."
+ "Check whether two subjects are equal.
+If optional argument simple-first is t, first argument is already
+simplified."
(cond
((null simple-first)
(equal (gnus-simplify-subject-fully s1)
(equal s1
(gnus-simplify-subject-fully s2)))))
-(defun gnus-offer-save-summaries ()
- "Offer to save all active summary buffers."
- (save-excursion
- (let ((buflist (buffer-list))
- buffers bufname)
- ;; Go through all buffers and find all summaries.
- (while buflist
- (and (setq bufname (buffer-name (car buflist)))
- (string-match "Summary" bufname)
- (save-excursion
- (set-buffer bufname)
- ;; We check that this is, indeed, a summary buffer.
- (and (eq major-mode 'gnus-summary-mode)
- ;; Also make sure this isn't bogus.
- gnus-newsgroup-prepared))
- (push bufname buffers))
- (setq buflist (cdr buflist)))
- ;; Go through all these summary buffers and offer to save them.
- (when buffers
- (map-y-or-n-p
- "Update summary buffer %s? "
- (lambda (buf) (set-buffer buf) (gnus-summary-exit))
- buffers)))))
-
(defun gnus-summary-bubble-group ()
"Increase the score of the current group.
This is a handy function to add to `gnus-summary-exit-hook' to
" " gnus-summary-next-page
"\177" gnus-summary-prev-page
[delete] gnus-summary-prev-page
+ [backspace] gnus-summary-prev-page
"\r" gnus-summary-scroll-up
"n" gnus-summary-next-unread-article
"p" gnus-summary-prev-unread-article
"?" gnus-summary-mark-as-dormant
"\C-c\M-\C-s" gnus-summary-limit-include-expunged
"\C-c\C-s\C-n" gnus-summary-sort-by-number
+ "\C-c\C-s\C-l" gnus-summary-sort-by-lines
"\C-c\C-s\C-a" gnus-summary-sort-by-author
"\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-v\C-v" gnus-uu-decode-uu-view
"\C-d" gnus-summary-enter-digest-group
"\M-\C-d" gnus-summary-read-document
+ "\M-\C-e" gnus-summary-edit-parameters
"\C-c\C-b" gnus-bug
"*" gnus-cache-enter-article
"\M-*" gnus-cache-remove-article
"\C-l" gnus-recenter
"I" gnus-summary-increase-score
"L" gnus-summary-lower-score
-
+ "\M-i" gnus-symbolic-argument
+ "h" gnus-summary-select-article-buffer
+
"V" gnus-summary-score-map
"X" gnus-uu-extract-map
"S" gnus-summary-send-map)
"u" gnus-summary-limit-to-unread
"m" gnus-summary-limit-to-marks
"v" gnus-summary-limit-to-score
+ "*" gnus-summary-limit-include-cached
"D" gnus-summary-limit-include-dormant
+ "T" gnus-summary-limit-include-thread
"d" gnus-summary-limit-exclude-dormant
- ;; "t" gnus-summary-limit-exclude-thread
+ "t" gnus-summary-limit-to-age
"E" gnus-summary-limit-include-expunged
"c" gnus-summary-limit-exclude-childless-dormant
"C" gnus-summary-limit-mark-excluded-as-read)
"j" gnus-summary-goto-article
"g" gnus-summary-goto-subject
"l" gnus-summary-goto-last-article
- "p" gnus-summary-pop-article)
+ "o" gnus-summary-pop-article)
(gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map)
"k" gnus-summary-kill-thread
"\M-#" gnus-uu-unmark-thread)
(gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map)
- "g" gnus-summary-prepare
+ "g" gnus-summary-prepare
"c" gnus-summary-insert-cached-articles)
(gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
"R" gnus-summary-reselect-current-group
"G" gnus-summary-rescan-group
"N" gnus-summary-next-group
+ "s" gnus-summary-save-newsrc
"P" gnus-summary-prev-group)
(gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map)
"^" gnus-summary-refer-parent-article
"r" gnus-summary-refer-parent-article
"R" gnus-summary-refer-references
+ "T" gnus-summary-refer-thread
"g" gnus-summary-show-article
- "s" gnus-summary-isearch-article)
+ "s" gnus-summary-isearch-article
+ "P" gnus-summary-print-article)
(gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map)
"b" gnus-article-add-buttons
"r" gnus-summary-caesar-message
"t" gnus-article-hide-headers
"v" gnus-summary-verbose-headers
- "m" gnus-summary-toggle-mime)
+ "m" gnus-summary-toggle-mime
+ "h" gnus-article-treat-html
+ "d" gnus-article-treat-dumbquotes)
(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
"a" gnus-article-hide
"u" gnus-article-date-ut
"l" gnus-article-date-local
"e" gnus-article-date-lapsed
- "o" gnus-article-date-original)
+ "o" gnus-article-date-original
+ "i" gnus-article-date-iso8601
+ "s" gnus-article-date-user)
(gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map)
"t" gnus-article-remove-trailing-blank-lines
"l" gnus-article-strip-leading-blank-lines
"m" gnus-article-strip-multiple-blank-lines
- "a" gnus-article-strip-blank-lines)
+ "a" gnus-article-strip-blank-lines
+ "A" gnus-article-strip-all-blank-lines
+ "s" gnus-article-strip-leading-space)
(gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
"v" gnus-version
"Score"
(nconc
(list
- ["Enter score..." gnus-summary-score-entry t])
+ ["Enter score..." gnus-summary-score-entry t]
+ ["Customize" gnus-score-customize t])
(gnus-make-score-map 'increase)
(gnus-make-score-map 'lower)
'(("Mark"
'(("Default header"
["Ask" (gnus-score-set-default 'gnus-score-default-header nil)
- :style radio
+ :style radio
:selected (null gnus-score-default-header)]
["From" (gnus-score-set-default 'gnus-score-default-header 'a)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'a)]
["Subject" (gnus-score-set-default 'gnus-score-default-header 's)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 's)]
["Article body"
(gnus-score-set-default 'gnus-score-default-header 'b)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'b )]
["All headers"
(gnus-score-set-default 'gnus-score-default-header 'h)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'h )]
["Message-ID" (gnus-score-set-default 'gnus-score-default-header 'i)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'i )]
["Thread" (gnus-score-set-default 'gnus-score-default-header 't)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 't )]
["Crossposting"
(gnus-score-set-default 'gnus-score-default-header 'x)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'x )]
["Lines" (gnus-score-set-default 'gnus-score-default-header 'l)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'l )]
["Date" (gnus-score-set-default 'gnus-score-default-header 'd)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'd )]
["Followups to author"
(gnus-score-set-default 'gnus-score-default-header 'f)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'f )])
("Default type"
["Ask" (gnus-score-set-default 'gnus-score-default-type nil)
- :style radio
+ :style radio
:selected (null gnus-score-default-type)]
;; The `:active' key is commented out in the following,
;; because the GNU Emacs hack to support radio buttons use
- ;; active to indicate which button is selected.
+ ;; active to indicate which button is selected.
["Substring" (gnus-score-set-default 'gnus-score-default-type 's)
- :style radio
+ :style radio
;; :active (not (memq gnus-score-default-header '(l d)))
:selected (eq gnus-score-default-type 's)]
["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r)
;; :active (not (memq gnus-score-default-header '(l d)))
:selected (eq gnus-score-default-type 'e)]
["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f)
- :style radio
+ :style radio
;; :active (not (memq gnus-score-default-header '(l d)))
:selected (eq gnus-score-default-type 'f)]
["Before date" (gnus-score-set-default 'gnus-score-default-type 'b)
- :style radio
+ :style radio
;; :active (eq (gnus-score-default-header 'd))
:selected (eq gnus-score-default-type 'b)]
["At date" (gnus-score-set-default 'gnus-score-default-type 'n)
- :style radio
+ :style radio
;; :active (eq (gnus-score-default-header 'd))
:selected (eq gnus-score-default-type 'n)]
["After date" (gnus-score-set-default 'gnus-score-default-type 'a)
- :style radio
+ :style radio
;; :active (eq (gnus-score-default-header 'd))
:selected (eq gnus-score-default-type 'a)]
["Less than number"
(gnus-score-set-default 'gnus-score-default-type '<)
- :style radio
+ :style radio
;; :active (eq (gnus-score-default-header 'l))
:selected (eq gnus-score-default-type '<)]
["Equal to number"
(gnus-score-set-default 'gnus-score-default-type '=)
- :style radio
+ :style radio
;; :active (eq (gnus-score-default-header 'l))
:selected (eq gnus-score-default-type '=)]
- ["Greater than number"
+ ["Greater than number"
(gnus-score-set-default 'gnus-score-default-type '>)
- :style radio
+ :style radio
;; :active (eq (gnus-score-default-header 'l))
:selected (eq gnus-score-default-type '>)])
["Default fold" gnus-score-default-fold-toggle
(gnus-score-set-default 'gnus-score-default-duration 't)
:style radio
:selected (eq gnus-score-default-duration 't)]
- ["Immediate"
+ ["Immediate"
(gnus-score-set-default 'gnus-score-default-duration 'i)
:style radio
:selected (eq gnus-score-default-duration 'i)]))
["Citation" gnus-article-highlight-citation t])
("Date"
["Local" gnus-article-date-local t]
+ ["ISO8601" gnus-article-date-iso8601 t]
["UT" gnus-article-date-ut t]
["Original" gnus-article-date-original t]
- ["Lapsed" gnus-article-date-lapsed t])
- ("Filter"
+ ["Lapsed" gnus-article-date-lapsed t]
+ ["User-defined" gnus-article-date-user t])
+ ("Washing"
("Remove Blanks"
["Leading" gnus-article-strip-leading-blank-lines t]
["Multiple" gnus-article-strip-multiple-blank-lines t]
["Trailing" gnus-article-remove-trailing-blank-lines t]
- ["All of the above" gnus-article-strip-blank-lines t])
+ ["All of the above" gnus-article-strip-blank-lines t]
+ ["All" gnus-article-strip-all-blank-lines t]
+ ["Leading space" gnus-article-strip-leading-space t])
["Overstrike" gnus-article-treat-overstrike t]
+ ["Dumb quotes" gnus-article-treat-dumbquotes t]
["Emphasis" gnus-article-emphasize t]
["Word wrap" gnus-article-fill-cited-article t]
["CR" gnus-article-remove-cr t]
["Show X-Face" gnus-article-display-x-face t]
["Quoted-Printable" gnus-article-de-quoted-unreadable t]
+ ["UnHTMLize" gnus-article-treat-html t]
["Rot 13" gnus-summary-caesar-message t]
+ ["Unix pipe" gnus-summary-pipe-message t]
["Add buttons" gnus-article-add-buttons t]
["Add buttons to head" gnus-article-add-buttons-to-head t]
["Stop page breaking" gnus-summary-stop-page-breaking t]
["Save in default format" gnus-summary-save-article t]
["Save in file" gnus-summary-save-article-file t]
["Save in Unix mail format" gnus-summary-save-article-mail t]
- ["Write to file" gnus-summary-write-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])
+ ["Add to SOUP packet" gnus-soup-add-article t]
+ ["Print" gnus-summary-print-article t])
("Backend"
["Respool article..." gnus-summary-respool-article t]
["Move article..." gnus-summary-move-article
["Save" gnus-uu-decode-save t]
["Binhex" gnus-uu-decode-binhex t]
["Postscript" gnus-uu-decode-postscript t])
+ ("Cache"
+ ["Enter article" gnus-cache-enter-article t]
+ ["Remove article" gnus-cache-remove-article t])
+ ["Select article buffer" gnus-summary-select-article-buffer t]
["Enter digest buffer" gnus-summary-enter-digest-group t]
["Isearch article..." gnus-summary-isearch-article t]
- ["Search articles forward..." gnus-summary-search-article-forward t]
- ["Search articles backward..." gnus-summary-search-article-backward t]
["Beginning of the article" gnus-summary-beginning-of-article t]
["End of the article" gnus-summary-end-of-article t]
["Fetch parent of article" gnus-summary-refer-parent-article t]
["Fetch referenced articles" gnus-summary-refer-references t]
+ ["Fetch current thread" gnus-summary-refer-thread t]
["Fetch article with id..." gnus-summary-refer-article t]
["Redisplay" gnus-summary-show-article t]))
["Cancel article" gnus-summary-cancel-article t]
["Reply" gnus-summary-reply t]
["Reply and yank" gnus-summary-reply-with-original t]
+ ["Wide reply" gnus-summary-wide-reply t]
+ ["Wide reply and yank" gnus-summary-wide-reply-with-original t]
["Mail forward" gnus-summary-mail-forward t]
["Post forward" gnus-summary-post-forward t]
["Digest and mail" gnus-uu-digest-mail-forward t]
(easy-menu-define
gnus-summary-misc-menu gnus-summary-mode-map ""
'("Misc"
- ("Mark"
- ("Read"
- ["Mark as read" gnus-summary-mark-as-read-forward t]
- ["Mark same subject and select"
- gnus-summary-kill-same-subject-and-select t]
- ["Mark same subject" gnus-summary-kill-same-subject t]
- ["Catchup" gnus-summary-catchup t]
- ["Catchup all" gnus-summary-catchup-all t]
- ["Catchup to here" gnus-summary-catchup-to-here t]
- ["Catchup region" gnus-summary-mark-region-as-read t]
- ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t])
- ("Various"
- ["Tick" gnus-summary-tick-article-forward t]
- ["Mark as dormant" gnus-summary-mark-as-dormant t]
- ["Remove marks" gnus-summary-clear-mark-forward t]
- ["Set expirable mark" gnus-summary-mark-as-expirable t]
- ["Set bookmark" gnus-summary-set-bookmark t]
- ["Remove bookmark" gnus-summary-remove-bookmark t])
- ("Limit"
- ["Marks..." gnus-summary-limit-to-marks t]
- ["Subject..." gnus-summary-limit-to-subject t]
- ["Author..." gnus-summary-limit-to-author t]
- ["Score" gnus-summary-limit-to-score t]
- ["Unread" gnus-summary-limit-to-unread t]
- ["Non-dormant" gnus-summary-limit-exclude-dormant t]
- ["Articles" gnus-summary-limit-to-articles t]
- ["Pop limit" gnus-summary-pop-limit t]
- ["Show dormant" gnus-summary-limit-include-dormant t]
- ["Hide childless dormant"
- gnus-summary-limit-exclude-childless-dormant t]
- ;;["Hide thread" gnus-summary-limit-exclude-thread t]
- ["Show expunged" gnus-summary-show-all-expunged t])
- ("Process mark"
- ["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]
- ["Mark above" gnus-uu-mark-over t]
- ["Mark series" gnus-uu-mark-series t]
- ["Mark region" gnus-uu-mark-region t]
- ["Mark by regexp..." gnus-uu-mark-by-regexp t]
- ["Mark all" gnus-uu-mark-all t]
- ["Mark buffer" gnus-uu-mark-buffer t]
- ["Mark sparse" gnus-uu-mark-sparse t]
- ["Mark thread" gnus-uu-mark-thread t]
- ["Unmark thread" gnus-uu-unmark-thread t]
- ("Process Mark Sets"
- ["Kill" gnus-summary-kill-process-mark t]
- ["Yank" gnus-summary-yank-process-mark
- gnus-newsgroup-process-stack]
- ["Save" gnus-summary-save-process-mark t])))
+ ("Mark Read"
+ ["Mark as read" gnus-summary-mark-as-read-forward t]
+ ["Mark same subject and select"
+ gnus-summary-kill-same-subject-and-select t]
+ ["Mark same subject" gnus-summary-kill-same-subject t]
+ ["Catchup" gnus-summary-catchup t]
+ ["Catchup all" gnus-summary-catchup-all t]
+ ["Catchup to here" gnus-summary-catchup-to-here t]
+ ["Catchup region" gnus-summary-mark-region-as-read t]
+ ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t])
+ ("Mark Various"
+ ["Tick" gnus-summary-tick-article-forward t]
+ ["Mark as dormant" gnus-summary-mark-as-dormant t]
+ ["Remove marks" gnus-summary-clear-mark-forward t]
+ ["Set expirable mark" gnus-summary-mark-as-expirable t]
+ ["Set bookmark" gnus-summary-set-bookmark t]
+ ["Remove bookmark" gnus-summary-remove-bookmark t])
+ ("Mark Limit"
+ ["Marks..." gnus-summary-limit-to-marks t]
+ ["Subject..." gnus-summary-limit-to-subject t]
+ ["Author..." gnus-summary-limit-to-author t]
+ ["Age..." gnus-summary-limit-to-age t]
+ ["Score" gnus-summary-limit-to-score t]
+ ["Unread" gnus-summary-limit-to-unread t]
+ ["Non-dormant" gnus-summary-limit-exclude-dormant t]
+ ["Articles" gnus-summary-limit-to-articles t]
+ ["Pop limit" gnus-summary-pop-limit t]
+ ["Show dormant" gnus-summary-limit-include-dormant t]
+ ["Hide childless dormant"
+ gnus-summary-limit-exclude-childless-dormant t]
+ ;;["Hide thread" gnus-summary-limit-exclude-thread t]
+ ["Show expunged" gnus-summary-show-all-expunged t])
+ ("Process Mark"
+ ["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]
+ ["Mark above" gnus-uu-mark-over t]
+ ["Mark series" gnus-uu-mark-series t]
+ ["Mark region" gnus-uu-mark-region t]
+ ["Mark by regexp..." gnus-uu-mark-by-regexp t]
+ ["Mark all" gnus-uu-mark-all t]
+ ["Mark buffer" gnus-uu-mark-buffer t]
+ ["Mark sparse" gnus-uu-mark-sparse t]
+ ["Mark thread" gnus-uu-mark-thread t]
+ ["Unmark thread" gnus-uu-unmark-thread t]
+ ("Process Mark Sets"
+ ["Kill" gnus-summary-kill-process-mark t]
+ ["Yank" gnus-summary-yank-process-mark
+ gnus-newsgroup-process-stack]
+ ["Save" gnus-summary-save-process-mark t]))
("Scroll article"
["Page forward" gnus-summary-next-page t]
["Page backward" gnus-summary-prev-page t]
["Sort by author" gnus-summary-sort-by-author 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])
+ ["Sort by score" gnus-summary-sort-by-score t]
+ ["Sort by lines" gnus-summary-sort-by-lines t])
("Help"
["Fetch group FAQ" gnus-summary-fetch-faq t]
["Describe group" gnus-summary-describe-group t]
["Read manual" gnus-info-find-node t])
- ("Cache"
- ["Enter article" gnus-cache-enter-article t]
- ["Remove article" gnus-cache-remove-article t])
("Modes"
["Pick and read" gnus-pick-mode t]
["Binary" gnus-binary-mode t])
+ ("Regeneration"
+ ["Regenerate" gnus-summary-prepare t]
+ ["Insert cached articles" gnus-summary-insert-cached-articles t]
+ ["Toggle threading" gnus-summary-toggle-threads t])
["Filter articles..." gnus-summary-execute-command t]
["Run command on subjects..." 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]
["Expand window" gnus-summary-expand-window t]
["Expire expirable articles" gnus-summary-expire-articles
(gnus-check-backend-function
'request-expire-articles gnus-newsgroup-name)]
- ["Regenerate buffer" gnus-summary-prepare t]
["Edit local kill file" gnus-summary-edit-local-kill t]
["Edit main kill file" gnus-summary-edit-global-kill t]
+ ["Edit group parameters" gnus-summary-edit-parameters t]
("Exit"
["Catchup and exit" gnus-summary-catchup-and-exit t]
["Catchup all and exit" gnus-summary-catchup-and-exit t]
["Exit and goto next group" gnus-summary-next-group t]
["Exit and goto prev group" gnus-summary-prev-group t]
["Reselect group" gnus-summary-reselect-current-group t]
- ["Rescan group" gnus-summary-rescan-group t])))
+ ["Rescan group" gnus-summary-rescan-group t]
+ ["Update dribble" gnus-summary-save-newsrc t])))
- (run-hooks 'gnus-summary-menu-hook)))
+ (gnus-run-hooks 'gnus-summary-menu-hook)))
(defun gnus-score-set-default (var value)
"A version of set that updates the GNU Emacs menu-bar."
("permanent" nil)
("immediate" now)))
header)
- (list
- (apply
+ (list
+ (apply
'nconc
(list
(if (eq type 'lower)
(let (outh)
(while headers
(setq header (car headers))
- (setq outh
- (cons
- (apply
+ (setq outh
+ (cons
+ (apply
'nconc
(list (car header))
(let ((ts (cdr (assoc (nth 2 header) types)))
outt)
(while ts
(setq outt
- (cons
- (apply
+ (cons
+ (apply
'nconc
(list (caar ts))
(let ((ps perms)
(string= (nth 1 header)
"body"))
""
- (list 'gnus-summary-header
+ (list 'gnus-summary-header
(nth 1 header)))
(list 'quote (nth 1 (car ts)))
(list 'gnus-score-default nil)
\\{gnus-summary-mode-map}"
(interactive)
- (when (and menu-bar-mode
- (gnus-visual-p 'summary-menu 'menu))
+ (when (gnus-visual-p 'summary-menu 'menu)
(gnus-summary-make-menu-bar))
(kill-all-local-variables)
(gnus-summary-make-local-variables)
(setq truncate-lines t)
(setq selective-display t)
(setq selective-display-ellipses t) ;Display `...'
- (setq buffer-display-table gnus-summary-display-table)
+ (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)
- (gnus-make-local-hook 'post-command-hook)
- (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
- (run-hooks 'gnus-summary-mode-hook)
+ (make-local-hook 'post-command-hook)
+ (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
+ (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-update-format-specifications nil 'summary 'summary-mode 'summary-dummy)
(gnus-update-summary-mark-positions))
(defmacro gnus-data-header (data)
`(nth 3 ,data))
+(defmacro gnus-data-set-header (data header)
+ `(setf (nth 3 ,data) ,header))
+
(defmacro gnus-data-level (data)
`(nth 4 ,data))
(setcdr list (cdr data))
(setcdr data ilist)
(when offset
- (gnus-data-update-list (cdr data) offset)))
+ (gnus-data-update-list (cdr list) offset)))
(setq gnus-newsgroup-data-reverse nil))))
(defun gnus-data-remove (article &optional offset)
(let ((data gnus-newsgroup-data))
(if (= (gnus-data-number (car data)) article)
- (setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
- gnus-newsgroup-data-reverse nil)
+ (progn
+ (setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
+ gnus-newsgroup-data-reverse nil)
+ (when offset
+ (gnus-data-update-list gnus-newsgroup-data offset)))
(while (cdr data)
(when (= (gnus-data-number (cadr data)) article)
(setcdr data (cddr data))
"Say whether this article is a pseudo article or not."
(not (vectorp (gnus-data-header (gnus-data-find article)))))
+(defmacro gnus-summary-article-sparse-p (article)
+ "Say whether this article is a sparse article or not."
+ `(memq ,article gnus-newsgroup-sparse))
+
+(defmacro gnus-summary-article-ancient-p (article)
+ "Say whether this article is a sparse article or not."
+ `(memq ,article gnus-newsgroup-ancient))
+
(defun gnus-article-parent-p (number)
"Say whether this article is a parent or not."
(let ((data (gnus-data-find-list number)))
(level (gnus-data-level (car data)))
children)
(setq data (cdr data))
- (while (and data
+ (while (and data
(= (gnus-data-level (car data)) (1+ level)))
(push (gnus-data-number (car data)) children)
(setq data (cdr data)))
(gnus-summary-last-subject))))
(defmacro gnus-summary-article-header (&optional number)
+ "Return the header of article NUMBER."
`(gnus-data-header (gnus-data-find
,(or number '(gnus-summary-article-number)))))
(defmacro gnus-summary-thread-level (&optional number)
+ "Return the level of thread that starts with article NUMBER."
`(if (and (eq gnus-summary-make-false-root 'dummy)
(get-text-property (point) 'gnus-intangible))
0
,(or number '(gnus-summary-article-number))))))
(defmacro gnus-summary-article-mark (&optional number)
+ "Return the mark of article NUMBER."
`(gnus-data-mark (gnus-data-find
,(or number '(gnus-summary-article-number)))))
(defmacro gnus-summary-article-pos (&optional number)
+ "Return the position of the line of article NUMBER."
`(gnus-data-pos (gnus-data-find
,(or number '(gnus-summary-article-number)))))
gnus-summary-default-score 0))
(defun gnus-summary-article-children (&optional number)
+ "Return a list of article numbers that are children of article NUMBER."
(let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))))
(level (gnus-data-level (car data)))
l children)
(nreverse children)))
(defun gnus-summary-article-parent (&optional number)
+ "Return the article number of the parent of article NUMBER."
(let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))
(gnus-data-list t)))
(level (gnus-data-level (car data))))
(= mark gnus-expirable-mark))))
(defmacro gnus-article-mark (number)
+ "Return the MARK of article NUMBER.
+This macro should only be used when computing the mark the \"first\"
+time; i.e., when generating the summary lines. After that,
+`gnus-summary-article-mark' should be used to examine the
+marks of articles."
`(cond
+ ((memq ,number gnus-newsgroup-unsendable) gnus-unsendable-mark)
+ ((memq ,number gnus-newsgroup-undownloaded) gnus-undownloaded-mark)
+ ((memq ,number gnus-newsgroup-downloadable) gnus-downloadable-mark)
((memq ,number gnus-newsgroup-unreads) gnus-unread-mark)
((memq ,number gnus-newsgroup-marked) gnus-ticked-mark)
((memq ,number gnus-newsgroup-dormant) gnus-dormant-mark)
(mouse-set-point e)
(gnus-summary-next-page nil t))
+(defun gnus-summary-set-display-table ()
+ ;; Change the display table. Odd characters have a tendency to mess
+ ;; up nicely formatted displays - we make all possible glyphs
+ ;; display only a single character.
+
+ ;; We start from the standard display table, if any.
+ (let ((table (or (copy-sequence standard-display-table)
+ (make-display-table)))
+ (i 32))
+ ;; Nix out all the control chars...
+ (while (>= (setq i (1- i)) 0)
+ (aset table i [??]))
+ ;; ... but not newline and cr, of course. (cr is necessary for the
+ ;; selective display).
+ (aset table ?\n nil)
+ (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))
+ (while (>= (setq i (1- i)) 127)
+ ;; Only modify if the entry is nil.
+ (unless (aref table i)
+ (aset table i [??]))))
+ (setq buffer-display-table table)))
+
(defun gnus-summary-setup-buffer (group)
"Initialize summary buffer."
(let ((buffer (concat "*Summary " group "*")))
(score-file gnus-current-score-file))
(save-excursion
(set-buffer gnus-group-buffer)
- (setq gnus-newsgroup-name name)
- (setq gnus-newsgroup-marked marked)
- (setq gnus-newsgroup-unreads unread)
- (setq gnus-current-headers headers)
- (setq gnus-newsgroup-data data)
- (setq gnus-article-current gac)
- (setq gnus-summary-buffer summary)
- (setq gnus-article-buffer article-buffer)
- (setq gnus-original-article-buffer original)
- (setq gnus-reffed-article-number reffed)
- (setq gnus-current-score-file score-file)
+ (setq gnus-newsgroup-name name
+ gnus-newsgroup-marked marked
+ gnus-newsgroup-unreads unread
+ gnus-current-headers headers
+ gnus-newsgroup-data data
+ gnus-article-current gac
+ gnus-summary-buffer summary
+ gnus-article-buffer article-buffer
+ gnus-original-article-buffer original
+ gnus-reffed-article-number reffed
+ gnus-current-score-file score-file)
;; The article buffer also has local variables.
(when (gnus-buffer-live-p gnus-article-buffer)
(set-buffer gnus-article-buffer)
(setq gnus-summary-buffer summary))))))
+(defun gnus-summary-article-unread-p (article)
+ "Say whether ARTICLE is unread or not."
+ (memq article gnus-newsgroup-unreads))
+
(defun gnus-summary-first-article-p (&optional article)
"Return whether ARTICLE is the first article in the buffer."
(if (not (setq article (or article (gnus-summary-article-number))))
(let ((gnus-replied-mark 129)
(gnus-score-below-mark 130)
(gnus-score-over-mark 130)
+ (gnus-download-mark 131)
(spec gnus-summary-line-format-spec)
thread gnus-visual pos)
(save-excursion
(gnus-set-work-buffer)
- (let ((gnus-summary-line-format-spec spec))
+ (let ((gnus-summary-line-format-spec spec)
+ (gnus-newsgroup-downloadable '((0 . t))))
(gnus-summary-insert-line
[0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1)
(goto-char (point-min))
pos)
(goto-char (point-min))
(push (cons 'score (and (search-forward "\202" nil t) (- (point) 2)))
+ pos)
+ (goto-char (point-min))
+ (push (cons 'download
+ (and (search-forward "\203" nil t) (- (point) 2)))
pos)))
(setq gnus-summary-mark-positions pos))))
(point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
(list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
-(defun gnus-summary-insert-line (gnus-tmp-header
- gnus-tmp-level gnus-tmp-current
- gnus-tmp-unread gnus-tmp-replied
+(defun gnus-summary-insert-line (gnus-tmp-header
+ gnus-tmp-level gnus-tmp-current
+ gnus-tmp-unread gnus-tmp-replied
gnus-tmp-expirable gnus-tmp-subject-or-nil
- &optional gnus-tmp-dummy gnus-tmp-score
+ &optional gnus-tmp-dummy gnus-tmp-score
gnus-tmp-process)
(let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
(gnus-tmp-lines (mail-header-lines gnus-tmp-header))
'gnus-number gnus-tmp-number)
(when (gnus-visual-p 'summary-highlight 'highlight)
(forward-line -1)
- (run-hooks 'gnus-summary-update-hook)
+ (gnus-run-hooks 'gnus-summary-update-hook)
(forward-line 1))))
(defun gnus-summary-update-line (&optional dont-update)
'score))
;; Do visual highlighting.
(when (gnus-visual-p 'summary-highlight 'highlight)
- (run-hooks 'gnus-summary-update-hook)))))
+ (gnus-run-hooks 'gnus-summary-update-hook)))))
(defvar gnus-tmp-new-adopts nil)
(defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
- "Return the number of articles in THREAD.
+ "Return the number of articles in THREAD.
This may be 0 in some cases -- if none of the articles in
the thread are to be displayed."
(let* ((number
(symbolp (car elem)) ; Has to be a symbol in there.
(not (memq (car elem)
'(quit-config to-address to-list to-group)))
- (progn ; So we set it.
+ (ignore-errors ; So we set it.
(make-local-variable (car elem))
(set (car elem) (eval (nth 1 elem))))))))
If SHOW-ALL is non-nil, already read articles are also listed.
If NO-ARTICLE is non-nil, no article is selected initially.
If NO-DISPLAY, don't generate a summary buffer."
+ (let (result)
+ (while (and group
+ (null (setq result
+ (let ((gnus-auto-select-next nil))
+ (or (gnus-summary-read-group-1
+ group show-all no-article
+ kill-buffer no-display)
+ (setq show-all nil)))))
+ (eq gnus-auto-select-next 'quietly))
+ (set-buffer gnus-group-buffer)
+ (if (not (equal group (gnus-group-group-name)))
+ (setq group (gnus-group-group-name))
+ (setq group nil)))
+ result))
+
+(defun gnus-summary-read-group-1 (group show-all no-article
+ kill-buffer no-display)
+ ;; Killed foreign groups can't be entered.
+ (when (and (not (gnus-group-native-p group))
+ (not (gnus-gethash group gnus-newsrc-hashtb)))
+ (error "Dead non-native groups can't be entered"))
(gnus-message 5 "Retrieving newsgroup: %s..." group)
(let* ((new-group (gnus-summary-setup-buffer group))
(quit-config (gnus-group-quit-config group))
(kill-buffer (current-buffer))
(if (not quit-config)
(progn
+ ;; Update the info -- marks might need to be removed,
+ ;; for instance.
+ (gnus-summary-update-info)
(set-buffer gnus-group-buffer)
(gnus-group-jump-to-group group)
(gnus-group-next-unread-group 1))
(gnus-copy-sequence
(gnus-active gnus-newsgroup-name)))
;; You can change the summary buffer in some way with this hook.
- (run-hooks 'gnus-select-group-hook)
+ (gnus-run-hooks 'gnus-select-group-hook)
;; Set any local variables in the group parameters.
(gnus-summary-set-local-parameters gnus-newsgroup-name)
(gnus-update-format-specifications
(let ((gnus-newsgroup-dormant nil))
(gnus-summary-initial-limit show-all))
(gnus-summary-initial-limit show-all))
- (setq gnus-newsgroup-limit
- (mapcar
+ (setq gnus-newsgroup-limit
+ (mapcar
(lambda (header) (mail-header-number header))
gnus-newsgroup-headers)))
;; Generate the summary buffer.
((and gnus-newsgroup-scored show-all)
(gnus-summary-limit-include-expunged t))))
;; Function `gnus-apply-kill-file' must be called in this hook.
- (run-hooks 'gnus-apply-kill-hook)
+ (gnus-run-hooks 'gnus-apply-kill-hook)
(if (and (zerop (buffer-size))
(not no-display))
(progn
;; This newsgroup is empty.
- (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
+ (gnus-summary-catchup-and-exit nil t)
(gnus-message 6 "No unread news")
(when kill-buffer
(gnus-kill-or-deaden-summary kill-buffer))
(and gnus-show-threads
gnus-thread-hide-subtree
(gnus-summary-hide-all-threads))
+ (when kill-buffer
+ (gnus-kill-or-deaden-summary kill-buffer))
;; Show first unread article if requested.
(if (and (not no-article)
(not no-display)
;; article in the group.
(goto-char (point-min))
(gnus-summary-position-point)
- (gnus-set-mode-line 'summary)
- (gnus-configure-windows 'summary 'force))
- (when kill-buffer
- (gnus-kill-or-deaden-summary kill-buffer))
+ (gnus-configure-windows 'summary 'force)
+ (gnus-set-mode-line 'summary))
(when (get-buffer-window gnus-group-buffer t)
;; Gotta use windows, because recenter does weird stuff if
;; the current buffer ain't the displayed window.
(select-window (get-buffer-window gnus-group-buffer t))
(when (gnus-group-goto-group group)
(recenter))
- (select-window owin))))
- ;; Mark this buffer as "prepared".
- (setq gnus-newsgroup-prepared t)
- t))))
+ (select-window owin)))
+ ;; Mark this buffer as "prepared".
+ (setq gnus-newsgroup-prepared t)
+ (gnus-run-hooks 'gnus-summary-prepared-hook)
+ t)))))
(defun gnus-summary-prepare ()
"Generate the summary buffer."
(erase-buffer)
(setq gnus-newsgroup-data nil
gnus-newsgroup-data-reverse nil)
- (run-hooks 'gnus-summary-generate-hook)
+ (gnus-run-hooks 'gnus-summary-generate-hook)
;; Generate the buffer, either with threads or without.
(when gnus-newsgroup-headers
(gnus-summary-prepare-threads
(setq gnus-newsgroup-data (nreverse gnus-newsgroup-data))
;; Call hooks for modifying summary buffer.
(goto-char (point-min))
- (run-hooks 'gnus-summary-prepare-hook)))
+ (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."
(setq subject
(cond
;; Truncate the subject.
+ (gnus-simplify-subject-functions
+ (gnus-map-function gnus-simplify-subject-functions subject))
((numberp gnus-summary-gather-subject-limit)
(setq subject (gnus-simplify-subject-re subject))
(if (> (length subject) gnus-summary-gather-subject-limit)
;; Just remove the leading "Re:".
(t
(gnus-simplify-subject-re subject))))
-
+
(if (and gnus-summary-gather-exclude-subject
(string-match gnus-summary-gather-exclude-subject subject))
nil ; This article shouldn't be gathered
(defun gnus-summary-simplify-subject-query ()
"Query where the respool algorithm would put this article."
(interactive)
- (gnus-set-global-variables)
(gnus-summary-select-article)
(message (gnus-general-simplify-subject (gnus-summary-article-subject))))
"Gather threads by looking at Subject headers."
(if (not gnus-summary-make-false-root)
threads
- (let ((hashtb (gnus-make-hashtable 1023))
+ (let ((hashtb (gnus-make-hashtable 1024))
(prev threads)
(result threads)
subject hthread whole-subject)
(while threads
(setq subject (gnus-general-simplify-subject
- (setq whole-subject (mail-header-subject
+ (setq whole-subject (mail-header-subject
(caar threads)))))
(when subject
(if (setq hthread (gnus-gethash subject hashtb))
(defun gnus-gather-threads-by-references (threads)
"Gather threads by looking at References headers."
- (let ((idhashtb (gnus-make-hashtable 1023))
- (thhashtb (gnus-make-hashtable 1023))
+ (let ((idhashtb (gnus-make-hashtable 1024))
+ (thhashtb (gnus-make-hashtable 1024))
(prev threads)
(result threads)
ids references id gthread gid entered ref)
(setq threads (cdr threads)))
result))
+(defun gnus-thread-loop-p (root thread)
+ "Say whether ROOT is in THREAD."
+ (let ((stack (list thread))
+ (infloop 0)
+ th)
+ (while (setq thread (pop stack))
+ (setq th (cdr thread))
+ (while (and th
+ (not (eq (caar th) root)))
+ (pop th))
+ (if th
+ ;; We have found a loop.
+ (let (ref-dep)
+ (setcdr thread (delq (car th) (cdr thread)))
+ (if (boundp (setq ref-dep (intern "none"
+ gnus-newsgroup-dependencies)))
+ (setcdr (symbol-value ref-dep)
+ (nconc (cdr (symbol-value ref-dep))
+ (list (car th))))
+ (set ref-dep (list nil (car th))))
+ (setq infloop 1
+ stack nil))
+ ;; Push all the subthreads onto the stack.
+ (push (cdr thread) stack)))
+ infloop))
+
(defun gnus-make-threads ()
"Go through the dependency hashtb and find the roots. Return all threads."
(let (threads)
- (mapatoms
- (lambda (refs)
- (unless (car (symbol-value refs))
- ;; These threads do not refer back to any other articles,
- ;; so they're roots.
- (setq threads (append (cdr (symbol-value refs)) threads))))
- gnus-newsgroup-dependencies)
+ (while (catch 'infloop
+ (mapatoms
+ (lambda (refs)
+ ;; Deal with self-referencing References loops.
+ (when (and (car (symbol-value refs))
+ (not (zerop
+ (apply
+ '+
+ (mapcar
+ (lambda (thread)
+ (gnus-thread-loop-p
+ (car (symbol-value refs)) thread))
+ (cdr (symbol-value refs)))))))
+ (setq threads nil)
+ (throw 'infloop t))
+ (unless (car (symbol-value refs))
+ ;; These threads do not refer back to any other articles,
+ ;; so they're roots.
+ (setq threads (append (cdr (symbol-value refs)) threads))))
+ gnus-newsgroup-dependencies)))
threads))
(defun gnus-build-sparse-threads ()
(let ((headers gnus-newsgroup-headers)
(deps gnus-newsgroup-dependencies)
- header references generation relations
- cthread subject child end pthread relation)
- ;; First we create an alist of generations/relations, where
+ header references generation relations
+ cthread subject child end pthread relation new-child)
+ ;; First we create an alist of generations/relations, where
;; generations is how much we trust the relation, and the relation
;; is parent/child.
(gnus-message 7 "Making sparse threads...")
(while (search-backward ">" nil t)
(setq end (1+ (point)))
(when (search-backward "<" nil t)
- (push (list (incf generation)
- child (setq child (buffer-substring (point) end))
- subject)
- relations)))
+ (unless (string= (setq new-child (buffer-substring (point) end))
+ child)
+ (push (list (incf generation)
+ child (setq child new-child)
+ subject)
+ relations))))
(push (list (1+ generation) child nil subject) relations)
(erase-buffer)))
(kill-buffer (current-buffer)))
;; Sort over trustworthiness.
- (setq relations (sort relations (lambda (r1 r2) (< (car r1) (car r2)))))
+ (setq relations (sort relations 'car-less-than-car))
(while (setq relation (pop relations))
(when (if (boundp (setq cthread (intern (cadr relation) deps)))
(unless (car (symbol-value cthread))
;; Make this article the parent of these threads.
(setcar (symbol-value cthread)
- (vector gnus-reffed-article-number
+ (vector gnus-reffed-article-number
(cadddr relation)
"" ""
(cadr relation)
(prog1
(save-excursion
(set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (while (and (not found) (search-forward id nil t))
- (beginning-of-line)
- (setq found (looking-at
- (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
- (regexp-quote id))))
- (or found (beginning-of-line 2)))
- (when found
- (beginning-of-line)
- (and
- (setq header (gnus-nov-parse-line
- (read (current-buffer)) deps))
- (gnus-parent-id (mail-header-references header)))))
+ (let ((case-fold-search nil))
+ (goto-char (point-min))
+ (while (and (not found)
+ (search-forward id nil t))
+ (beginning-of-line)
+ (setq found (looking-at
+ (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
+ (regexp-quote id))))
+ (or found (beginning-of-line 2)))
+ (when found
+ (beginning-of-line)
+ (and
+ (setq header (gnus-nov-parse-line
+ (read (current-buffer)) deps))
+ (gnus-parent-id (mail-header-references header))))))
(when header
(let ((number (mail-header-number header)))
(push number gnus-newsgroup-limit)
(delq number gnus-newsgroup-unselected)))
(push number gnus-newsgroup-ancient)))))))
+(defun gnus-build-all-threads ()
+ "Read all the headers."
+ (let ((deps gnus-newsgroup-dependencies)
+ (gnus-summary-ignore-duplicates t)
+ found header article)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (let ((case-fold-search nil))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (ignore-errors
+ (setq article (read (current-buffer)))
+ (setq header (gnus-nov-parse-line article deps)))
+ (when header
+ (push header gnus-newsgroup-headers)
+ (if (memq (setq article (mail-header-number header))
+ gnus-newsgroup-unselected)
+ (progn
+ (push article gnus-newsgroup-unreads)
+ (setq gnus-newsgroup-unselected
+ (delq article gnus-newsgroup-unselected)))
+ (push article gnus-newsgroup-ancient))
+ (forward-line 1)))))))
+
(defun gnus-summary-update-article-line (article header)
"Update the line for ARTICLE using HEADERS."
(let* ((id (mail-header-id header))
header level nil (gnus-article-mark article)
(memq article gnus-newsgroup-replied)
(memq article gnus-newsgroup-expirable)
- (mail-header-subject header)
+ ;; Only insert the Subject string when it's different
+ ;; from the previous Subject string.
+ (if (gnus-subject-equal
+ (condition-case ()
+ (mail-header-subject
+ (gnus-data-header
+ (cadr
+ (gnus-data-find-list
+ article
+ (gnus-data-list t)))))
+ ;; Error on the side of excessive subjects.
+ (error ""))
+ (mail-header-subject header))
+ ""
+ (mail-header-subject header))
nil (cdr (assq article gnus-newsgroup-scored))
(memq article gnus-newsgroup-processable))
(when length
(gnus-data-update-list
(cdr datal) (- length (- (gnus-data-pos data) (point))))))))
-
+
(defun gnus-summary-update-article (article &optional iheader)
"Update ARTICLE in the summary buffer."
(set-buffer gnus-summary-buffer)
(references (mail-header-references header))
(parent
(gnus-id-to-thread
- (or (gnus-parent-id
+ (or (gnus-parent-id
(when (and references
(not (equal "" references)))
references))
(defun gnus-rebuild-thread (id)
"Rebuild the thread containing ID."
(let ((buffer-read-only nil)
- current thread data)
+ old-pos current thread data)
(if (not gnus-show-threads)
(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 current (save-excursion
(and (zerop (forward-line -1))
(gnus-summary-article-number))))
(setq data (nreverse gnus-newsgroup-data))
(setq threads gnus-newsgroup-threads))
;; We splice the new data into the data structure.
- (gnus-data-enter-list current data)
- (gnus-data-compute-positions)
+ (gnus-data-enter-list current data (- (point) old-pos))
(setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads)))))
(defun gnus-number-to-header (number)
(defun gnus-parent-headers (headers &optional generation)
"Return the headers of the GENERATIONeth parent of HEADERS."
- (unless generation
+ (unless generation
(setq generation 1))
- (let (references parent)
- (while (and headers (not (zerop generation)))
+ (let ((parent t)
+ references)
+ (while (and parent headers (not (zerop generation)))
(setq references (mail-header-references headers))
(when (and references
(setq parent (gnus-parent-id references))
(let ((level (gnus-summary-thread-level article))
(refs (mail-header-references (gnus-summary-article-header article)))
particle)
- (cond
+ (cond
((null level) nil)
((zerop level) t)
((null refs) t)
(defun gnus-root-id (id)
"Return the id of the root of the thread where ID appears."
(let (last-id prev)
- (while (and id (setq prev (car (gnus-gethash
+ (while (and id (setq prev (car (gnus-gethash
id gnus-newsgroup-dependencies))))
(setq last-id id
id (gnus-parent-id (mail-header-references prev))))
last-id))
+(defun gnus-articles-in-thread (thread)
+ "Return the list of articles in THREAD."
+ (cons (mail-header-number (car thread))
+ (apply 'nconc (mapcar 'gnus-articles-in-thread (cdr thread)))))
+
(defun gnus-remove-thread (id &optional dont-remove)
"Remove the thread that has ID in it."
(let ((dep gnus-newsgroup-dependencies)
;; If we use dummy roots, then we have to remove the
;; dummy root as well.
(when (eq gnus-summary-make-false-root 'dummy)
- ;; Uhm.
- )
+ (gnus-delete-line)
+ (gnus-data-compute-positions))
(setq thread (cdr thread))
(while thread
(gnus-remove-thread-1 (car thread))
(defun gnus-remove-thread-1 (thread)
"Remove the thread THREAD recursively."
- (let ((number (mail-header-number (car thread)))
- pos)
- (when (setq pos (text-property-any
- (point-min) (point-max) 'gnus-number number))
- (goto-char pos)
- (gnus-delete-line)
- (gnus-data-remove number))
- (setq thread (cdr thread))
+ (let ((number (mail-header-number (pop thread)))
+ d)
+ (setq thread (reverse thread))
(while thread
- (gnus-remove-thread-1 (pop thread)))))
+ (gnus-remove-thread-1 (pop thread)))
+ (when (setq d (gnus-data-find number))
+ (goto-char (gnus-data-pos d))
+ (gnus-data-remove
+ number
+ (- (gnus-point-at-bol)
+ (prog1
+ (1+ (gnus-point-at-eol))
+ (gnus-delete-line)))))))
(defun gnus-sort-threads (threads)
"Sort THREADS."
(gnus-message 7 "Sorting articles...")
(prog1
(setq gnus-newsgroup-headers
- (sort articles (gnus-make-sort-function
+ (sort articles (gnus-make-sort-function
gnus-article-sort-functions)))
(gnus-message 7 "Sorting articles...done"))))
(gnus-article-sort-by-number
(gnus-thread-header h1) (gnus-thread-header h2)))
+(defsubst gnus-article-sort-by-lines (h1 h2)
+ "Sort articles by article Lines header."
+ (< (mail-header-lines h1)
+ (mail-header-lines h2)))
+
+(defun gnus-thread-sort-by-lines (h1 h2)
+ "Sort threads by root article Lines header."
+ (gnus-article-sort-by-lines
+ (gnus-thread-header h1) (gnus-thread-header h2)))
+
(defsubst gnus-article-sort-by-author (h1 h2)
"Sort articles by root author."
(string-lessp
(let ((extract (funcall
gnus-extract-address-components
(mail-header-from h1))))
- (or (car extract) (cdr extract)))
+ (or (car extract) (cadr extract) ""))
(let ((extract (funcall
gnus-extract-address-components
(mail-header-from h2))))
- (or (car extract) (cdr extract)))))
+ (or (car extract) (cadr extract) ""))))
(defun gnus-thread-sort-by-author (h1 h2)
"Sort threads by root author."
gnus-tmp-header nil))
;; If the article lies outside the current limit,
;; then we do not display it.
- ((and (not (memq number gnus-newsgroup-limit))
- (not gnus-tmp-dummy-line))
+ ((not (memq number gnus-newsgroup-limit))
(setq gnus-tmp-gathered
(nconc (mapcar
(lambda (h) (mail-header-number (car h)))
default-score)
gnus-summary-mark-below)
;; Don't touch sparse articles.
- (not (memq number gnus-newsgroup-sparse))
- (not (memq number gnus-newsgroup-ancient)))
+ (not (gnus-summary-article-sparse-p number))
+ (not (gnus-summary-article-ancient-p number)))
(setq gnus-newsgroup-unreads
(delq number gnus-newsgroup-unreads))
(if gnus-newsgroup-auto-expire
'gnus-number number)
(when gnus-visual-p
(forward-line -1)
- (run-hooks 'gnus-summary-update-hook)
+ (gnus-run-hooks 'gnus-summary-update-hook)
(forward-line 1))
(setq gnus-tmp-prev-subject subject)))
"Generate an unthreaded summary buffer based on HEADERS."
(let (header number mark)
+ (beginning-of-line)
+
(while headers
;; We may have to root out some bad articles...
(when (memq (setq number (mail-header-number
(< (or (cdr (assq number gnus-newsgroup-scored))
gnus-summary-default-score 0)
gnus-summary-mark-below)
- (not (memq number gnus-newsgroup-ancient)))
+ (not (gnus-summary-article-ancient-p number)))
(setq gnus-newsgroup-unreads
(delq number gnus-newsgroup-unreads))
(if gnus-newsgroup-auto-expire
"Select newsgroup GROUP.
If READ-ALL is non-nil, all articles in the group are selected."
(let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
+ ;;!!! Dirty hack; should be removed.
+ (gnus-summary-ignore-duplicates
+ (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual)
+ t
+ gnus-summary-ignore-duplicates))
(info (nth 2 entry))
articles fetched-articles cached)
(unless (gnus-check-server
- (setq gnus-current-select-method (gnus-find-method-for-group group)))
+ (setq gnus-current-select-method
+ (gnus-find-method-for-group group)))
(error "Couldn't open server"))
(or (and entry (not (eq (car entry) t))) ; Either it's active...
(setq gnus-newsgroup-processable nil)
+ (gnus-update-read-articles group gnus-newsgroup-unreads)
+ (unless (gnus-ephemeral-group-p gnus-newsgroup-name)
+ (gnus-group-update-group group))
+
(setq articles (gnus-articles-to-read group read-all))
(cond
(not (eq gnus-fetch-old-headers 'some))
(not (numberp gnus-fetch-old-headers)))
(> (length articles) 1))))))
- (gnus-get-newsgroup-headers-xover articles)
+ (gnus-get-newsgroup-headers-xover
+ articles nil nil gnus-newsgroup-name t)
(gnus-get-newsgroup-headers)))
(gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)
;; Removed marked articles that do not exist.
(gnus-update-missing-marks
(gnus-sorted-complement fetched-articles articles))
+ ;; Let the Gnus agent mark articles as read.
+ (when gnus-agent
+ (gnus-agent-get-undownloaded-list))
;; We might want to build some more threads first.
- (and gnus-fetch-old-headers
- (eq gnus-headers-retrieved-by 'nov)
- (gnus-build-old-threads))
+ (when (and gnus-fetch-old-headers
+ (eq gnus-headers-retrieved-by 'nov))
+ (if (eq gnus-fetch-old-headers 'invisible)
+ (gnus-build-all-threads)
+ (gnus-build-old-threads)))
;; Check whether auto-expire is to be done in this group.
(setq gnus-newsgroup-auto-expire
(gnus-group-auto-expirable-p group))
;; GROUP is successfully selected.
(or gnus-newsgroup-headers t)))))
-(defun gnus-articles-to-read (group read-all)
+(defun gnus-articles-to-read (group &optional read-all)
;; Find out what articles the user wants to read.
(let* ((articles
;; Select all articles if `read-all' is non-nil, or if there
(read-string
(format
"How many articles from %s (default %d): "
- gnus-newsgroup-name number))))
+ (gnus-limit-string gnus-newsgroup-name 35)
+ number))))
(if (string-match "^[ \t]*$" input) number input)))
((and (> scored marked) (< scored number)
(> (- scored number) 20))
;; All articles have to be subsets of the active articles.
(cond
;; Adjust "simple" lists.
- ((memq mark '(tick dormant expirable reply save))
+ ((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))))))
;; Adjust assocs.
((memq mark uncompressed)
+ (when (not (listp (cdr (symbol-value var))))
+ (set var (list (symbol-value var))))
+ (when (not (listp (cdr articles)))
+ (setq articles (list articles)))
(while articles
(when (or (not (consp (setq article (pop articles))))
(< (car article) min)
(set var (delq article (symbol-value var))))))))))
(defun gnus-update-missing-marks (missing)
- "Go through the list of MISSING articles and remove them mark lists."
+ "Go through the list of MISSING articles and remove them from the mark lists."
(when missing
(let ((types gnus-article-mark-lists)
var m)
type list newmarked symbol)
(when info
;; Add all marks lists that are non-nil to the list of marks lists.
- (while types
- (setq type (pop types))
+ (while (setq type (pop types))
(when (setq list (symbol-value
(setq symbol
(intern (format "gnus-newsgroup-%s"
(car type))))))
+
+ ;; Get rid of the entries of the articles that have the
+ ;; default score.
+ (when (and (eq (cdr type) 'score)
+ gnus-save-score
+ list)
+ (let* ((arts list)
+ (prev (cons nil list))
+ (all prev))
+ (while arts
+ (if (or (not (consp (car arts)))
+ (= (cdar arts) gnus-summary-default-score))
+ (setcdr prev (cdr arts))
+ (setq prev arts))
+ (setq arts (cdr arts)))
+ (setq list (cdr all))))
+
(push (cons (cdr type)
(if (memq (cdr type) uncompressed) list
- (gnus-compress-sequence
+ (gnus-compress-sequence
(set symbol (sort list '<)) t)))
newmarked)))
(gnus-mode-string-quote
(mail-header-subject gnus-current-headers))
""))
- max-len
+ bufname-length max-len
gnus-tmp-header);; passed as argument to any user-format-funcs
(setq mode-string (eval mformat))
+ (setq bufname-length (if (string-match "%b" mode-string)
+ (- (length
+ (buffer-name
+ (if (eq where 'summary)
+ nil
+ (get-buffer gnus-article-buffer))))
+ 2)
+ 0))
(setq max-len (max 4 (if gnus-mode-non-string-length
(- (window-width)
- gnus-mode-non-string-length)
+ gnus-mode-non-string-length
+ bufname-length)
(length mode-string))))
;; We might have to chop a bit of the string off...
(when (> (length mode-string) max-len)
;; Pad the mode string a bit.
(setq mode-string (format (format "%%-%ds" max-len) mode-string))))
;; Update the mode line.
- (setq mode-line-buffer-identification
- (gnus-mode-line-buffer-identification
- (list mode-string)))
+ (setq mode-line-buffer-identification
+ (gnus-mode-line-buffer-identification (list mode-string)))
(set-buffer-modified-p t))))
(defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
The resulting hash table is returned, or nil if no Xrefs were found."
(let* ((virtual (gnus-virtual-group-p from-newsgroup))
(prefix (if virtual "" (gnus-group-real-prefix from-newsgroup)))
- (xref-hashtb (make-vector 63 0))
+ (xref-hashtb (gnus-make-hashtable))
start group entry number xrefs header)
(while headers
(setq header (pop headers))
(gnus-group-make-articles-read name idlist))))
xref-hashtb)))))
-(defun gnus-group-make-articles-read (group articles)
- "Update the info of GROUP to say that only ARTICLES are unread."
+(defun gnus-compute-read-articles (group articles)
+ (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
+ (info (nth 2 entry))
+ (active (gnus-active group))
+ ninfo)
+ (when entry
+ ;; First peel off all illegal article numbers.
+ (when active
+ (let ((ids articles)
+ id first)
+ (while (setq id (pop ids))
+ (when (and first (> id (cdr active)))
+ ;; We'll end up in this situation in one particular
+ ;; obscure situation. If you re-scan a group and get
+ ;; a new article that is cross-posted to a different
+ ;; group that has not been re-scanned, you might get
+ ;; crossposted article that has a higher number than
+ ;; Gnus believes possible. So we re-activate this
+ ;; group as well. This might mean doing the
+ ;; crossposting thingy will *increase* the number
+ ;; of articles in some groups. Tsk, tsk.
+ (setq active (or (gnus-activate-group group) active)))
+ (when (or (> id (cdr active))
+ (< id (car active)))
+ (setq articles (delq id articles))))))
+ ;; If the read list is nil, we init it.
+ (if (and active
+ (null (gnus-info-read info))
+ (> (car active) 1))
+ (setq ninfo (cons 1 (1- (car active))))
+ (setq ninfo (gnus-info-read info)))
+ ;; Then we add the read articles to the range.
+ (gnus-add-to-range
+ ninfo (setq articles (sort articles '<))))))
+
+(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))
(info (nth 2 entry))
(active (gnus-active group))
range)
- ;; First peel off all illegal article numbers.
- (when active
- (let ((ids articles)
- id first)
- (while (setq id (pop ids))
- (when (and first (> id (cdr active)))
- ;; We'll end up in this situation in one particular
- ;; obscure situation. If you re-scan a group and get
- ;; a new article that is cross-posted to a different
- ;; group that has not been re-scanned, you might get
- ;; crossposted article that has a higher number than
- ;; Gnus believes possible. So we re-activate this
- ;; group as well. This might mean doing the
- ;; crossposting thingy will *increase* the number
- ;; of articles in some groups. Tsk, tsk.
- (setq active (or (gnus-activate-group group) active)))
- (when (or (> id (cdr active))
- (< id (car active)))
- (setq articles (delq id articles))))))
- (gnus-undo-register
- `(progn
- (gnus-info-set-marks ',info ',(gnus-info-marks info))
- (gnus-info-set-read ',info ',(gnus-info-read info))
- (gnus-group-update-group group t)))
- ;; If the read list is nil, we init it.
- (and active
- (null (gnus-info-read info))
- (> (car active) 1)
- (gnus-info-set-read info (cons 1 (1- (car active)))))
- ;; Then we add the read articles to the range.
- (gnus-info-set-read
- info
- (setq range
- (gnus-add-to-range
- (gnus-info-read info) (setq articles (sort articles '<)))))
- ;; Then we have to re-compute how many unread
- ;; articles there are in this group.
- (when active
- (cond
- ((not range)
- (setq num (- (1+ (cdr active)) (car active))))
- ((not (listp (cdr range)))
- (setq num (- (cdr active) (- (1+ (cdr range))
- (car range)))))
- (t
- (while range
- (if (numberp (car range))
- (setq num (1+ num))
- (setq num (+ num (- (1+ (cdar range)) (caar range)))))
- (setq range (cdr range)))
- (setq num (- (cdr active) num))))
- ;; Update the number of unread articles.
- (setcar entry num)
- ;; Update the group buffer.
- (gnus-group-update-group group t))))
+ (when entry
+ (setq range (gnus-compute-read-articles group articles))
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-undo-register
+ `(progn
+ (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
+ (gnus-info-set-read ',info ',(gnus-info-read info))
+ (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
+ (gnus-group-update-group ,group t))))
+ ;; Add the read articles to the range.
+ (gnus-info-set-read info range)
+ ;; Then we have to re-compute how many unread
+ ;; articles there are in this group.
+ (when active
+ (cond
+ ((not range)
+ (setq num (- (1+ (cdr active)) (car active))))
+ ((not (listp (cdr range)))
+ (setq num (- (cdr active) (- (1+ (cdr range))
+ (car range)))))
+ (t
+ (while range
+ (if (numberp (car range))
+ (setq num (1+ num))
+ (setq num (+ num (- (1+ (cdar range)) (caar range)))))
+ (setq range (cdr range)))
+ (setq num (- (cdr active) num))))
+ ;; Update the number of unread articles.
+ (setcar entry num)
+ ;; Update the group buffer.
+ (gnus-group-update-group group t)))))
(defun gnus-methods-equal-p (m1 m2)
(let ((m1 (or m1 gnus-select-method))
(set-buffer nntp-server-buffer)
;; Translate all TAB characters into SPACE characters.
(subst-char-in-region (point-min) (point-max) ?\t ? t)
- (run-hooks 'gnus-parse-headers-hook)
+ (gnus-run-hooks 'gnus-parse-headers-hook)
(let ((case-fold-search t)
in-reply-to header p lines)
(goto-char (point-min))
(progn
(goto-char p)
(if (search-forward "\nsubject: " nil t)
- (nnheader-header-value) "(none)"))
+ (funcall
+ gnus-unstructured-field-decoder (nnheader-header-value))
+ "(none)"))
;; From.
(progn
(goto-char p)
(if (search-forward "\nfrom: " nil t)
- (nnheader-header-value) "(nobody)"))
+ (funcall
+ gnus-structured-field-decoder (nnheader-header-value))
+ "(nobody)"))
;; Date.
(progn
(goto-char p)
;; Message-ID.
(progn
(goto-char p)
- (if (search-forward "\nmessage-id: " nil t)
- (setq id (nnheader-header-value))
- ;; If there was no message-id, we just fake one to make
- ;; subsequent routines simpler.
- (setq id (concat "none+"
- (int-to-string
- (setq gnus-newsgroup-none-id
- (1+ gnus-newsgroup-none-id)))))))
+ (setq id (if (re-search-forward
+ "^message-id: *\\(<[^\n\t> ]+>\\)" nil t)
+ ;; We do it this way to make sure the Message-ID
+ ;; is (somewhat) syntactically valid.
+ (buffer-substring (match-beginning 1)
+ (match-end 1))
+ ;; If there was no message-id, we just fake one
+ ;; to make subsequent routines simpler.
+ (nnheader-generate-fake-message-id))))
;; References.
(progn
(goto-char p)
(if (and (search-forward "\nin-reply-to: " nil t)
(setq in-reply-to (nnheader-header-value))
(string-match "<[^>]+>" in-reply-to))
- (setq ref (substring in-reply-to (match-beginning 0)
- (match-end 0)))
+ (let (ref2)
+ (setq ref (substring in-reply-to (match-beginning 0)
+ (match-end 0)))
+ (while (string-match "<[^>]+>" in-reply-to (match-end 0))
+ (setq ref2 (substring in-reply-to (match-beginning 0)
+ (match-end 0)))
+ (when (> (length ref2) (length ref))
+ (setq ref ref2))))
(setq ref nil))))
;; Chars.
0
(progn
(goto-char p)
(if (search-forward "\nlines: " nil t)
- (if (numberp (setq lines (read cur)))
+ (if (numberp (setq lines (ignore-errors (read cur))))
lines 0)
0))
;; Xref.
(nnheader-header-value)))))
(when (equal id ref)
(setq ref nil))
+
+ (when gnus-alter-header-function
+ (funcall gnus-alter-header-function header)
+ (setq id (mail-header-id header)
+ ref (gnus-parent-id (mail-header-references header))))
+
;; We do the threading while we read the headers. The
;; message-id and the last reference are both entered into
;; the same hash table. Some tippy-toeing around has to be
(if (boundp (setq id-dep (intern id dependencies)))
(if (and (car (symbol-value id-dep))
(not force-new))
- ;; An article with this Message-ID has already
- ;; been seen, so we ignore this one, except we add
- ;; any additional Xrefs (in case the two articles
- ;; came from different servers).
- (progn
- (mail-header-set-xref
- (car (symbol-value id-dep))
- (concat (or (mail-header-xref
- (car (symbol-value id-dep)))
- "")
- (or (mail-header-xref header) "")))
- (setq header nil))
+ ;; An article with this Message-ID has already been seen.
+ (if gnus-summary-ignore-duplicates
+ ;; We ignore this one, except we add
+ ;; any additional Xrefs (in case the two articles
+ ;; came from different servers).
+ (progn
+ (mail-header-set-xref
+ (car (symbol-value id-dep))
+ (concat (or (mail-header-xref
+ (car (symbol-value id-dep)))
+ "")
+ (or (mail-header-xref header) "")))
+ (setq header nil))
+ ;; We rename the Message-ID.
+ (set
+ (setq id-dep (intern (setq id (nnmail-message-id))
+ dependencies))
+ (list header))
+ (mail-header-set-id header id))
(setcar (symbol-value id-dep) header))
(set id-dep (list header)))
- (when header
+ (when header
(if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
(setcdr (symbol-value ref-dep)
(nconc (cdr (symbol-value ref-dep))
(let ((num (ignore-errors (read buffer))))
(if (numberp num) num 0)))
(unless (eobp)
- (forward-char 1))))
+ (search-forward "\t" eol 'move))))
(defmacro gnus-nov-skip-field ()
'(search-forward "\t" eol 'move))
(defmacro gnus-nov-field ()
'(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
-(defvar gnus-nov-none-counter 0)
+;; (defvar gnus-nov-none-counter 0)
;; This function has to be called with point after the article number
;; on the beginning of the line.
header ref id id-dep ref-dep)
;; overview: [num subject from date id refs chars lines misc]
- (narrow-to-region (point) eol)
- (unless (eobp)
- (forward-char))
-
- (setq header
- (vector
- number ; number
- (gnus-nov-field) ; subject
- (gnus-nov-field) ; from
- (gnus-nov-field) ; date
- (setq id (or (gnus-nov-field)
- (concat "none+"
- (int-to-string
- (incf gnus-nov-none-counter))))) ; id
- (progn
- (let ((beg (point)))
- (search-forward "\t" eol)
- (if (search-backward ">" beg t)
- (setq ref
- (buffer-substring
- (1+ (point))
- (search-backward "<" beg t)))
- (setq ref nil))
- (goto-char beg))
- (gnus-nov-field)) ; refs
- (gnus-nov-read-integer) ; chars
- (gnus-nov-read-integer) ; lines
- (if (= (following-char) ?\n)
- nil
- (gnus-nov-field)) ; misc
- ))
-
- (widen)
-
+ (unwind-protect
+ (progn
+ (narrow-to-region (point) eol)
+ (unless (eobp)
+ (forward-char))
+
+ (setq header
+ (vector
+ number ; number
+ (funcall
+ gnus-unstructured-field-decoder (gnus-nov-field)) ; subject
+ (funcall
+ gnus-structured-field-decoder (gnus-nov-field)) ; from
+ (gnus-nov-field) ; date
+ (setq id (or (gnus-nov-field)
+ (nnheader-generate-fake-message-id))) ; id
+ (progn
+ (let ((beg (point)))
+ (search-forward "\t" eol)
+ (if (search-backward ">" beg t)
+ (setq ref
+ (buffer-substring
+ (1+ (point))
+ (or (search-backward "<" beg t) beg)))
+ (setq ref nil))
+ (goto-char beg))
+ (gnus-nov-field)) ; refs
+ (gnus-nov-read-integer) ; chars
+ (gnus-nov-read-integer) ; lines
+ (if (= (following-char) ?\n)
+ nil
+ (gnus-nov-field))))) ; misc
+
+ (widen))
+
+ (when gnus-alter-header-function
+ (funcall gnus-alter-header-function header)
+ (setq id (mail-header-id header)
+ ref (gnus-parent-id (mail-header-references header))))
+
;; We build the thread tree.
(when (equal id ref)
;; This article refers back to itself. Naughty, naughty.
(if (boundp (setq id-dep (intern id dependencies)))
(if (and (car (symbol-value id-dep))
(not force-new))
- ;; An article with this Message-ID has already been seen,
- ;; so we ignore this one, except we add any additional
- ;; Xrefs (in case the two articles came from different
- ;; servers.
- (progn
- (mail-header-set-xref
- (car (symbol-value id-dep))
- (concat (or (mail-header-xref
- (car (symbol-value id-dep)))
- "")
- (or (mail-header-xref header) "")))
- (setq header nil))
+ ;; An article with this Message-ID has already been seen.
+ (if gnus-summary-ignore-duplicates
+ ;; We ignore this one, except we add any additional
+ ;; Xrefs (in case the two articles came from different
+ ;; servers.
+ (progn
+ (mail-header-set-xref
+ (car (symbol-value id-dep))
+ (concat (or (mail-header-xref
+ (car (symbol-value id-dep)))
+ "")
+ (or (mail-header-xref header) "")))
+ (setq header nil))
+ ;; We rename the Message-ID.
+ (set
+ (setq id-dep (intern (setq id (nnmail-message-id))
+ dependencies))
+ (list header))
+ (mail-header-set-id header id))
(setcar (symbol-value id-dep) header))
(set id-dep (list header)))
(when header
header))
;; Goes through the xover lines and returns a list of vectors
-(defun gnus-get-newsgroup-headers-xover (sequence &optional
- force-new dependencies)
+(defun gnus-get-newsgroup-headers-xover (sequence &optional
+ force-new dependencies
+ group also-fetch-heads)
"Parse the news overview data in the server buffer, and return a
list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
;; Get the Xref when the users reads the articles since most/some
(save-excursion
(set-buffer nntp-server-buffer)
;; Allow the user to mangle the headers before parsing them.
- (run-hooks 'gnus-parse-headers-hook)
+ (gnus-run-hooks 'gnus-parse-headers-hook)
(goto-char (point-min))
(while (not (eobp))
(condition-case ()
(push header headers))
(forward-line 1))
(error
- (gnus-error 4 "Strange nov line")))
+ (gnus-error 4 "Strange nov line (%d)"
+ (count-lines (point-min) (point)))))
(forward-line 1))
- (nreverse headers))))
+ ;; A common bug in inn is that if you have posted an article and
+ ;; then retrieves the active file, it will answer correctly --
+ ;; the new article is included. However, a NOV entry for the
+ ;; article may not have been generated yet, so this may fail.
+ ;; We work around this problem by retrieving the last few
+ ;; headers using HEAD.
+ (if (or (not also-fetch-heads)
+ (not sequence))
+ ;; We (probably) got all the headers.
+ (nreverse headers)
+ (let ((gnus-nov-is-evil t))
+ (nconc
+ (nreverse headers)
+ (when (gnus-retrieve-headers sequence group)
+ (gnus-get-newsgroup-headers))))))))
(defun gnus-article-get-xrefs ()
"Fill in the Xref value in `gnus-current-headers', if necessary.
(defun gnus-summary-insert-subject (id &optional old-header use-old-header)
"Find article ID and insert the summary line for that article."
- (let ((header (if (and old-header use-old-header)
- old-header (gnus-read-header id)))
+ (let ((header (cond ((and old-header use-old-header)
+ old-header)
+ ((and (numberp id)
+ (gnus-number-to-header id))
+ (gnus-number-to-header id))
+ (t
+ (gnus-read-header id))))
(number (and (numberp id) id))
- pos)
+ pos d)
(when header
;; Rebuild the thread that this article is part of and go to the
;; article we have fetched.
(when (and (not gnus-show-threads)
old-header)
- (when (setq pos (text-property-any
- (point-min) (point-max) 'gnus-number
- (mail-header-number old-header)))
- (goto-char pos)
- (gnus-delete-line)
- (gnus-data-remove (mail-header-number old-header))))
+ (when (setq d (gnus-data-find (mail-header-number old-header)))
+ (goto-char (gnus-data-pos d))
+ (gnus-data-remove
+ number
+ (- (gnus-point-at-bol)
+ (prog1
+ (1+ (gnus-point-at-eol))
+ (gnus-delete-line))))))
(when old-header
(mail-header-set-number header (mail-header-number old-header)))
(setq gnus-newsgroup-sparse
(delq (setq number (mail-header-number header))
gnus-newsgroup-sparse))
(setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient))
+ (push number gnus-newsgroup-limit)
(gnus-rebuild-thread (mail-header-id header))
(gnus-summary-goto-subject number nil t))
(when (and (numberp number)
"Return a list of articles to be worked upon. The prefix argument,
the list of process marked articles, and the current article will be
taken into consideration."
- (cond
- (n
- ;; A numerical prefix has been given.
- (let ((backward (< n 0))
- (n (abs (prefix-numeric-value n)))
- articles article)
- (save-excursion
- (while
- (and (> n 0)
- (push (setq article (gnus-summary-article-number))
- articles)
- (if backward
- (gnus-summary-find-prev nil article)
- (gnus-summary-find-next nil article)))
- (decf n)))
- (nreverse articles)))
- ((and (boundp 'transient-mark-mode)
- transient-mark-mode
- mark-active)
- ;; Work on the region between point and mark.
- (let ((max (max (point) (mark)))
- articles article)
- (save-excursion
- (goto-char (min (point) (mark)))
- (while
- (and
- (push (setq article (gnus-summary-article-number)) articles)
- (gnus-summary-find-next nil article)
- (< (point) max)))
- (nreverse articles))))
- (gnus-newsgroup-processable
- ;; There are process-marked articles present.
- ;; Save current state.
- (gnus-summary-save-process-mark)
- ;; Return the list.
- (reverse gnus-newsgroup-processable))
- (t
- ;; Just return the current article.
- (list (gnus-summary-article-number)))))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (cond
+ (n
+ ;; A numerical prefix has been given.
+ (setq n (prefix-numeric-value n))
+ (let ((backward (< n 0))
+ (n (abs (prefix-numeric-value n)))
+ articles article)
+ (save-excursion
+ (while
+ (and (> n 0)
+ (push (setq article (gnus-summary-article-number))
+ articles)
+ (if backward
+ (gnus-summary-find-prev nil article)
+ (gnus-summary-find-next nil article)))
+ (decf n)))
+ (nreverse articles)))
+ ((and (gnus-region-active-p) (mark))
+ (message "region active")
+ ;; Work on the region between point and mark.
+ (let ((max (max (point) (mark)))
+ articles article)
+ (save-excursion
+ (goto-char (min (min (point) (mark))))
+ (while
+ (and
+ (push (setq article (gnus-summary-article-number)) articles)
+ (gnus-summary-find-next nil article)
+ (< (point) max)))
+ (nreverse articles))))
+ (gnus-newsgroup-processable
+ ;; There are process-marked articles present.
+ ;; Save current state.
+ (gnus-summary-save-process-mark)
+ ;; Return the list.
+ (reverse gnus-newsgroup-processable))
+ (t
+ ;; Just return the current article.
+ (list (gnus-summary-article-number))))))
(defun gnus-summary-save-process-mark ()
"Push the current set of process marked articles on the stack."
;; possible valid number, or the second line from the top,
;; whichever is the least.
(set-window-start
- window (min bottom (save-excursion
+ window (min bottom (save-excursion
(forward-line (- top)) (point)))))
;; Do horizontal recentering while we're at it.
(when (and (get-buffer-window (current-buffer) t)
(push first unread)
(setq first (1+ first)))
;; Return the list of unread articles.
- (nreverse unread)))
+ (delq 0 (nreverse unread))))
(defun gnus-list-of-read-articles (group)
"Return a list of unread, unticked and non-dormant articles."
;; Various summary commands
+(defun gnus-summary-select-article-buffer ()
+ "Reconfigure windows to show article buffer."
+ (interactive)
+ (if (not (gnus-buffer-live-p gnus-article-buffer))
+ (error "There is no article buffer for this summary buffer")
+ (gnus-configure-windows 'article)
+ (select-window (get-buffer-window gnus-article-buffer))))
+
(defun gnus-summary-universal-argument (arg)
"Perform any operation on all articles that are process/prefixed."
(interactive "P")
- (gnus-set-global-variables)
(let ((articles (gnus-summary-work-articles arg))
func article)
(if (eq
"Exit and then reselect the current newsgroup.
The prefix argument ALL means to select all articles."
(interactive "P")
- (gnus-set-global-variables)
(when (gnus-ephemeral-group-p gnus-newsgroup-name)
(error "Ephemeral groups can't be reselected"))
(let ((current-subject (gnus-summary-article-number))
(group gnus-newsgroup-name))
(setq gnus-newsgroup-begin nil)
(gnus-summary-exit)
- ;; We have to adjust the point of group mode buffer because the
- ;; current point was moved to the next unread newsgroup by
- ;; exiting.
+ ;; 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)
(when rescan
(save-excursion
(interactive "P")
(gnus-summary-reselect-current-group all t))
-(defun gnus-summary-update-info ()
- (let ((group gnus-newsgroup-name))
- (when gnus-newsgroup-kill-headers
- (setq gnus-newsgroup-killed
- (gnus-compress-sequence
- (nconc
- (gnus-set-sorted-intersection
- (gnus-uncompress-range gnus-newsgroup-killed)
- (setq gnus-newsgroup-unselected
- (sort gnus-newsgroup-unselected '<)))
- (setq gnus-newsgroup-unreads
- (sort gnus-newsgroup-unreads '<)))
- t)))
- (unless (listp (cdr gnus-newsgroup-killed))
- (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
- (let ((headers gnus-newsgroup-headers))
- (run-hooks 'gnus-exit-group-hook)
- (unless gnus-save-score
- (setq gnus-newsgroup-scored nil))
- ;; Set the new ranges of read articles.
- (gnus-update-read-articles
- group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
- ;; Set the current article marks.
- (gnus-update-marks)
- ;; Do the cross-ref thing.
- (when gnus-use-cross-reference
- (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
- ;; Do adaptive scoring, and possibly save score files.
- (when gnus-newsgroup-adaptive
- (gnus-score-adaptive))
- (when gnus-use-scoring
- (gnus-score-save))
- ;; Do not switch windows but change the buffer to work.
- (set-buffer gnus-group-buffer)
- (unless (gnus-ephemeral-group-p gnus-newsgroup-name)
- (gnus-group-update-group group)))))
+(defun gnus-summary-update-info (&optional non-destructive)
+ (save-excursion
+ (let ((group gnus-newsgroup-name))
+ (when group
+ (when gnus-newsgroup-kill-headers
+ (setq gnus-newsgroup-killed
+ (gnus-compress-sequence
+ (nconc
+ (gnus-set-sorted-intersection
+ (gnus-uncompress-range gnus-newsgroup-killed)
+ (setq gnus-newsgroup-unselected
+ (sort gnus-newsgroup-unselected '<)))
+ (setq gnus-newsgroup-unreads
+ (sort gnus-newsgroup-unreads '<)))
+ t)))
+ (unless (listp (cdr gnus-newsgroup-killed))
+ (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
+ (let ((headers gnus-newsgroup-headers))
+ (when (and (not gnus-save-score)
+ (not non-destructive))
+ (setq gnus-newsgroup-scored nil))
+ ;; Set the new ranges of read articles.
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-undo-force-boundary))
+ (gnus-update-read-articles
+ group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
+ ;; Set the current article marks.
+ (gnus-update-marks)
+ ;; Do the cross-ref thing.
+ (when gnus-use-cross-reference
+ (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
+ ;; Do not switch windows but change the buffer to work.
+ (set-buffer gnus-group-buffer)
+ (unless (gnus-ephemeral-group-p group)
+ (gnus-group-update-group group)))))))
+
+(defun gnus-summary-save-newsrc (&optional force)
+ "Save the current number of read/marked articles in the dribble buffer.
+The dribble buffer will then be saved.
+If FORCE (the prefix), also save the .newsrc file(s)."
+ (interactive "P")
+ (gnus-summary-update-info t)
+ (if force
+ (gnus-save-newsrc-file)
+ (gnus-dribble-save)))
(defun gnus-summary-exit (&optional temporary)
"Exit reading current newsgroup, and then return to group selection mode.
(interactive)
(gnus-set-global-variables)
(gnus-kill-save-kill-buffer)
+ (gnus-async-halt-prefetch)
(let* ((group gnus-newsgroup-name)
(quit-config (gnus-group-quit-config gnus-newsgroup-name))
(mode major-mode)
+ (group-point nil)
(buf (current-buffer)))
- (run-hooks 'gnus-summary-prepare-exit-hook)
+ (gnus-run-hooks 'gnus-summary-prepare-exit-hook)
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-original-article-buffer)
(gnus-dup-enter-articles))
(when gnus-use-trees
(gnus-tree-close group))
+ ;; Remove entries for this group.
+ (nnmail-purge-split-history (gnus-group-real-name group))
;; Make all changes in this group permanent.
(unless quit-config
- (gnus-summary-update-info))
+ (gnus-run-hooks 'gnus-exit-group-hook)
+ (gnus-summary-update-info)
+ ;; Do adaptive scoring, and possibly save score files.
+ (when gnus-newsgroup-adaptive
+ (gnus-score-adaptive))
+ (when gnus-use-scoring
+ (gnus-score-save)))
(gnus-close-group group)
- ;; Make sure where I was, and go to next newsgroup.
+ ;; Make sure where we were, and go to next newsgroup.
(set-buffer gnus-group-buffer)
(unless quit-config
(gnus-group-jump-to-group group))
- (run-hooks 'gnus-summary-exit-hook)
- (unless quit-config
+ (gnus-run-hooks 'gnus-summary-exit-hook)
+ (unless (or quit-config
+ ;; If this group has disappeared from the summary
+ ;; buffer, don't skip forwards.
+ (not (string= group (gnus-group-group-name))))
(gnus-group-next-unread-group 1))
+ (setq group-point (point))
(if temporary
nil ;Nothing to do.
;; If we have several article buffers, we kill them at exit.
;; Clear the current group name.
(if (not quit-config)
(progn
- (gnus-group-jump-to-group group)
- (gnus-group-next-unread-group 1)
+ (goto-char group-point)
(gnus-configure-windows 'group 'force))
(gnus-handle-ephemeral-exit quit-config))
(unless quit-config
(defun gnus-summary-exit-no-update (&optional no-questions)
"Quit reading current newsgroup without updating read article info."
(interactive)
- (gnus-set-global-variables)
(let* ((group gnus-newsgroup-name)
(quit-config (gnus-group-quit-config group)))
(when (or no-questions
gnus-expert-user
- (gnus-y-or-n-p "Do you really wanna quit reading this group? "))
+ (gnus-y-or-n-p "Discard changes to this group and exit? "))
+ (gnus-async-halt-prefetch)
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-article-buffer)
(suppress-keymap gnus-dead-summary-mode-map)
(substitute-key-definition
'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
- (let ((keys '("\C-d" "\r" "\177")))
+ (let ((keys '("\C-d" "\r" "\177" [delete])))
(while keys
(define-key gnus-dead-summary-mode-map
(pop keys) 'gnus-summary-wake-up-the-dead))))
(if (null arg) (not gnus-dead-summary-mode)
(> (prefix-numeric-value arg) 0)))
(when gnus-dead-summary-mode
- (unless (assq 'gnus-dead-summary-mode minor-mode-alist)
- (push '(gnus-dead-summary-mode " Dead") minor-mode-alist))
- (unless (assq 'gnus-dead-summary-mode minor-mode-map-alist)
- (push (cons 'gnus-dead-summary-mode gnus-dead-summary-mode-map)
- minor-mode-map-alist)))))
+ (gnus-add-minor-mode
+ 'gnus-dead-summary-mode " Dead" gnus-dead-summary-mode-map))))
(defun gnus-deaden-summary ()
"Make the current summary buffer into a dead summary buffer."
(defun gnus-kill-or-deaden-summary (buffer)
"Kill or deaden the summary BUFFER."
- (when (and (buffer-name buffer)
- (not gnus-single-article-buffer))
- (save-excursion
- (set-buffer buffer)
- (gnus-kill-buffer gnus-article-buffer)
- (gnus-kill-buffer gnus-original-article-buffer)))
- (cond (gnus-kill-summary-on-exit
- (when (and gnus-use-trees
- (and (get-buffer buffer)
- (buffer-name (get-buffer buffer))))
+ (save-excursion
+ (when (and (buffer-name buffer)
+ (not gnus-single-article-buffer))
+ (save-excursion
+ (set-buffer buffer)
+ (gnus-kill-buffer gnus-article-buffer)
+ (gnus-kill-buffer gnus-original-article-buffer)))
+ (cond (gnus-kill-summary-on-exit
+ (when (and gnus-use-trees
+ (and (get-buffer buffer)
+ (buffer-name (get-buffer buffer))))
+ (save-excursion
+ (set-buffer (get-buffer buffer))
+ (gnus-tree-close gnus-newsgroup-name)))
+ (gnus-kill-buffer buffer))
+ ((and (get-buffer buffer)
+ (buffer-name (get-buffer buffer)))
(save-excursion
- (set-buffer (get-buffer buffer))
- (gnus-tree-close gnus-newsgroup-name)))
- (gnus-kill-buffer buffer))
- ((and (get-buffer buffer)
- (buffer-name (get-buffer buffer)))
- (save-excursion
- (set-buffer buffer)
- (gnus-deaden-summary)))))
+ (set-buffer buffer)
+ (gnus-deaden-summary))))))
(defun gnus-summary-wake-up-the-dead (&rest args)
"Wake up the dead summary buffer."
(when current-prefix-arg
(completing-read
"Faq dir: " (and (listp gnus-group-faq-directory)
- gnus-group-faq-directory)))))
+ (mapcar (lambda (file) (list file))
+ gnus-group-faq-directory))))))
(let (gnus-faq-buffer)
(when (setq gnus-faq-buffer
(gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
initially. If NEXT-GROUP, go to this group. If BACKWARD, go to
previous group instead."
(interactive "P")
- (gnus-set-global-variables)
;; Stop pre-fetching.
(gnus-async-halt-prefetch)
(let ((current-group gnus-newsgroup-name)
(progn
(gnus-message 5 "Returning to the group buffer")
(setq entered t)
- (set-buffer current-buffer)
- (gnus-summary-exit)
- (run-hooks 'gnus-group-no-more-groups-hook))
+ (when (gnus-buffer-live-p current-buffer)
+ (set-buffer current-buffer)
+ (gnus-summary-exit))
+ (gnus-run-hooks 'gnus-group-no-more-groups-hook))
;; We try to enter the target group.
(gnus-group-jump-to-group target-group)
(let ((unreads (gnus-group-group-unread)))
(if (and (or (eq t unreads)
(and unreads (not (zerop unreads))))
(gnus-summary-read-group
- target-group nil no-article current-buffer))
+ target-group nil no-article
+ (and (buffer-name current-buffer) current-buffer)))
(setq entered t)
(setq current-group target-group
target-group nil)))))))
"Make the summary buffer take up the entire Emacs frame.
Given a prefix, will force an `article' buffer configuration."
(interactive "P")
- (gnus-set-global-variables)
(if arg
(gnus-configure-windows 'article 'force)
(gnus-configure-windows 'summary 'force)))
(if gnus-summary-display-article-function
(funcall gnus-summary-display-article-function article all-header)
(gnus-article-prepare article all-header))
- (run-hooks 'gnus-select-article-hook)
+ (gnus-run-hooks 'gnus-select-article-hook)
(when (and gnus-current-article
(not (zerop gnus-current-article)))
(gnus-summary-goto-subject gnus-current-article))
did)
(and (not pseudo)
(gnus-summary-article-pseudo-p article)
- (error "This is a pseudo-article."))
+ (error "This is a pseudo-article"))
(prog1
(save-excursion
(set-buffer gnus-summary-buffer)
If SUBJECT, only articles with SUBJECT are selected.
If BACKWARD, the previous article is selected instead of the next."
(interactive "P")
- (gnus-set-global-variables)
(cond
;; Is there such an article?
((and (gnus-summary-search-forward unread subject backward)
;; If not, we try the first unread, if that is wanted.
((and subject
gnus-auto-select-same
- ;; Make sure that we don't select the current article.
- (not (eq (gnus-summary-article-number)
- (save-excursion
- (gnus-summary-first-subject t)
- (gnus-summary-article-number))))
(gnus-summary-first-unread-article))
(gnus-summary-position-point)
(gnus-message 6 "Wrapped"))
(unless (gnus-ephemeral-group-p gnus-newsgroup-name)
(gnus-summary-jump-to-group gnus-newsgroup-name))
(let ((cmd last-command-char)
+ (point
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (point)))
(group
(if (eq gnus-keep-same-level 'best)
(gnus-summary-best-group gnus-newsgroup-name)
(t
(when (gnus-key-press-event-p last-input-event)
(gnus-summary-walk-group-buffer
- gnus-newsgroup-name cmd unread backward))))))))
+ gnus-newsgroup-name cmd unread backward point))))))))
-(defun gnus-summary-walk-group-buffer (from-group cmd unread backward)
+(defun gnus-summary-walk-group-buffer (from-group cmd unread backward start)
(let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
(?\C-p (gnus-group-prev-unread-group 1))))
(cursor-in-echo-area t)
keve key group ended)
(save-excursion
(set-buffer gnus-group-buffer)
- (gnus-summary-jump-to-group from-group)
+ (goto-char start)
(setq group
(if (eq gnus-keep-same-level 'best)
(gnus-summary-best-group gnus-newsgroup-name)
(defun gnus-summary-next-unread-article ()
"Select unread article after current one."
(interactive)
- (gnus-summary-next-article
+ (gnus-summary-next-article
(or (not (eq gnus-summary-goto-unread 'never))
(gnus-summary-last-article-p (gnus-summary-article-number)))
(and gnus-auto-select-same
(setq gnus-summary-buffer (current-buffer))
(gnus-set-global-variables)
(let ((article (gnus-summary-article-number))
- (endp nil))
+ (article-window (get-buffer-window gnus-article-buffer t))
+ endp)
(gnus-configure-windows 'article)
(if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark)
(if (and (eq gnus-summary-goto-unread 'never)
(not (equal (car gnus-article-current) gnus-newsgroup-name)))
;; Selected subject is different from current article's.
(gnus-summary-display-article article)
- (gnus-eval-in-buffer-window gnus-article-buffer
- (setq endp (gnus-article-next-page lines)))
- (when endp
- (cond (circular
- (gnus-summary-beginning-of-article))
- (lines
- (gnus-message 3 "End of message"))
- ((null lines)
- (if (and (eq gnus-summary-goto-unread 'never)
- (not (gnus-summary-last-article-p article)))
- (gnus-summary-next-article)
- (gnus-summary-next-unread-article)))))))
+ (when article-window
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (setq endp (gnus-article-next-page lines)))
+ (when endp
+ (cond (circular
+ (gnus-summary-beginning-of-article))
+ (lines
+ (gnus-message 3 "End of message"))
+ ((null lines)
+ (if (and (eq gnus-summary-goto-unread 'never)
+ (not (gnus-summary-last-article-p article)))
+ (gnus-summary-next-article)
+ (gnus-summary-next-unread-article))))))))
(gnus-summary-recenter)
(gnus-summary-position-point)))
-(defun gnus-summary-prev-page (&optional lines)
+(defun gnus-summary-prev-page (&optional lines move)
"Show previous page of selected article.
-Argument LINES specifies lines to be scrolled down."
+Argument LINES specifies lines to be scrolled down.
+If MOVE, move to the previous unread article if point is at
+the beginning of the buffer."
(interactive "P")
- (gnus-set-global-variables)
- (let ((article (gnus-summary-article-number)))
+ (let ((article (gnus-summary-article-number))
+ (article-window (get-buffer-window gnus-article-buffer t))
+ endp)
(gnus-configure-windows 'article)
(if (or (null gnus-current-article)
(null gnus-article-current)
;; Selected subject is different from current article's.
(gnus-summary-display-article article)
(gnus-summary-recenter)
- (gnus-eval-in-buffer-window gnus-article-buffer
- (gnus-article-prev-page lines))))
+ (when article-window
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (setq endp (gnus-article-prev-page lines)))
+ (when (and move endp)
+ (cond (lines
+ (gnus-message 3 "Beginning of message"))
+ ((null lines)
+ (if (and (eq gnus-summary-goto-unread 'never)
+ (not (gnus-summary-first-article-p article)))
+ (gnus-summary-prev-article)
+ (gnus-summary-prev-unread-article))))))))
(gnus-summary-position-point))
+(defun gnus-summary-prev-page-or-article (&optional lines)
+ "Show previous page of selected article.
+Argument LINES specifies lines to be scrolled down.
+If at the beginning of the article, go to the next article."
+ (interactive "P")
+ (gnus-summary-prev-page lines t))
+
(defun gnus-summary-scroll-up (lines)
"Scroll up (or down) one line current article.
Argument LINES specifies lines to be scrolled up (or down if negative)."
(interactive "p")
- (gnus-set-global-variables)
(gnus-configure-windows 'article)
(gnus-summary-show-thread)
(when (eq (gnus-summary-select-article nil nil 'pseudo) 'old)
(defun gnus-summary-next-same-subject ()
"Select next article which has the same subject as current one."
(interactive)
- (gnus-set-global-variables)
(gnus-summary-next-article nil (gnus-summary-article-subject)))
(defun gnus-summary-prev-same-subject ()
"Select previous article which has the same subject as current one."
(interactive)
- (gnus-set-global-variables)
(gnus-summary-prev-article nil (gnus-summary-article-subject)))
(defun gnus-summary-next-unread-same-subject ()
"Select next unread article which has the same subject as current one."
(interactive)
- (gnus-set-global-variables)
(gnus-summary-next-article t (gnus-summary-article-subject)))
(defun gnus-summary-prev-unread-same-subject ()
"Select previous unread article which has the same subject as current one."
(interactive)
- (gnus-set-global-variables)
(gnus-summary-prev-article t (gnus-summary-article-subject)))
(defun gnus-summary-first-unread-article ()
"Select the first unread article.
Return nil if there are no unread articles."
(interactive)
- (gnus-set-global-variables)
(prog1
(when (gnus-summary-first-subject t)
(gnus-summary-show-thread)
"Select the first article.
Return nil if there are no articles."
(interactive)
- (gnus-set-global-variables)
(prog1
(when (gnus-summary-first-subject)
(gnus-summary-show-thread)
(defun gnus-summary-best-unread-article ()
"Select the unread article with the highest score."
(interactive)
- (gnus-set-global-variables)
(let ((best -1000000)
(data gnus-newsgroup-data)
article score)
(gnus-summary-goto-subject article))))
(defun gnus-summary-goto-article (article &optional all-headers force)
- "Fetch ARTICLE and display it if it exists.
+ "Fetch ARTICLE (article number or Message-ID) and display it if it exists.
If ALL-HEADERS is non-nil, no header lines are hidden."
(interactive
(list
- (string-to-int
- (completing-read
- "Article number: "
- (mapcar (lambda (number) (list (int-to-string number)))
- gnus-newsgroup-limit)))
+ (completing-read
+ "Article number or Message-ID: "
+ (mapcar (lambda (number) (list (int-to-string number)))
+ gnus-newsgroup-limit))
current-prefix-arg
t))
(prog1
- (if (gnus-summary-goto-subject article force)
- (gnus-summary-display-article article all-headers)
- (gnus-message 4 "Couldn't go to article %s" article) nil)
+ (if (and (stringp article)
+ (string-match "@" article))
+ (gnus-summary-refer-article article)
+ (when (stringp article)
+ (setq article (string-to-number article)))
+ (if (gnus-summary-goto-subject article force)
+ (gnus-summary-display-article article all-headers)
+ (gnus-message 4 "Couldn't go to article %s" article) nil))
(gnus-summary-position-point)))
(defun gnus-summary-goto-last-article ()
(interactive)
(prog1
(when gnus-last-article
- (gnus-summary-goto-article gnus-last-article))
+ (gnus-summary-goto-article gnus-last-article nil t))
(gnus-summary-position-point)))
(defun gnus-summary-pop-article (number)
(setq gnus-newsgroup-history
(cdr (setq to (nthcdr number gnus-newsgroup-history))))
(if to
- (gnus-summary-goto-article (car to))
+ (gnus-summary-goto-article (car to) nil t)
(error "Article history empty")))
(gnus-summary-position-point))
"Limit the summary buffer to the next N articles.
If not given a prefix, use the process marked articles instead."
(interactive "P")
- (gnus-set-global-variables)
(prog1
(let ((articles (gnus-summary-work-articles n)))
(setq gnus-newsgroup-processable nil)
"Restore the previous limit.
If given a prefix, remove all limits."
(interactive "P")
- (gnus-set-global-variables)
- (when total
+ (when total
(setq gnus-newsgroup-limits
(list (mapcar (lambda (h) (mail-header-number h))
gnus-newsgroup-headers))))
(defun gnus-summary-limit-to-subject (subject &optional header)
"Limit the summary buffer to articles that have subjects that match a regexp."
- (interactive "sRegexp: ")
+ (interactive "sLimit to subject (regexp): ")
(unless header
(setq header "subject"))
(when (not (equal "" subject))
(defun gnus-summary-limit-to-author (from)
"Limit the summary buffer to articles that have authors that match a regexp."
- (interactive "sRegexp: ")
+ (interactive "sLimit to author (regexp): ")
(gnus-summary-limit-to-subject from "from"))
+(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
+articles that are younger than AGE days."
+ (interactive "nTime in days: \nP")
+ (prog1
+ (let ((data gnus-newsgroup-data)
+ (cutoff (nnmail-days-to-time age))
+ articles d date is-younger)
+ (while (setq d (pop data))
+ (when (and (vectorp (gnus-data-header d))
+ (setq date (mail-header-date (gnus-data-header d))))
+ (setq is-younger (nnmail-time-less
+ (nnmail-time-since (nnmail-date-to-time date))
+ cutoff))
+ (when (if younger-p is-younger (not is-younger))
+ (push (gnus-data-number d) articles))))
+ (gnus-summary-limit (nreverse articles)))
+ (gnus-summary-position-point)))
+
(defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
(make-obsolete
'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
gnus-killed-mark gnus-kill-file-mark
gnus-low-score-mark gnus-expirable-mark
gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark
- gnus-duplicate-mark)
+ gnus-duplicate-mark gnus-souped-mark)
'reverse)))
(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks)
Returns how many articles were removed."
(interactive "sMarks: ")
(gnus-summary-limit-to-marks marks t))
-
+
(defun gnus-summary-limit-to-marks (marks &optional reverse)
"Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
If REVERSE (the prefix), limit the summary buffer to articles that are
not marked with MARKS. MARKS can either be a string of marks or a
list of marks.
Returns how many articles were removed."
- (interactive (list (read-string "Marks: ") current-prefix-arg))
- (gnus-set-global-variables)
+ (interactive "sMarks: \nP")
(prog1
(let ((data gnus-newsgroup-data)
(marks (if (listp marks) marks
(defun gnus-summary-limit-to-score (&optional score)
"Limit to articles with score at or above SCORE."
(interactive "P")
- (gnus-set-global-variables)
(setq score (if score
(prefix-numeric-value score)
(or gnus-summary-default-score 0)))
(gnus-summary-limit articles)
(gnus-summary-position-point))))
+(defun gnus-summary-limit-include-thread (id)
+ "Display all the hidden articles that in the current thread."
+ (interactive (list (mail-header-id (gnus-summary-article-header))))
+ (let ((articles (gnus-articles-in-thread
+ (gnus-id-to-thread (gnus-root-id id)))))
+ (prog1
+ (gnus-summary-limit (nconc articles gnus-newsgroup-limit))
+ (gnus-summary-position-point))))
+
(defun gnus-summary-limit-include-dormant ()
- "Display all the hidden articles that are marked as dormant."
+ "Display all the hidden articles that are marked as dormant.
+Note that this command only works on a subset of the articles currently
+fetched for this group."
(interactive)
- (gnus-set-global-variables)
(unless gnus-newsgroup-dormant
(error "There are no dormant articles in this group"))
(prog1
(defun gnus-summary-limit-exclude-dormant ()
"Hide all dormant articles."
(interactive)
- (gnus-set-global-variables)
(prog1
(gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
(gnus-summary-position-point)))
(defun gnus-summary-limit-exclude-childless-dormant ()
"Hide all dormant articles that have no children."
(interactive)
- (gnus-set-global-variables)
(let ((data (gnus-data-list t))
articles d children)
;; Find all articles that are either not dormant or have
;; children.
(while (setq d (pop data))
(when (or (not (= (gnus-data-mark d) gnus-dormant-mark))
- (and (setq children
+ (and (setq children
(gnus-article-children (gnus-data-number d)))
(let (found)
(while children
'<)
(sort gnus-newsgroup-limit '<)))
article)
- (setq gnus-newsgroup-unreads nil)
+ (setq gnus-newsgroup-unreads gnus-newsgroup-limit)
(if all
(setq gnus-newsgroup-dormant nil
gnus-newsgroup-marked nil
(defsubst gnus-cut-thread (thread)
"Go forwards in the thread until we find an article that we want to display."
(when (or (eq gnus-fetch-old-headers 'some)
+ (eq gnus-fetch-old-headers 'invisible)
(eq gnus-build-sparse-threads 'some)
(eq gnus-build-sparse-threads 'more))
;; Deal with old-fetched headers and sparse threads.
(while (and
thread
(or
- (memq (mail-header-number (car thread)) gnus-newsgroup-sparse)
- (memq (mail-header-number (car thread)) gnus-newsgroup-ancient))
- (or (<= (length (cdr thread)) 1)
- (gnus-invisible-cut-children (cdr thread))))
- (setq thread (cadr thread))))
+ (gnus-summary-article-sparse-p (mail-header-number (car thread)))
+ (gnus-summary-article-ancient-p
+ (mail-header-number (car thread))))
+ (if (or (<= (length (cdr thread)) 1)
+ (eq gnus-fetch-old-headers 'invisible))
+ (setq gnus-newsgroup-limit
+ (delq (mail-header-number (car thread))
+ gnus-newsgroup-limit)
+ thread (cadr thread))
+ (when (gnus-invisible-cut-children (cdr thread))
+ (let ((th (cdr thread)))
+ (while th
+ (if (memq (mail-header-number (caar th))
+ gnus-newsgroup-limit)
+ (setq thread (car th)
+ th nil)
+ (setq th (cdr th))))))))))
thread)
(defun gnus-cut-threads (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)
(eq gnus-build-sparse-threads 'some)
(eq gnus-build-sparse-threads 'more))
(let ((th threads))
(if (or gnus-inhibit-limiting
(and (null gnus-newsgroup-dormant)
(not (eq gnus-fetch-old-headers 'some))
+ (not (eq gnus-fetch-old-headers 'invisible))
(null gnus-summary-expunge-below)
(not (eq gnus-build-sparse-threads 'some))
(not (eq gnus-build-sparse-threads 'more))
;; If this article is dormant and has absolutely no visible
;; children, then this article isn't visible.
(and (memq number gnus-newsgroup-dormant)
- (= children 0))
- ;; If this is "fetch-old-headered" and there is only one
- ;; visible child (or less), then we don't want this article.
+ (zerop children))
+ ;; If this is "fetch-old-headered" and there is no
+ ;; visible children, then we don't want this article.
(and (eq gnus-fetch-old-headers 'some)
- (memq number gnus-newsgroup-ancient)
+ (gnus-summary-article-ancient-p number)
(zerop children))
+ ;; If this is "fetch-old-headered" and `invisible', then
+ ;; we don't want this article.
+ (and (eq gnus-fetch-old-headers 'invisible)
+ (gnus-summary-article-ancient-p number))
;; If this is a sparsely inserted article with no children,
;; we don't want it.
(and (eq gnus-build-sparse-threads 'some)
- (memq number gnus-newsgroup-sparse)
+ (gnus-summary-article-sparse-p number)
(zerop children))
;; If we use expunging, and this article is really
;; low-scored, then we don't want this article.
gnus-newsgroup-reads)))
t)
;; Check NoCeM things.
- (and gnus-use-nocem
- (gnus-nocem-unwanted-article-p
- (mail-header-id (car thread))))))
+ (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))))
;; Nope, invisible article.
0
;; Ok, this article is to be visible, so we add it to the limit
If N is negative, go to ancestor -N instead.
The difference between N and the number of articles fetched is returned."
(interactive "p")
- (gnus-set-global-variables)
(let ((skip 1)
error header ref)
(when (not (natnump n))
(while (and (> n 0)
(not error))
(setq header (gnus-summary-article-header))
- (setq ref
- ;; If we try to find the parent of the currently
- ;; displayed article, then we take a look at the actual
- ;; References header, since this is slightly more
- ;; reliable than the References field we got from the
- ;; server.
- (if (and (eq (mail-header-number header)
- (cdr gnus-article-current))
- (equal gnus-newsgroup-name
- (car gnus-article-current)))
- (save-excursion
- (set-buffer gnus-original-article-buffer)
- (nnheader-narrow-to-headers)
- (prog1
- (message-fetch-field "references")
- (widen)))
+ (if (and (eq (mail-header-number header)
+ (cdr gnus-article-current))
+ (equal gnus-newsgroup-name
+ (car gnus-article-current)))
+ ;; If we try to find the parent of the currently
+ ;; displayed article, then we take a look at the actual
+ ;; References header, since this is slightly more
+ ;; reliable than the References field we got from the
+ ;; server.
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (nnheader-narrow-to-headers)
+ (unless (setq ref (message-fetch-field "references"))
+ (setq ref (message-fetch-field "in-reply-to")))
+ (widen))
+ (setq ref
;; It's not the current article, so we take a bet on
;; the value we got from the server.
(mail-header-references header)))
- (if ref
+ (if (and ref
+ (not (equal ref "")))
(unless (gnus-summary-refer-article (gnus-parent-id ref skip))
(gnus-message 1 "Couldn't find parent"))
(gnus-message 1 "No references in article %d"
(defun gnus-summary-refer-references ()
"Fetch all articles mentioned in the References header.
-Return how many articles were fetched."
+Return the number of articles fetched."
(interactive)
- (gnus-set-global-variables)
(let ((ref (mail-header-references (gnus-summary-article-header)))
(current (gnus-summary-article-number))
(n 0))
(gnus-summary-position-point)
n)))
-(defun gnus-summary-refer-article (message-id)
- "Fetch an article specified by MESSAGE-ID."
- (interactive "sMessage-ID: ")
+(defun gnus-summary-refer-thread (&optional limit)
+ "Fetch all articles in the current thread.
+If LIMIT (the numerical prefix), fetch that many old headers instead
+of what's specified by the `gnus-refer-thread-limit' variable."
+ (interactive "P")
+ (let ((id (mail-header-id (gnus-summary-article-header)))
+ (limit (if limit (prefix-numeric-value limit)
+ gnus-refer-thread-limit))
+ fmethod root)
+ ;; 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)
+ 'nov)
+ (gnus-build-all-threads)
+ (error "Can't fetch thread from backends that don't support NOV"))
+ (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name))
+ (gnus-summary-limit-include-thread id)))
+
+(defun gnus-summary-refer-article (message-id &optional arg)
+ "Fetch an article specified by MESSAGE-ID.
+If ARG (the prefix), fetch the article using `gnus-refer-article-method'
+or `gnus-select-method', no matter what backend the article comes from."
+ (interactive "sMessage-ID: \nP")
(when (and (stringp message-id)
(not (zerop (length message-id))))
;; Construct the correct Message-ID if necessary.
(setq message-id (concat message-id ">")))
(let* ((header (gnus-id-to-header message-id))
(sparse (and header
+ (gnus-summary-article-sparse-p
+ (mail-header-number header))
(memq (mail-header-number header)
- gnus-newsgroup-sparse))))
- (if header
- (prog1
- ;; The article is present in the buffer, to we just go to it.
- (gnus-summary-goto-article
- (mail-header-number header) nil header)
- (when sparse
- (gnus-summary-update-article (mail-header-number header))))
+ gnus-newsgroup-limit)))
+ h)
+ (cond
+ ;; If the article is present in the buffer we just go to it.
+ ((and header
+ (or (not (gnus-summary-article-sparse-p
+ (mail-header-number header)))
+ sparse))
+ (prog1
+ (gnus-summary-goto-article
+ (mail-header-number header) nil t)
+ (when sparse
+ (gnus-summary-update-article (mail-header-number header)))))
+ (t
;; We fetch the article
- (let ((gnus-override-method
- (and (gnus-news-group-p gnus-newsgroup-name)
- gnus-refer-article-method))
+ (let ((gnus-override-method
+ (cond ((gnus-news-group-p gnus-newsgroup-name)
+ gnus-refer-article-method)
+ (arg
+ (or gnus-refer-article-method gnus-select-method))
+ (t nil)))
number)
;; Start the special refer-article method, if necessary.
(when (and gnus-refer-article-method
;; Fetch the header, and display the article.
(if (setq number (gnus-summary-insert-subject message-id))
(gnus-summary-select-article nil nil nil number)
- (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
+ (gnus-message 3 "Couldn't fetch article %s" message-id))))))))
+
+(defun gnus-summary-edit-parameters ()
+ "Edit the group parameters of the current group."
+ (gnus-group-edit-group gnus-newsgroup-name 'params))
(defun gnus-summary-enter-digest-group (&optional force)
"Enter an nndoc group based on the current article.
If FORCE, force a digest interpretation. If not, try
to guess what the document format is."
(interactive "P")
- (gnus-set-global-variables)
(let ((conf gnus-current-window-configuration))
(save-excursion
(gnus-summary-select-article))
gnus-current-article)))
(ogroup gnus-newsgroup-name)
(params (append (gnus-info-params (gnus-get-info ogroup))
- (list (cons 'to-group ogroup))))
+ (list (cons 'to-group ogroup))
+ (list (cons 'save-article-group ogroup))))
(case-fold-search t)
(buf (current-buffer))
dig)
(unwind-protect
(if (gnus-group-read-ephemeral-group
name `(nndoc ,name (nndoc-address ,(get-buffer dig))
- (nndoc-article-type
+ (nndoc-article-type
,(if force 'digest 'guess))) t)
;; Make all postings to this group go to the parent group.
(nconc (gnus-info-params (gnus-get-info name))
(cons (current-buffer) 'summary)))
(t
(error "Couldn't select virtual nndoc group")))))
-
+
(defun gnus-summary-isearch-article (&optional regexp-p)
"Do incremental search forward on the current article.
If REGEXP-P (the prefix) is non-nil, do regexp isearch."
(interactive "P")
- (gnus-set-global-variables)
(gnus-summary-select-article)
(gnus-configure-windows 'article)
(gnus-eval-in-buffer-window gnus-article-buffer
- ;;(goto-char (point-min))
- (isearch-forward regexp-p)))
+ (save-restriction
+ (widen)
+ (isearch-forward regexp-p))))
(defun gnus-summary-search-article-forward (regexp &optional backward)
"Search for an article containing REGEXP forward.
(concat ", default " gnus-last-search-regexp)
"")))
current-prefix-arg))
- (gnus-set-global-variables)
(if (string-equal regexp "")
(setq regexp (or gnus-last-search-regexp ""))
(setq gnus-last-search-regexp regexp))
"Search for an article containing REGEXP.
Optional argument BACKWARD means do search for backward.
`gnus-select-article-hook' is not called during the search."
+ ;; We have to require this here to make sure that the following
+ ;; dynamic binding isn't shadowed by autoloading.
+ (require 'gnus-async)
(let ((gnus-select-article-hook nil) ;Disable hook.
(gnus-article-display-hook nil)
(gnus-mark-article-hook nil) ;Inhibit marking as read.
(gnus-use-article-prefetch nil)
+ (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay.
+ (gnus-use-trees nil) ;Inhibit updating tree buffer.
(sum (current-buffer))
(found nil)
point)
(setq point (point)))
;; We didn't find it, so we go to the next article.
(set-buffer sum)
- (if (not (if backward (gnus-summary-find-prev)
- (gnus-summary-find-next)))
- ;; No more articles.
- (setq found t)
- ;; Select the next article and adjust point.
- (gnus-summary-select-article)
- (set-buffer gnus-article-buffer)
- (widen)
- (goto-char (if backward (point-max) (point-min))))))
+ (setq found 'not)
+ (while (eq found 'not)
+ (if (not (if backward (gnus-summary-find-prev)
+ (gnus-summary-find-next)))
+ ;; No more articles.
+ (setq found t)
+ ;; Select the next article and adjust point.
+ (unless (gnus-summary-article-sparse-p
+ (gnus-summary-article-number))
+ (setq found nil)
+ (gnus-summary-select-article)
+ (set-buffer gnus-article-buffer)
+ (widen)
+ (goto-char (if backward (point-max) (point-min))))))))
(gnus-message 7 ""))
;; Return whether we found the regexp.
(when (eq found 'found)
current-prefix-arg))
(when (equal header "Body")
(setq header ""))
- (gnus-set-global-variables)
;; Hidden thread subtrees must be searched as well.
(gnus-summary-show-all-threads)
;; We don't want to change current point nor window configuration.
(defun gnus-summary-beginning-of-article ()
"Scroll the article back to the beginning."
(interactive)
- (gnus-set-global-variables)
(gnus-summary-select-article)
(gnus-configure-windows 'article)
(gnus-eval-in-buffer-window gnus-article-buffer
(widen)
(goto-char (point-min))
- (when gnus-break-pages
+ (when gnus-page-broken
(gnus-narrow-to-page))))
(defun gnus-summary-end-of-article ()
"Scroll to the end of the article."
(interactive)
- (gnus-set-global-variables)
(gnus-summary-select-article)
(gnus-configure-windows 'article)
(gnus-eval-in-buffer-window gnus-article-buffer
(widen)
(goto-char (point-max))
(recenter -3)
- (when gnus-break-pages
+ (when gnus-page-broken
(gnus-narrow-to-page))))
+(defun gnus-summary-print-article (&optional filename n)
+ "Generate and print a PostScript image of the N next (mail) 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 second argument FILENAME is nil, send the image to the
+printer. If FILENAME is a string, save the PostScript image in a file with
+that name. If FILENAME is a number, prompt the user for the name of the file
+to save in."
+ (interactive (list (ps-print-preprint current-prefix-arg)
+ current-prefix-arg))
+ (dolist (article (gnus-summary-work-articles n))
+ (gnus-summary-select-article nil nil 'pseudo article)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (let ((buffer (generate-new-buffer " *print*")))
+ (unwind-protect
+ (progn
+ (copy-to-buffer buffer (point-min) (point-max))
+ (set-buffer buffer)
+ (gnus-article-delete-invisible-text)
+ (let ((ps-left-header
+ (list
+ (concat "("
+ (mail-header-subject gnus-current-headers) ")")
+ (concat "("
+ (mail-header-from gnus-current-headers) ")")))
+ (ps-right-header
+ (list
+ "/pagenumberstring load"
+ (concat "("
+ (mail-header-date gnus-current-headers) ")"))))
+ (gnus-run-hooks 'gnus-ps-print-hook)
+ (ps-print-buffer-with-faces filename)))
+ (kill-buffer buffer))))))
+
(defun gnus-summary-show-article (&optional arg)
"Force re-fetching of the current article.
If ARG (the prefix) is non-nil, show the raw article without any
article massaging functions being run."
(interactive "P")
- (gnus-set-global-variables)
(if (not arg)
;; Select the article the normal way.
(gnus-summary-select-article nil 'force)
gnus-article-display-hook
gnus-article-prepare-hook
gnus-break-pages
+ gnus-show-mime
gnus-visual)
(gnus-summary-select-article nil 'force)))
(gnus-summary-goto-subject gnus-current-article)
- ; (gnus-configure-windows 'article)
(gnus-summary-position-point))
(defun gnus-summary-verbose-headers (&optional arg)
If ARG is a positive number, turn header display on.
If ARG is a negative number, turn header display off."
(interactive "P")
- (gnus-set-global-variables)
(setq gnus-show-all-headers
(cond ((or (not (numberp arg))
(zerop arg))
If ARG is a positive number, show the entire header.
If ARG is a negative number, hide the unwanted header lines."
(interactive "P")
- (gnus-set-global-variables)
(save-excursion
(set-buffer gnus-article-buffer)
(let* ((buffer-read-only nil)
(setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
(insert-buffer-substring gnus-original-article-buffer 1 e)
(let ((article-inhibit-hiding t))
- (run-hooks 'gnus-article-display-hook))
+ (gnus-run-hooks 'gnus-article-display-hook))
(when (or (not hidden) (and (numberp arg) (< arg 0)))
(gnus-article-hide-headers)))))
(defun gnus-summary-show-all-headers ()
"Make all header lines visible."
(interactive)
- (gnus-set-global-variables)
(gnus-article-show-all-headers))
(defun gnus-summary-toggle-mime (&optional arg)
"Toggle MIME processing.
If ARG is a positive number, turn MIME processing on."
(interactive "P")
- (gnus-set-global-variables)
(setq gnus-show-mime
(if (null arg) (not gnus-show-mime)
(> (prefix-numeric-value arg) 0)))
(defun gnus-summary-caesar-message (&optional arg)
"Caesar rotate the current article by 13.
-The numerical prefix specifies how manu places to rotate each letter
+The numerical prefix specifies how many places to rotate each letter
forward."
(interactive "P")
- (gnus-set-global-variables)
(gnus-summary-select-article)
(let ((mail-header-separator ""))
(gnus-eval-in-buffer-window gnus-article-buffer
(defun gnus-summary-stop-page-breaking ()
"Stop page breaking in the current article."
(interactive)
- (gnus-set-global-variables)
(gnus-summary-select-article)
(gnus-eval-in-buffer-window gnus-article-buffer
(widen)
(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-remove-text-with-property 'gnus-next))
+ (setq gnus-page-broken nil))))
-(defun gnus-summary-move-article (&optional n to-newsgroup
+(defun gnus-summary-move-article (&optional n to-newsgroup
select-method action)
"Move the current article to a different newsgroup.
If N is a positive number, move the N next articles.
(interactive "P")
(unless action
(setq action 'move))
- (gnus-set-global-variables)
+ ;; Disable marking as read.
+ (let (gnus-mark-article-hook)
+ (save-window-excursion
+ (gnus-summary-select-article)))
;; Check whether the source group supports the required functions.
(cond ((and (eq action 'move)
(not (gnus-check-backend-function
(symbol-value (intern (format "gnus-current-%s-group" action)))
articles prefix))
(set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
- (setq to-method (or select-method
+ (setq to-method (or select-method
(gnus-group-name-to-method to-newsgroup)))
;; Check the method we are to move this article to...
- (unless (gnus-check-backend-function
+ (unless (gnus-check-backend-function
'request-accept-article (car to-method))
(error "%s does not support article copying" (car to-method)))
(unless (gnus-check-server to-method)
(cond
;; Move the article.
((eq action 'move)
+ ;; Remove this article from future suppression.
+ (gnus-dup-unsuppress-article article)
(gnus-request-move-article
article ; Article to move
gnus-newsgroup-name ; From newsgroup
((eq action 'copy)
(save-excursion
(set-buffer copy-buf)
- (gnus-request-article-this-buffer article gnus-newsgroup-name)
- (gnus-request-accept-article
- to-newsgroup select-method (not articles))))
+ (when (gnus-request-article-this-buffer article gnus-newsgroup-name)
+ (gnus-request-accept-article
+ to-newsgroup select-method (not articles)))))
;; Crosspost the article.
((eq action 'crosspost)
(let ((xref (message-tokenize-header
" ")))
(setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
":" article))
- (unless xref
+ (unless xref
(setq xref (list (system-name))))
(setq new-xref
(concat
- (mapconcat 'identity
+ (mapconcat 'identity
(delete "Xref:" (delete new-xref xref))
" ")
- new-xref))
+ " " new-xref))
(save-excursion
(set-buffer copy-buf)
+ ;; First put the article in the destination group.
(gnus-request-article-this-buffer article gnus-newsgroup-name)
- (nnheader-replace-header "xref" new-xref)
- (gnus-request-accept-article
- to-newsgroup select-method (not articles)))))))
- (if (not art-group)
- (gnus-message 1 "Couldn't %s article %s"
- (cadr (assq action names)) article)
+ (when (consp (setq art-group
+ (gnus-request-accept-article
+ to-newsgroup select-method (not articles))))
+ (setq new-xref (concat new-xref " " (car art-group)
+ ":" (cdr art-group)))
+ ;; Now we have the new Xrefs header, so we insert
+ ;; it and replace the new article.
+ (nnheader-replace-header "Xref" new-xref)
+ (gnus-request-replace-article
+ (cdr art-group) to-newsgroup (current-buffer))
+ art-group))))))
+ (cond
+ ((not art-group)
+ (gnus-message 1 "Couldn't %s article %s"
+ (cadr (assq action names)) article))
+ ((and (eq art-group 'junk)
+ (eq action 'move))
+ (gnus-summary-mark-article article gnus-canceled-mark)
+ (gnus-message 4 "Deleted article %s" article))
+ (t
(let* ((entry
(or
(gnus-gethash (car art-group) gnus-newsrc-hashtb)
(gnus-gethash
(gnus-group-prefixed-name
(car art-group)
- (or select-method
+ (or select-method
(gnus-find-method-for-group to-newsgroup)))
gnus-newsrc-hashtb)))
(info (nth 2 entry))
(memq article gnus-newsgroup-dormant)
(memq article gnus-newsgroup-unreads)))
+ (when (and (equal to-group gnus-newsgroup-name)
+ (not (memq article gnus-newsgroup-unreads)))
+ ;; Mark this article as read in this group.
+ (push (cons to-article gnus-read-mark) gnus-newsgroup-reads)
+ (setcdr (gnus-active to-group) to-article)
+ (setcdr gnus-newsgroup-active to-article))
+
(while marks
(when (memq article (symbol-value
(intern (format "gnus-newsgroup-%s"
(symbol-value
(intern (format "gnus-newsgroup-%s"
(caar marks)))))))
- ;; Copy mark to other group.
+ ;; Copy the marks to other group.
(gnus-add-marked-articles
to-group (cdar marks) (list to-article) info))
- (setq marks (cdr marks)))))
+ (setq marks (cdr marks)))
+
+ (gnus-dribble-enter
+ (concat "(gnus-group-set-info '"
+ (gnus-prin1-to-string (gnus-get-info to-group))
+ ")"))))
;; Update the Xref header in this article to point to
;; the new crossposted article we have just created.
(save-excursion
(set-buffer copy-buf)
(gnus-request-article-this-buffer article gnus-newsgroup-name)
- (nnheader-replace-header
- "xref" (concat new-xref " " (car art-group)
- ":" (cdr art-group)))
+ (nnheader-replace-header "Xref" new-xref)
(gnus-request-replace-article
article gnus-newsgroup-name (current-buffer)))))
+ ;;;!!!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-mark-article article gnus-canceled-mark))))
(gnus-summary-remove-process-mark article))
;; Re-activate all groups that have been moved to.
(while to-groups
- (gnus-activate-group (pop to-groups)))
-
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (when (gnus-group-goto-group (car to-groups) t)
+ (gnus-group-get-new-news-this-group 1 t))
+ (pop to-groups)))
+
(gnus-kill-buffer copy-buf)
(gnus-summary-position-point)
(gnus-set-mode-line 'summary)))
If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
re-spool using this method."
(interactive "P")
- (gnus-summary-move-article n nil select-method 'copy))
+ (gnus-summary-move-article n to-newsgroup select-method 'copy))
(defun gnus-summary-crosspost-article (&optional n)
"Crosspost the current article to some other group."
(gnus-summary-move-article n nil nil 'crosspost))
(defcustom gnus-summary-respool-default-method nil
- "Default method for respooling an article.
+ "Default method for respooling an article.
If nil, use to the current newsgroup method."
- :type 'gnus-select-method-name
- :group 'gnus-summary)
+ :type `(choice (gnus-select-method :value (nnml ""))
+ (const nil))
+ :group 'gnus-summary-mail)
(defun gnus-summary-respool-article (&optional n method)
"Respool the current article.
In the former case, the articles in question will be moved from the
current group into whatever groups they are destined to. In the
latter case, they will be copied into the relevant groups."
- (interactive
+ (interactive
(list current-prefix-arg
(let* ((methods (gnus-methods-using 'respool))
(methname
(car (gnus-find-method-for-group
gnus-newsgroup-name)))))
(method
- (gnus-completing-read
+ (gnus-completing-read
methname "What backend do you want to use when respooling?"
methods nil t nil 'gnus-mail-method-history))
ms)
(cond
- ((zerop (length (setq ms (gnus-servers-using-backend
+ ((zerop (length (setq ms (gnus-servers-using-backend
(intern method)))))
(list (intern method) ""))
((= 1 (length ms))
(let ((ms-alist (mapcar (lambda (m) (cons (cadr m) m)) ms)))
(cdr (assoc (completing-read "Server name: " ms-alist nil t)
ms-alist))))))))
- (gnus-set-global-variables)
(unless method
(error "No method given for respooling"))
(if (assoc (symbol-name
(defun gnus-summary-import-article (file)
"Import a random file into a mail newsgroup."
(interactive "fImport file: ")
- (gnus-set-global-variables)
(let ((group gnus-newsgroup-name)
(now (current-time))
atts lines)
(defun gnus-summary-expire-articles (&optional now)
"Expire all articles that are marked as expirable in the current group."
(interactive)
- (gnus-set-global-variables)
(when (gnus-check-backend-function
'request-expire-articles gnus-newsgroup-name)
;; This backend supports expiry.
;; We need to update the info for
;; this group for `gnus-list-of-read-articles'
;; to give us the right answer.
+ (gnus-run-hooks 'gnus-exit-group-hook)
(gnus-summary-update-info)
(gnus-list-of-read-articles gnus-newsgroup-name))
(setq gnus-newsgroup-expirable
;; through the expiry process.
(gnus-message 6 "Expiring articles...")
;; The list of articles that weren't expired is returned.
- (if expiry-wait
- (let ((nnmail-expiry-wait-function nil)
- (nnmail-expiry-wait expiry-wait))
- (setq es (gnus-request-expire-articles
- expirable gnus-newsgroup-name)))
- (setq es (gnus-request-expire-articles
- expirable gnus-newsgroup-name)))
+ (save-excursion
+ (if expiry-wait
+ (let ((nnmail-expiry-wait-function nil)
+ (nnmail-expiry-wait expiry-wait))
+ (setq es (gnus-request-expire-articles
+ expirable gnus-newsgroup-name)))
+ (setq es (gnus-request-expire-articles
+ expirable gnus-newsgroup-name))))
(unless total
(setq gnus-newsgroup-expirable es))
;; We go through the old list of expirable, and mark all
This means that *all* articles that are marked as expirable will be
deleted forever, right now."
(interactive)
- (gnus-set-global-variables)
- (or gnus-expert-user
- (gnus-y-or-n-p
- "Are you really, really, really sure you want to delete all these messages? ")
- (error "Phew!"))
+ (unless gnus-expert-user
+ (gnus-yes-or-no-p
+ "Are you really, really, really sure you want to delete all these messages? ")
+ (error "Phew!"))
(gnus-summary-expire-articles t))
;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
If N is nil and articles have been marked with the process mark,
delete these instead."
(interactive "P")
- (gnus-set-global-variables)
(unless (gnus-check-backend-function 'request-expire-articles
gnus-newsgroup-name)
- (error "The current newsgroup does not support article deletion."))
+ (error "The current newsgroup does not support article deletion"))
;; Compute the list of articles to delete.
(let ((articles (gnus-summary-work-articles n))
not-deleted)
(if (and gnus-novice-user
- (not (gnus-y-or-n-p
+ (not (gnus-yes-or-no-p
(format "Do you really want to delete %s forever? "
(if (> (length articles) 1)
(format "these %s articles" (length articles))
;; after all.
(unless (memq (car articles) not-deleted)
(gnus-summary-mark-article (car articles) gnus-canceled-mark))
- (setq articles (cdr articles))))
+ (setq articles (cdr articles)))
+ (when not-deleted
+ (gnus-message 4 "Couldn't delete articles %s" not-deleted)))
(gnus-summary-position-point)
(gnus-set-mode-line 'summary)
not-deleted))
"Edit the current article.
This will have permanent effect only in mail groups.
If FORCE is non-nil, allow editing of articles even in read-only
-groups."
+groups."
(interactive "P")
(save-excursion
(set-buffer gnus-summary-buffer)
(gnus-set-global-variables)
(when (and (not force)
(gnus-group-read-only-p))
- (error "The current newsgroup does not support article editing."))
+ (error "The current newsgroup does not support article editing"))
;; Select article if needed.
(unless (eq (gnus-summary-article-number)
gnus-current-article)
(gnus-summary-select-article t))
+ (gnus-article-date-original)
(gnus-article-edit-article
- `(lambda ()
+ `(lambda (no-highlight)
(gnus-summary-edit-article-done
,(or (mail-header-references gnus-current-headers) "")
- ,(gnus-group-read-only-p) ,gnus-summary-buffer)))))
+ ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight)))))
(defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit)
-(defun gnus-summary-edit-article-done (&optional references read-only buffer)
+(defun gnus-summary-edit-article-done (&optional references read-only buffer
+ no-highlight)
"Make edits to the current article permanent."
(interactive)
;; Replace the article.
(not (gnus-request-replace-article
(cdr gnus-article-current) (car gnus-article-current)
(current-buffer))))
- (error "Couldn't replace article.")
+ (error "Couldn't replace article")
;; Update the summary buffer.
(if (and references
(equal (message-tokenize-header references " ")
(save-excursion
(save-restriction
(message-narrow-to-head)
- (let ((header (nnheader-parse-head t)))
- (set-buffer buffer)
- (mail-header-set-number header (cdr gnus-article-current))
- (gnus-summary-update-article-line
- (cdr gnus-article-current) header))))
+ (let ((head (buffer-string))
+ header)
+ (nnheader-temp-write nil
+ (insert (format "211 %d Article retrieved.\n"
+ (cdr gnus-article-current)))
+ (insert head)
+ (insert ".\n")
+ (let ((nntp-server-buffer (current-buffer)))
+ (setq header (car (gnus-get-newsgroup-headers
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ gnus-newsgroup-dependencies)
+ t))))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-data-set-header
+ (gnus-data-find (cdr gnus-article-current))
+ header)
+ (gnus-summary-update-article-line
+ (cdr gnus-article-current) header))))))
;; Update threads.
(set-buffer (or buffer gnus-summary-buffer))
(gnus-summary-update-article (cdr gnus-article-current)))
;; Prettify the article buffer again.
- (save-excursion
- (set-buffer gnus-article-buffer)
- (run-hooks 'gnus-article-display-hook))
+ (unless no-highlight
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (gnus-run-hooks 'gnus-article-display-hook)
+ (set-buffer gnus-original-article-buffer)
+ (gnus-request-article
+ (cdr gnus-article-current)
+ (car gnus-article-current) (current-buffer))))
;; Prettify the summary buffer line.
(when (gnus-visual-p 'summary-highlight 'highlight)
- (run-hooks 'gnus-visual-mark-article-hook))))
+ (gnus-run-hooks 'gnus-visual-mark-article-hook))))
(defun gnus-summary-edit-wash (key)
"Perform editing command in the article buffer."
- (interactive
+ (interactive
(list
(progn
(message "%s" (concat (this-command-keys) "- "))
;;; Respooling
-(defun gnus-summary-respool-query ()
+(defun gnus-summary-respool-query (&optional silent)
"Query where the respool algorithm would put this article."
(interactive)
- (gnus-set-global-variables)
- (gnus-summary-select-article)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (save-restriction
- (goto-char (point-min))
- (search-forward "\n\n")
- (narrow-to-region (point-min) (point))
- (message "This message would go to %s"
- (mapconcat 'car (nnmail-article-group 'identity) ", ")))))
+ (let (gnus-mark-article-hook)
+ (gnus-summary-select-article)
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (save-restriction
+ (message-narrow-to-head)
+ (let ((groups (nnmail-article-group 'identity)))
+ (unless silent
+ (if groups
+ (message "This message would go to %s"
+ (mapconcat 'car groups ", "))
+ (message "This message would go to no groups"))
+ groups))))))
;; Summary marking commands.
If UNMARK is positive, remove any kind of mark.
If UNMARK is negative, tick articles."
(interactive "P")
- (gnus-set-global-variables)
(when unmark
(setq unmark (prefix-numeric-value unmark)))
(let ((count
If UNMARK is positive, remove any kind of mark.
If UNMARK is negative, tick articles."
(interactive "P")
- (gnus-set-global-variables)
(when unmark
(setq unmark (prefix-numeric-value unmark)))
(let ((count
the process mark instead. The difference between N and the actual
number of articles marked is returned."
(interactive "p")
- (gnus-set-global-variables)
(let ((backward (< n 0))
(n (abs n)))
(while (and
(defun gnus-summary-unmark-as-processable (n)
"Remove the process mark from the next N articles.
-If N is negative, mark backward instead. The difference between N and
-the actual number of articles marked is returned."
+If N is negative, unmark backward instead. The difference between N and
+the actual number of articles unmarked is returned."
(interactive "p")
- (gnus-set-global-variables)
(gnus-summary-mark-as-processable n t))
(defun gnus-summary-unmark-all-processable ()
"Remove the process mark from all articles."
(interactive)
- (gnus-set-global-variables)
(save-excursion
(while gnus-newsgroup-processable
(gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
If N is negative, mark backward instead. The difference between N and
the actual number of articles marked is returned."
(interactive "p")
- (gnus-set-global-variables)
(gnus-summary-mark-forward n gnus-expirable-mark))
(defun gnus-summary-mark-article-as-replied (article)
(defun gnus-summary-set-bookmark (article)
"Set a bookmark in current article."
(interactive (list (gnus-summary-article-number)))
- (gnus-set-global-variables)
(when (or (not (get-buffer gnus-article-buffer))
(not gnus-current-article)
(not gnus-article-current)
(defun gnus-summary-remove-bookmark (article)
"Remove the bookmark from the current article."
(interactive (list (gnus-summary-article-number)))
- (gnus-set-global-variables)
;; Remove old bookmark, if one exists.
(let ((old (assq article gnus-newsgroup-bookmarks)))
(if old
If N is negative, mark backward instead. The difference between N and
the actual number of articles marked is returned."
(interactive "p")
- (gnus-set-global-variables)
(gnus-summary-mark-forward n gnus-dormant-mark))
(defun gnus-summary-set-process-mark (article)
The difference between N and the actual number of articles marked is
returned."
(interactive "p")
- (gnus-set-global-variables)
(let ((backward (< n 0))
(gnus-summary-goto-unread
(and gnus-summary-goto-unread
(defun gnus-summary-mark-article-as-unread (mark)
"Mark the current article quickly as unread with MARK."
- (let ((article (gnus-summary-article-number)))
- (if (< article 0)
- (gnus-error 1 "Unmarkable article")
- (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
- (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
- (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
- (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
- (cond ((= mark gnus-ticked-mark)
- (push article gnus-newsgroup-marked))
- ((= mark gnus-dormant-mark)
- (push article gnus-newsgroup-dormant))
- (t
- (push article gnus-newsgroup-unreads)))
- (setq gnus-newsgroup-reads
- (delq (assq article gnus-newsgroup-reads)
- gnus-newsgroup-reads))
+ (let* ((article (gnus-summary-article-number))
+ (old-mark (gnus-summary-article-mark article)))
+ (if (eq mark old-mark)
+ t
+ (if (<= article 0)
+ (progn
+ (gnus-error 1 "Can't mark negative article numbers")
+ nil)
+ (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
+ (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
+ (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
+ (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
+ (cond ((= mark gnus-ticked-mark)
+ (push article gnus-newsgroup-marked))
+ ((= mark gnus-dormant-mark)
+ (push article gnus-newsgroup-dormant))
+ (t
+ (push article gnus-newsgroup-unreads)))
+ (setq gnus-newsgroup-reads
+ (delq (assq article gnus-newsgroup-reads)
+ gnus-newsgroup-reads))
+
+ ;; See whether the article is to be put in the cache.
+ (and gnus-use-cache
+ (vectorp (gnus-summary-article-header article))
+ (save-excursion
+ (gnus-cache-possibly-enter-article
+ gnus-newsgroup-name article
+ (gnus-summary-article-header article)
+ (= mark gnus-ticked-mark)
+ (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
- ;; See whether the article is to be put in the cache.
- (and gnus-use-cache
- (vectorp (gnus-summary-article-header article))
- (save-excursion
- (gnus-cache-possibly-enter-article
- gnus-newsgroup-name article
- (gnus-summary-article-header article)
- (= mark gnus-ticked-mark)
- (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
-
- ;; Fix the mark.
- (gnus-summary-update-mark mark 'unread))
- t))
+ ;; Fix the mark.
+ (gnus-summary-update-mark mark 'unread)
+ t))))
(defun gnus-summary-mark-article (&optional article mark no-expire)
"Mark ARTICLE with MARK. MARK can be any character.
(and (not no-expire)
gnus-newsgroup-auto-expire
(or (not mark)
- (and (numberp mark)
+ (and (gnus-characterp mark)
(or (= mark gnus-killed-mark) (= mark gnus-del-mark)
(= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
(= mark gnus-read-mark) (= mark gnus-souped-mark)
(= mark gnus-duplicate-mark))))
(setq mark gnus-expirable-mark))
(let* ((mark (or mark gnus-del-mark))
- (article (or article (gnus-summary-article-number))))
- (unless article
- (error "No article on current line"))
- (if (or (= mark gnus-unread-mark)
- (= mark gnus-ticked-mark)
- (= mark gnus-dormant-mark))
- (gnus-mark-article-as-unread article mark)
- (gnus-mark-article-as-read article mark))
-
- ;; See whether the article is to be put in the cache.
- (and gnus-use-cache
- (not (= mark gnus-canceled-mark))
- (vectorp (gnus-summary-article-header article))
- (save-excursion
- (gnus-cache-possibly-enter-article
- gnus-newsgroup-name article
- (gnus-summary-article-header article)
- (= mark gnus-ticked-mark)
- (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
-
- (when (gnus-summary-goto-subject article nil t)
- (let ((buffer-read-only nil))
- (gnus-summary-show-thread)
- ;; Fix the mark.
- (gnus-summary-update-mark mark 'unread)
- t))))
+ (article (or article (gnus-summary-article-number)))
+ (old-mark (gnus-summary-article-mark article)))
+ (if (eq mark old-mark)
+ t
+ (unless article
+ (error "No article on current line"))
+ (if (not (if (or (= mark gnus-unread-mark)
+ (= mark gnus-ticked-mark)
+ (= mark gnus-dormant-mark))
+ (gnus-mark-article-as-unread article mark)
+ (gnus-mark-article-as-read article mark)))
+ t
+ ;; See whether the article is to be put in the cache.
+ (and gnus-use-cache
+ (not (= mark gnus-canceled-mark))
+ (vectorp (gnus-summary-article-header article))
+ (save-excursion
+ (gnus-cache-possibly-enter-article
+ gnus-newsgroup-name article
+ (gnus-summary-article-header article)
+ (= mark gnus-ticked-mark)
+ (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
+
+ (when (gnus-summary-goto-subject article nil t)
+ (let ((buffer-read-only nil))
+ (gnus-summary-show-thread)
+ ;; Fix the mark.
+ (gnus-summary-update-mark mark 'unread)
+ t))))))
(defun gnus-summary-update-secondary-mark (article)
"Update the secondary (read, process, cache) mark."
(t gnus-unread-mark))
'replied)
(when (gnus-visual-p 'summary-highlight 'highlight)
- (run-hooks 'gnus-summary-update-hook))
+ (gnus-run-hooks 'gnus-summary-update-hook))
t)
(defun gnus-summary-update-mark (mark type)
(push (cons article mark) gnus-newsgroup-reads)
;; Possibly remove from cache, if that is used.
(when gnus-use-cache
- (gnus-cache-enter-remove-article article))))
+ (gnus-cache-enter-remove-article article))
+ t))
(defun gnus-mark-article-as-unread (article &optional mark)
"Enter ARTICLE in the pertinent lists and remove it from others."
(let ((mark (or mark gnus-ticked-mark)))
- (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)
- gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)
- gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)
- gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
+ (if (<= article 0)
+ (progn
+ (gnus-error 1 "Can't mark negative article numbers")
+ nil)
+ (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)
+ gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)
+ gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)
+ gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
- ;; Unsuppress duplicates?
- (when gnus-suppress-duplicates
- (gnus-dup-unsuppress-article article))
-
- (cond ((= mark gnus-ticked-mark)
- (push article gnus-newsgroup-marked))
- ((= mark gnus-dormant-mark)
- (push article gnus-newsgroup-dormant))
- (t
- (push article gnus-newsgroup-unreads)))
- (setq gnus-newsgroup-reads
- (delq (assq article gnus-newsgroup-reads)
- gnus-newsgroup-reads))))
+ ;; Unsuppress duplicates?
+ (when gnus-suppress-duplicates
+ (gnus-dup-unsuppress-article article))
+
+ (cond ((= mark gnus-ticked-mark)
+ (push article gnus-newsgroup-marked))
+ ((= mark gnus-dormant-mark)
+ (push article gnus-newsgroup-dormant))
+ (t
+ (push article gnus-newsgroup-unreads)))
+ (setq gnus-newsgroup-reads
+ (delq (assq article gnus-newsgroup-reads)
+ gnus-newsgroup-reads))
+ t)))
(defalias 'gnus-summary-mark-as-unread-forward
'gnus-summary-tick-article-forward)
(defun gnus-summary-mark-below (score mark)
"Mark articles with score less than SCORE with MARK."
(interactive "P\ncMark: ")
- (gnus-set-global-variables)
(setq score (if score
(prefix-numeric-value score)
(or gnus-summary-default-score 0)))
(save-excursion
(set-buffer gnus-summary-buffer)
(goto-char (point-min))
- (while
+ (while
(progn
(and (< (gnus-summary-article-score) score)
(gnus-summary-mark-article nil mark))
(defun gnus-summary-kill-below (&optional score)
"Mark articles with score below SCORE as read."
(interactive "P")
- (gnus-set-global-variables)
(gnus-summary-mark-below score gnus-killed-mark))
(defun gnus-summary-clear-above (&optional score)
"Clear all marks from articles with score above SCORE."
(interactive "P")
- (gnus-set-global-variables)
(gnus-summary-mark-above score gnus-unread-mark))
(defun gnus-summary-tick-above (&optional score)
"Tick all articles with score above SCORE."
(interactive "P")
- (gnus-set-global-variables)
(gnus-summary-mark-above score gnus-ticked-mark))
(defun gnus-summary-mark-above (score mark)
"Mark articles with score over SCORE with MARK."
(interactive "P\ncMark: ")
- (gnus-set-global-variables)
(setq score (if score
(prefix-numeric-value score)
(or gnus-summary-default-score 0)))
(defun gnus-summary-limit-include-expunged (&optional no-error)
"Display all the hidden articles that were expunged for low scores."
(interactive)
- (gnus-set-global-variables)
(let ((buffer-read-only nil))
(let ((scored gnus-newsgroup-scored)
headers h)
(setq scored (cdr scored)))
(if (not headers)
(when (not no-error)
- (error "No expunged articles hidden."))
+ (error "No expunged articles hidden"))
(goto-char (point-min))
(gnus-summary-prepare-unthreaded (nreverse headers))
(goto-char (point-min))
t))))
(defun gnus-summary-catchup (&optional all quietly to-here not-mark)
- "Mark all articles not marked as unread in this newsgroup as read.
-If prefix argument ALL is non-nil, all articles are marked as read.
+ "Mark all unread articles in this newsgroup as read.
+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 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")
- (gnus-set-global-variables)
(prog1
(save-excursion
(when (or quietly
(if (and not-mark
(not gnus-newsgroup-adaptive)
(not gnus-newsgroup-auto-expire)
- (not gnus-suppress-duplicates))
+ (not gnus-suppress-duplicates)
+ (or (not gnus-use-cache)
+ (eq gnus-use-cache 'passive)))
(progn
(when all
(setq gnus-newsgroup-marked nil
gnus-newsgroup-dormant nil))
- (setq gnus-newsgroup-unreads nil))
+ (setq gnus-newsgroup-unreads gnus-newsgroup-downloadable))
;; We actually mark all articles as canceled, which we
;; have to do when using auto-expiry or adaptive scoring.
(gnus-summary-show-all-threads)
(if to-here (< (point) to-here) t)
(gnus-summary-mark-article-as-read gnus-catchup-mark)
(gnus-summary-find-next (not all)))))
- (unless to-here
- (setq gnus-newsgroup-unreads nil))
(gnus-set-mode-line 'summary))
- (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
- (when (and (not to-here) (eq 'nnvirtual (car method)))
- (nnvirtual-catchup-group
- (gnus-group-real-name gnus-newsgroup-name)
- (nth 1 method) all)))
t))
(gnus-summary-position-point)))
"Mark all unticked articles before the current one as read.
If ALL is non-nil, also mark ticked and dormant articles as read."
(interactive "P")
- (gnus-set-global-variables)
(save-excursion
(gnus-save-hidden-threads
(let ((beg (point)))
(defun gnus-summary-catchup-all (&optional quietly)
"Mark all articles in this newsgroup as read."
(interactive "P")
- (gnus-set-global-variables)
(gnus-summary-catchup t quietly))
(defun gnus-summary-catchup-and-exit (&optional all quietly)
"Mark all articles not marked as unread in this newsgroup as read, then exit.
If prefix argument ALL is non-nil, all articles are marked as read."
(interactive "P")
- (gnus-set-global-variables)
(when (gnus-summary-catchup all quietly nil 'fast)
;; Select next newsgroup or exit.
(if (eq gnus-auto-select-next 'quietly)
(defun gnus-summary-catchup-all-and-exit (&optional quietly)
"Mark all articles in this newsgroup as read, and then exit."
(interactive "P")
- (gnus-set-global-variables)
(gnus-summary-catchup-and-exit t quietly))
;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
If given a prefix, mark all articles, unread as well as ticked, as
read."
(interactive "P")
- (gnus-set-global-variables)
(save-excursion
(gnus-summary-catchup all))
(gnus-summary-next-article t nil nil t))
(defun gnus-summary-rethread-current ()
"Rethread the thread the current article is part of."
(interactive)
- (gnus-set-global-variables)
(let* ((gnus-show-threads t)
(article (gnus-summary-article-number))
(id (mail-header-id (gnus-summary-article-header)))
(gnus-summary-goto-subject article)))
(defun gnus-summary-reparent-thread ()
- "Make current article child of the marked (or previous) article.
+ "Make the current article child of the marked (or previous) article.
Note that the re-threading will only work if `gnus-thread-ignore-subject'
is non-nil or the Subject: of both articles are the same."
(interactive)
(unless (not (gnus-group-read-only-p))
- (error "The current newsgroup does not support article editing."))
+ (error "The current newsgroup does not support article editing"))
(unless (<= (length gnus-newsgroup-processable) 1)
- (error "No more than one article may be marked."))
+ (error "No more than one article may be marked"))
(save-window-excursion
(let ((gnus-article-buffer " *reparent*")
(current-article (gnus-summary-article-number))
- ; first grab the marked article, otherwise one line up.
+ ;; First grab the marked article, otherwise one line up.
(parent-article (if (not (null gnus-newsgroup-processable))
(car gnus-newsgroup-processable)
(save-excursion
(if (eq (forward-line -1) 0)
(gnus-summary-article-number)
- (error "Beginning of summary buffer."))))))
+ (error "Beginning of summary buffer"))))))
(unless (not (eq current-article parent-article))
- (error "An article may not be self-referential."))
- (let ((message-id (mail-header-id
+ (error "An article may not be self-referential"))
+ (let ((message-id (mail-header-id
(gnus-summary-article-header parent-article))))
(unless (and message-id (not (equal message-id "")))
- (error "No message-id in desired parent."))
- (gnus-summary-select-article t t nil current-article)
- (set-buffer gnus-article-buffer)
- (setq buffer-read-only nil)
+ (error "No message-id in desired parent"))
+ ;; We don't want the article to be marked as read.
+ (let (gnus-mark-article-hook)
+ (gnus-summary-select-article t t nil current-article))
+ (set-buffer gnus-original-article-buffer)
(let ((buf (format "%s" (buffer-string))))
- (erase-buffer)
- (insert buf))
- (goto-char (point-min))
- (if (search-forward-regexp "^References: " nil t)
- (insert message-id " " )
- (insert "References: " message-id "\n"))
- (unless (gnus-request-replace-article current-article
- (car gnus-article-current)
- gnus-article-buffer)
- (error "Couldn't replace article."))
+ (nnheader-temp-write nil
+ (insert buf)
+ (goto-char (point-min))
+ (if (re-search-forward "^References: " nil t)
+ (progn
+ (re-search-forward "^[^ \t]" nil t)
+ (forward-line -1)
+ (end-of-line)
+ (insert " " message-id))
+ (insert "References: " message-id "\n"))
+ (unless (gnus-request-replace-article
+ current-article (car gnus-article-current)
+ (current-buffer))
+ (error "Couldn't replace article"))))
(set-buffer gnus-summary-buffer)
(gnus-summary-unmark-all-processable)
+ (gnus-summary-update-article current-article)
(gnus-summary-rethread-current)
- (gnus-message 3 "Article %d is now the child of article %d."
+ (gnus-message 3 "Article %d is now the child of article %d"
current-article parent-article)))))
(defun gnus-summary-toggle-threads (&optional arg)
"Toggle showing conversation threads.
If ARG is positive number, turn showing conversation threads on."
(interactive "P")
- (gnus-set-global-variables)
(let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
(setq gnus-show-threads
(if (null arg) (not gnus-show-threads)
(defun gnus-summary-show-all-threads ()
"Show all threads."
(interactive)
- (gnus-set-global-variables)
(save-excursion
(let ((buffer-read-only nil))
(subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
"Show thread subtrees.
Returns nil if no thread was there to be shown."
(interactive)
- (gnus-set-global-variables)
(let ((buffer-read-only nil)
(orig (point))
;; first goto end then to beg, to have point at beg after let
(defun gnus-summary-hide-all-threads ()
"Hide all thread subtrees."
(interactive)
- (gnus-set-global-variables)
(save-excursion
(goto-char (point-min))
(gnus-summary-hide-thread)
"Hide thread subtrees.
Returns nil if no threads were there to be hidden."
(interactive)
- (gnus-set-global-variables)
(let ((buffer-read-only nil)
(start (point))
(article (gnus-summary-article-number)))
If SILENT, don't output messages."
(interactive "p")
- (gnus-set-global-variables)
(let ((backward (< n 0))
(n (abs n)))
(while (and (> n 0)
(gnus-summary-go-to-next-thread backward))
(decf n))
- (unless silent
+ (unless silent
(gnus-summary-position-point))
(when (and (not silent) (/= 0 n))
(gnus-message 7 "No more threads"))
Returns the difference between N and the number of skips actually
done."
(interactive "p")
- (gnus-set-global-variables)
(gnus-summary-next-thread (- n)))
(defun gnus-summary-go-down-thread ()
Returns the difference between N and how many steps down that were
taken."
(interactive "p")
- (gnus-set-global-variables)
(let ((up (< n 0))
(n (abs n)))
(while (and (> n 0)
Returns the difference between N and how many steps down that were
taken."
(interactive "p")
- (gnus-set-global-variables)
(gnus-summary-down-thread (- n)))
(defun gnus-summary-top-thread ()
"Go to the top of the thread."
(interactive)
- (gnus-set-global-variables)
(while (gnus-summary-go-up-thread))
(gnus-summary-article-number))
If the prefix argument is positive, remove any kinds of marks.
If the prefix argument is negative, tick articles instead."
(interactive "P")
- (gnus-set-global-variables)
(when unmark
(setq unmark (prefix-numeric-value unmark)))
(let ((articles (gnus-summary-articles-in-thread)))
;; Summary sorting commands
(defun gnus-summary-sort-by-number (&optional reverse)
- "Sort summary buffer by article number.
+ "Sort the summary buffer by article number.
Argument REVERSE means reverse order."
(interactive "P")
(gnus-summary-sort 'number reverse))
(defun gnus-summary-sort-by-author (&optional reverse)
- "Sort summary buffer by author name alphabetically.
+ "Sort the summary buffer by author name alphabetically.
If case-fold-search is non-nil, case of letters is ignored.
Argument REVERSE means reverse order."
(interactive "P")
(gnus-summary-sort 'author reverse))
(defun gnus-summary-sort-by-subject (&optional reverse)
- "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
+ "Sort the summary buffer by subject alphabetically. `Re:'s are ignored.
If case-fold-search is non-nil, case of letters is ignored.
Argument REVERSE means reverse order."
(interactive "P")
(gnus-summary-sort 'subject reverse))
(defun gnus-summary-sort-by-date (&optional reverse)
- "Sort summary buffer by date.
+ "Sort the summary buffer by date.
Argument REVERSE means reverse order."
(interactive "P")
(gnus-summary-sort 'date reverse))
(defun gnus-summary-sort-by-score (&optional reverse)
- "Sort summary buffer by score.
+ "Sort the summary buffer by score.
Argument REVERSE means reverse order."
(interactive "P")
(gnus-summary-sort 'score reverse))
+(defun gnus-summary-sort-by-lines (&optional reverse)
+ "Sort the summary buffer by article length.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'lines reverse))
+
(defun gnus-summary-sort (predicate reverse)
"Sort summary buffer by PREDICATE. REVERSE means reverse order."
- (gnus-set-global-variables)
(let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
(article (intern (format "gnus-article-sort-by-%s" predicate)))
(gnus-thread-sort-functions
save those articles instead.
The variable `gnus-default-article-saver' specifies the saver function."
(interactive "P")
- (gnus-set-global-variables)
(let* ((articles (gnus-summary-work-articles n))
- (save-buffer (save-excursion
+ (save-buffer (save-excursion
(nnheader-set-temp-buffer " *Gnus Save*")))
(num (length articles))
header article file)
(gnus-summary-set-saved-mark article))))
(gnus-kill-buffer save-buffer)
(gnus-summary-position-point)
+ (gnus-set-mode-line 'summary)
n))
(defun gnus-summary-pipe-output (&optional arg)
If N is nil and any articles have been marked with the process mark,
pipe those articles instead."
(interactive "P")
- (gnus-set-global-variables)
(let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
(gnus-summary-save-article arg t))
(gnus-configure-windows 'pipe))
If N is nil and any articles have been marked with the process mark,
save those articles instead."
(interactive "P")
- (gnus-set-global-variables)
(let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
(gnus-summary-save-article arg)))
If N is nil and any articles have been marked with the process mark,
save those articles instead."
(interactive "P")
- (gnus-set-global-variables)
(let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
(gnus-summary-save-article arg)))
If N is nil and any articles have been marked with the process mark,
save those articles instead."
(interactive "P")
- (gnus-set-global-variables)
(let ((gnus-default-article-saver 'gnus-summary-save-in-file))
(gnus-summary-save-article arg)))
If N is nil and any articles have been marked with the process mark,
save those articles instead."
(interactive "P")
- (gnus-set-global-variables)
(let ((gnus-default-article-saver 'gnus-summary-write-to-file))
(gnus-summary-save-article arg)))
If N is nil and any articles have been marked with the process mark,
save those articles instead."
(interactive "P")
- (gnus-set-global-variables)
(let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
(gnus-summary-save-article arg)))
+(defun gnus-summary-pipe-message (program)
+ "Pipe the current article through PROGRAM."
+ (interactive "sProgram: ")
+ (gnus-summary-select-article)
+ (let ((mail-header-separator "")
+ (art-buf (get-buffer gnus-article-buffer)))
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (save-restriction
+ (widen)
+ (let ((start (window-start))
+ buffer-read-only)
+ (message-pipe-buffer-body program)
+ (set-window-start (get-buffer-window (current-buffer)) start))))))
+
(defun gnus-get-split-value (methods)
"Return a value based on the split METHODS."
(let (split-name method result match)
(setq result (eval match)))))
(setq split-name (append (cdr method) split-name))
(cond ((stringp result)
- (push result split-name))
+ (push (expand-file-name
+ result gnus-article-save-directory)
+ split-name))
((consp result)
(setq split-name (append result split-name)))))))))
split-name))
nil nil
'gnus-group-history))
(t
- (gnus-completing-read nil prom
+ (gnus-completing-read nil prom
(mapcar (lambda (el) (list el))
(nreverse split-name))
nil nil nil
(when to-newsgroup
(if (or (string= to-newsgroup "")
(string= to-newsgroup prefix))
- (setq to-newsgroup (or default "")))
+ (setq to-newsgroup default))
+ (unless to-newsgroup
+ (error "No group name entered"))
(or (gnus-active to-newsgroup)
(gnus-activate-group to-newsgroup)
(if (gnus-y-or-n-p (format "No such group: %s. Create it? "
to-newsgroup))
- (or (and (gnus-request-create-group
+ (or (and (gnus-request-create-group
to-newsgroup (gnus-group-name-to-method to-newsgroup))
(gnus-activate-group to-newsgroup nil nil
(gnus-group-name-to-method
(funcall (if (string-match "%s" action)
'format 'concat)
action
- (mapconcat (lambda (f) f) files " ")))))
+ (mapconcat
+ (lambda (f)
+ (if (equal f " ")
+ f
+ (gnus-quote-arg-for-sh-or-csh f)))
+ files " ")))))
(setq ps (cdr ps)))))
(if (and gnus-view-pseudos (not not-view))
(while pslist
(cond ((assq 'execute props)
(gnus-execute-command (cdr (assq 'execute props)))))
(let ((gnus-current-article (gnus-summary-article-number)))
- (run-hooks 'gnus-mark-article-hook)))
+ (gnus-run-hooks 'gnus-mark-article-hook)))
(defun gnus-execute-command (command &optional automatic)
(save-excursion
(gnus-article-setup-buffer)
(set-buffer gnus-article-buffer)
(setq buffer-read-only nil)
- (let ((command (if automatic command (read-string "Command: " command)))
- ;; Just binding this here doesn't help, because there might
- ;; be output from the process after exiting the scope of
- ;; this `let'.
- ;; (buffer-read-only nil)
- )
+ (let ((command (if automatic command
+ (read-string "Command: " (cons command 0)))))
(erase-buffer)
(insert "$ " command "\n\n")
(if gnus-view-pseudo-asynchronously
- (start-process "gnus-execute" nil shell-file-name
+ (start-process "gnus-execute" (current-buffer) shell-file-name
shell-command-switch command)
(call-process shell-file-name nil t nil
shell-command-switch command)))))
(defun gnus-summary-edit-global-kill (article)
"Edit the \"global\" kill file."
(interactive (list (gnus-summary-article-number)))
- (gnus-set-global-variables)
(gnus-group-edit-global-kill article))
(defun gnus-summary-edit-local-kill ()
"Edit a local kill file applied to the current newsgroup."
(interactive)
- (gnus-set-global-variables)
(setq gnus-current-headers (gnus-summary-article-header))
- (gnus-set-global-variables)
(gnus-group-edit-local-kill
(gnus-summary-article-number) gnus-newsgroup-name))
(defun gnus-read-header (id &optional header)
"Read the headers of article ID and enter them into the Gnus system."
(let ((group gnus-newsgroup-name)
- (gnus-override-method
+ (gnus-override-method
(and (gnus-news-group-p gnus-newsgroup-name)
gnus-refer-article-method))
where)
;; This is an article number.
(setq header (or header (gnus-summary-article-header id))))
(if (and header
- (not (memq (mail-header-number header) gnus-newsgroup-sparse)))
+ (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-gethash parent gnus-newsgroup-dependencies))))
+ (when thread
+ (delq (assq header thread) thread))))
;; We have to really fetch the header to this article.
(save-excursion
(set-buffer nntp-server-buffer)
(when (setq where (gnus-request-head id group))
+ (nnheader-fold-continuation-lines)
(goto-char (point-max))
(insert ".\n")
(goto-char (point-min))
(t gnus-reffed-article-number))
(current-buffer))
(insert " Article retrieved.\n"))
- (if (not (setq header (car (gnus-get-newsgroup-headers nil t))))
+ (if (or (not where)
+ (not (setq header (car (gnus-get-newsgroup-headers nil t)))))
() ; Malformed head.
- (unless (memq (mail-header-number header) gnus-newsgroup-sparse)
+ (unless (gnus-summary-article-sparse-p (mail-header-number header))
(when (and (stringp id)
(not (string= (gnus-group-real-name group)
(car where))))
;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
(from (if (get-text-property beg gnus-mouse-face-prop)
beg
- (or (next-single-property-change
+ (or (next-single-property-change
beg gnus-mouse-face-prop nil end)
beg)))
(to
(setq list (cdr list))))
(let ((face (cdar list)))
(unless (eq face (get-text-property beg 'face))
- (gnus-put-text-property
- beg end 'face
+ (gnus-put-text-property
+ beg end 'face
(setq face (if (boundp face) (symbol-value face) face)))
(when gnus-summary-highlight-line-function
(funcall gnus-summary-highlight-line-function article face))))
(goto-char p)))
-(defun gnus-update-read-articles (group unread)
+(defun gnus-update-read-articles (group unread &optional compute)
"Update the list of read articles in GROUP."
(let* ((active (or gnus-newsgroup-active (gnus-active group)))
(entry (gnus-gethash group gnus-newsrc-hashtb))
(setq unread (cdr unread)))
(when (<= prev (cdr active))
(push (cons prev (cdr active)) read))
- (gnus-undo-register
- `(progn
- (gnus-info-set-marks ',info ',(gnus-info-marks info))
- (gnus-info-set-read ',info ',(gnus-info-read info))
- (gnus-get-unread-articles-in-group ,info (gnus-active ,group))))
- ;; Enter this list into the group info.
- (gnus-info-set-read
- info (if (> (length read) 1) (nreverse read) read))
- ;; Set the number of unread articles in gnus-newsrc-hashtb.
- (gnus-get-unread-articles-in-group info (gnus-active group))
- t)))
+ (if compute
+ (if (> (length read) 1) (nreverse read) read)
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-undo-register
+ `(progn
+ (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
+ (gnus-info-set-read ',info ',(gnus-info-read info))
+ (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
+ (gnus-group-update-group ,group t))))
+ ;; Enter this list into the group info.
+ (gnus-info-set-read
+ info (if (> (length read) 1) (nreverse read) read))
+ ;; Set the number of unread articles in gnus-newsrc-hashtb.
+ (gnus-get-unread-articles-in-group info (gnus-active group))
+ t))))
+
+(defun gnus-offer-save-summaries ()
+ "Offer to save all active summary buffers."
+ (save-excursion
+ (let ((buflist (buffer-list))
+ buffers bufname)
+ ;; Go through all buffers and find all summaries.
+ (while buflist
+ (and (setq bufname (buffer-name (car buflist)))
+ (string-match "Summary" bufname)
+ (save-excursion
+ (set-buffer bufname)
+ ;; We check that this is, indeed, a summary buffer.
+ (and (eq major-mode 'gnus-summary-mode)
+ ;; Also make sure this isn't bogus.
+ gnus-newsgroup-prepared
+ ;; Also make sure that this isn't a dead summary buffer.
+ (not gnus-dead-summary-mode)))
+ (push bufname buffers))
+ (setq buflist (cdr buflist)))
+ ;; Go through all these summary buffers and offer to save them.
+ (when buffers
+ (map-y-or-n-p
+ "Update summary buffer %s? "
+ (lambda (buf)
+ (switch-to-buffer buf)
+ (gnus-summary-exit))
+ buffers)))))
+
+(gnus-ems-redefine)
(provide 'gnus-sum)
projects / gnus / blobdiff