;;; 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
;;; Code:
-(require 'gnus-load)
+(require 'gnus)
(require 'gnus-group)
(require 'gnus-spec)
(require 'gnus-range)
(require 'gnus-int)
(require 'gnus-undo)
-(require 'gnus)
-(defvar gnus-kill-summary-on-exit t
+(defcustom gnus-kill-summary-on-exit t
"*If non-nil, kill the summary buffer when you exit from it.
If nil, the summary will become a \"*Dead Summary*\" buffer, and
-it will be killed sometime later.")
+it will be killed sometime later."
+ :group 'gnus-summary-exit
+ :type 'boolean)
-(defvar gnus-fetch-old-headers nil
+(defcustom gnus-fetch-old-headers nil
"*Non-nil means that Gnus will try to build threads by grabbing old headers.
If an unread article in the group refers to an older, already read (or
just marked as read) article, the old article will not normally be
This variable can also be a number. In that case, no more than that
number of old headers will be fetched.
-The server has to support NOV for any of this to work.")
+The server has to support NOV for any of this to work."
+ :group 'gnus-thread
+ :type '(choice (const :tag "off" nil)
+ (const some)
+ number
+ (sexp :menu-tag "other" t)))
-(defvar gnus-summary-make-false-root 'adopt
+(defcustom gnus-summary-make-false-root 'adopt
"*nil means that Gnus won't gather loose threads.
If the root of a thread has expired or been read in a previous
session, the information necessary to build a complete thread has been
the parent and mark all the step-children as such.
If this variable is `empty', the \"children\" are printed with empty
subject fields. (Or rather, they will be printed with a string
-given by the `gnus-summary-same-subject' variable.)")
-
-(defvar gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
+given by the `gnus-summary-same-subject' variable.)"
+ :group 'gnus-thread
+ :type '(choice (const :tag "off" nil)
+ (const none)
+ (const dummy)
+ (const adopt)
+ (const empty)))
+
+(defcustom gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
"*A regexp to match subjects to be excluded from loose thread gathering.
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.")
+common subjects, gathering might become saner."
+ :group 'gnus-thread
+ :type 'regexp)
-(defvar gnus-summary-gather-subject-limit nil
+(defcustom gnus-summary-gather-subject-limit nil
"*Maximum length of subject comparisons when gathering loose threads.
Use nil to compare full subjects. Setting this variable to a low
number will help gather threads that have been corrupted by
same few characters will be incorrectly gathered.
If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
-comparing subjects.")
-
-(defvar gnus-simplify-ignored-prefixes nil
- "*Regexp, matches for which are removed from subject lines when simplifying fuzzily.")
-
-(defvar gnus-build-sparse-threads nil
+comparing subjects."
+ :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-thread
+ :type '(choice (const :tag "off" nil)
+ regexp))
+
+(defcustom gnus-build-sparse-threads nil
"*If non-nil, fill in the gaps in threads.
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.")
-
-(defvar gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject
+non-nil and non-`some', fill in all gaps that Gnus manages to guess."
+ :group 'gnus-thread
+ :type '(choice (const :tag "off" nil)
+ (const some)
+ (const more)
+ (sexp :menu-tag "all" t)))
+
+(defcustom gnus-summary-thread-gathering-function
+ 'gnus-gather-threads-by-subject
"Function used for gathering loose threads.
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.")
+headers of the articles to find matches."
+ :group 'gnus-thread
+ :type '(set (function-item gnus-gather-threads-by-subject)
+ (function-item gnus-gather-threads-by-references)
+ (function :tag "other")))
;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
-(defvar gnus-summary-same-subject ""
+(defcustom gnus-summary-same-subject ""
"*String indicating that the current article has the same subject as the previous.
This variable will only be used if the value of
-`gnus-summary-make-false-root' is `empty'.")
-
-(defvar gnus-summary-goto-unread t
- "*If non-nil, marking commands will go to the next unread article.
-If `never', \\<gnus-summary-mode-map>\\[gnus-summary-next-page] will go to the next article,
-whether it is read or not.")
-
-(defvar gnus-summary-default-score 0
+`gnus-summary-make-false-root' is `empty'."
+ :group 'gnus-summary-format
+ :type 'string)
+
+(defcustom gnus-summary-goto-unread t
+ "*If t, marking commands will go to the next unread article.
+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-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.
-If this variable is nil, scoring will be disabled.")
+All scores generated by the score files will be added to this score.
+If this variable is nil, scoring will be disabled."
+ :group 'gnus-score-default
+ :type '(choice (const :tag "disable")
+ integer))
-(defvar gnus-summary-zcore-fuzz 0
+(defcustom gnus-summary-zcore-fuzz 0
"*Fuzziness factor for the zcore in the summary buffer.
Articles with scores closer than this to `gnus-summary-default-score'
-will not be marked.")
+will not be marked."
+ :group 'gnus-summary-format
+ :type 'integer)
-(defvar gnus-simplify-subject-fuzzy-regexp nil
+(defcustom gnus-simplify-subject-fuzzy-regexp nil
"*Strings to be removed when doing fuzzy matches.
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.")
+simplification is selected."
+ :group 'gnus-thread
+ :type '(repeat regexp))
-(defvar gnus-show-threads t
- "*If non-nil, display threads in summary mode.")
+(defcustom gnus-show-threads t
+ "*If non-nil, display threads in summary mode."
+ :group 'gnus-thread
+ :type 'boolean)
-(defvar gnus-thread-hide-subtree nil
+(defcustom gnus-thread-hide-subtree nil
"*If non-nil, hide all threads initially.
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.")
+to expose hidden threads."
+ :group 'gnus-thread
+ :type 'boolean)
-(defvar gnus-thread-hide-killed t
- "*If non-nil, hide killed threads automatically.")
+(defcustom gnus-thread-hide-killed t
+ "*If non-nil, hide killed threads automatically."
+ :group 'gnus-thread
+ :type 'boolean)
-(defvar gnus-thread-ignore-subject nil
+(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.")
+from their parents will start separate threads."
+ :group 'gnus-thread
+ :type 'boolean)
-(defvar gnus-thread-operation-ignore-subject t
+(defcustom gnus-thread-operation-ignore-subject t
"*If non-nil, subjects will be ignored when doing thread commands.
This affects commands like `gnus-summary-kill-thread' and
`gnus-summary-lower-thread'.
If this variable is nil, articles in the same thread with different
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.")
-
-(defvar gnus-thread-indent-level 4
- "*Number that says how much each sub-thread should be indented.")
-
-(defvar gnus-auto-extend-newsgroup t
- "*If non-nil, extend newsgroup forward and backward when requested.")
-
-(defvar gnus-auto-select-first t
+equal will be included."
+ :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-thread
+ :type 'integer)
+
+(defcustom gnus-auto-extend-newsgroup t
+ "*If non-nil, extend newsgroup forward and backward when requested."
+ :group 'gnus-summary-choose
+ :type 'boolean)
+
+(defcustom gnus-auto-select-first t
"*If nil, don't select the first unread article when entering a group.
If this variable is `best', select the highest-scored unread article
in the group. If neither nil nor `best', select the first unread
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'.")
+`gnus-select-group-hook'."
+ :group 'gnus-group-select
+ :type '(choice (const :tag "none" nil)
+ (const best)
+ (sexp :menu-tag "first" t)))
-(defvar gnus-auto-select-next t
+(defcustom gnus-auto-select-next t
"*If non-nil, offer to go to the next group from the end of the previous.
If the value is t and the next newsgroup is empty, Gnus will exit
summary mode and go back to group mode. If the value is neither nil
`almost-quietly', the next group will be selected without any
confirmation if you are located on the last article in the group.
Finally, if this variable is `slightly-quietly', the `Z n' command
-will go to the next group without confirmation.")
-
-(defvar gnus-auto-select-same nil
- "*If non-nil, select the next article with the same subject.")
-
-(defvar gnus-summary-check-current nil
+will go to the next group without confirmation."
+ :group 'gnus-summary-maneuvering
+ :type '(choice (const :tag "off" nil)
+ (const quietly)
+ (const almost-quietly)
+ (const slightly-quietly)
+ (sexp :menu-tag "on" t)))
+
+(defcustom gnus-auto-select-same nil
+ "*If non-nil, select the next article with the same subject."
+ :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.")
+current article is unread."
+ :group 'gnus-summary-maneuvering
+ :type 'boolean)
-(defvar gnus-auto-center-summary t
+(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.")
-
-(defvar gnus-show-all-headers nil
- "*If non-nil, don't hide any headers.")
-
-(defvar gnus-single-article-buffer t
+and non-`vertical', do both horizontal and vertical recentering."
+ :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-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.")
+If nil, each group will get its own article buffer."
+ :group 'gnus-article-various
+ :type 'boolean)
-(defvar gnus-break-pages t
+(defcustom gnus-break-pages t
"*If non-nil, do page breaking on articles.
The page delimiter is specified by the `gnus-page-delimiter'
-variable.")
+variable."
+ :group 'gnus-article-various
+ :type 'boolean)
-(defvar gnus-show-mime nil
+(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'.")
+`gnus-show-mime-method'."
+ :group 'gnus-article-mime
+ :type 'boolean)
-(defvar gnus-move-split-methods nil
+(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.")
-
-;; Mark variables suggested by Thomas Michanek
-;; <Thomas.Michanek@telelogic.se>.
-(defvar gnus-unread-mark ?
- "*Mark used for unread articles.")
-(defvar gnus-ticked-mark ?!
- "*Mark used for ticked articles.")
-(defvar gnus-dormant-mark ??
- "*Mark used for dormant articles.")
-(defvar gnus-del-mark ?r
- "*Mark used for del'd articles.")
-(defvar gnus-read-mark ?R
- "*Mark used for read articles.")
-(defvar gnus-expirable-mark ?E
- "*Mark used for expirable articles.")
-(defvar gnus-killed-mark ?K
- "*Mark used for killed articles.")
-(defvar gnus-souped-mark ?F
- "*Mark used for killed articles.")
-(defvar gnus-kill-file-mark ?X
- "*Mark used for articles killed by kill files.")
-(defvar gnus-low-score-mark ?Y
- "*Mark used for articles with a low score.")
-(defvar gnus-catchup-mark ?C
- "*Mark used for articles that are caught up.")
-(defvar gnus-replied-mark ?A
- "*Mark used for articles that have been replied to.")
-(defvar gnus-cached-mark ?*
- "*Mark used for articles that are in the cache.")
-(defvar gnus-saved-mark ?S
- "*Mark used for articles that have been saved to.")
-(defvar gnus-ancient-mark ?O
- "*Mark used for ancient articles.")
-(defvar gnus-sparse-mark ?Q
- "*Mark used for sparsely reffed articles.")
-(defvar gnus-canceled-mark ?G
- "*Mark used for canceled articles.")
-(defvar gnus-duplicate-mark ?M
- "*Mark used for duplicate articles.")
-(defvar gnus-score-over-mark ?+
- "*Score mark used for articles with high scores.")
-(defvar gnus-score-below-mark ?-
- "*Score mark used for articles with low scores.")
-(defvar gnus-empty-thread-mark ?
- "*There is no thread under the article.")
-(defvar gnus-not-empty-thread-mark ?=
- "*There is a thread under the article.")
-
-(defvar gnus-view-pseudo-asynchronously nil
- "*If non-nil, Gnus will view pseudo-articles asynchronously.")
-
-(defvar gnus-view-pseudos nil
+It uses the same syntax as the `gnus-split-methods' variable."
+ :group 'gnus-summary-mail
+ :type '(repeat (choice (list function)
+ (cons regexp (repeat string))
+ sexp)))
+
+(defcustom gnus-unread-mark ?
+ "*Mark used for unread articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-ticked-mark ?!
+ "*Mark used for ticked articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-dormant-mark ??
+ "*Mark used for dormant articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-del-mark ?r
+ "*Mark used for del'd articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-read-mark ?R
+ "*Mark used for read articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-expirable-mark ?E
+ "*Mark used for expirable articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-killed-mark ?K
+ "*Mark used for killed articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-souped-mark ?F
+ "*Mark used for killed articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-kill-file-mark ?X
+ "*Mark used for articles killed by kill files."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-low-score-mark ?Y
+ "*Mark used for articles with a low score."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-catchup-mark ?C
+ "*Mark used for articles that are caught up."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-replied-mark ?A
+ "*Mark used for articles that have been replied to."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-cached-mark ?*
+ "*Mark used for articles that are in the cache."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-saved-mark ?S
+ "*Mark used for articles that have been saved to."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-ancient-mark ?O
+ "*Mark used for ancient articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-sparse-mark ?Q
+ "*Mark used for sparsely reffed articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-canceled-mark ?G
+ "*Mark used for canceled articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-duplicate-mark ?M
+ "*Mark used for duplicate articles."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-score-over-mark ?+
+ "*Score mark used for articles with high scores."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-score-below-mark ?-
+ "*Score mark used for articles with low scores."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-empty-thread-mark ?
+ "*There is no thread under the article."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-not-empty-thread-mark ?=
+ "*There is a thread under the article."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-view-pseudo-asynchronously nil
+ "*If non-nil, Gnus will view pseudo-articles asynchronously."
+ :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.")
+will not be asked to confirm the command."
+ :group 'gnus-extract-view
+ :type '(choice (const :tag "off" nil)
+ (const automatic)
+ (const not-confirm)))
-(defvar gnus-view-pseudos-separately t
+(defcustom gnus-view-pseudos-separately t
"*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.")
+list of parameters to that command."
+ :group 'gnus-extract-view
+ :type 'boolean)
-(defvar gnus-insert-pseudo-articles t
- "*If non-nil, insert pseudo-articles when decoding articles.")
+(defcustom gnus-insert-pseudo-articles t
+ "*If non-nil, insert pseudo-articles when decoding articles."
+ :group 'gnus-extract-view
+ :type 'boolean)
-(defvar gnus-summary-dummy-line-format
+(defcustom gnus-summary-dummy-line-format
"* %(: :%) %S\n"
"*The format specification for the dummy roots in the summary buffer.
It works along the same lines as a normal formatting string,
with some simple extensions.
-%S The subject")
+%S The subject"
+ :group 'gnus-threading
+ :type 'string)
-(defvar gnus-summary-mode-line-format "Gnus: %%b [%A] %Z"
+(defcustom gnus-summary-mode-line-format "Gnus: %%b [%A] %Z"
"*The format specification for the summary mode line.
It works along the same lines as a normal formatting string,
with some simple extensions:
%s Current score file name
%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")
+%E Number of articles expunged by the score files"
+ :group 'gnus-summary-format
+ :type 'string)
-(defvar gnus-summary-mark-below 0
+(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.")
+score file."
+ :group 'gnus-score-default
+ :type 'integer)
-(defvar gnus-article-sort-functions '(gnus-article-sort-by-number)
+(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.")
-
-(defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number)
+This variable is only used when not using a threaded display."
+ :group 'gnus-summary-sort
+ :type '(repeat (choice (function-item gnus-article-sort-by-number)
+ (function-item gnus-article-sort-by-author)
+ (function-item gnus-article-sort-by-subject)
+ (function-item gnus-article-sort-by-date)
+ (function-item gnus-article-sort-by-score)
+ (function :tag "other"))))
+
+(defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number)
"*List of functions used for sorting threads in the summary buffer.
By default, threads are sorted by article number.
Ready-made functions include `gnus-thread-sort-by-number',
`gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
`gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
-`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').")
-
-(defvar gnus-thread-score-function '+
+`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function')."
+ :group 'gnus-summary-sort
+ :type '(repeat (choice (function-item gnus-thread-sort-by-number)
+ (function-item gnus-thread-sort-by-author)
+ (function-item gnus-thread-sort-by-subject)
+ (function-item gnus-thread-sort-by-date)
+ (function-item gnus-thread-sort-by-score)
+ (function-item gnus-thread-sort-by-total-score)
+ (function :tag "other"))))
+
+(defcustom gnus-thread-score-function '+
"*Function used for calculating the total score of a thread.
The function is called with the scores of the article and each
subthread and should then return the score of the thread.
-Some functions you can use are `+', `max', or `min'.")
+Some functions you can use are `+', `max', or `min'."
+ :group 'gnus-summary-sort
+ :type 'function)
-(defvar gnus-summary-expunge-below nil
- "All articles that have a score less than this variable will be expunged.")
+(defcustom gnus-summary-expunge-below nil
+ "All articles that have a score less than this variable will be expunged."
+ :group 'gnus-score-default
+ :type '(choice (const :tag "off" nil)
+ integer))
-(defvar gnus-thread-expunge-below nil
+(defcustom gnus-thread-expunge-below nil
"All threads that have a total score less than this variable will be expunged.
See `gnus-thread-score-function' for en explanation of what a
-\"thread score\" is.")
+\"thread score\" is."
+ :group 'gnus-treading
+ :group 'gnus-score-default
+ :type '(choice (const :tag "off" nil)
+ integer))
-(defvar gnus-summary-mode-hook nil
+(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.")
-
-(defvar gnus-summary-menu-hook nil
- "*Hook run after the creation of the summary mode menu.")
-
-(defvar gnus-summary-exit-hook nil
- "*A hook called on exit from the summary buffer.")
-
-(defvar gnus-summary-prepare-hook nil
+This hook is run before any variables are set in the summary buffer."
+ :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-visual
+ :type 'hook)
+
+(defcustom gnus-summary-exit-hook nil
+ "*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.")
+If you want to modify the summary buffer, you can use this hook."
+ :group 'gnus-summary-various
+ :type 'hook)
-(defvar gnus-summary-generate-hook nil
+(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.")
+like."
+ :group 'gnus-summary-various
+ :type 'hook)
-(defvar gnus-select-group-hook nil
+(defcustom gnus-select-group-hook nil
"*A hook called when a newsgroup is selected.
If you'd like to simplify subjects like the
header
(gnus-simplify-subject
(mail-header-subject header) 're-only)))
- gnus-newsgroup-headers))))")
+ gnus-newsgroup-headers))))"
+ :group 'gnus-group-select
+ :type 'hook)
-(defvar gnus-select-article-hook nil
- "*A hook called when an article is selected.")
+(defcustom gnus-select-article-hook nil
+ "*A hook called when an article is selected."
+ :group 'gnus-summary-choose
+ :type 'hook)
-(defvar gnus-visual-mark-article-hook
+(defcustom gnus-visual-mark-article-hook
(list 'gnus-highlight-selected-summary)
"*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.")
-
-(defvar gnus-parse-headers-hook nil
- "*A hook called before parsing the headers.")
-(add-hook 'gnus-parse-headers-hook 'gnus-decode-rfc1522)
-
-(defvar gnus-exit-group-hook nil
- "*A hook called when exiting (not quitting) summary mode.")
-
-(defvar gnus-summary-update-hook
+is not run if `gnus-visual' is nil."
+ :group 'gnus-summary-visual
+ :type 'hook)
+
+(defcustom gnus-parse-headers-hook
+ (list 'gnus-decode-rfc1522)
+ "*A hook called before parsing the headers."
+ :group 'gnus-various
+ :type 'hook)
+
+(defcustom gnus-exit-group-hook nil
+ "*A hook called when exiting (not quitting) summary mode."
+ :group 'gnus-various
+ :type 'hook)
+
+(defcustom gnus-summary-update-hook
(list 'gnus-summary-highlight-line)
"*A hook called when a summary line is changed.
The hook will not be called if `gnus-visual' is nil.
The default function `gnus-summary-highlight-line' will
highlight the line according to the `gnus-summary-highlight'
-variable.")
+variable."
+ :group 'gnus-summary-visual
+ :type 'hook)
-(defvar gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read)
+(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.")
-
-(defvar gnus-group-no-more-groups-hook nil
- "*A hook run when returning to group mode having no more (unread) groups.")
-
-(defvar gnus-summary-selected-face 'underline
- "Face used for highlighting the current article in the summary buffer.")
-
-(defvar gnus-summary-highlight
- (cond
- ((not (eq gnus-display-type 'color))
- '(((> score default) . bold)
- ((< score default) . italic)))
- ((eq gnus-background-mode 'dark)
- (list
- (cons
- '(= mark gnus-canceled-mark)
- (custom-face-lookup "yellow" "black" nil
- nil nil nil))
- (cons '(and (> score default)
- (or (= mark gnus-dormant-mark)
- (= mark gnus-ticked-mark)))
- (custom-face-lookup
- "pink" nil nil t nil nil))
- (cons '(and (< score default)
- (or (= mark gnus-dormant-mark)
- (= mark gnus-ticked-mark)))
- (custom-face-lookup "pink" nil nil
- nil t nil))
- (cons '(or (= mark gnus-dormant-mark)
- (= mark gnus-ticked-mark))
- (custom-face-lookup
- "pink" nil nil nil nil nil))
-
- (cons
- '(and (> score default) (= mark gnus-ancient-mark))
- (custom-face-lookup "medium blue" nil nil t
- nil nil))
- (cons
- '(and (< score default) (= mark gnus-ancient-mark))
- (custom-face-lookup "SkyBlue" nil nil
- nil t nil))
- (cons
- '(= mark gnus-ancient-mark)
- (custom-face-lookup "SkyBlue" nil nil
- nil nil nil))
- (cons '(and (> score default) (= mark gnus-unread-mark))
- (custom-face-lookup "white" nil nil t
- nil nil))
- (cons '(and (< score default) (= mark gnus-unread-mark))
- (custom-face-lookup "white" nil nil
- nil t nil))
- (cons '(= mark gnus-unread-mark)
- (custom-face-lookup
- "white" nil nil nil nil nil))
-
- (cons '(> score default) 'bold)
- (cons '(< score default) 'italic)))
- (t
- (list
- (cons
- '(= mark gnus-canceled-mark)
- (custom-face-lookup
- "yellow" "black" nil nil nil nil))
- (cons '(and (> score default)
- (or (= mark gnus-dormant-mark)
- (= mark gnus-ticked-mark)))
- (custom-face-lookup "firebrick" nil nil
- t nil nil))
- (cons '(and (< score default)
- (or (= mark gnus-dormant-mark)
- (= mark gnus-ticked-mark)))
- (custom-face-lookup "firebrick" nil nil
- nil t nil))
- (cons
- '(or (= mark gnus-dormant-mark)
- (= mark gnus-ticked-mark))
- (custom-face-lookup
- "firebrick" nil nil nil nil nil))
-
- (cons '(and (> score default) (= mark gnus-ancient-mark))
- (custom-face-lookup "RoyalBlue" nil nil
- t nil nil))
- (cons '(and (< score default) (= mark gnus-ancient-mark))
- (custom-face-lookup "RoyalBlue" nil nil
- nil t nil))
- (cons
- '(= mark gnus-ancient-mark)
- (custom-face-lookup
- "RoyalBlue" nil nil nil nil nil))
-
- (cons '(and (> score default) (/= mark gnus-unread-mark))
- (custom-face-lookup "DarkGreen" nil nil
- t nil nil))
- (cons '(and (< score default) (/= mark gnus-unread-mark))
- (custom-face-lookup "DarkGreen" nil nil
- nil t nil))
- (cons
- '(/= mark gnus-unread-mark)
- (custom-face-lookup "DarkGreen" nil nil
- nil nil nil))
-
- (cons '(> score default) 'bold)
- (cons '(< score default) 'italic))))
- "Controls the highlighting of summary buffer lines.
-
-Below is a list of `Form'/`Face' pairs. When deciding how a a
-particular summary line should be displayed, each form is
-evaluated. The content of the face field after the first true form is
-used. You can change how those summary lines are displayed, by
-editing the face field.
-
-It is also possible to change and add form fields, but currently that
-requires an understanding of Lisp expressions. Hopefully this will
-change in a future release. For now, you can use the following
-variables in the Lisp expression:
-
-score: The article's score
+automatically when it is selected."
+ :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-group-select
+ :type 'hook)
+
+(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-visual
+ :type 'face)
+
+(defcustom gnus-summary-highlight
+ '(((= mark gnus-canceled-mark)
+ . gnus-summary-cancelled-face)
+ ((and (> score default)
+ (or (= mark gnus-dormant-mark)
+ (= mark gnus-ticked-mark)))
+ . gnus-summary-high-ticked-face)
+ ((and (< score default)
+ (or (= mark gnus-dormant-mark)
+ (= mark gnus-ticked-mark)))
+ . gnus-summary-low-ticked-face)
+ ((or (= mark gnus-dormant-mark)
+ (= mark gnus-ticked-mark))
+ . gnus-summary-normal-ticked-face)
+ ((and (> score default) (= mark gnus-ancient-mark))
+ . gnus-summary-high-ancient-face)
+ ((and (< score default) (= mark gnus-ancient-mark))
+ . gnus-summary-low-ancient-face)
+ ((= mark gnus-ancient-mark)
+ . gnus-summary-normal-ancient-face)
+ ((and (> score default) (= mark gnus-unread-mark))
+ . gnus-summary-high-unread-face)
+ ((and (< score default) (= mark gnus-unread-mark))
+ . gnus-summary-low-unread-face)
+ ((and (= mark gnus-unread-mark))
+ . gnus-summary-normal-unread-face)
+ ((> score default)
+ . gnus-summary-high-read-face)
+ ((< score default)
+ . gnus-summary-low-read-face)
+ (t
+ . gnus-summary-normal-read-face))
+ "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
+of the face field after the first true form is used. You can change
+how those summary lines are displayed, by editing the face field.
+
+You can use the following variables in the FORM field.
+
+score: The articles score
default: The default article score.
-below: The score below which articles are automatically marked as read.
-mark: The article's mark.")
+below: The score below which articles are automatically marked as read.
+mark: The articles mark."
+ :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)
(when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject)
(setq subject (substring subject (match-end 0))))
;; Remove uninteresting prefixes.
- (if (and (not re-only)
- gnus-simplify-ignored-prefixes
- (string-match gnus-simplify-ignored-prefixes subject))
- (setq subject (substring subject (match-end 0))))
+ (when (and (not re-only)
+ gnus-simplify-ignored-prefixes
+ (string-match gnus-simplify-ignored-prefixes subject))
+ (setq subject (substring subject (match-end 0))))
;; Remove words in parentheses from end.
(unless re-only
(while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
;; Remove any leading "re:"s, any trailing paren phrases, and simplify
;; all whitespace.
-;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
+(defsubst gnus-simplify-buffer-fuzzy-step (regexp &optional newtext)
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (replace-match (or newtext ""))))
+
(defun gnus-simplify-buffer-fuzzy ()
- (let ((case-fold-search t))
- (goto-char (point-min))
- (while (search-forward "\t" nil t)
- (replace-match " " t t))
- (goto-char (point-min))
- (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" nil t)
- (goto-char (match-beginning 0))
- (while (or
- (looking-at "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
- (looking-at "^[[].*: .*[]]$"))
- (goto-char (point-min))
- (while (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *"
- nil t)
- (replace-match "" t t))
- (goto-char (point-min))
- (while (re-search-forward "^[[].*: .*[]]$" nil t)
- (goto-char (match-end 0))
- (delete-char -1)
- (delete-region
- (progn (goto-char (match-beginning 0)))
- (re-search-forward ":"))))
- (goto-char (point-min))
- (while (re-search-forward " *[[{(][^()\n]*[]})] *$" nil t)
- (replace-match "" t t))
- (goto-char (point-min))
- (while (re-search-forward " +" nil t)
- (replace-match " " t t))
- (goto-char (point-min))
- (while (re-search-forward " $" nil t)
- (replace-match "" t t))
- (goto-char (point-min))
- (while (re-search-forward "^ +" nil t)
- (replace-match "" t t))
- (goto-char (point-min))
- (when gnus-simplify-subject-fuzzy-regexp
- (if (listp gnus-simplify-subject-fuzzy-regexp)
- (let ((list gnus-simplify-subject-fuzzy-regexp))
- (while list
- (goto-char (point-min))
- (while (re-search-forward (car list) nil t)
- (replace-match "" t t))
- (setq list (cdr list))))
- (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
- (replace-match "" t t))))))
+ "Simplify string in the buffer fuzzily.
+The string in the accessible portion of the current buffer is simplified.
+It is assumed to be a single-line subject.
+Whitespace is generally cleaned up, and miscellaneous leading/trailing
+matter is removed. Additional things can be deleted by setting
+gnus-simplify-subject-fuzzy-regexp."
+ (let ((case-fold-search t)
+ (modified-tick))
+ (gnus-simplify-buffer-fuzzy-step "\t" " ")
+
+ (while (not (eq modified-tick (buffer-modified-tick)))
+ (setq modified-tick (buffer-modified-tick))
+ (cond
+ ((listp gnus-simplify-subject-fuzzy-regexp)
+ (mapcar 'gnus-simplify-buffer-fuzzy-step
+ gnus-simplify-subject-fuzzy-regexp))
+ (gnus-simplify-subject-fuzzy-regexp
+ (gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp)))
+ (gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *")
+ (gnus-simplify-buffer-fuzzy-step
+ "^ *\\(re\\|fw\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
+ (gnus-simplify-buffer-fuzzy-step "^[[].*:\\( .*\\)[]]$" "\\1"))
+
+ (gnus-simplify-buffer-fuzzy-step " *[[{(][^()\n]*[]})] *$")
+ (gnus-simplify-buffer-fuzzy-step " +" " ")
+ (gnus-simplify-buffer-fuzzy-step " $")
+ (gnus-simplify-buffer-fuzzy-step "^ +")))
(defun gnus-simplify-subject-fuzzy (subject)
- "Simplify a subject string fuzzily."
+ "Simplify a subject string fuzzily.
+See gnus-simplify-buffer-fuzzy for details."
(save-excursion
(gnus-set-work-buffer)
(let ((case-fold-search t))
(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
(gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map)
"o" gnus-summary-save-article
"m" gnus-summary-save-article-mail
+ "F" gnus-summary-write-article-file
"r" gnus-summary-save-article-rmail
"f" gnus-summary-save-article-file
"b" gnus-summary-save-article-body-file
"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 default format" gnus-summary-save-article t]
["Save in file" gnus-summary-save-article-file t]
["Save in Unix mail format" gnus-summary-save-article-mail t]
+ ["Write to file" gnus-summary-write-article-mail t]
["Save in MH folder" gnus-summary-save-article-folder t]
["Save in VM folder" gnus-summary-save-article-vm t]
["Save in RMAIL mbox" gnus-summary-save-article-rmail t]
["Save body in file" gnus-summary-save-article-body-file t]
["Pipe through a filter" gnus-summary-pipe-output t]
- ["Add to SOUP packet" gnus-soup-add-article t])
+ ["Add to SOUP packet" gnus-soup-add-article t]
+ ["Print" gnus-summary-print-article t])
("Backend"
["Respool article..." gnus-summary-respool-article t]
["Move article..." gnus-summary-move-article
["Save" gnus-uu-decode-save t]
["Binhex" gnus-uu-decode-binhex t]
["Postscript" gnus-uu-decode-postscript t])
+ ("Cache"
+ ["Enter article" gnus-cache-enter-article t]
+ ["Remove article" gnus-cache-remove-article t])
["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]
["Send bounced mail" gnus-summary-resend-bounced-mail t]
["Send a mail" gnus-summary-mail-other-window t]
["Uuencode and post" gnus-uu-post-news t]
+ ["Followup via news" gnus-summary-followup-to-mail t]
+ ["Followup via news and yank"
+ gnus-summary-followup-to-mail-with-original t]
;;("Draft"
;;["Send" gnus-summary-send-draft t]
;;["Send bounced" gnus-resend-bounced-mail 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]
["Go to subject number..." gnus-summary-goto-subject t]
["Go to article number..." gnus-summary-goto-article t]
["Go to the last article" gnus-summary-goto-last-article t]
- ["Pop article off history" gnus-summary-pop-article t])
+ ["Pop article off history" gnus-summary-pop-article t])
("Sort"
["Sort by number" gnus-summary-sort-by-number 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)
(setq outp
(cons
(vector
- (caar ps)
+ (caar ps)
(list
'gnus-summary-score-entry
(nth 1 header)
- (if (or (string= (nth 1 header)
+ (if (or (string= (nth 1 header)
"head")
(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)
+ (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)
- (gnus-make-local-hook 'post-command-hook)
- (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
- (run-hooks 'gnus-summary-mode-hook))
+ (gnus-update-summary-mark-positions))
(defun gnus-summary-make-local-variables ()
"Make all the local summary buffer variables."
(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))
(defun gnus-data-enter (after-article number mark pos header level offset)
(let ((data (gnus-data-find-list after-article)))
- (or data (error "No such article: %d" after-article))
+ (unless data
+ (error "No such article: %d" after-article))
(setcdr data (cons (gnus-data-make number mark pos header level)
(cdr data)))
(setq gnus-newsgroup-data-reverse nil)
(progn
(setcdr list gnus-newsgroup-data)
(setq gnus-newsgroup-data ilist)
- (and offset (gnus-data-update-list (cdr list) offset)))
+ (when offset
+ (gnus-data-update-list (cdr list) offset)))
(setcdr list (cdr data))
(setcdr data ilist)
- (and offset (gnus-data-update-list (cdr data) offset)))
+ (when 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)
- (and (= (gnus-data-number (cadr data)) article)
- (progn
- (setcdr data (cddr data))
- (and offset (gnus-data-update-list (cdr data) offset))
- (setq data nil
- gnus-newsgroup-data-reverse nil)))
+ (when (= (gnus-data-number (cadr data)) article)
+ (setcdr data (cddr data))
+ (when offset
+ (gnus-data-update-list (cdr data) offset))
+ (setq data nil
+ gnus-newsgroup-data-reverse nil))
(setq data (cdr data))))))
(defmacro gnus-data-list (backward)
"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)))
(while (and (setq data (cdr data))
(> (setq l (gnus-data-level (car data))) level))
(and (= (1+ level) l)
- (setq children (cons (gnus-data-number (car data))
- children))))
+ (push (gnus-data-number (car data))
+ children)))
(nreverse children)))
(defun gnus-summary-article-parent (&optional number)
;; Saving hidden threads.
(put 'gnus-save-hidden-threads 'lisp-indent-function 0)
-(put 'gnus-save-hidden-threads 'lisp-indent-hook 0)
(put 'gnus-save-hidden-threads 'edebug-form-spec '(body))
(defmacro gnus-save-hidden-threads (&rest forms)
(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))))
+ nil
+ (eq article (caar gnus-newsgroup-data))))
+
(defun gnus-summary-last-article-p (&optional article)
"Return whether ARTICLE is the last article in the buffer."
(if (not (setq article (or article (gnus-summary-article-number))))
- t ; All non-existent numbers are the last article. :-)
+ t ; All non-existent numbers are the last article. :-)
(not (cdr (gnus-data-find-list article)))))
(defun gnus-make-thread-indent-array ()
(let ((gnus-replied-mark 129)
(gnus-score-below-mark 130)
(gnus-score-over-mark 130)
- (thread nil)
- (gnus-visual nil)
(spec gnus-summary-line-format-spec)
- pos)
+ thread gnus-visual pos)
(save-excursion
(gnus-set-work-buffer)
(let ((gnus-summary-line-format-spec spec))
(setq pos (list (cons 'unread (and (search-forward "\200" nil t)
(- (point) 2)))))
(goto-char (point-min))
- (push (cons 'replied (and (search-forward "\201" nil t)
+ (push (cons 'replied (and (search-forward "\201" nil t)
(- (point) 2)))
pos)
(goto-char (point-min))
(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-score-char
(if (or (null gnus-summary-default-score)
(<= (abs (- gnus-tmp-score gnus-summary-default-score))
- gnus-summary-zcore-fuzz)) ?
+ gnus-summary-zcore-fuzz))
+ ?
(if (< gnus-tmp-score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark)))
- (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark)
- ((memq gnus-tmp-current gnus-newsgroup-cached)
- gnus-cached-mark)
- (gnus-tmp-replied gnus-replied-mark)
- ((memq gnus-tmp-current gnus-newsgroup-saved)
- gnus-saved-mark)
- (t gnus-unread-mark)))
+ (gnus-tmp-replied
+ (cond (gnus-tmp-process gnus-process-mark)
+ ((memq gnus-tmp-current gnus-newsgroup-cached)
+ gnus-cached-mark)
+ (gnus-tmp-replied gnus-replied-mark)
+ ((memq gnus-tmp-current gnus-newsgroup-saved)
+ gnus-saved-mark)
+ (t gnus-unread-mark)))
(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))
(buffer-read-only nil))
(when (string= gnus-tmp-name "")
(setq gnus-tmp-name gnus-tmp-from))
- (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
+ (unless (numberp gnus-tmp-lines)
+ (setq gnus-tmp-lines 0))
(gnus-put-text-property
(point)
(progn (eval gnus-summary-line-format-spec) (point))
(gnus-summary-update-mark
(if (or (null gnus-summary-default-score)
(<= (abs (- score gnus-summary-default-score))
- gnus-summary-zcore-fuzz)) ?
+ gnus-summary-zcore-fuzz))
+ ?
(if (< score gnus-summary-default-score)
- gnus-score-below-mark gnus-score-over-mark)) 'score))
+ gnus-score-below-mark gnus-score-over-mark))
+ 'score))
;; Do visual highlighting.
(when (gnus-visual-p 'summary-highlight 'highlight)
(run-hooks 'gnus-summary-update-hook)))))
(defvar gnus-tmp-new-adopts nil)
(defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
- "Return the number of articles in THREAD.
+ "Return the number of articles in THREAD.
This may be 0 in some cases -- if none of the articles in
the thread are to be displayed."
(let* ((number
(and (consp elem) ; Has to be a cons.
(consp (cdr elem)) ; The cdr has to be a list.
(symbolp (car elem)) ; Has to be a symbol in there.
- (not (memq (car elem)
+ (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))
(set-buffer gnus-group-buffer)
(gnus-group-jump-to-group group)
(gnus-group-next-unread-group 1))
- (if (not (buffer-name (car quit-config)))
- (gnus-configure-windows 'group 'force)
- (set-buffer (car quit-config))
- (and (eq major-mode 'gnus-summary-mode)
- (gnus-set-global-variables))
- (gnus-configure-windows (cdr quit-config)))))
+ (gnus-handle-ephemeral-exit quit-config)))
(gnus-message 3 "Can't select group")
nil)
;; The user did a `C-g' while prompting for number of articles,
(gnus-group-jump-to-group group)
(gnus-group-next-unread-group 1)
(gnus-configure-windows 'group 'force))
- (if (not (buffer-name (car quit-config)))
- (gnus-configure-windows 'group 'force)
- (set-buffer (car quit-config))
- (and (eq major-mode 'gnus-summary-mode)
- (gnus-set-global-variables))
- (gnus-configure-windows (cdr quit-config))))
+ (gnus-handle-ephemeral-exit quit-config))
;; Finally signal the quit.
(signal 'quit nil))
;; The group was successfully selected.
(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)))))
- (if subject
- (if (setq hthread (gnus-gethash subject hashtb))
- (progn
- ;; We enter a dummy root into the thread, if we
- ;; haven't done that already.
- (unless (stringp (caar hthread))
- (setcar hthread (list whole-subject (car hthread))))
- ;; We add this new gathered thread to this gathered
- ;; thread.
- (setcdr (car hthread)
- (nconc (cdar hthread) (list (car threads))))
- ;; Remove it from the list of threads.
- (setcdr prev (cdr threads))
- (setq threads prev))
- ;; Enter this thread into the hash table.
- (gnus-sethash subject threads hashtb)))
+ (when subject
+ (if (setq hthread (gnus-gethash subject hashtb))
+ (progn
+ ;; We enter a dummy root into the thread, if we
+ ;; haven't done that already.
+ (unless (stringp (caar hthread))
+ (setcar hthread (list whole-subject (car hthread))))
+ ;; We add this new gathered thread to this gathered
+ ;; thread.
+ (setcdr (car hthread)
+ (nconc (cdar hthread) (list (car threads))))
+ ;; Remove it from the list of threads.
+ (setcdr prev (cdr threads))
+ (setq threads prev))
+ ;; Enter this thread into the hash table.
+ (gnus-sethash subject threads hashtb)))
(setq prev threads)
(setq threads (cdr threads)))
result)))
(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...")
(while (search-backward ">" nil t)
(setq end (1+ (point)))
(when (search-backward "<" nil t)
- (push (list (incf generation)
+ (push (list (incf generation)
child (setq child (buffer-substring (point) end))
subject)
relations)))
(unless (car (symbol-value cthread))
;; Make this article the parent of these threads.
(setcar (symbol-value cthread)
- (vector gnus-reffed-article-number
- (cadddr relation)
+ (vector gnus-reffed-article-number
+ (cadddr relation)
"" ""
- (cadr relation)
+ (cadr relation)
(or (caddr relation) "") 0 0 "")))
(set cthread (list (vector gnus-reffed-article-number
- (cadddr relation)
- "" "" (cadr relation)
+ (cadddr relation)
+ "" "" (cadr relation)
(or (caddr relation) "") 0 0 ""))))
(push gnus-reffed-article-number gnus-newsgroup-limit)
(push gnus-reffed-article-number gnus-newsgroup-sparse)
(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
- (if (and references
- (not (equal "" references)))
- references))
+ (or (gnus-parent-id
+ (when (and references
+ (not (equal "" references)))
+ references))
"none")))
(buffer-read-only nil)
(old (car thread))
(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))))
(let (threads)
;; We then insert this thread into the summary buffer.
(let (gnus-newsgroup-data gnus-newsgroup-threads)
- (gnus-summary-prepare-threads (gnus-cut-threads (list thread)))
+ (if gnus-show-threads
+ (gnus-summary-prepare-threads (gnus-cut-threads (list thread)))
+ (gnus-summary-prepare-unthreaded thread))
(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."
(defsubst gnus-article-sort-by-date (h1 h2)
"Sort articles by root article date."
- (string-lessp
- (inline (gnus-sortable-date (mail-header-date h1)))
- (inline (gnus-sortable-date (mail-header-date h2)))))
+ (gnus-time-less
+ (gnus-date-get-time (mail-header-date h1))
+ (gnus-date-get-time (mail-header-date h2))))
(defun gnus-thread-sort-by-date (h1 h2)
"Sort threads by root article date."
(mapcar 'gnus-thread-total-score
(cdr (gnus-gethash (mail-header-id root)
gnus-newsgroup-dependencies)))
- (if (> (mail-header-number root) 0)
- (list (or (cdr (assq (mail-header-number root)
- gnus-newsgroup-scored))
- gnus-summary-default-score 0))))
+ (when (> (mail-header-number root) 0)
+ (list (or (cdr (assq (mail-header-number root)
+ gnus-newsgroup-scored))
+ gnus-summary-default-score 0))))
(list gnus-summary-default-score)
'(0))))
thread (list (car gnus-tmp-new-adopts))
gnus-tmp-header (caar thread)
gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts))
- (if new-roots
- (setq thread (list (car new-roots))
- gnus-tmp-header (caar thread)
- new-roots (cdr new-roots))))
+ (when new-roots
+ (setq thread (list (car new-roots))
+ gnus-tmp-header (caar thread)
+ new-roots (cdr new-roots))))
(if threads
;; If there are some threads, we do them before the
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-score-char
(if (or (null gnus-summary-default-score)
(<= (abs (- gnus-tmp-score gnus-summary-default-score))
- gnus-summary-zcore-fuzz)) ?
+ gnus-summary-zcore-fuzz))
+ ?
(if (< gnus-tmp-score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark))
gnus-tmp-replied
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))
- (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
+ (unless (numberp gnus-tmp-lines)
+ (setq gnus-tmp-lines 0))
(gnus-put-text-property
(point)
(progn (eval gnus-summary-line-format-spec) (point))
"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
gnus-newsgroup-reads)))
(setq mark (gnus-article-mark number))
- (setq gnus-newsgroup-data
- (cons (gnus-data-make number mark (1+ (point)) header 0)
- gnus-newsgroup-data))
+ (push (gnus-data-make number mark (1+ (point)) header 0)
+ gnus-newsgroup-data)
(gnus-summary-insert-line
- header 0 nil mark (memq number gnus-newsgroup-replied)
+ header 0 number
+ mark (memq number gnus-newsgroup-replied)
(memq number gnus-newsgroup-expirable)
(mail-header-subject header) nil
(cdr (assq number gnus-newsgroup-scored))
"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)
- (or (gnus-check-server
- (setq gnus-current-select-method (gnus-find-method-for-group group)))
- (error "Couldn't open server"))
+ (unless (gnus-check-server
+ (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...
(gnus-activate-group group) ; Or we can activate it...
(when (equal major-mode 'gnus-summary-mode)
(kill-buffer (current-buffer)))
(error "Couldn't request group %s: %s"
- group (gnus-status-message group)))
+ group (gnus-status-message group)))
(setq gnus-newsgroup-name group)
(setq gnus-newsgroup-unselected nil)
(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))
(setq number (length articles)))
(setq articles (copy-sequence articles)))
- (if (< (abs select) number)
- (if (< select 0)
- ;; Select the N oldest articles.
- (setcdr (nthcdr (1- (abs select)) articles) nil)
- ;; Select the N most recent articles.
- (setq articles (nthcdr (- number select) articles))))
+ (when (< (abs select) number)
+ (if (< select 0)
+ ;; Select the N oldest articles.
+ (setcdr (nthcdr (1- (abs select)) articles) nil)
+ ;; Select the N most recent articles.
+ (setq articles (nthcdr (- number select) articles))))
(setq gnus-newsgroup-unselected
(gnus-sorted-intersection
gnus-newsgroup-unreads
(defun gnus-killed-articles (killed articles)
(let (out)
(while articles
- (if (inline (gnus-member-of-range (car articles) killed))
- (setq out (cons (car articles) out)))
+ (when (inline (gnus-member-of-range (car articles) killed))
+ (push (car articles) out))
(setq articles (cdr articles)))
out))
;; 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-tmp-unselected (length gnus-newsgroup-unselected))
(gnus-tmp-unread-and-unselected
(cond ((and (zerop gnus-tmp-unread-and-unticked)
- (zerop gnus-tmp-unselected)) "")
+ (zerop gnus-tmp-unselected))
+ "")
((zerop gnus-tmp-unselected)
(format "{%d more}" gnus-tmp-unread-and-unticked))
(t (format "{%d(+%d) more}"
(if (and gnus-current-headers
(vectorp gnus-current-headers))
(gnus-mode-string-quote
- (mail-header-subject gnus-current-headers)) ""))
- max-len
+ (mail-header-subject gnus-current-headers))
+ ""))
+ 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))
(and (prog1
(setq entry (gnus-gethash name gnus-newsrc-hashtb)
info (nth 2 entry))
- (if (stringp (setq nth4 (gnus-info-method info)))
- (setq nth4 (gnus-server-to-method nth4))))
+ (when (stringp (setq nth4 (gnus-info-method info)))
+ (setq nth4 (gnus-server-to-method nth4))))
;; Only do the xrefs if the group has the same
;; select method as the group we have just read.
(or (gnus-methods-equal-p
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))
gnus-valid-select-methods)))
(equal (nth 1 m1) (nth 1 m2)))))))
-(defsubst gnus-header-value ()
- (buffer-substring (match-end 0) (gnus-point-at-eol)))
-
(defvar gnus-newsgroup-none-id 0)
(defun gnus-get-newsgroup-headers (&optional dependencies force-new)
(progn
(goto-char p)
(if (search-forward "\nsubject: " nil t)
- (gnus-header-value) "(none)"))
+ (nnheader-header-value) "(none)"))
;; From.
(progn
(goto-char p)
(if (search-forward "\nfrom: " nil t)
- (gnus-header-value) "(nobody)"))
+ (nnheader-header-value) "(nobody)"))
;; Date.
(progn
(goto-char p)
(if (search-forward "\ndate: " nil t)
- (gnus-header-value) ""))
+ (nnheader-header-value) ""))
;; Message-ID.
(progn
(goto-char p)
- (if (search-forward "\nmessage-id: " nil t)
- (setq id (gnus-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
(setq end (point))
(prog1
- (gnus-header-value)
+ (nnheader-header-value)
(setq ref
(buffer-substring
(progn
;; were no references and the in-reply-to header looks
;; promising.
(if (and (search-forward "\nin-reply-to: " nil t)
- (setq in-reply-to (gnus-header-value))
+ (setq in-reply-to (nnheader-header-value))
(string-match "<[^>]+>" in-reply-to))
(setq ref (substring in-reply-to (match-beginning 0)
(match-end 0)))
- (setq ref ""))))
+ (setq ref nil))))
;; Chars.
0
;; Lines.
(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.
(progn
(goto-char p)
(and (search-forward "\nxref: " nil t)
- (gnus-header-value)))))
+ (nnheader-header-value)))))
(when (equal id ref)
(setq ref nil))
;; We do the threading while we read the headers. The
(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
- (if (boundp (setq ref-dep (intern ref dependencies)))
+ (when header
+ (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
(setcdr (symbol-value ref-dep)
(nconc (cdr (symbol-value ref-dep))
(list (symbol-value id-dep))))
(set ref-dep (list nil (symbol-value id-dep))))
- (setq headers (cons header headers)))
+ (push header headers))
(goto-char (point-max))
(widen))
(nreverse headers)))))
'(prog1
(if (= (following-char) ?\t)
0
- (let ((num (condition-case nil (read buffer) (error nil))))
+ (let ((num (ignore-errors (read buffer))))
(if (numberp num) num 0)))
- (or (eobp) (forward-char 1))))
+ (unless (eobp)
+ (forward-char 1))))
(defmacro gnus-nov-skip-field ()
'(search-forward "\t" eol 'move))
(defmacro gnus-nov-field ()
'(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
-;; Goes through the xover lines and returns a list of vectors
-(defun gnus-get-newsgroup-headers-xover (sequence &optional
- force-new dependencies)
- "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
- ;; NNTP servers do not include Xrefs when using XOVER.
- (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
- (let ((cur nntp-server-buffer)
- (dependencies (or dependencies gnus-newsgroup-dependencies))
- number headers header)
- (save-excursion
- (set-buffer nntp-server-buffer)
- ;; Allow the user to mangle the headers before parsing them.
- (run-hooks 'gnus-parse-headers-hook)
- (goto-char (point-min))
- (while (and sequence (not (eobp)))
- (setq number (read cur))
- (while (and sequence (< (car sequence) number))
- (setq sequence (cdr sequence)))
- (and sequence
- (eq number (car sequence))
- (progn
- (setq sequence (cdr sequence))
- (if (setq header
- (inline (gnus-nov-parse-line
- number dependencies force-new)))
- (setq headers (cons header headers)))))
- (forward-line 1))
- (setq headers (nreverse headers)))
- headers))
+;; (defvar gnus-nov-none-counter 0)
;; This function has to be called with point after the article number
;; on the beginning of the line.
(defun gnus-nov-parse-line (number dependencies &optional force-new)
- (let ((none 0)
- (eol (gnus-point-at-eol))
+ (let ((eol (gnus-point-at-eol))
(buffer (current-buffer))
header ref id id-dep ref-dep)
;; overview: [num subject from date id refs chars lines misc]
- (narrow-to-region (point) eol)
- (or (eobp) (forward-char))
-
- (condition-case nil
- (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
- (setq none (1+ none)))))) ; id
- (progn
- (save-excursion
+ (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)
(buffer-substring
(1+ (point))
(search-backward "<" beg t)))
- (setq ref nil))))
- (gnus-nov-field)) ; refs
- (gnus-nov-read-integer) ; chars
- (gnus-nov-read-integer) ; lines
- (if (= (following-char) ?\n)
- nil
- (gnus-nov-field)) ; misc
- ))
- (error (progn
- (gnus-error 4 "Strange nov line")
- (setq header nil)
- (goto-char eol))))
+ (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)
+ (widen))
;; We build the thread tree.
- (when header
- (when (equal id ref)
- ;; This article refers back to itself. Naughty, naughty.
- (setq ref nil))
- (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))
- (setcar (symbol-value id-dep) header))
- (set id-dep (list header))))
+ (when (equal id ref)
+ ;; This article refers back to itself. Naughty, naughty.
+ (setq ref nil))
+ (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.
+ (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
(if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
(setcdr (symbol-value ref-dep)
(set ref-dep (list nil (symbol-value id-dep)))))
header))
+;; Goes through the xover lines and returns a list of vectors
+(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
+ ;; NNTP servers do not include Xrefs when using XOVER.
+ (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
+ (let ((cur nntp-server-buffer)
+ (dependencies (or dependencies gnus-newsgroup-dependencies))
+ number headers header)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ ;; Allow the user to mangle the headers before parsing them.
+ (run-hooks 'gnus-parse-headers-hook)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (condition-case ()
+ (while (and sequence (not (eobp)))
+ (setq number (read cur))
+ (while (and sequence
+ (< (car sequence) number))
+ (setq sequence (cdr sequence)))
+ (and sequence
+ (eq number (car sequence))
+ (progn
+ (setq sequence (cdr sequence))
+ (setq header (inline
+ (gnus-nov-parse-line
+ number dependencies force-new))))
+ (push header headers))
+ (forward-line 1))
+ (error
+ (gnus-error 4 "Strange nov line (%d)"
+ (count-lines (point-min) (point)))))
+ (forward-line 1))
+ ;; 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.
This is meant to be called in `gnus-article-internal-prepare-hook'."
(save-restriction
(nnheader-narrow-to-headers)
(goto-char (point-min))
- (if (or (and (eq (downcase (following-char)) ?x)
- (looking-at "Xref:"))
- (search-forward "\nXref:" nil t))
- (progn
- (goto-char (1+ (match-end 0)))
- (setq xref (buffer-substring (point)
- (progn (end-of-line) (point))))
- (mail-header-set-xref headers xref))))))))
+ (when (or (and (eq (downcase (following-char)) ?x)
+ (looking-at "Xref:"))
+ (search-forward "\nXref:" nil t))
+ (goto-char (1+ (match-end 0)))
+ (setq xref (buffer-substring (point)
+ (progn (end-of-line) (point))))
+ (mail-header-set-xref headers xref)))))))
(defun gnus-summary-insert-subject (id &optional old-header use-old-header)
"Find article ID and insert the summary line for that article."
(let ((header (if (and old-header use-old-header)
old-header (gnus-read-header id)))
(number (and (numberp id) id))
- pos)
+ pos d)
(when header
;; Rebuild the thread that this article is part of and go to the
;; article we have fetched.
(when (and (not gnus-show-threads)
old-header)
- (when (setq pos (text-property-any
- (point-min) (point-max) 'gnus-number
- (mail-header-number old-header)))
- (goto-char pos)
- (gnus-delete-line)
- (gnus-data-remove (mail-header-number old-header))))
+ (when (setq d (gnus-data-find (mail-header-number old-header)))
+ (goto-char (gnus-data-pos d))
+ (gnus-data-remove
+ number
+ (- (gnus-point-at-bol)
+ (prog1
+ (1+ (gnus-point-at-eol))
+ (gnus-delete-line))))))
(when old-header
(mail-header-set-number header (mail-header-number old-header)))
(setq gnus-newsgroup-sparse
- (delq (setq number (mail-header-number header))
+ (delq (setq number (mail-header-number header))
gnus-newsgroup-sparse))
(setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient))
(gnus-rebuild-thread (mail-header-id header))
;; article if ID is a number -- so that the next `P' or `N'
;; command will fetch the previous (or next) article even
;; if the one we tried to fetch this time has been canceled.
- (and (> number gnus-newsgroup-end)
- (setq gnus-newsgroup-end number))
- (and (< number gnus-newsgroup-begin)
- (setq gnus-newsgroup-begin number))
+ (when (> number gnus-newsgroup-end)
+ (setq gnus-newsgroup-end number))
+ (when (< number gnus-newsgroup-begin)
+ (setq gnus-newsgroup-begin number))
(setq gnus-newsgroup-unselected
(delq number gnus-newsgroup-unselected)))
;; Report back a success?
(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)
If optional argument BACKWARD is non-nil, search backward instead."
(save-excursion
(set-buffer gnus-group-buffer)
- (if (gnus-group-search-forward
- backward nil (if use-level (gnus-group-group-level) nil))
- (gnus-group-group-name))))
+ (when (gnus-group-search-forward
+ backward nil (if use-level (gnus-group-group-level) nil))
+ (gnus-group-group-name))))
(defun gnus-summary-best-group (&optional exclude-group)
"Find the name of the best unread group.
(not unread)
(not (gnus-data-unread-p (car arts)))))
(setq arts (cdr arts)))
- (if (setq result
- (if unread
- (progn
- (while arts
- (and (gnus-data-unread-p (car arts))
- (setq result (car arts)
- arts nil))
- (setq arts (cdr arts)))
- result)
- (car arts)))
- (progn
- (goto-char (gnus-data-pos result))
- (gnus-data-number result)))))
+ (when (setq result
+ (if unread
+ (progn
+ (while arts
+ (when (gnus-data-unread-p (car arts))
+ (setq result (car arts)
+ arts nil))
+ (setq arts (cdr arts)))
+ result)
+ (car arts)))
+ (goto-char (gnus-data-pos result))
+ (gnus-data-number result))))
(defun gnus-summary-find-subject (subject &optional unread backward article)
(let* ((simp-subject (gnus-simplify-subject-fully subject))
;; 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)
(if (eq (current-buffer) (get-buffer gnus-group-buffer))
(save-window-excursion
;; Take care of tree window mode.
- (if (get-buffer-window gnus-group-buffer)
- (pop-to-buffer gnus-group-buffer))
+ (when (get-buffer-window gnus-group-buffer)
+ (pop-to-buffer gnus-group-buffer))
(gnus-group-jump-to-group newsgroup))
(save-excursion
;; Take care of tree window mode.
(if (not (listp (cdr read)))
(setq first (1+ (cdr read)))
;; `read' is a list of ranges.
- (if (/= (setq nlast (or (and (numberp (car read)) (car read))
- (caar read))) 1)
- (setq first 1))
+ (when (/= (setq nlast (or (and (numberp (car read)) (car read))
+ (caar read)))
+ 1)
+ (setq first 1))
(while read
- (if first
- (while (< first nlast)
- (setq unread (cons first unread))
- (setq first (1+ first))))
+ (when first
+ (while (< first nlast)
+ (push first unread)
+ (setq first (1+ first))))
(setq first (1+ (if (atom (car read)) (car read) (cdar read))))
(setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
(setq read (cdr read)))))
;; And add the last unread articles.
(while (<= first last)
- (setq unread (cons first unread))
+ (push first unread)
(setq first (1+ first)))
;; Return the list of unread articles.
(nreverse unread)))
(save-excursion
(while articles
(gnus-summary-goto-subject (setq article (pop articles)))
- (command-execute func)
+ (let (gnus-newsgroup-processable)
+ (command-execute func))
(gnus-summary-remove-process-mark article)))))
(gnus-summary-position-point))
(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)
- (or (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))
(set-buffer gnus-group-buffer)
(gnus-summary-clear-local-variables)
;; Return to group mode buffer.
- (if (eq mode 'gnus-summary-mode)
- (gnus-kill-buffer buf)))
+ (when (eq mode 'gnus-summary-mode)
+ (gnus-kill-buffer buf)))
(setq gnus-current-select-method gnus-select-method)
(pop-to-buffer gnus-group-buffer)
;; Clear the current group name.
(gnus-group-jump-to-group group)
(gnus-group-next-unread-group 1)
(gnus-configure-windows 'group 'force))
- (if (not (buffer-name (car quit-config)))
- (gnus-configure-windows 'group 'force)
- (set-buffer (car quit-config))
- (cond ((eq major-mode 'gnus-summary-mode)
- (gnus-set-global-variables))
- ((eq major-mode 'gnus-article-mode)
- (save-excursion
- ;; The `gnus-summary-buffer' variable may point
- ;; to the old summary buffer when using a single
- ;; article buffer.
- (unless (gnus-buffer-live-p gnus-summary-buffer)
- (set-buffer gnus-group-buffer))
- (set-buffer gnus-summary-buffer)
- (gnus-set-global-variables))))
- (gnus-configure-windows (cdr quit-config) 'force)))
+ (gnus-handle-ephemeral-exit quit-config))
(unless quit-config
(setq gnus-newsgroup-name nil)))))
(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)
(when (equal (gnus-group-group-name) group)
(gnus-group-next-unread-group 1))
(when quit-config
- (if (not (buffer-name (car quit-config)))
- (gnus-configure-windows 'group 'force)
- (set-buffer (car quit-config))
- (when (eq major-mode 'gnus-summary-mode)
- (gnus-set-global-variables))
- (gnus-configure-windows (cdr quit-config)))))))
+ (gnus-handle-ephemeral-exit quit-config)))))
+
+(defun gnus-handle-ephemeral-exit (quit-config)
+ "Handle movement when leaving an ephemeral group. The state
+which existed when entering the ephemeral is reset."
+ (if (not (buffer-name (car quit-config)))
+ (gnus-configure-windows 'group 'force)
+ (set-buffer (car quit-config))
+ (cond ((eq major-mode 'gnus-summary-mode)
+ (gnus-set-global-variables))
+ ((eq major-mode 'gnus-article-mode)
+ (save-excursion
+ ;; The `gnus-summary-buffer' variable may point
+ ;; to the old summary buffer when using a single
+ ;; article buffer.
+ (unless (gnus-buffer-live-p gnus-summary-buffer)
+ (set-buffer gnus-group-buffer))
+ (set-buffer gnus-summary-buffer)
+ (gnus-set-global-variables))))
+ (if (or (eq (cdr quit-config) 'article)
+ (eq (cdr quit-config) 'pick))
+ (progn
+ ;; The current article may be from the ephemeral group
+ ;; thus it is best that we reload this article
+ (gnus-summary-show-article)
+ (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode))
+ (gnus-configure-windows 'pick 'force)
+ (gnus-configure-windows (cdr quit-config) 'force)))
+ (gnus-configure-windows (cdr quit-config) 'force))
+ (when (eq major-mode 'gnus-summary-mode)
+ (gnus-summary-next-subject 1 nil t)
+ (gnus-summary-recenter)
+ (gnus-summary-position-point))))
;;; Dead summaries.
(when (string-match "Summary" name)
(rename-buffer
(concat (substring name 0 (match-beginning 0)) "Dead "
- (substring name (match-beginning 0))) t))))
+ (substring name (match-beginning 0)))
+ t))))
(defun gnus-kill-or-deaden-summary (buffer)
"Kill or deaden the summary BUFFER."
(when (string-match "Dead " name)
(rename-buffer
(concat (substring name 0 (match-beginning 0))
- (substring name (match-end 0))) t)))
+ (substring name (match-end 0)))
+ t)))
(gnus-message 3 "This dead summary is now alive again"))
;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
in."
(interactive
(list
- (if current-prefix-arg
- (completing-read
- "Faq dir: " (and (listp gnus-group-faq-directory)
- gnus-group-faq-directory)))))
+ (when current-prefix-arg
+ (completing-read
+ "Faq dir: " (and (listp gnus-group-faq-directory)
+ gnus-group-faq-directory)))))
(let (gnus-faq-buffer)
- (and (setq gnus-faq-buffer
- (gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
- (gnus-configure-windows 'summary-faq))))
+ (when (setq gnus-faq-buffer
+ (gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
+ (gnus-configure-windows 'summary-faq))))
;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
(defun gnus-summary-describe-group (&optional force)
previous group instead."
(interactive "P")
(gnus-set-global-variables)
+ ;; Stop pre-fetching.
+ (gnus-async-halt-prefetch)
(let ((current-group gnus-newsgroup-name)
(current-buffer (current-buffer))
entered)
(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)
(while (and data
(not (gnus-data-unread-p (car data))))
(setq data (cdr data)))
- (if data
- (progn
- (goto-char (gnus-data-pos (car data)))
- (gnus-data-number (car data)))))))
+ (when data
+ (goto-char (gnus-data-pos (car data)))
+ (gnus-data-number (car data))))))
(gnus-summary-position-point)))
(defun gnus-summary-next-subject (n &optional unread dont-display)
(gnus-summary-find-prev unread)
(gnus-summary-find-next unread)))
(setq n (1- n)))
- (if (/= 0 n) (gnus-message 7 "No more%s articles"
- (if unread " unread" "")))
+ (when (/= 0 n)
+ (gnus-message 7 "No more%s articles"
+ (if unread " unread" "")))
(unless dont-display
(gnus-summary-recenter)
(gnus-summary-position-point))
(not (zerop gnus-current-article)))
(gnus-summary-goto-subject gnus-current-article))
(gnus-summary-recenter)
- (when gnus-use-trees
+ (when (and gnus-use-trees gnus-show-threads)
(gnus-possibly-generate-tree article)
(gnus-highlight-selected-tree article))
;; Successfully display article.
(prog1
(gnus-summary-display-article article all-headers)
(setq did article))
- (if (or all-headers gnus-show-all-headers)
- (gnus-article-show-all-headers))
+ (when (or all-headers gnus-show-all-headers)
+ (gnus-article-show-all-headers))
'old))
- (if did
- (gnus-article-set-window-start
- (cdr (assq article gnus-newsgroup-bookmarks)))))))
+ (when did
+ (gnus-article-set-window-start
+ (cdr (assq article gnus-newsgroup-bookmarks)))))))
(defun gnus-summary-set-current-mark (&optional current-mark)
"Obsolete function."
;; 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"))
nil t))
;; Go to next/previous group.
(t
- (or (gnus-ephemeral-group-p gnus-newsgroup-name)
- (gnus-summary-jump-to-group gnus-newsgroup-name))
+ (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
- (gnus-summary-walk-group-buffer
- gnus-newsgroup-name cmd unread backward)))))))
+ (when (gnus-key-press-event-p last-input-event)
+ (gnus-summary-walk-group-buffer
+ 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)
((assq key keystrokes)
(let ((obuf (current-buffer)))
(switch-to-buffer gnus-group-buffer)
- (and group
- (gnus-group-jump-to-group group))
+ (when group
+ (gnus-group-jump-to-group group))
(eval (cadr (assq key keystrokes)))
(setq group (gnus-group-group-name))
(switch-to-buffer obuf))
(defun gnus-summary-next-unread-article ()
"Select unread article after current one."
(interactive)
- (gnus-summary-next-article t (and gnus-auto-select-same
- (gnus-summary-article-subject))))
+ (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
+ (gnus-summary-article-subject))))
(defun gnus-summary-prev-article (&optional unread subject)
"Select the article after the current one.
(defun gnus-summary-prev-unread-article ()
"Select unread article before current one."
(interactive)
- (gnus-summary-prev-article t (and gnus-auto-select-same
- (gnus-summary-article-subject))))
+ (gnus-summary-prev-article
+ (or (not (eq gnus-summary-goto-unread 'never))
+ (gnus-summary-first-article-p (gnus-summary-article-number)))
+ (and gnus-auto-select-same
+ (gnus-summary-article-subject))))
(defun gnus-summary-next-page (&optional lines circular)
"Show next page of the selected article.
(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)."
(when (eq (gnus-summary-select-article nil nil 'pseudo) 'old)
(gnus-eval-in-buffer-window gnus-article-buffer
(cond ((> lines 0)
- (if (gnus-article-next-page lines)
- (gnus-message 3 "End of message")))
+ (when (gnus-article-next-page lines)
+ (gnus-message 3 "End of message")))
((< lines 0)
(gnus-article-prev-page (- lines))))))
(gnus-summary-recenter)
(gnus-summary-display-article (gnus-summary-article-number)))
(gnus-summary-position-point)))
+(defun gnus-summary-first-article ()
+ "Select the first article.
+Return nil if there are no articles."
+ (interactive)
+ (gnus-set-global-variables)
+ (prog1
+ (when (gnus-summary-first-subject)
+ (gnus-summary-show-thread)
+ (gnus-summary-first-subject)
+ (gnus-summary-display-article (gnus-summary-article-number)))
+ (gnus-summary-position-point)))
+
(defun gnus-summary-best-unread-article ()
"Select the unread article with the highest score."
(interactive)
"Go to the previously read article."
(interactive)
(prog1
- (and gnus-last-article
- (gnus-summary-goto-article gnus-last-article))
+ (when gnus-last-article
+ (gnus-summary-goto-article gnus-last-article))
(gnus-summary-position-point)))
(defun gnus-summary-pop-article (number)
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))
(prog1
(let ((articles (gnus-summary-find-matching
(or header "subject") subject 'all)))
- (or articles (error "Found no matches for \"%s\"" subject))
+ (unless articles
+ (error "Found no matches for \"%s\"" subject))
(gnus-summary-limit articles))
(gnus-summary-position-point))))
(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-to-marks)
-(make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
+(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks)
+(make-obsolete 'gnus-summary-delete-marked-with
+ 'gnus-summary-limit-exlude-marks)
-(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, limit the summary buffer to articles that are not marked
+(defun gnus-summary-limit-exclude-marks (marks &optional reverse)
+ "Exclude articles that are marked with MARKS (e.g. \"DK\").
+If REVERSE, limit the summary buffer to articles that are marked
with MARKS. MARKS can either be a string of marks or a list of marks.
Returns how many articles were removed."
(interactive "sMarks: ")
+ (gnus-summary-limit-to-marks marks t))
+
+(defun gnus-summary-limit-to-marks (marks &optional reverse)
+ "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
+If REVERSE (the prefix), limit the summary buffer to articles that are
+not marked with MARKS. MARKS can either be a string of marks or a
+list of marks.
+Returns how many articles were removed."
+ (interactive (list (read-string "Marks: ") current-prefix-arg))
(gnus-set-global-variables)
(prog1
(let ((data gnus-newsgroup-data)
(append marks nil))) ; Transform to list.
articles)
(while data
- (and (if reverse (not (memq (gnus-data-mark (car data)) marks))
- (memq (gnus-data-mark (car data)) marks))
- (setq articles (cons (gnus-data-number (car data)) articles)))
+ (when (if reverse (not (memq (gnus-data-mark (car data)) marks))
+ (memq (gnus-data-mark (car data)) marks))
+ (push (gnus-data-number (car data)) articles))
(setq data (cdr data)))
(gnus-summary-limit articles))
(gnus-summary-position-point)))
"Display all the hidden articles that are marked as dormant."
(interactive)
(gnus-set-global-variables)
- (or gnus-newsgroup-dormant
- (error "There are no dormant articles in this group"))
+ (unless gnus-newsgroup-dormant
+ (error "There are no dormant articles in this group"))
(prog1
(gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
(gnus-summary-position-point)))
;; 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
(setq articles (car gnus-newsgroup-limits)
gnus-newsgroup-limits (cdr gnus-newsgroup-limits))
;; We use the new limit, so we push the old limit on the stack.
- (setq gnus-newsgroup-limits
- (cons gnus-newsgroup-limit gnus-newsgroup-limits)))
+ (push gnus-newsgroup-limit gnus-newsgroup-limits))
;; Set the limit.
(setq gnus-newsgroup-limit articles)
(let ((total (length gnus-newsgroup-data))
(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
;; and return 1.
- (setq gnus-newsgroup-limit (cons number gnus-newsgroup-limit))
+ (push number gnus-newsgroup-limit)
1))))
(defun gnus-expunge-thread (thread)
(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)
(delete-matching-lines "^\\(Path\\):\\|^From ")
(widen))
(unwind-protect
- (let ((gnus-current-window-configuration
- (if (and (boundp 'gnus-pick-mode)
- (symbol-value (intern "gnus-pick-mode")))
- 'pick 'summary)))
- (if (gnus-group-read-ephemeral-group
- name `(nndoc ,name (nndoc-address ,(get-buffer dig))
- (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))
- params)
- ;; Couldn't select this doc group.
- (switch-to-buffer buf)
- (gnus-set-global-variables)
- (gnus-configure-windows 'summary)
- (gnus-message 3 "Article couldn't be entered?")))
+ (if (gnus-group-read-ephemeral-group
+ name `(nndoc ,name (nndoc-address ,(get-buffer dig))
+ (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))
+ params)
+ ;; Couldn't select this doc group.
+ (switch-to-buffer buf)
+ (gnus-set-global-variables)
+ (gnus-configure-windows 'summary)
+ (gnus-message 3 "Article couldn't be entered?"))
(kill-buffer dig)))))
(defun gnus-summary-read-document (n)
"Open a new group based on the current article(s).
+This will allow you to read digests and other similar
+documents as newsgroups.
Obeys the standard process/prefix convention."
(interactive "P")
(let* ((articles (gnus-summary-work-articles n))
(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)
(func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
(case-fold-search (not not-case-fold))
articles d)
- (or (fboundp (intern (concat "mail-header-" header)))
- (error "%s is not a valid header" header))
+ (unless (fboundp (intern (concat "mail-header-" header)))
+ (error "%s is not a valid header" header))
(while data
(setq d (car data))
(and (or (not unread) ; We want all articles...
(gnus-data-unread-p d)) ; Or just unreads.
(vectorp (gnus-data-header d)) ; It's not a pseudo.
(string-match regexp (funcall func (gnus-data-header d))) ; Match.
- (setq articles (cons (gnus-data-number d) articles))) ; Success!
+ (push (gnus-data-number d) articles)) ; Success!
(setq data (cdr data)))
(nreverse articles)))
(gnus-eval-in-buffer-window gnus-article-buffer
(widen)
(goto-char (point-min))
- (and gnus-break-pages (gnus-narrow-to-page))))
+ (when gnus-page-broken
+ (gnus-narrow-to-page))))
(defun gnus-summary-end-of-article ()
"Scroll to the end of the article."
(widen)
(goto-char (point-max))
(recenter -3)
- (and gnus-break-pages (gnus-narrow-to-page))))
+ (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.
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)
(insert-buffer-substring gnus-original-article-buffer 1 e)
(let ((article-inhibit-hiding t))
(run-hooks 'gnus-article-display-hook))
- (if (or (not hidden) (and (numberp arg) (< arg 0)))
- (gnus-article-hide-headers)))))
+ (when (or (not hidden) (and (numberp arg) (< arg 0)))
+ (gnus-article-hide-headers)))))
(defun gnus-summary-show-all-headers ()
"Make all header lines visible."
(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-set-global-variables)
(gnus-summary-select-article)
(gnus-eval-in-buffer-window gnus-article-buffer
- (widen)))
+ (widen)
+ (when (gnus-visual-p 'page-marker)
+ (let ((buffer-read-only nil))
+ (gnus-remove-text-with-property 'gnus-prev)
+ (gnus-remove-text-with-property 'gnus-next)))))
-(defun gnus-summary-move-article (&optional n to-newsgroup select-method action)
+(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.
If N is a negative number, move the N previous articles.
newsgroup that you want to move to have to support the `request-move'
and `request-accept' functions."
(interactive "P")
- (unless action (setq action 'move))
+ (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...
- (or (gnus-check-backend-function 'request-accept-article (car to-method))
- (error "%s does not support article copying" (car to-method)))
- (or (gnus-check-server to-method)
- (error "Can't open server %s" (car to-method)))
+ (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)
+ (error "Can't open server %s" (car to-method)))
(gnus-message 6 "%s to %s: %s..."
(caddr (assq action names))
(or (car select-method) to-newsgroup) articles)
to-newsgroup select-method (not articles))))
;; Crosspost the article.
((eq action 'crosspost)
- (let ((xref (mail-header-xref (gnus-summary-article-header article))))
- (setq new-xref (concat gnus-newsgroup-name ":" article))
- (if (and xref (not (string= xref "")))
- (progn
- (when (string-match "^Xref: " xref)
- (setq xref (substring xref (match-end 0))))
- (setq new-xref (concat xref " " new-xref)))
- (setq new-xref (concat (system-name) " " new-xref)))
+ (let ((xref (message-tokenize-header
+ (mail-header-xref (gnus-summary-article-header article))
+ " ")))
+ (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
+ ":" article))
+ (unless xref
+ (setq xref (list (system-name))))
+ (setq new-xref
+ (concat
+ (mapconcat 'identity
+ (delete "Xref:" (delete new-xref 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 " " (gnus-group-prefixed-name
- (car art-group) to-method)
- ":" (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."
(interactive "P")
(gnus-summary-move-article n nil nil 'crosspost))
-(defvar gnus-summary-respool-default-method nil
- "Default method for respooling an article.
-If nil, use to the current newsgroup method.")
+(defcustom gnus-summary-respool-default-method nil
+ "Default method for respooling an article.
+If nil, use to the current newsgroup method."
+ :type 'gnus-select-method-name
+ :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-method-history))
+ methods nil t nil 'gnus-mail-method-history))
ms)
(cond
- ((zerop (length (setq ms (gnus-servers-using-backend method))))
+ ((zerop (length (setq ms (gnus-servers-using-backend
+ (intern method)))))
(list (intern method) ""))
((= 1 (length ms))
(car ms))
(t
- (cdr (completing-read
- "Server name: "
- (mapcar (lambda (m) (cons (cadr m) m)) ms) nil t)))))))
+ (let ((ms-alist (mapcar (lambda (m) (cons (cadr m) m)) ms)))
+ (cdr (assoc (completing-read "Server name: " ms-alist nil t)
+ ms-alist))))))))
(gnus-set-global-variables)
(unless method
(error "No method given for respooling"))
(let ((group gnus-newsgroup-name)
(now (current-time))
atts lines)
- (or (gnus-check-backend-function 'request-accept-article group)
- (error "%s does not support article importing" group))
+ (unless (gnus-check-backend-function 'request-accept-article group)
+ (error "%s does not support article importing" group))
(or (file-readable-p file)
(not (file-regular-p file))
(error "Can't read %s" file))
"Date: " (timezone-make-date-arpa-standard
(current-time-string (nth 5 atts))
(current-time-zone now)
- (current-time-zone now)) "\n"
+ (current-time-zone now))
+ "\n"
"Message-ID: " (message-make-message-id) "\n"
"Lines: " (int-to-string lines) "\n"
"Chars: " (int-to-string (nth 7 atts)) "\n\n"))
;; This backend supports expiry.
(let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
(expirable (if total
- (gnus-list-of-read-articles gnus-newsgroup-name)
+ (progn
+ ;; 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
(sort gnus-newsgroup-expirable '<))))
(expiry-wait (if now 'immediate
(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))
delete these instead."
(interactive "P")
(gnus-set-global-variables)
- (or (gnus-check-backend-function 'request-expire-articles
- gnus-newsgroup-name)
- (error "The current newsgroup does not support article deletion."))
+ (unless (gnus-check-backend-function 'request-expire-articles
+ gnus-newsgroup-name)
+ (error "The current newsgroup does not support article deletion."))
;; Compute the list of articles to delete.
(let ((articles (gnus-summary-work-articles n))
not-deleted)
(if (and gnus-novice-user
- (not (gnus-y-or-n-p
+ (not (gnus-yes-or-no-p
(format "Do you really want to delete %s forever? "
- (if (> (length articles) 1)
+ (if (> (length articles) 1)
(format "these %s articles" (length articles))
"this article")))))
()
(gnus-summary-remove-process-mark (car articles))
;; The backend might not have been able to delete the article
;; after all.
- (or (memq (car articles) not-deleted)
- (gnus-summary-mark-article (car articles) gnus-canceled-mark))
- (setq articles (cdr articles))))
+ (unless (memq (car articles) not-deleted)
+ (gnus-summary-mark-article (car articles) gnus-canceled-mark))
+ (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.
If UNMARK is negative, tick articles."
(interactive "P")
(gnus-set-global-variables)
- (if unmark
- (setq unmark (prefix-numeric-value unmark)))
+ (when unmark
+ (setq unmark (prefix-numeric-value unmark)))
(let ((count
(gnus-summary-mark-same-subject
(gnus-summary-article-subject) unmark)))
If UNMARK is negative, tick articles."
(interactive "P")
(gnus-set-global-variables)
- (if unmark
- (setq unmark (prefix-numeric-value unmark)))
+ (when unmark
+ (setq unmark (prefix-numeric-value unmark)))
(let ((count
(gnus-summary-mark-same-subject
(gnus-summary-article-subject) unmark)))
;; If marked as read, go to next unread subject.
- (if (null unmark)
- ;; Go to next unread subject.
- (gnus-summary-next-subject 1 t))
+ (when (null unmark)
+ ;; Go to next unread subject.
+ (gnus-summary-next-subject 1 t))
(gnus-message 7 "%d articles are marked as %s"
count (if unmark "unread" "read"))))
(gnus-summary-set-process-mark (gnus-summary-article-number)))
(zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
(setq n (1- n)))
- (if (/= 0 n) (gnus-message 7 "No more articles"))
+ (when (/= 0 n)
+ (gnus-message 7 "No more articles"))
(gnus-summary-recenter)
(gnus-summary-position-point)
n))
(defun gnus-summary-mark-article-as-replied (article)
"Mark ARTICLE replied and update the summary line."
- (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied))
+ (push article gnus-newsgroup-replied)
(let ((buffer-read-only nil))
(when (gnus-summary-goto-subject article)
(gnus-summary-update-secondary-mark article))))
"Set a bookmark in current article."
(interactive (list (gnus-summary-article-number)))
(gnus-set-global-variables)
- (if (or (not (get-buffer gnus-article-buffer))
- (not gnus-current-article)
- (not gnus-article-current)
- (not (equal gnus-newsgroup-name (car gnus-article-current))))
- (error "No current article selected"))
+ (when (or (not (get-buffer gnus-article-buffer))
+ (not gnus-current-article)
+ (not gnus-article-current)
+ (not (equal gnus-newsgroup-name (car gnus-article-current))))
+ (error "No current article selected"))
;; Remove old bookmark, if one exists.
(let ((old (assq article gnus-newsgroup-bookmarks)))
- (if old (setq gnus-newsgroup-bookmarks
- (delq old gnus-newsgroup-bookmarks))))
+ (when old
+ (setq gnus-newsgroup-bookmarks
+ (delq old gnus-newsgroup-bookmarks))))
;; Set the new bookmark, which is on the form
;; (article-number . line-number-in-body).
- (setq gnus-newsgroup-bookmarks
- (cons
- (cons article
- (save-excursion
- (set-buffer gnus-article-buffer)
- (count-lines
- (min (point)
- (save-excursion
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
- (point)))
- (point))))
- gnus-newsgroup-bookmarks))
+ (push
+ (cons article
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (count-lines
+ (min (point)
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (point)))
+ (point))))
+ gnus-newsgroup-bookmarks)
(gnus-message 6 "A bookmark has been added to the current article."))
(defun gnus-summary-remove-bookmark (article)
(not (eq gnus-summary-goto-unread 'never)))
t)))
(setq n (1- n)))
- (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
+ (when (/= 0 n)
+ (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
(gnus-summary-recenter)
(gnus-summary-position-point)
(gnus-set-mode-line 'summary)
(setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
(setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
(setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
- (setq gnus-newsgroup-reads
- (cons (cons article mark) gnus-newsgroup-reads))
+ (push (cons article mark) gnus-newsgroup-reads)
;; Possibly remove from cache, if that is used.
- (and gnus-use-cache (gnus-cache-enter-remove-article article))
+ (when gnus-use-cache
+ (gnus-cache-enter-remove-article article))
;; Allow the backend to change the mark.
(setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
;; Check for auto-expiry.
If ARTICLE is nil, then the article on the current line will be
marked."
;; The mark might be a string.
- (and (stringp mark)
- (setq mark (aref mark 0)))
+ (when (stringp mark)
+ (setq mark (aref mark 0)))
;; If no mark is given, then we check auto-expiring.
(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)
(setq mark gnus-expirable-mark))
(let* ((mark (or mark gnus-del-mark))
(article (or article (gnus-summary-article-number))))
- (or article (error "No article on current line"))
+ (unless article
+ (error "No article on current line"))
(if (or (= mark gnus-unread-mark)
(= mark gnus-ticked-mark)
(= mark gnus-dormant-mark))
(= mark gnus-ticked-mark)
(= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
- (if (gnus-summary-goto-subject article nil t)
- (let ((buffer-read-only nil))
- (gnus-summary-show-thread)
- ;; Fix the mark.
- (gnus-summary-update-mark mark 'unread)
- t))))
+ (when (gnus-summary-goto-subject article nil t)
+ (let ((buffer-read-only nil))
+ (gnus-summary-show-thread)
+ ;; Fix the mark.
+ (gnus-summary-update-mark mark 'unread)
+ t))))
(defun gnus-summary-update-secondary-mark (article)
"Update the secondary (read, process, cache) mark."
(let ((forward (cdr (assq type gnus-summary-mark-positions)))
(buffer-read-only nil))
(re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit)
- (when (looking-at "\r")
+ (when (looking-at "\r")
(incf forward))
(when (and forward
(<= (+ forward (point)) (point-max)))
;; Make the article expirable.
(let ((mark (or mark gnus-del-mark)))
(if (= mark gnus-expirable-mark)
- (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable))
+ (push article gnus-newsgroup-expirable)
(setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)))
;; Remove from unread and marked lists.
(setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
(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))
(set-buffer gnus-summary-buffer)
(goto-char (point-min))
(while (and (progn
- (if (> (gnus-summary-article-score) score)
- (gnus-summary-mark-article nil mark))
+ (when (> (gnus-summary-article-score) score)
+ (gnus-summary-mark-article nil mark))
t)
(gnus-summary-find-next)))))
(let ((scored gnus-newsgroup-scored)
headers h)
(while scored
- (or (gnus-summary-goto-subject (caar scored))
- (and (setq h (gnus-summary-article-header (caar scored)))
- (< (cdar scored) gnus-summary-expunge-below)
- (setq headers (cons h headers))))
+ (unless (gnus-summary-goto-subject (caar scored))
+ (and (setq h (gnus-summary-article-header (caar scored)))
+ (< (cdar scored) gnus-summary-expunge-below)
+ (push h headers)))
(setq scored (cdr scored)))
(if (not headers)
(when (not no-error)
t))))
(defun gnus-summary-catchup (&optional all quietly to-here not-mark)
- "Mark all articles not marked as unread in this newsgroup as read.
-If prefix argument ALL is non-nil, all articles are marked as read.
+ "Mark all unread articles in this newsgroup as read.
+If prefix argument ALL is non-nil, ticked and dormant articles will
+also be marked as read.
If QUIETLY is non-nil, no questions will be asked.
If TO-HERE is non-nil, it should be a point in the buffer. All
articles before this point will be marked as read.
+Note that this function will only catch up the unread article
+in the current summary buffer limitation.
The number of articles marked as read is returned."
(interactive "P")
(gnus-set-global-variables)
(prog1
- (when (or quietly
- (not gnus-interactive-catchup) ;Without confirmation?
- gnus-expert-user
- (gnus-y-or-n-p
- (if all
- "Mark absolutely all articles as read? "
- "Mark all unread articles as read? ")))
- (if (and not-mark
- (not gnus-newsgroup-adaptive)
- (not gnus-newsgroup-auto-expire)
- (not gnus-suppress-duplicates))
- (progn
- (when all
- (setq gnus-newsgroup-marked nil
- gnus-newsgroup-dormant nil))
- (setq gnus-newsgroup-unreads nil))
- ;; We actually mark all articles as canceled, which we
- ;; have to do when using auto-expiry or adaptive scoring.
- (gnus-summary-show-all-threads)
- (when (gnus-summary-first-subject (not all))
- (while (and
- (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)))
+ (save-excursion
+ (when (or quietly
+ (not gnus-interactive-catchup) ;Without confirmation?
+ gnus-expert-user
+ (gnus-y-or-n-p
+ (if all
+ "Mark absolutely all articles as read? "
+ "Mark all unread articles as read? ")))
+ (if (and not-mark
+ (not gnus-newsgroup-adaptive)
+ (not gnus-newsgroup-auto-expire)
+ (not gnus-suppress-duplicates))
+ (progn
+ (when all
+ (setq gnus-newsgroup-marked nil
+ gnus-newsgroup-dormant nil))
+ (setq gnus-newsgroup-unreads nil))
+ ;; We actually mark all articles as canceled, which we
+ ;; have to do when using auto-expiry or adaptive scoring.
+ (gnus-summary-show-all-threads)
+ (when (gnus-summary-first-subject (not all))
+ (while (and
+ (if to-here (< (point) to-here) t)
+ (gnus-summary-mark-article-as-read gnus-catchup-mark)
+ (gnus-summary-find-next (not all)))))
+ (gnus-set-mode-line 'summary))
+ t))
(gnus-summary-position-point)))
(defun gnus-summary-catchup-to-here (&optional all)
If prefix argument ALL is non-nil, all articles are marked as read."
(interactive "P")
(gnus-set-global-variables)
- (gnus-summary-catchup all quietly nil 'fast)
- ;; Select next newsgroup or exit.
- (if (eq gnus-auto-select-next 'quietly)
- (gnus-summary-next-group nil)
- (gnus-summary-exit)))
+ (when (gnus-summary-catchup all quietly nil 'fast)
+ ;; Select next newsgroup or exit.
+ (if (eq gnus-auto-select-next 'quietly)
+ (gnus-summary-next-group nil)
+ (gnus-summary-exit))))
(defun gnus-summary-catchup-all-and-exit (&optional quietly)
"Mark all articles in this newsgroup as read, and then exit."
(mail-header-subject (gnus-data-header (car data)))))
(t nil)))
(end-point (save-excursion
- (if (gnus-summary-go-to-next-thread)
+ (if (gnus-summary-go-to-next-thread)
(point) (point-max))))
articles)
(while (and data
(gnus-summary-goto-subject article)))
(defun gnus-summary-reparent-thread ()
- "Make current article child of the marked (or previous) article.
+ "Make the current article child of the marked (or previous) article.
Note that the re-threading will only work if `gnus-thread-ignore-subject'
is non-nil or the Subject: of both articles are the same."
(interactive)
- (or (not (gnus-group-read-only-p))
- (error "The current newsgroup does not support article editing."))
- (or (<= (length gnus-newsgroup-processable) 1)
- (error "No more than one article may be marked."))
+ (unless (not (gnus-group-read-only-p))
+ (error "The current newsgroup does not support article editing."))
+ (unless (<= (length gnus-newsgroup-processable) 1)
+ (error "No more than one article may be marked."))
(save-window-excursion
(let ((gnus-article-buffer " *reparent*")
(current-article (gnus-summary-article-number))
- ; first grab the marked article, otherwise one line up.
+ ;; First grab the marked article, otherwise one line up.
(parent-article (if (not (null gnus-newsgroup-processable))
(car gnus-newsgroup-processable)
(save-excursion
(if (eq (forward-line -1) 0)
(gnus-summary-article-number)
(error "Beginning of summary buffer."))))))
- (or (not (eq current-article parent-article))
- (error "An article may not be self-referential."))
- (let ((message-id (mail-header-id
+ (unless (not (eq current-article parent-article))
+ (error "An article may not be self-referential."))
+ (let ((message-id (mail-header-id
(gnus-summary-article-header parent-article))))
- (or (and message-id (not (equal message-id "")))
- (error "No message-id in desired parent."))
+ (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"))
- (or (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"))
(defun gnus-summary-go-down-thread ()
"Go down one level in the current thread."
(let ((children (gnus-summary-article-children)))
- (and children
- (gnus-summary-goto-subject (car children)))))
+ (when children
+ (gnus-summary-goto-subject (car children)))))
(defun gnus-summary-go-up-thread ()
"Go up one level in the current thread."
(let ((parent (gnus-summary-article-parent)))
- (and parent
- (gnus-summary-goto-subject parent))))
+ (when parent
+ (gnus-summary-goto-subject parent))))
(defun gnus-summary-down-thread (n)
"Go down thread N steps.
(gnus-summary-go-down-thread)))
(setq n (1- n)))
(gnus-summary-position-point)
- (if (/= 0 n) (gnus-message 7 "Can't go further"))
+ (when (/= 0 n)
+ (gnus-message 7 "Can't go further"))
n))
(defun gnus-summary-up-thread (n)
gnus-thread-hide-killed
(gnus-summary-hide-thread))
;; If marked as read, go to next unread subject.
- (if (null unmark)
- ;; Go to next unread subject.
- (gnus-summary-next-subject 1 t)))
+ (when (null unmark)
+ ;; Go to next unread subject.
+ (gnus-summary-next-subject 1 t)))
(gnus-set-mode-line 'summary))
;; 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-in-file))
(gnus-summary-save-article arg)))
+(defun gnus-summary-write-article-file (&optional arg)
+ "Write the current article to a file, deleting the previous file.
+If N is a positive number, save the N next articles.
+If N is a negative number, save the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+save those articles instead."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((gnus-default-article-saver 'gnus-summary-write-to-file))
+ (gnus-summary-save-article arg)))
+
(defun gnus-summary-save-article-body-file (&optional arg)
"Append the current article body to a file.
If N is a positive number, save the N next articles.
(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)
(when (cond
((stringp match)
;; Regular expression.
- (condition-case ()
- (re-search-forward match nil t)
- (error nil)))
+ (ignore-errors
+ (re-search-forward match nil t)))
((gnus-functionp match)
;; Function.
(save-restriction
(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))
+(defun gnus-valid-move-group-p (group)
+ (and (boundp group)
+ (symbol-name group)
+ (memq 'respool
+ (assoc (symbol-name
+ (car (gnus-find-method-for-group
+ (symbol-name group))))
+ gnus-valid-select-methods))))
+
(defun gnus-read-move-group-name (prompt default articles prefix)
"Read a group name."
(let* ((split-name (gnus-get-split-value gnus-move-split-methods))
(minibuffer-confirm-incomplete nil) ; XEmacs
- group-map
- (dum (mapatoms
- (lambda (g)
- (and (boundp g)
- (symbol-name g)
- (memq 'respool
- (assoc (symbol-name
- (car (gnus-find-method-for-group
- (symbol-name g))))
- gnus-valid-select-methods))
- (push (list (symbol-name g)) group-map)))
- gnus-active-hashtb))
(prom
(format "%s %s to:"
prompt
(cond
((null split-name)
(gnus-completing-read default prom
- group-map nil nil prefix
+ gnus-active-hashtb
+ 'gnus-valid-move-group-p
+ nil prefix
'gnus-group-history))
((= 1 (length split-name))
- (gnus-completing-read (car split-name) prom group-map
- nil nil nil
+ (gnus-completing-read (car split-name) prom
+ gnus-active-hashtb
+ 'gnus-valid-move-group-p
+ 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
(let ((buffer-read-only nil)
(article (gnus-summary-article-number))
after-article b e)
- (or (gnus-summary-goto-subject article)
- (error (format "No such article: %d" article)))
+ (unless (gnus-summary-goto-subject article)
+ (error "No such article: %d" article))
(gnus-summary-position-point)
;; If all commands are to be bunched up on one line, we collect
;; them here.
- (if gnus-view-pseudos-separately
- ()
+ (unless gnus-view-pseudos-separately
(let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
files action)
(while ps
(while (and ps (cdr ps)
(string= (or action "1")
(or (cdr (assq 'action (cadr ps))) "2")))
- (setq files (cons (cdr (assq 'name (cadr ps))) files))
+ (push (cdr (assq 'name (cadr ps))) files)
(setcdr ps (cddr ps)))
- (if (not files)
- ()
- (if (not (string-match "%s" action))
- (setq files (cons " " files)))
- (setq files (cons " " files))
- (and (assq 'execute (car ps))
- (setcdr (assq 'execute (car ps))
- (funcall (if (string-match "%s" action)
- 'format 'concat)
- action
- (mapconcat (lambda (f) f) files " ")))))
+ (when files
+ (when (not (string-match "%s" action))
+ (push " " files))
+ (push " " files)
+ (when (assq 'execute (car ps))
+ (setcdr (assq 'execute (car ps))
+ (funcall (if (string-match "%s" action)
+ 'format 'concat)
+ action
+ (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
- (and (assq 'execute (car pslist))
- (gnus-execute-command (cdr (assq 'execute (car pslist)))
- (eq gnus-view-pseudos 'not-confirm)))
+ (when (assq 'execute (car pslist))
+ (gnus-execute-command (cdr (assq 'execute (car pslist)))
+ (eq gnus-view-pseudos 'not-confirm)))
(setq pslist (cdr pslist)))
(save-excursion
(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))
+ gnus-refer-article-method))
where)
;; First we check to see whether the header in question is already
;; fetched.
;; 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.
- (when (setq where (gnus-request-head id group))
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (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"))
- ;(when (and header
- ; (memq (mail-header-number header) gnus-newsgroup-sparse))
- ; (setcar (gnus-id-to-thread id) nil))
- (if (not (setq header (car (gnus-get-newsgroup-headers))))
+ (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)
- (if (and (stringp id)
- (not (string= (gnus-group-real-name group)
- (car where))))
- ;; If we fetched by Message-ID and the article came
- ;; from a different group, we fudge some bogus article
- ;; numbers for this article.
- (mail-header-set-number header gnus-reffed-article-number))
- (decf gnus-reffed-article-number)
- (gnus-remove-header (mail-header-number header))
- (push header gnus-newsgroup-headers)
- (setq gnus-current-headers header)
- (push (mail-header-number header) gnus-newsgroup-limit))
+ (unless (gnus-summary-article-sparse-p (mail-header-number header))
+ (when (and (stringp id)
+ (not (string= (gnus-group-real-name group)
+ (car where))))
+ ;; If we fetched by Message-ID and the article came
+ ;; from a different group, we fudge some bogus article
+ ;; numbers for this article.
+ (mail-header-set-number header gnus-reffed-article-number))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (decf gnus-reffed-article-number)
+ (gnus-remove-header (mail-header-number header))
+ (push header gnus-newsgroup-headers)
+ (setq gnus-current-headers header)
+ (push (mail-header-number header) gnus-newsgroup-limit)))
header)))))
(defun gnus-remove-header (number)
(let* ((beg (progn (beginning-of-line) (point)))
(end (progn (end-of-line) (point)))
;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
- (from (if (get-text-property beg gnus-mouse-face-prop)
+ (from (if (get-text-property beg gnus-mouse-face-prop)
beg
- (or (next-single-property-change
- beg gnus-mouse-face-prop nil end)
+ (or (next-single-property-change
+ beg gnus-mouse-face-prop nil end)
beg)))
(to
(if (= from end)
(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))))
;; Compute the ranges of read articles by looking at the list of
;; unread articles.
(while unread
- (if (/= (car unread) prev)
- (setq read (cons (if (= prev (1- (car unread))) prev
- (cons prev (1- (car unread)))) read)))
+ (when (/= (car unread) prev)
+ (push (if (= prev (1- (car unread))) prev
+ (cons prev (1- (car unread))))
+ read))
(setq prev (1+ (car unread)))
(setq unread (cdr unread)))
(when (<= prev (cdr active))
- (setq read (cons (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))))
+ (push (cons prev (cdr active)) read))
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-undo-register
+ `(progn
+ (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
+ (gnus-info-set-read ',info ',(gnus-info-read info))
+ (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
+ (gnus-group-update-group ,group t))))
;; Enter this list into the group info.
(gnus-info-set-read
info (if (> (length read) 1) (nreverse read) read))
(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)
+
;;; gnus-sum.el ends here
projects / gnus / blobdiff