;;; gnus-sum.el --- summary mode commands for Gnus
-;; Copyright (C) 1996,97 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
;;; Code:
+(eval-when-compile (require 'cl))
+
(require 'gnus)
(require 'gnus-group)
(require 'gnus-spec)
(require 'gnus-range)
(require 'gnus-int)
(require 'gnus-undo)
+(require 'gnus-util)
+(require 'mm-decode)
+(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
(defcustom gnus-kill-summary-on-exit t
"*If non-nil, kill the summary buffer when you exit from it.
just marked as read) article, the old article will not normally be
displayed in the Summary buffer. If this variable is non-nil, Gnus
will attempt to grab the headers to the old articles, and thereby
-build complete threads. If it has the value `some', only enough
-headers to connect otherwise loose threads will be displayed.
-This variable can also be a number. In that case, no more than that
-number of old headers will be fetched.
+build complete threads. If it has the value `some', only enough
+headers to connect otherwise loose threads will be displayed. This
+variable can also be a number. In that case, no more than that number
+of old headers will be fetched. If it has the value `invisible', all
+old headers will be fetched, but none will be displayed.
The server has to support NOV for any of this to work."
:group 'gnus-thread
number
(sexp :menu-tag "other" t)))
+(defcustom gnus-refer-thread-limit 200
+ "*The number of old headers to fetch when doing \\<gnus-summary-mode-map>\\[gnus-summary-refer-thread].
+If t, fetch all the available old headers."
+ :group 'gnus-thread
+ :type '(choice number
+ (sexp :menu-tag "other" t)))
+
(defcustom gnus-summary-make-false-root 'adopt
"*nil means that Gnus won't gather loose threads.
If the root of a thread has expired or been read in a previous
(const fuzzy)
(sexp :menu-tag "on" t)))
+(defcustom gnus-simplify-subject-functions nil
+ "List of functions taking a string argument that simplify subjects.
+The functions are applied recursively.
+
+Useful functions to put in this list include: `gnus-simplify-subject-re',
+`gnus-simplify-subject-fuzzy' and `gnus-simplify-whitespace'."
+ :group 'gnus-thread
+ :type '(repeat function))
+
(defcustom gnus-simplify-ignored-prefixes nil
"*Regexp, matches for which are removed from subject lines when simplifying fuzzily."
:group 'gnus-thread
(defcustom gnus-summary-thread-gathering-function
'gnus-gather-threads-by-subject
- "Function used for gathering loose threads.
+ "*Function used for gathering loose threads.
There are two pre-defined functions: `gnus-gather-threads-by-subject',
which only takes Subjects into consideration; and
`gnus-gather-threads-by-references', which compared the References
headers of the articles to find matches."
:group 'gnus-thread
- :type '(set (function-item gnus-gather-threads-by-subject)
- (function-item gnus-gather-threads-by-references)
- (function :tag "other")))
+ :type '(radio (function-item gnus-gather-threads-by-subject)
+ (function-item gnus-gather-threads-by-references)
+ (function :tag "other")))
-;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
(defcustom gnus-summary-same-subject ""
"*String indicating that the current article has the same subject as the previous.
This variable will only be used if the value of
:group 'gnus-thread
:type 'boolean)
-(defcustom gnus-thread-ignore-subject nil
- "*If non-nil, ignore subjects and do all threading based on the Reference header.
-If nil, which is the default, articles that have different subjects
-from their parents will start separate threads."
+(defcustom gnus-thread-ignore-subject t
+ "*If non-nil, which is the default, ignore subjects and do all threading based on the Reference header.
+If nil, articles that have different subjects from their parents will
+start separate threads."
:group 'gnus-thread
: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
-article.
+in the group. If t, select the first unread article.
+
+This variable can also be a function to place point on a likely
+subject line. Useful values include `gnus-summary-first-unread-subject',
+`gnus-summary-first-unread-article' and
+`gnus-summary-best-unread-article'.
If you want to prevent automatic selection of the first unread article
in some newsgroups, set the variable to nil in
:group 'gnus-group-select
:type '(choice (const :tag "none" nil)
(const best)
- (sexp :menu-tag "first" t)))
+ (sexp :menu-tag "first" t)
+ (function-item gnus-summary-first-unread-subject)
+ (function-item gnus-summary-first-unread-article)
+ (function-item gnus-summary-best-unread-article)))
(defcustom gnus-auto-select-next t
"*If non-nil, offer to go to the next group from the end of the previous.
(sexp :menu-tag "on" t)))
(defcustom gnus-auto-select-same nil
- "*If non-nil, select the next article with the same subject."
+ "*If non-nil, select the next article with the same subject.
+If there are no more articles with the same subject, go to
+the first unread article."
:group 'gnus-summary-maneuvering
:type 'boolean)
:group 'gnus-summary-maneuvering
:type '(choice (const :tag "none" nil)
(const vertical)
+ (integer :tag "height")
(sexp :menu-tag "both" t)))
(defcustom gnus-show-all-headers nil
"*If non-nil, ignore articles with identical Message-ID headers."
:group 'gnus-summary
:type 'boolean)
-
+
(defcustom gnus-single-article-buffer t
"*If non-nil, display all articles in the same buffer.
If nil, each group will get its own article buffer."
:group 'gnus-article-various
:type 'boolean)
-(defcustom gnus-show-mime nil
- "*If non-nil, do mime processing of articles.
-The articles will simply be fed to the function given by
-`gnus-show-mime-method'."
- :group 'gnus-article-mime
- :type 'boolean)
-
(defcustom gnus-move-split-methods nil
"*Variable used to suggest where articles are to be moved to.
It uses the same syntax as the `gnus-split-methods' variable."
:group 'gnus-summary-mail
- :type '(repeat (choice (list function)
- (cons regexp (repeat string))
- sexp)))
+ :type '(repeat (choice (list :value (fun) function)
+ (cons :value ("" "") regexp (repeat string))
+ (sexp :value nil))))
(defcustom gnus-unread-mark ?
"*Mark used for unread articles."
:group 'gnus-summary-marks
:type 'character)
+(defcustom gnus-undownloaded-mark ?@
+ "*Mark used for articles that weren't downloaded."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-downloadable-mark ?%
+ "*Mark used for articles that are to be downloaded."
+ :group 'gnus-summary-marks
+ :type 'character)
+
+(defcustom gnus-unsendable-mark ?=
+ "*Mark used for articles that won't be sent."
+ :group 'gnus-summary-marks
+ :type 'character)
+
(defcustom gnus-score-over-mark ?+
"*Score mark used for articles with high scores."
:group 'gnus-summary-marks
:type 'boolean)
(defcustom gnus-summary-dummy-line-format
- "* %(: :%) %S\n"
+ " %(: :%) %S\n"
"*The format specification for the dummy roots in the summary buffer.
It works along the same lines as a normal formatting string,
with some simple extensions.
:group 'gnus-threading
:type 'string)
-(defcustom gnus-summary-mode-line-format "Gnus: %%b [%A] %Z"
+(defcustom gnus-summary-mode-line-format "Gnus: %g [%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:
%G Group name
%p Unprefixed group name
%A Current article number
+%z Current article score
%V Gnus version
%U Number of unread articles in the group
%e Number of unselected articles in the group
:type 'function)
(defcustom gnus-summary-expunge-below nil
- "All articles that have a score less than this variable will be expunged."
+ "All articles that have a score less than this variable will be expunged.
+This variable is local to the summary buffers."
:group 'gnus-score-default
:type '(choice (const :tag "off" nil)
integer))
(defcustom gnus-thread-expunge-below nil
"All threads that have a total score less than this variable will be expunged.
See `gnus-thread-score-function' for en explanation of what a
-\"thread score\" is."
+\"thread score\" is.
+
+This variable is local to the summary buffers."
:group 'gnus-treading
:group 'gnus-score-default
:type '(choice (const :tag "off" nil)
:group 'gnus-summary-various
:type 'hook)
+(defcustom gnus-summary-prepared-hook nil
+ "*A hook called as the last thing after the summary buffer has been generated."
+ :group 'gnus-summary-various
+ :type 'hook)
+
(defcustom gnus-summary-generate-hook nil
"*A hook run just before generating the summary buffer.
This hook is commonly used to customize threading variables and the
:group 'gnus-summary-visual
:type 'hook)
-(defcustom gnus-parse-headers-hook
- (list 'gnus-hack-decode-rfc1522 'gnus-decode-rfc1522)
+(defcustom gnus-parse-headers-hook nil
"*A hook called before parsing the headers."
:group 'gnus-various
:type 'hook)
. gnus-summary-high-unread-face)
((and (< score default) (= mark gnus-unread-mark))
. gnus-summary-low-unread-face)
- ((and (= mark gnus-unread-mark))
+ ((= mark gnus-unread-mark)
+ . gnus-summary-normal-unread-face)
+ ((and (> score default) (memq mark (list gnus-downloadable-mark
+ gnus-undownloaded-mark)))
+ . gnus-summary-high-unread-face)
+ ((and (< score default) (memq mark (list gnus-downloadable-mark
+ gnus-undownloaded-mark)))
+ . gnus-summary-low-unread-face)
+ ((memq mark (list gnus-downloadable-mark gnus-undownloaded-mark))
. gnus-summary-normal-unread-face)
((> score default)
. gnus-summary-high-read-face)
. gnus-summary-low-read-face)
(t
. gnus-summary-normal-read-face))
- "Controls the highlighting of summary buffer lines.
+ "*Controls the highlighting of summary buffer lines.
A list of (FORM . FACE) pairs. When deciding how a a particular
summary line should be displayed, each form is evaluated. The content
:type '(repeat (cons (sexp :tag "Form" nil)
face)))
+(defcustom gnus-alter-header-function nil
+ "Function called to allow alteration of article header structures.
+The function is called with one parameter, the article header vector,
+which it may alter in any way.")
+
+(defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string
+ "Variable that says which function should be used to decode a string with encoded words.")
+
+(defcustom gnus-extra-headers nil
+ "*Extra headers to parse."
+ :group 'gnus-summary
+ :type '(repeat symbol))
+
+(defcustom gnus-ignored-from-addresses
+ (and user-mail-address (regexp-quote user-mail-address))
+ "*Regexp of From headers that may be suppressed in favor of To headers."
+ :group 'gnus-summary
+ :type 'regexp)
;;; Internal variables
+(defvar gnus-article-mime-handles nil)
+(defvar gnus-article-decoded-p nil)
(defvar gnus-scores-exclude-files nil)
(defvar gnus-page-broken nil)
(?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
(?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
(?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
- (?o (gnus-date-iso8601 gnus-tmp-header) ?s)
+ (?o (gnus-date-iso8601 (mail-header-date gnus-tmp-header)) ?s)
(?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
(?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
(?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
(?l (bbb-grouplens-score gnus-tmp-header) ?s)
(?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
(?U gnus-tmp-unread ?c)
+ (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header) ?s)
(?t (gnus-summary-number-of-articles-in-thread
(and (boundp 'thread) (car thread)) gnus-tmp-level)
?d)
(?d (length gnus-newsgroup-dormant) ?d)
(?t (length gnus-newsgroup-marked) ?d)
(?r (length gnus-newsgroup-reads) ?d)
+ (?z (gnus-summary-article-score gnus-tmp-article-number) ?d)
(?E gnus-newsgroup-expunged-tally ?d)
(?s (gnus-current-score-file-nondirectory) ?s)))
(defvar gnus-newsgroup-processable nil
"List of articles in the current newsgroup that can be processed.")
+(defvar gnus-newsgroup-downloadable nil
+ "List of articles in the current newsgroup that can be processed.")
+
+(defvar gnus-newsgroup-undownloaded nil
+ "List of articles in the current newsgroup that haven't been downloaded..")
+
+(defvar gnus-newsgroup-unsendable nil
+ "List of articles in the current newsgroup that won't be sent.")
+
(defvar gnus-newsgroup-bookmarks nil
"List of articles in the current newsgroup that have bookmarks.")
gnus-newsgroup-reads gnus-newsgroup-saved
gnus-newsgroup-replied gnus-newsgroup-expirable
gnus-newsgroup-processable gnus-newsgroup-killed
+ gnus-newsgroup-downloadable gnus-newsgroup-undownloaded
+ gnus-newsgroup-unsendable
gnus-newsgroup-bookmarks gnus-newsgroup-dormant
gnus-newsgroup-headers gnus-newsgroup-threads
gnus-newsgroup-prepared gnus-summary-highlight-line-function
;; Byte-compiler warning.
(defvar gnus-article-mode-map)
+;; MIME stuff.
+
+(defvar gnus-decode-encoded-word-methods
+ '(mail-decode-encoded-word-string)
+ "List of methods used to decode encoded words.
+
+This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is
+FUNCTION, FUNCTION will be apply to all newsgroups. If item is a
+(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups
+whose names match REGEXP.
+
+For example:
+((\"chinese\" . gnus-decode-encoded-word-string-by-guess)
+ mail-decode-encoded-word-string
+ (\"chinese\" . rfc1843-decode-string))
+")
+
+(defvar gnus-decode-encoded-word-methods-cache nil)
+
+(defun gnus-multi-decode-encoded-word-string (string)
+ "Apply the functions from `gnus-encoded-word-methods' that match."
+ (unless (and gnus-decode-encoded-word-methods-cache
+ (eq gnus-newsgroup-name
+ (car gnus-decode-encoded-word-methods-cache)))
+ (setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name))
+ (mapc '(lambda (x)
+ (if (symbolp x)
+ (nconc gnus-decode-encoded-word-methods-cache (list x))
+ (if (and gnus-newsgroup-name
+ (string-match (car x) gnus-newsgroup-name))
+ (nconc gnus-decode-encoded-word-methods-cache
+ (list (cdr x))))))
+ gnus-decode-encoded-word-methods))
+ (let ((xlist gnus-decode-encoded-word-methods-cache))
+ (pop xlist)
+ (while xlist
+ (setq string (funcall (pop xlist) string))))
+ string)
+
;; Subject simplification.
+(defun gnus-simplify-whitespace (str)
+ "Remove excessive whitespace."
+ (let ((mystr str))
+ ;; Multiple spaces.
+ (while (string-match "[ \t][ \t]+" mystr)
+ (setq mystr (concat (substring mystr 0 (match-beginning 0))
+ " "
+ (substring mystr (match-end 0)))))
+ ;; Leading spaces.
+ (when (string-match "^[ \t]+" mystr)
+ (setq mystr (substring mystr (match-end 0))))
+ ;; Trailing spaces.
+ (when (string-match "[ \t]+$" mystr)
+ (setq mystr (substring mystr 0 (match-beginning 0))))
+ mystr))
+
(defsubst gnus-simplify-subject-re (subject)
"Remove \"Re:\" from subject lines."
(if (string-match "^[Rr][Ee]: *" subject)
(defun gnus-simplify-subject-fuzzy (subject)
"Simplify a subject string fuzzily.
-See gnus-simplify-buffer-fuzzy for details."
+See `gnus-simplify-buffer-fuzzy' for details."
(save-excursion
(gnus-set-work-buffer)
(let ((case-fold-search t))
+ ;; Remove uninteresting prefixes.
+ (when (and gnus-simplify-ignored-prefixes
+ (string-match gnus-simplify-ignored-prefixes subject))
+ (setq subject (substring subject (match-end 0))))
(insert subject)
(inline (gnus-simplify-buffer-fuzzy))
(buffer-string))))
(defsubst gnus-simplify-subject-fully (subject)
"Simplify a subject string according to gnus-summary-gather-subject-limit."
(cond
+ (gnus-simplify-subject-functions
+ (gnus-map-function gnus-simplify-subject-functions subject))
((null gnus-summary-gather-subject-limit)
(gnus-simplify-subject-re subject))
((eq gnus-summary-gather-subject-limit 'fuzzy)
subject)))
(defsubst gnus-subject-equal (s1 s2 &optional simple-first)
- "Check whether two subjects are equal. If optional argument
-simple-first is t, first argument is already simplified."
+ "Check whether two subjects are equal.
+If optional argument simple-first is t, first argument is already
+simplified."
(cond
((null simple-first)
(equal (gnus-simplify-subject-fully s1)
" " gnus-summary-next-page
"\177" gnus-summary-prev-page
[delete] gnus-summary-prev-page
+ [backspace] gnus-summary-prev-page
"\r" gnus-summary-scroll-up
+ "\M-\r" gnus-summary-scroll-down
"n" gnus-summary-next-unread-article
"p" gnus-summary-prev-unread-article
"N" gnus-summary-next-article
"\M-g" gnus-summary-rescan-group
"w" gnus-summary-stop-page-breaking
"\C-c\C-r" gnus-summary-caesar-message
- "\M-t" gnus-summary-toggle-mime
"f" gnus-summary-followup
"F" gnus-summary-followup-with-original
"C" gnus-summary-cancel-article
"\C-c\C-v\C-v" gnus-uu-decode-uu-view
"\C-d" gnus-summary-enter-digest-group
"\M-\C-d" gnus-summary-read-document
+ "\M-\C-e" gnus-summary-edit-parameters
"\C-c\C-b" gnus-bug
"*" gnus-cache-enter-article
"\M-*" gnus-cache-remove-article
"\C-l" gnus-recenter
"I" gnus-summary-increase-score
"L" gnus-summary-lower-score
-
+ "\M-i" gnus-symbolic-argument
+ "h" gnus-summary-select-article-buffer
+ "b" gnus-article-view-part
+
"V" gnus-summary-score-map
"X" gnus-uu-extract-map
"S" gnus-summary-send-map)
"u" gnus-summary-limit-to-unread
"m" gnus-summary-limit-to-marks
"v" gnus-summary-limit-to-score
+ "*" gnus-summary-limit-include-cached
"D" gnus-summary-limit-include-dormant
+ "T" gnus-summary-limit-include-thread
"d" gnus-summary-limit-exclude-dormant
"t" gnus-summary-limit-to-age
"E" gnus-summary-limit-include-expunged
[delete] gnus-summary-prev-page
"p" gnus-summary-prev-page
"\r" gnus-summary-scroll-up
+ "\M-\r" gnus-summary-scroll-down
"<" gnus-summary-beginning-of-article
">" gnus-summary-end-of-article
"b" gnus-summary-beginning-of-article
"^" gnus-summary-refer-parent-article
"r" gnus-summary-refer-parent-article
"R" gnus-summary-refer-references
+ "T" gnus-summary-refer-thread
"g" gnus-summary-show-article
"s" gnus-summary-isearch-article
"P" gnus-summary-print-article)
"r" gnus-summary-caesar-message
"t" gnus-article-hide-headers
"v" gnus-summary-verbose-headers
- "m" gnus-summary-toggle-mime
- "h" gnus-article-treat-html)
+ "h" gnus-article-treat-html
+ "d" gnus-article-treat-dumbquotes)
(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
"a" gnus-article-hide
"b" gnus-article-hide-boring-headers
"s" gnus-article-hide-signature
"c" gnus-article-hide-citation
+ "C" gnus-article-hide-citation-in-followups
"p" gnus-article-hide-pgp
"P" gnus-article-hide-pem
"\C-c" gnus-article-hide-citation-maybe)
"c" gnus-article-highlight-citation
"s" gnus-article-highlight-signature)
+ (gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map)
+ "w" gnus-article-decode-mime-words
+ "c" gnus-article-decode-charset
+ "v" gnus-mime-view-all-parts
+ "b" gnus-article-view-part)
+
(gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
"z" gnus-article-date-ut
"u" gnus-article-date-ut
"l" gnus-article-date-local
"e" gnus-article-date-lapsed
projects / gnus / blobdiff