;;; gnus-sum.el --- summary mode commands for Gnus
-;; Copyright (C) 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Keywords: news
(require 'gnus-int)
(require 'gnus-undo)
-(defgroup gnus-summary nil
- "Summary buffers."
- :group 'gnus)
-
(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
number of old headers will be fetched.
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
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-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
+(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
+ :group 'gnus-thread
:type '(set (function-item gnus-gather-threads-by-subject)
(function-item gnus-gather-threads-by-references)
(function :tag "other")))
"*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
+ :group 'gnus-summary-mail
: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)
-
(defcustom gnus-unread-mark ?
"*Mark used for unread articles."
: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
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
+ :group 'gnus-score-default
:type '(choice (const :tag "off" nil)
integer))
"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
+ :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-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
+(defcustom gnus-parse-headers-hook
(list '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-low-unread-face)
((and (= mark gnus-unread-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)))
+
;;; 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)
;; 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))
(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
((null gnus-summary-gather-subject-limit)
(gnus-simplify-subject-re subject))
(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-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
"v" gnus-summary-limit-to-score
"D" gnus-summary-limit-include-dormant
"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)
"\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)
"r" gnus-summary-refer-parent-article
"R" gnus-summary-refer-references
"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)
(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
+ "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
+ "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)]))
["Local" gnus-article-date-local 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]
+ ["Leading space" gnus-article-strip-leading-space t])
["Overstrike" gnus-article-treat-overstrike 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 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])
["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]
["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]
("Exit"
["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)))
("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-mark-positions)
- (gnus-make-local-hook 'post-command-hook)
- (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
+ (make-local-hook 'post-command-hook)
+ (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
(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)))
(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 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 "*")))
(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))))
(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-tmp-from (mail-header-from gnus-tmp-header))
(gnus-tmp-name
(cond
- ((string-match "(.+)" gnus-tmp-from)
- (substring gnus-tmp-from
- (1+ (match-beginning 0)) (1- (match-end 0))))
((string-match "<[^>]+> *$" gnus-tmp-from)
(let ((beg (match-beginning 0)))
(or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
(substring gnus-tmp-from (1+ (match-beginning 0))
(1- (match-end 0))))
(substring gnus-tmp-from 0 beg))))
+ ((string-match "(.+)" gnus-tmp-from)
+ (substring gnus-tmp-from
+ (1+ (match-beginning 0)) (1- (match-end 0))))
(t gnus-tmp-from)))
(gnus-tmp-subject (mail-header-subject gnus-tmp-header))
(gnus-tmp-number (mail-header-number gnus-tmp-header))
(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))
+ (gnus-summary-read-group-1
+ group show-all no-article
+ kill-buffer no-display))))
+ (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))
(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.
(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))
(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)
+ t)))))
(defun gnus-summary-prepare ()
"Generate the summary buffer."
;; 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
"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
+ header references generation relations
cthread subject child end pthread relation)
- ;; First we create an alist of generations/relations, where
+ ;; 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...")
(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)
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 ((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))))
;; 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-tmp-from (mail-header-from gnus-tmp-header)
gnus-tmp-name
(cond
- ((string-match "(.+)" gnus-tmp-from)
- (substring gnus-tmp-from
- (1+ (match-beginning 0)) (1- (match-end 0))))
((string-match "<[^>]+> *$" gnus-tmp-from)
(setq beg-match (match-beginning 0))
(or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
(substring gnus-tmp-from (1+ (match-beginning 0))
(1- (match-end 0))))
(substring gnus-tmp-from 0 beg-match)))
+ ((string-match "(.+)" gnus-tmp-from)
+ (substring gnus-tmp-from
+ (1+ (match-beginning 0)) (1- (match-end 0))))
(t gnus-tmp-from)))
(when (string= gnus-tmp-name "")
(setq gnus-tmp-name gnus-tmp-from))
"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)
;; 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))))))
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))
xref-hashtb)))))
(defun gnus-group-make-articles-read (group articles)
- "Update the info of GROUP to say that only ARTICLES are unread."
+ "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))
(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)))
+ (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))))
;; If the read list is nil, we init it.
(and active
(null (gnus-info-read info))
;; 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 (search-forward "\nmessage-id:" nil t)
+ (buffer-substring
+ (1- (or (search-forward "<" nil t) (point)))
+ (or (search-forward ">" nil t) (point)))
+ ;; 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)
(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.
(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
(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
+ (gnus-nov-field) ; subject
+ (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))
+ (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))
;; We build the thread tree.
(when (equal id ref)
(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
(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.
(let ((header (if (and old-header use-old-header)
old-header (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
(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)
(gnus-summary-find-next nil article)))
(decf n)))
(nreverse articles)))
- ((and (boundp 'transient-mark-mode)
- transient-mark-mode
- mark-active)
+ ((gnus-region-active-p)
;; Work on the region between point and mark.
(let ((max (max (point) (mark)))
articles article)
;; 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)
(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 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.
+ (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-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.
(gnus-tree-close group))
;; Make all changes in this group permanent.
(unless quit-config
+ (run-hooks 'gnus-exit-group-hook)
(gnus-summary-update-info))
(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))
(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? "))
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-article-buffer)
(progn
(gnus-message 5 "Returning to the group buffer")
(setq entered t)
- (set-buffer current-buffer)
- (gnus-summary-exit)
+ (when (gnus-buffer-live-p current-buffer)
+ (set-buffer current-buffer)
+ (gnus-summary-exit))
(run-hooks 'gnus-group-no-more-groups-hook))
;; We try to enter the target group.
(gnus-group-jump-to-group target-group)
;; 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)
"exiting"))
(gnus-summary-next-group nil group backward)))
(t
- (when (numberp last-input-event)
+ (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)."
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
;; 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
(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))))
+ (progn
+ (if (<= (length (cdr thread)) 1)
+ (setq 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)
;; 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 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-reads
+ (delq number gnus-newsgroup-unreads))
+ t))))
;; Nope, invisible article.
0
;; Ok, this article is to be visible, so we add it to the limit
(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"
(let ((ref (mail-header-references (gnus-summary-article-header)))
(current (gnus-summary-article-number))
(n 0))
- ;; For each Message-ID in the References header...
- (while (string-match "<[^>]*>" ref)
- (incf n)
- ;; ... fetch that article.
- (gnus-summary-refer-article
- (prog1 (match-string 0 ref)
- (setq ref (substring ref (match-end 0))))))
- (gnus-summary-goto-subject current)
- (gnus-summary-position-point)
- n))
+ (if (or (not ref)
+ (equal ref ""))
+ (error "No References in the current article")
+ ;; For each Message-ID in the References header...
+ (while (string-match "<[^>]*>" ref)
+ (incf n)
+ ;; ... fetch that article.
+ (gnus-summary-refer-article
+ (prog1 (match-string 0 ref)
+ (setq ref (substring ref (match-end 0))))))
+ (gnus-summary-goto-subject current)
+ (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-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
- (memq (mail-header-number header)
- gnus-newsgroup-sparse))))
+ (gnus-summary-article-sparse-p
+ (mail-header-number header)))))
(if header
(prog1
;; The article is present in the buffer, to we just go to it.
- (gnus-summary-goto-article
+ (gnus-summary-goto-article
(mail-header-number header) nil header)
(when sparse
(gnus-summary-update-article (mail-header-number header))))
;; 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
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."
(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.
(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)
(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 ()
(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)
+ "Generate and print a PostScript image of the article buffer.
+
+If the optional 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)))
+ (gnus-summary-select-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)
+ (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
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)
(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-remove-text-with-property 'gnus-prev)
(gnus-remove-text-with-property 'gnus-next)))))
-(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.
(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)
" ")))
(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)))))
(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))
+ (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)
+ :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))
;; We need to update the info for
;; this group for `gnus-list-of-read-articles'
;; to give us the right answer.
+ (run-hooks 'gnus-exit-group-hook)
(gnus-summary-update-info)
(gnus-list-of-read-articles gnus-newsgroup-name))
(setq gnus-newsgroup-expirable
(interactive)
(gnus-set-global-variables)
(or gnus-expert-user
- (gnus-y-or-n-p
+ (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))
(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)
(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))
+ (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))))
(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.
(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)
(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))
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)
(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)))
(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."
(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
(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
+ (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)
+ (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 (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)
+ (current-buffer))
+ (error "Couldn't replace article."))))
(set-buffer gnus-summary-buffer)
(gnus-summary-unmark-all-processable)
(gnus-summary-rethread-current)
(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"))
;; 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)
(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)
(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-set-global-variables)
+ (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
(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: " command))))
(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-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
;; 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))))
(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))))
+ (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))
(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)
(run-hooks 'gnus-sum-load-hook)
projects / gnus / blobdiff