;;; gnus-sum.el --- summary mode commands for Gnus
-;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
(require 'gnus-range)
(require 'gnus-int)
(require 'gnus-undo)
+(require 'gnus-util)
+(require 'mm-decode)
+;; Recursive :-(.
+;; (require 'gnus-art)
+(require 'nnoo)
(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
+(autoload 'gnus-cache-write-active "gnus-cache")
+(autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t)
+(autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t)
+(autoload 'mm-uu-dissect "mm-uu")
(defcustom gnus-kill-summary-on-exit t
"*If non-nil, kill the summary buffer when you exit from it.
: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."
+ "*If t, many commands will go to the next unread article.
+This applies to marking commands as well as other commands that
+\"naturally\" select the next article, like, for instance, `SPC' at
+the end of an article.
+
+If nil, the marking commands do NOT go to the next unread article
+(they go to the next article instead). If `never', commands that
+usually go to the next unread article, will go to the next article,
+whether it is read or not."
:group 'gnus-summary-marks
:link '(custom-manual "(gnus)Setting Marks")
:type '(choice (const :tag "off" nil)
: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."
+It uses the same syntax as the `gnus-split-methods' variable.
+However, whereas `gnus-split-methods' specifies file names as targets,
+this variable specifies group names."
:group 'gnus-summary-mail
:type '(repeat (choice (list :value (fun) function)
(cons :value ("" "") regexp (repeat string))
(sexp :value nil))))
-(defcustom gnus-unread-mark ?
+(defcustom gnus-unread-mark ? ;Whitespace
"*Mark used for unread articles."
:group 'gnus-summary-marks
:type 'character)
:group 'gnus-summary-marks
:type 'character)
-(defcustom gnus-empty-thread-mark ?
+(defcustom gnus-empty-thread-mark ? ;Whitespace
"*There is no thread under the article."
:group 'gnus-summary-marks
:type 'character)
:group 'gnus-extract-view
:type 'boolean)
+(defcustom gnus-auto-expirable-marks
+ (list gnus-killed-mark gnus-del-mark gnus-catchup-mark
+ gnus-low-score-mark gnus-ancient-mark gnus-read-mark
+ gnus-souped-mark gnus-duplicate-mark)
+ "*The list of marks converted into expiration if a group is auto-expirable."
+ :version "21.1"
+ :group 'gnus-summary
+ :type '(repeat character))
+
+(defcustom gnus-inhibit-user-auto-expire t
+ "*If non-nil, user marking commands will not mark an article as expirable, even if the group has auto-expire turned on."
+ :version "21.1"
+ :group 'gnus-summary
+ :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
: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:
:group 'gnus-summary-format
:type 'string)
+(defcustom gnus-list-identifiers nil
+ "Regexp that matches list identifiers to be removed from subject.
+This can also be a list of regexps."
+ :version "21.1"
+ :group 'gnus-summary-format
+ :group 'gnus-article-hiding
+ :type '(choice (const :tag "none" nil)
+ (regexp :value ".*")
+ (repeat :value (".*") regexp)))
+
(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
\"thread score\" is.
This variable is local to the summary buffers."
- :group 'gnus-treading
+ :group 'gnus-threading
:group 'gnus-score-default
:type '(choice (const :tag "off" nil)
integer))
(defcustom gnus-summary-mode-hook nil
"*A hook for Gnus summary mode.
This hook is run before any variables are set in the summary buffer."
+ :options '(turn-on-gnus-mailing-list-mode)
:group 'gnus-summary-various
:type 'hook)
:group 'gnus-summary-visual
:type 'hook)
-(defcustom gnus-structured-field-decoder 'identity
- "Function to decode non-ASCII characters in structured field for summary."
- :group 'gnus-various
- :type 'function)
-
-(defcustom gnus-unstructured-field-decoder 'identity
- "Function to decode non-ASCII characters in unstructured field for summary."
- :group 'gnus-various
- :type 'function)
-
-(defcustom gnus-parse-headers-hook
- (list 'gnus-hack-decode-rfc1522 'gnus-decode-rfc1522)
+(defcustom gnus-parse-headers-hook nil
"*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."
+ "*A hook called when exiting summary mode.
+This hook is not called from the non-updating exit commands like `Q'."
:group 'gnus-various
:type 'hook)
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."
+ :version "21.1"
+ :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."
+ :version "21.1"
+ :group 'gnus-summary
+ :type 'regexp)
+
+(defcustom gnus-group-charset-alist
+ '(("^hk\\>\\|^tw\\>\\|\\<big5\\>" cn-big5)
+ ("^cn\\>\\|\\<chinese\\>" cn-gb-2312)
+ ("^fj\\>\\|^japan\\>" iso-2022-jp-2)
+ ("^tnn\\>\\|^pin\\>\\|^sci.lang.japan" iso-2022-7bit)
+ ("^relcom\\>" koi8-r)
+ ("^fido7\\>" koi8-r)
+ ("^\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2)
+ ("^israel\\>" iso-8859-1)
+ ("^han\\>" euc-kr)
+ ("^alt.chinese.text.big5\\>" chinese-big5)
+ ("^soc.culture.vietnamese\\>" vietnamese-viqr)
+ ("^\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1)
+ (".*" iso-8859-1))
+ "Alist of regexps (to match group names) and default charsets to be used when reading."
+ :type '(repeat (list (regexp :tag "Group")
+ (symbol :tag "Charset")))
+ :group 'gnus-charset)
+
+(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown)
+ "List of charsets that should be ignored.
+When these charsets are used in the \"charset\" parameter, the
+default charset will be used instead."
+ :version "21.1"
+ :type '(repeat symbol)
+ :group 'gnus-charset)
+
+(defcustom gnus-group-ignored-charsets-alist
+ '(("alt\\.chinese\\.text" iso-8859-1))
+ "Alist of regexps (to match group names) and charsets that should be ignored.
+When these charsets are used in the \"charset\" parameter, the
+default charset will be used instead."
+ :type '(repeat (cons (regexp :tag "Group")
+ (repeat symbol)))
+ :group 'gnus-charset)
+
+(defcustom gnus-group-highlight-words-alist nil
+ "Alist of group regexps and highlight regexps.
+This variable uses the same syntax as `gnus-emphasis-alist'."
+ :version "21.1"
+ :type '(repeat (cons (regexp :tag "Group")
+ (repeat (list (regexp :tag "Highlight regexp")
+ (number :tag "Group for entire word" 0)
+ (number :tag "Group for displayed part" 0)
+ (symbol :tag "Face"
+ gnus-emphasis-highlight-words)))))
+ :group 'gnus-summary-visual)
+
+(defcustom gnus-summary-show-article-charset-alist
+ nil
+ "Alist of number and charset.
+The article will be shown with the charset corresponding to the
+numbered argument.
+For example: ((1 . cn-gb-2312) (2 . big5))."
+ :version "21.1"
+ :type '(repeat (cons (number :tag "Argument" 1)
+ (symbol :tag "Charset")))
+ :group 'gnus-charset)
+
+(defcustom gnus-preserve-marks t
+ "Whether marks are preserved when moving, copying and respooling messages."
+ :version "21.1"
+ :type 'boolean
+ :group 'gnus-summary-marks)
+
+(defcustom gnus-alter-articles-to-read-function nil
+ "Function to be called to alter the list of articles to be selected."
+ :type 'function
+ :group 'gnus-summary)
+
+(defcustom gnus-orphan-score nil
+ "*All orphans get this score added. Set in the score file."
+ :group 'gnus-score-default
+ :type '(choice (const nil)
+ integer))
+
+(defcustom gnus-summary-save-parts-default-mime "image/.*"
+ "*A regexp to match MIME parts when saving multiple parts of a message
+with gnus-summary-save-parts (X m). This regexp will be used by default
+when prompting the user for which type of files to save."
+ :group 'gnus-summary
+ :type 'regexp)
+
+
+(defcustom gnus-summary-save-parts-default-mime "image/.*"
+ "*A regexp to match MIME parts when saving multiple parts of a message
+with gnus-summary-save-parts (X m). This regexp will be used by default
+when prompting the user for which type of files to save."
+ :group 'gnus-summary
+ :type 'regexp)
+
+
;;; Internal variables
+(defvar gnus-article-mime-handles nil)
+(defvar gnus-article-decoded-p nil)
+(defvar gnus-article-charset nil)
+(defvar gnus-article-ignored-charsets nil)
(defvar gnus-scores-exclude-files nil)
(defvar gnus-page-broken nil)
+(defvar gnus-inhibit-mime-unbuttonizing nil)
(defvar gnus-original-article nil)
(defvar gnus-article-internal-prepare-hook nil)
(defvar gnus-thread-indent-array nil)
(defvar gnus-thread-indent-array-level gnus-thread-indent-level)
+(defvar gnus-sort-gathered-threads-function 'gnus-thread-sort-by-number
+ "Function called to sort the articles within a thread after it has been gathered together.")
+
+(defvar gnus-summary-save-parts-type-history nil)
+(defvar gnus-summary-save-parts-last-directory nil)
+
+(defvar gnus-summary-save-parts-type-history nil)
+(defvar gnus-summary-save-parts-last-directory nil)
;; Avoid highlighting in kill files.
(defvar gnus-summary-inhibit-highlight nil)
(?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)
?c)
(?u gnus-tmp-user-defined ?s)
(?P (gnus-pick-line-number) ?d))
- "An alist of format specifications that can appear in summary lines,
-and what variables they correspond with, along with the type of the
-variable (string, integer, character, etc).")
+ "An alist of format specifications that can appear in summary lines.
+These are paired with what variables they correspond with, along with
+the type of the variable (string, integer, character, etc).")
(defvar gnus-summary-dummy-line-format-alist
`((?S gnus-tmp-subject ?s)
(defvar gnus-have-all-headers nil)
(defvar gnus-last-article nil)
(defvar gnus-newsgroup-history nil)
+(defvar gnus-newsgroup-charset nil)
+(defvar gnus-newsgroup-ephemeral-charset nil)
+(defvar gnus-newsgroup-ephemeral-ignored-charsets nil)
+
+(defvar gnus-article-before-search nil)
(defconst gnus-summary-local-variables
'(gnus-newsgroup-name
gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
gnus-newsgroup-scored gnus-newsgroup-kill-headers
gnus-thread-expunge-below
- gnus-score-alist gnus-current-score-file gnus-summary-expunge-below
+ gnus-score-alist gnus-current-score-file
+ (gnus-summary-expunge-below . global)
(gnus-summary-mark-below . global)
+ (gnus-orphan-score . global)
gnus-newsgroup-active gnus-scores-exclude-files
gnus-newsgroup-history gnus-newsgroup-ancient
gnus-newsgroup-sparse gnus-newsgroup-process-stack
(gnus-newsgroup-expunged-tally . 0)
gnus-cache-removable-articles gnus-newsgroup-cached
gnus-newsgroup-data gnus-newsgroup-data-reverse
- gnus-newsgroup-limit gnus-newsgroup-limits)
+ gnus-newsgroup-limit gnus-newsgroup-limits
+ gnus-newsgroup-charset)
"Variables that are buffer-local to the summary buffers.")
+(defvar gnus-newsgroup-variables nil
+ "Variables that have separate values in the newsgroups.")
+
;; Byte-compiler warning.
-(defvar gnus-article-mode-map)
+(eval-when-compile (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))
+ (mapcar (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."
+ "Remove excessive whitespace from STR."
(let ((mystr str))
;; Multiple spaces.
(while (string-match "[ \t][ \t]+" mystr)
(defsubst gnus-simplify-buffer-fuzzy-step (regexp &optional newtext)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
- (replace-match (or newtext ""))))
+ (replace-match (or newtext ""))))
(defun gnus-simplify-buffer-fuzzy ()
"Simplify string in the buffer fuzzily.
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."
+`gnus-simplify-subject-fuzzy-regexp'."
(let ((case-fold-search t)
(modified-tick))
(gnus-simplify-buffer-fuzzy-step "\t" " ")
[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-\C-h" gnus-summary-hide-thread
"\M-\C-f" gnus-summary-next-thread
"\M-\C-b" gnus-summary-prev-thread
+ [(meta down)] gnus-summary-next-thread
+ [(meta up)] gnus-summary-prev-thread
"\M-\C-u" gnus-summary-up-thread
"\M-\C-d" gnus-summary-down-thread
"&" gnus-summary-execute-command
"\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-c" gnus-summary-sort-by-chars
"\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
"\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
"a" gnus-summary-post-news
"x" gnus-summary-limit-to-unread
"s" gnus-summary-isearch-article
- "t" gnus-article-hide-headers
+ "t" gnus-summary-toggle-header
"g" gnus-summary-show-article
"l" gnus-summary-goto-last-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
+ "\M-\C-a" gnus-summary-customize-parameters
"\C-c\C-b" gnus-bug
"*" gnus-cache-enter-article
"\M-*" gnus-cache-remove-article
"L" gnus-summary-lower-score
"\M-i" gnus-symbolic-argument
"h" gnus-summary-select-article-buffer
-
+
+ "b" gnus-article-view-part
+ "\M-t" gnus-summary-toggle-display-buttonized
+
"V" gnus-summary-score-map
"X" gnus-uu-extract-map
"S" gnus-summary-send-map)
"a" gnus-summary-limit-to-author
"u" gnus-summary-limit-to-unread
"m" gnus-summary-limit-to-marks
+ "M" gnus-summary-limit-exclude-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
+ "x" gnus-summary-limit-to-extra
"E" gnus-summary-limit-include-expunged
"c" gnus-summary-limit-exclude-childless-dormant
"C" gnus-summary-limit-mark-excluded-as-read)
[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
"e" gnus-summary-end-of-article
"^" gnus-summary-refer-parent-article
"r" gnus-summary-refer-parent-article
+ "D" gnus-summary-enter-digest-group
"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)
+ "P" gnus-summary-print-article
+ "M" gnus-mailing-list-insinuate
+ "t" gnus-article-babel)
(gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map)
"b" gnus-article-add-buttons
"o" gnus-article-treat-overstrike
"e" gnus-article-emphasize
"w" gnus-article-fill-cited-article
+ "Q" gnus-article-fill-long-lines
+ "C" gnus-article-capitalize-sentences
"c" gnus-article-remove-cr
"q" gnus-article-de-quoted-unreadable
+ "6" gnus-article-de-base64-unreadable
+ "Z" gnus-article-decode-HZ
+ "h" gnus-article-wash-html
+ "s" gnus-summary-force-verify-and-decrypt
"f" gnus-article-display-x-face
"l" gnus-summary-stop-page-breaking
"r" gnus-summary-caesar-message
- "t" gnus-article-hide-headers
+ "t" gnus-summary-toggle-header
"v" gnus-summary-verbose-headers
- "m" gnus-summary-toggle-mime
- "h" gnus-article-treat-html
+ "H" gnus-article-strip-headers-in-body
+ "p" gnus-article-verify-x-pgp-sig
"d" gnus-article-treat-dumbquotes)
(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
"b" gnus-article-hide-boring-headers
"s" gnus-article-hide-signature
"c" gnus-article-hide-citation
+ "C" gnus-article-hide-citation-in-followups
+ "l" gnus-article-hide-list-identifiers
"p" gnus-article-hide-pgp
+ "B" gnus-article-strip-banner
"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
"m" gnus-article-strip-multiple-blank-lines
"a" gnus-article-strip-blank-lines
"A" gnus-article-strip-all-blank-lines
- "s" gnus-article-strip-leading-space)
+ "s" gnus-article-strip-leading-space
+ "e" gnus-article-strip-trailing-space)
(gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
"v" gnus-version
"\M-\C-e" gnus-summary-expire-articles-now
"\177" gnus-summary-delete-article
[delete] gnus-summary-delete-article
+ [backspace] gnus-summary-delete-article
"m" gnus-summary-move-article
"r" gnus-summary-respool-article
"w" gnus-summary-edit-article
"c" gnus-summary-copy-article
"B" gnus-summary-crosspost-article
"q" gnus-summary-respool-query
+ "t" gnus-summary-respool-trace
"i" gnus-summary-import-article
"p" gnus-summary-article-posted-p)
"h" gnus-summary-save-article-folder
"v" gnus-summary-save-article-vm
"p" gnus-summary-pipe-output
- "s" gnus-soup-add-article))
+ "s" gnus-soup-add-article)
+
+ (gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
+ "b" gnus-summary-display-buttonized
+ "m" gnus-summary-repair-multipart
+ "v" gnus-article-view-part
+ "o" gnus-article-save-part
+ "c" gnus-article-copy-part
+ "C" gnus-article-view-part-as-charset
+ "e" gnus-article-externalize-part
+ "E" gnus-article-encrypt-body
+ "i" gnus-article-inline-part
+ "|" gnus-article-pipe-part))
(defun gnus-summary-make-menu-bar ()
(gnus-turn-off-edit-menu 'summary)
;; Define both the Article menu in the summary buffer and the equivalent
;; Commands menu in the article buffer here for consistency.
(let ((innards
- '(("Hide"
+ `(("Hide"
["All" gnus-article-hide t]
["Headers" gnus-article-hide-headers t]
["Signature" gnus-article-hide-signature t]
["Citation" gnus-article-hide-citation t]
+ ["List identifiers" gnus-article-hide-list-identifiers t]
["PGP" gnus-article-hide-pgp t]
+ ["Banner" gnus-article-strip-banner t]
["Boring headers" gnus-article-hide-boring-headers t])
("Highlight"
["All" gnus-article-highlight t]
["Headers" gnus-article-highlight-headers t]
["Signature" gnus-article-highlight-signature t]
["Citation" gnus-article-highlight-citation t])
+ ("MIME"
+ ["Words" gnus-article-decode-mime-words t]
+ ["Charset" gnus-article-decode-charset t]
+ ["QP" gnus-article-de-quoted-unreadable t]
+ ["Base64" gnus-article-de-base64-unreadable t]
+ ["View all" gnus-mime-view-all-parts t]
+ ["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t]
+ ["Encrypt body" gnus-article-encrypt-body t])
("Date"
["Local" gnus-article-date-local t]
["ISO8601" gnus-article-date-iso8601 t]
["Trailing" gnus-article-remove-trailing-blank-lines t]
["All of the above" gnus-article-strip-blank-lines t]
["All" gnus-article-strip-all-blank-lines t]
- ["Leading space" gnus-article-strip-leading-space t])
+ ["Leading space" gnus-article-strip-leading-space t]
+ ["Trailing space" gnus-article-strip-trailing-space t])
["Overstrike" gnus-article-treat-overstrike t]
["Dumb quotes" gnus-article-treat-dumbquotes t]
["Emphasis" gnus-article-emphasize t]
["Word wrap" gnus-article-fill-cited-article t]
+ ["Fill long lines" gnus-article-fill-long-lines t]
+ ["Capitalize sentences" gnus-article-capitalize-sentences 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]
+ ["Base64" gnus-article-de-base64-unreadable t]
+ ["Rot 13" gnus-summary-caesar-message
+ ,@(if (featurep 'xemacs) nil
+ '(:help "\"Caesar rotate\" article by 13"))]
["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]
- ["Toggle MIME" gnus-summary-toggle-mime t]
["Verbose header" gnus-summary-verbose-headers t]
- ["Toggle header" gnus-summary-toggle-header t])
+ ["Toggle header" gnus-summary-toggle-header t]
+ ["Html" gnus-article-wash-html t]
+ ["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t]
+ ["HZ" gnus-article-decode-HZ t])
("Output"
- ["Save in default format" gnus-summary-save-article t]
- ["Save in file" gnus-summary-save-article-file t]
+ ["Save in default format" gnus-summary-save-article
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Save article using default method"))]
+ ["Save in file" gnus-summary-save-article-file
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Save article in file"))]
["Save in Unix mail format" gnus-summary-save-article-mail t]
["Save in MH folder" gnus-summary-save-article-folder t]
["Save in VM folder" gnus-summary-save-article-vm t]
(gnus-check-backend-function
'request-expire-articles gnus-newsgroup-name)]
["Query respool" gnus-summary-respool-query t]
+ ["Trace respool" gnus-summary-respool-trace t]
["Delete expirable articles" gnus-summary-expire-articles-now
(gnus-check-backend-function
'request-expire-articles gnus-newsgroup-name)])
("Extract"
- ["Uudecode" gnus-uu-decode-uu t]
+ ["Uudecode" gnus-uu-decode-uu
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Decode uuencoded article(s)"))]
["Uudecode and save" gnus-uu-decode-uu-and-save t]
["Unshar" gnus-uu-decode-unshar t]
["Unshar and save" gnus-uu-decode-unshar-and-save t]
("Cache"
["Enter article" gnus-cache-enter-article t]
["Remove article" gnus-cache-remove-article t])
+ ["Translate" gnus-article-babel t]
["Select article buffer" gnus-summary-select-article-buffer t]
["Enter digest buffer" gnus-summary-enter-digest-group t]
["Isearch article..." gnus-summary-isearch-article t]
["Fetch referenced articles" gnus-summary-refer-references t]
["Fetch current thread" gnus-summary-refer-thread t]
["Fetch article with id..." gnus-summary-refer-article t]
+ ["Setup Mailing List Params" gnus-mailing-list-insinuate t]
["Redisplay" gnus-summary-show-article t])))
(easy-menu-define
gnus-summary-article-menu gnus-summary-mode-map ""
["Mark thread as read" gnus-summary-kill-thread t]
["Lower thread score" gnus-summary-lower-thread t]
["Raise thread score" gnus-summary-raise-thread t]
- ["Rethread current" gnus-summary-rethread-current t]
- ))
+ ["Rethread current" gnus-summary-rethread-current t]))
(easy-menu-define
gnus-summary-post-menu gnus-summary-mode-map ""
- '("Post"
- ["Post an article" gnus-summary-post-news t]
- ["Followup" gnus-summary-followup t]
- ["Followup and yank" gnus-summary-followup-with-original t]
+ `("Post"
+ ["Post an article" gnus-summary-post-news
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Post an article"))]
+ ["Followup" gnus-summary-followup
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Post followup to this article"))]
+ ["Followup and yank" gnus-summary-followup-with-original
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Post followup to this article, quoting its contents"))]
["Supersede article" gnus-summary-supersede-article t]
- ["Cancel article" gnus-summary-cancel-article t]
+ ["Cancel article" gnus-summary-cancel-article
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Cancel an article you posted"))]
["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]
+ ["Wide reply and yank" gnus-summary-wide-reply-with-original
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Mail a reply, quoting this article"))]
["Mail forward" gnus-summary-mail-forward t]
["Post forward" gnus-summary-post-forward t]
["Digest and mail" gnus-uu-digest-mail-forward t]
["Resend message" gnus-summary-resend-message 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]
+ ["Uuencode and post" gnus-uu-post-news
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Post a uuencoded article"))]
["Followup via news" gnus-summary-followup-to-mail t]
["Followup via news and yank"
gnus-summary-followup-to-mail-with-original t]
(easy-menu-define
gnus-summary-misc-menu gnus-summary-mode-map ""
- '("Misc"
+ `("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" gnus-summary-catchup
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Mark unread articles in this group as read"))]
["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]
["Subject..." gnus-summary-limit-to-subject t]
["Author..." gnus-summary-limit-to-author t]
["Age..." gnus-summary-limit-to-age t]
+ ["Extra..." gnus-summary-limit-to-extra t]
["Score" gnus-summary-limit-to-score t]
["Unread" gnus-summary-limit-to-unread t]
["Non-dormant" gnus-summary-limit-exclude-dormant t]
["Hide childless dormant"
gnus-summary-limit-exclude-childless-dormant t]
;;["Hide thread" gnus-summary-limit-exclude-thread t]
+ ["Hide marked" gnus-summary-limit-exclude-marks t]
["Show expunged" gnus-summary-show-all-expunged t])
("Process Mark"
["Set mark" gnus-summary-mark-as-processable t]
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]
+ ["Page forward" gnus-summary-next-page
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Show next page of article"))]
+ ["Page backward" gnus-summary-prev-page
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Show previous page of article"))]
["Line forward" gnus-summary-scroll-up t])
("Move"
["Next unread article" gnus-summary-next-unread-article 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 lines" gnus-summary-sort-by-lines t])
+ ["Sort by lines" gnus-summary-sort-by-lines t]
+ ["Sort by characters" gnus-summary-sort-by-chars t])
("Help"
["Fetch group FAQ" gnus-summary-fetch-faq t]
["Describe group" gnus-summary-describe-group t]
["Edit local kill file" gnus-summary-edit-local-kill t]
["Edit main kill file" gnus-summary-edit-global-kill t]
["Edit group parameters" gnus-summary-edit-parameters t]
+ ["Customize group parameters" gnus-summary-customize-parameters t]
+ ["Send a bug report" gnus-bug t]
("Exit"
- ["Catchup and exit" gnus-summary-catchup-and-exit t]
- ["Catchup all and exit" gnus-summary-catchup-and-exit t]
+ ["Catchup and exit" gnus-summary-catchup-and-exit
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Mark unread articles in this group as read, then exit"))]
+ ["Catchup all and exit" gnus-summary-catchup-all-and-exit t]
["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t]
- ["Exit group" gnus-summary-exit t]
+ ["Exit group" gnus-summary-exit
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Exit current group, return to group selection mode"))]
["Exit group without updating" gnus-summary-exit-no-update t]
["Exit and goto next group" gnus-summary-next-group t]
["Exit and goto prev group" gnus-summary-prev-group t]
(gnus-run-hooks 'gnus-summary-menu-hook)))
+(defvar gnus-summary-tool-bar-map nil)
+
+;; Emacs 21 tool bar. Should be no-op otherwise.
+(defun gnus-summary-make-tool-bar ()
+ (if (and (fboundp 'tool-bar-add-item-from-menu)
+ (default-value 'tool-bar-mode)
+ (not gnus-summary-tool-bar-map))
+ (setq gnus-summary-tool-bar-map
+ (let ((tool-bar-map (make-sparse-keymap))
+ (load-path (mm-image-load-path)))
+ (tool-bar-add-item-from-menu
+ 'gnus-summary-prev-unread "prev-ur" gnus-summary-mode-map)
+ (tool-bar-add-item-from-menu
+ 'gnus-summary-next-unread "next-ur" gnus-summary-mode-map)
+ (tool-bar-add-item-from-menu
+ 'gnus-summary-post-news "post" gnus-summary-mode-map)
+ (tool-bar-add-item-from-menu
+ 'gnus-summary-followup-with-original "fuwo" gnus-summary-mode-map)
+ (tool-bar-add-item-from-menu
+ 'gnus-summary-followup "followup" gnus-summary-mode-map)
+ (tool-bar-add-item-from-menu
+ 'gnus-summary-reply-with-original "reply-wo" gnus-summary-mode-map)
+ (tool-bar-add-item-from-menu
+ 'gnus-summary-reply "reply" gnus-summary-mode-map)
+ (tool-bar-add-item-from-menu
+ 'gnus-summary-caesar-message "rot13" gnus-summary-mode-map)
+ (tool-bar-add-item-from-menu
+ 'gnus-uu-decode-uu "uu-decode" gnus-summary-mode-map)
+ (tool-bar-add-item-from-menu
+ 'gnus-summary-save-article-file "save-aif" gnus-summary-mode-map)
+ (tool-bar-add-item-from-menu
+ 'gnus-summary-save-article "save-art" gnus-summary-mode-map)
+ (tool-bar-add-item-from-menu
+ 'gnus-uu-post-news "uu-post" gnus-summary-mode-map)
+ (tool-bar-add-item-from-menu
+ 'gnus-summary-catchup "catchup" gnus-summary-mode-map)
+ (tool-bar-add-item-from-menu
+ 'gnus-summary-catchup-and-exit "cu-exit" gnus-summary-mode-map)
+ (tool-bar-add-item-from-menu
+ 'gnus-summary-exit "exit-summ" gnus-summary-mode-map)
+ tool-bar-map)))
+ (if gnus-summary-tool-bar-map
+ (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map)))
+
(defun gnus-score-set-default (var value)
"A version of set that updates the GNU Emacs menu-bar."
(set var value)
("article body" "body" string)
("article head" "head" string)
("xref" "xref" string)
+ ("extra header" "extra" string)
("lines" "lines" number)
("followups to author" "followup" string)))
(types '((number ("less than" <)
(list 'gnus-summary-header
(nth 1 header)))
(list 'quote (nth 1 (car ts)))
- (list 'gnus-score-default nil)
+ (list 'gnus-score-delta-default
+ nil)
(nth 1 (car ps))
t)
t)
\\{gnus-summary-mode-map}"
(interactive)
- (when (gnus-visual-p 'summary-menu 'menu)
- (gnus-summary-make-menu-bar))
(kill-all-local-variables)
+ (when (gnus-visual-p 'summary-menu 'menu)
+ (gnus-summary-make-menu-bar)
+ (gnus-summary-make-tool-bar))
(gnus-summary-make-local-variables)
+ (let ((gnus-summary-local-variables gnus-newsgroup-variables))
+ (gnus-summary-make-local-variables))
(gnus-make-thread-indent-array)
(gnus-simplify-mode-line)
(setq major-mode 'gnus-summary-mode)
(setq mode-name "Summary")
(make-local-variable 'minor-mode-alist)
(use-local-map gnus-summary-mode-map)
- (buffer-disable-undo (current-buffer))
+ (buffer-disable-undo)
(setq buffer-read-only t) ;Disable modification
(setq truncate-lines t)
(setq selective-display t)
(make-local-variable 'gnus-summary-dummy-line-format)
(make-local-variable 'gnus-summary-dummy-line-format-spec)
(make-local-variable 'gnus-summary-mark-positions)
- (make-local-hook 'post-command-hook)
- (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
(make-local-hook 'pre-command-hook)
(add-hook 'pre-command-hook 'gnus-set-global-variables nil t)
(gnus-run-hooks 'gnus-summary-mode-hook)
+ (turn-on-gnus-mailing-list-mode)
+ (mm-enable-multibyte-mule4)
(gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy)
(gnus-update-summary-mark-positions))
(defun gnus-summary-make-local-variables ()
"Make all the local summary buffer variables."
- (let ((locals gnus-summary-local-variables)
- global local)
- (while (setq local (pop locals))
+ (let (global)
+ (dolist (local gnus-summary-local-variables)
(if (consp local)
(progn
(if (eq (cdr local) 'global)
(setq global (symbol-value (car local)))
;; Use the value from the list.
(setq global (eval (cdr local))))
- (make-local-variable (car local))
- (set (car local) global))
+ (set (make-local-variable (car local)) global))
;; Simple nil-valued local variable.
- (make-local-variable local)
- (set local nil)))))
+ (set (make-local-variable local) nil)))))
(defun gnus-summary-clear-local-variables ()
(let ((locals gnus-summary-local-variables))
(when list
(let ((data (and after-article (gnus-data-find-list after-article)))
(ilist list))
- (or data (not after-article) (error "No such article: %d" after-article))
- ;; Find the last element in the list to be spliced into the main
- ;; list.
- (while (cdr list)
- (setq list (cdr list)))
- (if (not data)
- (progn
- (setcdr list gnus-newsgroup-data)
- (setq gnus-newsgroup-data ilist)
+ (if (not (or data
+ after-article))
+ (let ((odata gnus-newsgroup-data))
+ (setq gnus-newsgroup-data (nconc list gnus-newsgroup-data))
(when offset
- (gnus-data-update-list (cdr list) offset)))
- (setcdr list (cdr data))
- (setcdr data ilist)
- (when offset
- (gnus-data-update-list (cdr list) offset)))
+ (gnus-data-update-list odata offset)))
+ ;; Find the last element in the list to be spliced into the main
+ ;; list.
+ (while (cdr list)
+ (setq list (cdr list)))
+ (if (not data)
+ (progn
+ (setcdr list gnus-newsgroup-data)
+ (setq gnus-newsgroup-data ilist)
+ (when offset
+ (gnus-data-update-list (cdr list) offset)))
+ (setcdr list (cdr data))
+ (setcdr data ilist)
+ (when offset
+ (gnus-data-update-list (cdr list) offset))))
(setq gnus-newsgroup-data-reverse nil))))
(defun gnus-data-remove (article &optional offset)
(defun gnus-data-update-list (data offset)
"Add OFFSET to the POS of all data entries in DATA."
+ (setq gnus-newsgroup-data-reverse nil)
(while data
(setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data))))
(setq data (cdr data))))
-(defun gnus-data-compute-positions ()
- "Compute the positions of all articles."
- (let ((data gnus-newsgroup-data)
- pos)
- (while data
- (when (setq pos (text-property-any
- (point-min) (point-max)
- 'gnus-number (gnus-data-number (car data))))
- (gnus-data-set-pos (car data) (+ pos 3)))
- (setq data (cdr data)))))
-
(defun gnus-summary-article-pseudo-p (article)
"Say whether this article is a pseudo article or not."
(not (vectorp (gnus-data-header (gnus-data-find article)))))
,@forms)
(gnus-restore-hidden-threads-configuration ,config)))))
+(defun gnus-data-compute-positions ()
+ "Compute the positions of all articles."
+ (setq gnus-newsgroup-data-reverse nil)
+ (let ((data gnus-newsgroup-data))
+ (save-excursion
+ (gnus-save-hidden-threads
+ (gnus-summary-show-all-threads)
+ (goto-char (point-min))
+ (while data
+ (while (get-text-property (point) 'gnus-intangible)
+ (forward-line 1))
+ (gnus-data-set-pos (car data) (+ (point) 3))
+ (setq data (cdr data))
+ (forward-line 1))))))
+
(defun gnus-hidden-threads-configuration ()
"Return the current hidden threads configuration."
(save-excursion
(defun gnus-restore-hidden-threads-configuration (config)
"Restore hidden threads configuration from CONFIG."
- (let (point buffer-read-only)
- (while (setq point (pop config))
- (when (and (< point (point-max))
- (goto-char point)
- (= (following-char) ?\n))
- (subst-char-in-region point (1+ point) ?\n ?\r)))))
+ (save-excursion
+ (let (point buffer-read-only)
+ (while (setq point (pop config))
+ (when (and (< point (point-max))
+ (goto-char point)
+ (eq (char-after) ?\n))
+ (subst-char-in-region point (1+ point) ?\n ?\r))))))
;; Various summary mode internalish functions.
(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.
+ "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)
(setq gnus-summary-buffer (current-buffer))
(not gnus-newsgroup-prepared))
;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
- (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
- (gnus-add-current-to-buffer-list)
+ (setq gnus-summary-buffer (set-buffer (gnus-get-buffer-create buffer)))
(gnus-summary-mode group)
(when gnus-carpal
(gnus-carpal-setup-buffer 'summary))
t)))
(defun gnus-set-global-variables ()
- ;; Set the global equivalents of the summary buffer-local variables
- ;; to the latest values they had. These reflect the summary buffer
- ;; that was in action when the last article was fetched.
+ "Set the global equivalents of the buffer-local variables.
+They are set to the latest values they had. These reflect the summary
+buffer that was in action when the last article was fetched."
(when (eq major-mode 'gnus-summary-mode)
(setq gnus-summary-buffer (current-buffer))
(let ((name gnus-newsgroup-name)
(original gnus-original-article-buffer)
(gac gnus-article-current)
(reffed gnus-reffed-article-number)
- (score-file gnus-current-score-file))
+ (score-file gnus-current-score-file)
+ (default-charset gnus-newsgroup-charset)
+ vlist)
+ (let ((locals gnus-newsgroup-variables))
+ (while locals
+ (if (consp (car locals))
+ (push (eval (caar locals)) vlist)
+ (push (eval (car locals)) vlist))
+ (setq locals (cdr locals)))
+ (setq vlist (nreverse vlist)))
(save-excursion
(set-buffer gnus-group-buffer)
(setq gnus-newsgroup-name name
gnus-article-buffer article-buffer
gnus-original-article-buffer original
gnus-reffed-article-number reffed
- gnus-current-score-file score-file)
+ gnus-current-score-file score-file
+ gnus-newsgroup-charset default-charset)
+ (let ((locals gnus-newsgroup-variables))
+ (while locals
+ (if (consp (car locals))
+ (set (caar locals) (pop vlist))
+ (set (car locals) (pop vlist)))
+ (setq locals (cdr locals))))
;; The article buffer also has local variables.
(when (gnus-buffer-live-p gnus-article-buffer)
(set-buffer gnus-article-buffer)
(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. :-)
+ ;; All non-existent numbers are the last article. :-)
+ t
(not (cdr (gnus-data-find-list article)))))
(defun gnus-make-thread-indent-array ()
(gnus-score-over-mark 130)
(gnus-download-mark 131)
(spec gnus-summary-line-format-spec)
- thread gnus-visual pos)
+ gnus-visual pos)
(save-excursion
(gnus-set-work-buffer)
(let ((gnus-summary-line-format-spec spec)
(gnus-newsgroup-downloadable '((0 . t))))
(gnus-summary-insert-line
- [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1)
+ [0 "" "" "" "" "" 0 0 "" nil] 0 nil 128 t nil "" nil 1)
(goto-char (point-min))
(setq pos (list (cons 'unread (and (search-forward "\200" nil t)
(- (point) 2)))))
(point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
(list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
+(defun gnus-summary-from-or-to-or-newsgroups (header)
+ (let ((to (cdr (assq 'To (mail-header-extra header))))
+ (newsgroups (cdr (assq 'Newsgroups (mail-header-extra header))))
+ (mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets
+ (save-excursion (set-buffer gnus-summary-buffer)
+ gnus-newsgroup-ignored-charsets)))
+ (cond
+ ((and to
+ gnus-ignored-from-addresses
+ (string-match gnus-ignored-from-addresses
+ (mail-header-from header)))
+ (concat "-> "
+ (or (car (funcall gnus-extract-address-components
+ (funcall
+ gnus-decode-encoded-word-function to)))
+ (funcall gnus-decode-encoded-word-function to))))
+ ((and newsgroups
+ gnus-ignored-from-addresses
+ (string-match gnus-ignored-from-addresses
+ (mail-header-from header)))
+ (concat "=> " newsgroups))
+ (t
+ (or (car (funcall gnus-extract-address-components
+ (mail-header-from header)))
+ (mail-header-from header))))))
+
(defun gnus-summary-insert-line (gnus-tmp-header
gnus-tmp-level gnus-tmp-current
gnus-tmp-unread gnus-tmp-replied
(if (or (null gnus-summary-default-score)
(<= (abs (- gnus-tmp-score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
- ?
+ ? ;Whitespace
(if (< gnus-tmp-score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark)))
(gnus-tmp-replied
(cond
((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))))
+ (or (and (string-match "^\".+\"" gnus-tmp-from)
+ (substring gnus-tmp-from 1 (1- (match-end 0))))
(substring gnus-tmp-from 0 beg))))
((string-match "(.+)" gnus-tmp-from)
(substring gnus-tmp-from
(setq gnus-tmp-name gnus-tmp-from))
(unless (numberp gnus-tmp-lines)
(setq gnus-tmp-lines 0))
- (gnus-put-text-property-excluding-characters-with-faces
+ (gnus-put-text-property
(point)
(progn (eval gnus-summary-line-format-spec) (point))
'gnus-number gnus-tmp-number)
(forward-line 1))))
(defun gnus-summary-update-line (&optional dont-update)
- ;; Update summary line after change.
+ "Update summary line after change."
(when (and gnus-summary-default-score
(not gnus-summary-inhibit-highlight))
(let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion.
(if (or (null gnus-summary-default-score)
(<= (abs (- score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
- ?
+ ? ;Whitespace
(if (< score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark))
'score))
(set (car elem) (eval (nth 1 elem))))))))
(defun gnus-summary-read-group (group &optional show-all no-article
- kill-buffer no-display backward)
+ kill-buffer no-display backward
+ select-articles)
"Start reading news in newsgroup GROUP.
If SHOW-ALL is non-nil, already read articles are also listed.
If NO-ARTICLE is non-nil, no article is selected initially.
(let ((gnus-auto-select-next nil))
(or (gnus-summary-read-group-1
group show-all no-article
- kill-buffer no-display)
- (setq show-all nil)))))
+ kill-buffer no-display
+ select-articles)
+ (setq show-all nil
+ select-articles nil)))))
(eq gnus-auto-select-next 'quietly))
(set-buffer gnus-group-buffer)
;; The entry function called above goes to the next
result))
(defun gnus-summary-read-group-1 (group show-all no-article
- kill-buffer no-display)
+ kill-buffer no-display
+ &optional select-articles)
;; Killed foreign groups can't be entered.
(when (and (not (gnus-group-native-p group))
(not (gnus-gethash group gnus-newsrc-hashtb)))
(gnus-message 5 "Retrieving newsgroup: %s..." group)
(let* ((new-group (gnus-summary-setup-buffer group))
(quit-config (gnus-group-quit-config group))
- (did-select (and new-group (gnus-select-newsgroup group show-all))))
+ (did-select (and new-group (gnus-select-newsgroup
+ group show-all select-articles))))
(cond
;; This summary buffer exists already, so we just select it.
((not new-group)
(gnus-summary-set-local-parameters gnus-newsgroup-name)
(gnus-update-format-specifications
nil 'summary 'summary-mode 'summary-dummy)
+ (gnus-update-summary-mark-positions)
;; Do score processing.
(when gnus-use-scoring
(gnus-possibly-score-headers))
(let ((gnus-newsgroup-dormant nil))
(gnus-summary-initial-limit show-all))
(gnus-summary-initial-limit show-all))
+ ;; When untreaded, all articles are always shown.
(setq gnus-newsgroup-limit
(mapcar
(lambda (header) (mail-header-number header))
(not no-display)
gnus-newsgroup-unreads
gnus-auto-select-first)
- (unless (if (eq gnus-auto-select-first 'best)
- (gnus-summary-best-unread-article)
- (gnus-summary-first-unread-article))
- (gnus-configure-windows 'summary))
+ (progn
+ (gnus-configure-windows 'summary)
+ (cond
+ ((eq gnus-auto-select-first 'best)
+ (gnus-summary-best-unread-article))
+ ((eq gnus-auto-select-first t)
+ (gnus-summary-first-unread-article))
+ ((gnus-functionp gnus-auto-select-first)
+ (funcall gnus-auto-select-first))))
;; Don't select any articles, just move point to the first
;; article in the group.
(goto-char (point-min))
(gnus-summary-position-point)
(gnus-configure-windows 'summary 'force)
- (gnus-set-mode-line 'summary))
+ (gnus-set-mode-line 'summary))
(when (get-buffer-window gnus-group-buffer t)
;; Gotta use windows, because recenter does weird stuff if
;; the current buffer ain't the displayed window.
result))
(defun gnus-sort-gathered-threads (threads)
- "Sort subtreads inside each gathered thread by article number."
+ "Sort subtreads inside each gathered thread by `gnus-sort-gathered-threads-function'."
(let ((result threads))
(while threads
(when (stringp (caar threads))
(setcdr (car threads)
- (sort (cdar threads) 'gnus-thread-sort-by-number)))
+ (sort (cdar threads) gnus-sort-gathered-threads-function)))
(setq threads (cdr threads)))
result))
threads))
;; Build the thread tree.
-(defun gnus-dependencies-add-header (header dependencies force-new)
+(defsubst gnus-dependencies-add-header (header dependencies force-new)
"Enter HEADER into the DEPENDENCIES table if it is not already there.
If FORCE-NEW is not nil, enter HEADER into the DEPENDENCIES table even
;; Yuk! This is a reference loop. Make the article be a
;; root article.
(progn
- (debug)
(mail-header-set-references (car (symbol-value id-dep)) "none")
(setq ref nil))
(setq ref (gnus-parent-id (mail-header-references ref-header)))))
(defun gnus-build-sparse-threads ()
(let ((headers gnus-newsgroup-headers)
+ (mail-parse-charset gnus-newsgroup-charset)
+ (gnus-summary-ignore-duplicates t)
header references generation relations
- cthread subject child end pthread relation new-child date)
+ subject child end new-child date)
;; First we create an alist of generations/relations, where
;; generations is how much we trust the relation, and the relation
;; is parent/child.
generation 0)
(while (search-backward ">" nil t)
(setq end (1+ (point)))
- (if (search-backward "<" nil t)
- (push (list (incf generation)
- child (setq child new-child)
- subject date)
- relations)))
- (push (list (1+ generation) child nil subject) relations)
+ (when (search-backward "<" nil t)
+ (setq new-child (buffer-substring (point) end))
+ (push (list (incf generation)
+ child (setq child new-child)
+ subject date)
+ relations)))
+ (when child
+ (push (list (1+ generation) child nil subject) relations))
(erase-buffer)))
(kill-buffer (current-buffer)))
;; Sort over trustworthiness.
(when (gnus-dependencies-add-header
(make-full-mail-header
gnus-reffed-article-number
- (nth 3 relation) "" (nth 4 relation)
+ (nth 3 relation) "" (or (nth 4 relation) "")
(nth 1 relation)
(or (nth 2 relation) "") 0 0 "")
gnus-newsgroup-dependencies nil)
;; fetch the headers for the articles that aren't there. This will
;; build complete threads - if the roots haven't been expired by the
;; server, that is.
- (let (id heads)
+ (let ((mail-parse-charset gnus-newsgroup-charset)
+ id heads)
(mapatoms
(lambda (refs)
(when (not (car (symbol-value refs)))
(setq heads nil)))))
gnus-newsgroup-dependencies)))
-;; The following macros and functions were written by Felix Lee
-;; <flee@cse.psu.edu>.
-
-(defmacro gnus-nov-read-integer ()
- '(prog1
- (if (= (following-char) ?\t)
- 0
- (let ((num (ignore-errors (read buffer))))
- (if (numberp num) num 0)))
- (unless (eobp)
- (search-forward "\t" eol 'move))))
-
-(defmacro gnus-nov-skip-field ()
- '(search-forward "\t" eol 'move))
-
-(defmacro gnus-nov-field ()
- '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
-
;; This function has to be called with point after the article number
;; on the beginning of the line.
(defsubst gnus-nov-parse-line (number dependencies &optional force-new)
(setq header
(make-full-mail-header
number ; number
- (funcall
- gnus-unstructured-field-decoder (gnus-nov-field)) ; subject
- (funcall
- gnus-structured-field-decoder (gnus-nov-field)) ; from
- (gnus-nov-field) ; date
- (or (gnus-nov-field)
- (nnheader-generate-fake-message-id)) ; id
- (gnus-nov-field) ; refs
- (gnus-nov-read-integer) ; chars
- (gnus-nov-read-integer) ; lines
- (unless (= (following-char) ?\n)
- (gnus-nov-field))))) ; misc
+ (funcall gnus-decode-encoded-word-function
+ (nnheader-nov-field)) ; subject
+ (funcall gnus-decode-encoded-word-function
+ (nnheader-nov-field)) ; from
+ (nnheader-nov-field) ; date
+ (nnheader-nov-read-message-id) ; id
+ (nnheader-nov-field) ; refs
+ (nnheader-nov-read-integer) ; chars
+ (nnheader-nov-read-integer) ; lines
+ (unless (eobp)
+ (if (looking-at "Xref: ")
+ (goto-char (match-end 0)))
+ (nnheader-nov-field)) ; Xref
+ (nnheader-nov-parse-extra)))) ; extra
(widen))
(gnus-dependencies-add-header header dependencies force-new)))
(defun gnus-build-get-header (id)
- ;; Look through the buffer of NOV lines and find the header to
- ;; ID. Enter this line into the dependencies hash table, and return
- ;; the id of the parent article (if any).
+ "Look through the buffer of NOV lines and find the header to ID.
+Enter this line into the dependencies hash table, and return
+the id of the parent article (if any)."
(let ((deps gnus-newsgroup-dependencies)
found header)
(prog1
(defun gnus-build-all-threads ()
"Read all the headers."
(let ((gnus-summary-ignore-duplicates t)
+ (mail-parse-charset gnus-newsgroup-charset)
(dependencies gnus-newsgroup-dependencies)
- found header article)
+ header article)
(save-excursion
(set-buffer nntp-server-buffer)
(let ((case-fold-search nil))
(while (not (eobp))
(ignore-errors
(setq article (read (current-buffer))
- header (gnus-nov-parse-line
- article dependencies)))
+ header (gnus-nov-parse-line article dependencies)))
(when header
- (push header gnus-newsgroup-headers)
- (if (memq (setq article (mail-header-number header))
- gnus-newsgroup-unselected)
- (progn
- (push article gnus-newsgroup-unreads)
- (setq gnus-newsgroup-unselected
- (delq article gnus-newsgroup-unselected)))
- (push article gnus-newsgroup-ancient))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (push header gnus-newsgroup-headers)
+ (if (memq (setq article (mail-header-number header))
+ gnus-newsgroup-unselected)
+ (progn
+ (push article gnus-newsgroup-unreads)
+ (setq gnus-newsgroup-unselected
+ (delq article gnus-newsgroup-unselected)))
+ (push article gnus-newsgroup-ancient)))
(forward-line 1)))))))
(defun gnus-summary-update-article-line (article header)
(memq article gnus-newsgroup-expirable)
;; 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))
+ (if (and
+ gnus-show-threads
+ (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))
(defun gnus-summary-update-article (article &optional iheader)
"Update ARTICLE in the summary buffer."
(set-buffer gnus-summary-buffer)
- (let* ((header (or iheader (gnus-summary-article-header article)))
+ (let* ((header (gnus-summary-article-header article))
(id (mail-header-id header))
(data (gnus-data-find article))
(thread (gnus-id-to-thread id))
references))
"none")))
(buffer-read-only nil)
- (old (car thread))
- (number (mail-header-number header))
- pos)
+ (old (car thread)))
(when thread
- ;; !!! Should this be in or not?
(unless iheader
- (setcar thread nil))
- (when parent
- (delq thread parent))
- (if (gnus-summary-insert-subject id header iheader)
+ (setcar thread nil)
+ (when parent
+ (delq thread parent)))
+ (if (gnus-summary-insert-subject id header)
;; Set the (possibly) new article number in the data structure.
(gnus-data-set-number data (gnus-id-to-article id))
(setcar thread old)
;;!!! then we want to insert at the beginning of the buffer.
;;!!! That happens to be true with Gnus now, but that may
;;!!! change in the future. Perhaps.
- (gnus-data-enter-list (if line nil current) data (- (point) old-pos))
- (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads))
- (when line
- (gnus-data-compute-positions)))))
+ (gnus-data-enter-list
+ (if line nil current) data (- (point) old-pos))
+ (setq gnus-newsgroup-threads
+ (nconc threads gnus-newsgroup-threads))
+ (gnus-data-compute-positions))))
(defun gnus-number-to-header (number)
"Return the header for article NUMBER."
"Remove the thread that has ID in it."
(let (headers thread last-id)
;; First go up in this thread until we find the root.
- (setq last-id (gnus-root-id id))
- (setq headers (list (car (gnus-id-to-thread last-id))
- (caadr (gnus-id-to-thread last-id))))
+ (setq last-id (gnus-root-id id)
+ headers (message-flatten-list (gnus-id-to-thread last-id)))
;; We have now found the real root of this thread. It might have
;; been gathered into some loose thread, so we have to search
;; through the threads to find the thread we wanted.
(gnus-remove-thread-1 (pop thread)))
(when (setq d (gnus-data-find number))
(goto-char (gnus-data-pos d))
+ (gnus-summary-show-thread)
(gnus-data-remove
number
(- (gnus-point-at-bol)
(1+ (gnus-point-at-eol))
(gnus-delete-line)))))))
+(defun gnus-sort-threads-1 (threads func)
+ (sort (mapcar (lambda (thread)
+ (cons (car thread)
+ (and (cdr thread)
+ (gnus-sort-threads-1 (cdr thread) func))))
+ threads) func))
+
(defun gnus-sort-threads (threads)
"Sort THREADS."
(if (not gnus-thread-sort-functions)
threads
- (gnus-message 7 "Sorting threads...")
+ (gnus-message 8 "Sorting threads...")
(prog1
- (sort threads (gnus-make-sort-function gnus-thread-sort-functions))
- (gnus-message 7 "Sorting threads...done"))))
+ (gnus-sort-threads-1
+ threads
+ (gnus-make-sort-function gnus-thread-sort-functions))
+ (gnus-message 8 "Sorting threads...done"))))
(defun gnus-sort-articles (articles)
"Sort ARTICLES."
;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
(defmacro gnus-thread-header (thread)
- ;; Return header of first article in THREAD.
- ;; Note that THREAD must never, ever be anything else than a variable -
- ;; using some other form will lead to serious barfage.
+ "Return header of first article in THREAD.
+Note that THREAD must never, ever be anything else than a variable -
+using some other form will lead to serious barfage."
(or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
;; (8% speedup to gnus-summary-prepare, just for fun :-)
- (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ;
+ (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207"
(vector thread) 2))
(defsubst gnus-article-sort-by-number (h1 h2)
(gnus-article-sort-by-lines
(gnus-thread-header h1) (gnus-thread-header h2)))
+(defsubst gnus-article-sort-by-chars (h1 h2)
+ "Sort articles by octet length."
+ (< (mail-header-chars h1)
+ (mail-header-chars h2)))
+
+(defun gnus-thread-sort-by-chars (h1 h2)
+ "Sort threads by root article octet length."
+ (gnus-article-sort-by-chars
+ (gnus-thread-header h1) (gnus-thread-header h2)))
+
(defsubst gnus-article-sort-by-author (h1 h2)
"Sort articles by root author."
(string-lessp
(defsubst gnus-article-sort-by-date (h1 h2)
"Sort articles by root article date."
- (gnus-time-less
+ (time-less-p
(gnus-date-get-time (mail-header-date h1))
(gnus-date-get-time (mail-header-date h2))))
(> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
(defun gnus-thread-total-score (thread)
- ;; This function find the total score of THREAD.
+ ;; This function find the total score of THREAD.
(cond ((null thread)
0)
((consp thread)
(defvar gnus-tmp-root-expunged nil)
(defvar gnus-tmp-dummy-line nil)
+(eval-when-compile (defvar gnus-tmp-header))
+(defun gnus-extra-header (type &optional header)
+ "Return the extra header of TYPE."
+ (or (cdr (assq type (mail-header-extra (or header gnus-tmp-header))))
+ ""))
+
(defun gnus-summary-prepare-threads (threads)
"Prepare summary buffer from THREADS and indentation LEVEL.
THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
(if (or (null gnus-summary-default-score)
(<= (abs (- gnus-tmp-score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
- ?
+ ? ;Whitespace
(if (< gnus-tmp-score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark))
gnus-tmp-replied
(cond
((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))))
+ (or (and (string-match "^\".+\"" gnus-tmp-from)
+ (substring gnus-tmp-from 1 (1- (match-end 0))))
(substring gnus-tmp-from 0 beg-match)))
((string-match "(.+)" gnus-tmp-from)
(substring gnus-tmp-from
(setq gnus-tmp-name gnus-tmp-from))
(unless (numberp gnus-tmp-lines)
(setq gnus-tmp-lines 0))
- (gnus-put-text-property-excluding-characters-with-faces
+ (gnus-put-text-property
(point)
(progn (eval gnus-summary-line-format-spec) (point))
'gnus-number number)
(cdr (assq number gnus-newsgroup-scored))
(memq number gnus-newsgroup-processable))))))
-(defun gnus-select-newsgroup (group &optional read-all)
+(defun gnus-summary-remove-list-identifiers ()
+ "Remove list identifiers in `gnus-list-identifiers' from articles in the current group."
+ (let ((regexp (if (stringp gnus-list-identifiers)
+ gnus-list-identifiers
+ (mapconcat 'identity gnus-list-identifiers " *\\|"))))
+ (dolist (header gnus-newsgroup-headers)
+ (when (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp
+ " *\\)\\)+\\(Re: +\\)?\\)")
+ (mail-header-subject header))
+ (mail-header-set-subject
+ header (concat (substring (mail-header-subject header)
+ 0 (match-beginning 1))
+ (or
+ (match-string 3 (mail-header-subject header))
+ (match-string 5 (mail-header-subject header)))
+ (substring (mail-header-subject header)
+ (match-end 1))))))))
+
+(defun gnus-select-newsgroup (group &optional read-all select-articles)
"Select newsgroup GROUP.
-If READ-ALL is non-nil, all articles in the group are selected."
+If READ-ALL is non-nil, all articles in the group are selected.
+If SELECT-ARTICLES, only select those articles from GROUP."
(let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
;;!!! Dirty hack; should be removed.
(gnus-summary-ignore-duplicates
- (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual)
+ (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual)
t
gnus-summary-ignore-duplicates))
(info (nth 2 entry))
(progn ; Or we bug out.
(when (equal major-mode 'gnus-summary-mode)
(kill-buffer (current-buffer)))
- (error "Couldn't request group %s: %s"
+ (error "Couldn't activate group %s: %s"
group (gnus-status-message group))))
(unless (gnus-request-group group t)
(setq gnus-newsgroup-name group)
(setq gnus-newsgroup-unselected nil)
(setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
+ (gnus-summary-setup-default-charset)
;; Adjust and set lists of article marks.
(when info
(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))
+ (if (setq articles select-articles)
+ (setq gnus-newsgroup-unselected
+ (gnus-sorted-intersection
+ gnus-newsgroup-unreads
+ (gnus-sorted-complement gnus-newsgroup-unreads articles)))
+ (setq articles (gnus-articles-to-read group read-all)))
(cond
((null articles)
;; Init the dependencies hash table.
(setq gnus-newsgroup-dependencies
(gnus-make-hashtable (length articles)))
+ (gnus-set-global-variables)
;; Retrieve the headers and read them in.
(gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
(setq gnus-newsgroup-headers
;; Removed marked articles that do not exist.
(gnus-update-missing-marks
(gnus-sorted-complement fetched-articles articles))
- ;; Let the Gnus agent mark articles as read.
- (when gnus-agent
- (gnus-agent-get-undownloaded-list))
;; We might want to build some more threads first.
(when (and gnus-fetch-old-headers
(eq gnus-headers-retrieved-by 'nov))
(if (eq gnus-fetch-old-headers 'invisible)
(gnus-build-all-threads)
(gnus-build-old-threads)))
+ ;; Let the Gnus agent mark articles as read.
+ (when gnus-agent
+ (gnus-agent-get-undownloaded-list))
+ ;; Remove list identifiers from subject
+ (when gnus-list-identifiers
+ (gnus-summary-remove-list-identifiers))
;; Check whether auto-expire is to be done in this group.
(setq gnus-newsgroup-auto-expire
(gnus-group-auto-expirable-p group))
(or gnus-newsgroup-headers t)))))
(defun gnus-articles-to-read (group &optional read-all)
- ;; Find out what articles the user wants to read.
+ "Find out what articles the user wants to read."
(let* ((articles
;; Select all articles if `read-all' is non-nil, or if there
;; are no unread articles.
(zerop (length gnus-newsgroup-unreads)))
(eq (gnus-group-find-parameter group 'display)
'all))
- (gnus-uncompress-range (gnus-active group))
+ (or
+ (gnus-uncompress-range (gnus-active group))
+ (gnus-cache-articles-in-group group))
(sort (append gnus-newsgroup-dormant gnus-newsgroup-marked
(copy-sequence gnus-newsgroup-unreads))
'<)))
(if (string-match "^[ \t]*$" input)
number input)))
(t number))
- (quit nil))))))
+ (quit
+ (message "Quit getting the articles to read")
+ nil))))))
(setq select (if (stringp select) (string-to-number select) select))
(if (or (null select) (zerop select))
select
(gnus-sorted-intersection
gnus-newsgroup-unreads
(gnus-sorted-complement gnus-newsgroup-unreads articles)))
+ (when gnus-alter-articles-to-read-function
+ (setq gnus-newsgroup-unreads
+ (sort
+ (funcall gnus-alter-articles-to-read-function
+ gnus-newsgroup-name gnus-newsgroup-unreads)
+ '<)))
articles)))
(defun gnus-killed-articles (killed articles)
out))
(defun gnus-adjust-marked-articles (info)
- "Set all article lists and remove all marks that are no longer legal."
+ "Set all article lists and remove all marks that are no longer valid."
(let* ((marked-lists (gnus-info-marks info))
(active (gnus-active (gnus-info-group info)))
(min (car active))
(let ((types gnus-article-mark-lists)
(info (gnus-get-info gnus-newsgroup-name))
(uncompressed '(score bookmark killed))
- type list newmarked symbol)
+ type list newmarked symbol delta-marks)
(when info
- ;; Add all marks lists that are non-nil to the list of marks lists.
+ ;; Add all marks lists to the list of marks lists.
(while (setq type (pop types))
- (when (setq list (symbol-value
- (setq symbol
- (intern (format "gnus-newsgroup-%s"
- (car type))))))
+ (setq list (symbol-value
+ (setq symbol
+ (intern (format "gnus-newsgroup-%s"
+ (car type))))))
+ (when list
;; Get rid of the entries of the articles that have the
;; default score.
(when (and (eq (cdr type) '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
- (set symbol (sort list '<)) t)))
- newmarked)))
-
+ (setq list (cdr all)))))
+
+ (unless (memq (cdr type) uncompressed)
+ (setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))
+
+ (when (gnus-check-backend-function
+ 'request-set-mark gnus-newsgroup-name)
+ ;; propagate flags to server, with the following exceptions:
+ ;; uncompressed:s are not proper flags (they are cons cells)
+ ;; cache is a internal gnus flag
+ ;; download are local to one gnus installation (well)
+ ;; unsend are for nndraft groups only
+ ;; xxx: generality of this? this suits nnimap anyway
+ (unless (memq (cdr type) (append '(cache download unsend)
+ uncompressed))
+ (let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
+ (del (gnus-remove-from-range (gnus-copy-sequence old) list))
+ (add (gnus-remove-from-range
+ (gnus-copy-sequence list) old)))
+ (when add
+ (push (list add 'add (list (cdr type))) delta-marks))
+ (when del
+ (push (list del 'del (list (cdr type))) delta-marks)))))
+
+ (when list
+ (push (cons (cdr type) list) newmarked)))
+
+ (when delta-marks
+ (unless (gnus-check-group gnus-newsgroup-name)
+ (error "Can't open server for %s" gnus-newsgroup-name))
+ (gnus-request-set-mark gnus-newsgroup-name delta-marks))
+
;; Enter these new marks into the info of the group.
(if (nthcdr 3 info)
(setcar (nthcdr 3 info) newmarked)
(setcdr (nthcdr i info) nil)))))))
(defun gnus-set-mode-line (where)
- "This function sets the mode line of the article or summary buffers.
+ "Set the mode line of the article or summary buffers.
If WHERE is `summary', the summary mode line format will be used."
;; Is this mode line one we keep updated?
- (when (memq where gnus-updated-mode-lines)
+ (when (and (memq where gnus-updated-mode-lines)
+ (symbol-value
+ (intern (format "gnus-%s-mode-line-format-spec" where))))
(let (mode-string)
(save-excursion
;; We evaluate this in the summary buffer since these
(let* ((mformat (symbol-value
(intern
(format "gnus-%s-mode-line-format-spec" where))))
- (gnus-tmp-group-name gnus-newsgroup-name)
+ (gnus-tmp-group-name (gnus-group-name-decode
+ gnus-newsgroup-name
+ (gnus-group-name-charset
+ nil
+ gnus-newsgroup-name)))
(gnus-tmp-article-number (or gnus-current-article 0))
(gnus-tmp-unread gnus-newsgroup-unreads)
(gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
;; We might have to chop a bit of the string off...
(when (> (length mode-string) max-len)
(setq mode-string
- (concat (gnus-truncate-string mode-string (- max-len 3))
+ (concat (truncate-string-to-width mode-string (- max-len 3))
"...")))
;; Pad the mode string a bit.
(setq mode-string (format (format "%%-%ds" max-len) mode-string))))
(active (gnus-active group))
ninfo)
(when entry
- ;; First peel off all illegal article numbers.
+ ;; First peel off all invalid article numbers.
(when active
(let ((ids articles)
id first)
;; Then we add the read articles to the range.
(gnus-add-to-range
ninfo (setq articles (sort articles '<))))))
-
+
(defun gnus-group-make-articles-read (group articles)
"Update the info of GROUP to say that ARTICLES are read."
(let* ((num 0)
;; Update the group buffer.
(gnus-group-update-group group t)))))
-(defun gnus-methods-equal-p (m1 m2)
- (let ((m1 (or m1 gnus-select-method))
- (m2 (or m2 gnus-select-method)))
- (or (equal m1 m2)
- (and (eq (car m1) (car m2))
- (or (not (memq 'address (assoc (symbol-name (car m1))
- gnus-valid-select-methods)))
- (equal (nth 1 m1) (nth 1 m2)))))))
-
(defvar gnus-newsgroup-none-id 0)
(defun gnus-get-newsgroup-headers (&optional dependencies force-new)
(or dependencies
(save-excursion (set-buffer gnus-summary-buffer)
gnus-newsgroup-dependencies)))
- headers id id-dep ref-dep end ref)
+ headers id end ref
+ (mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets
+ (save-excursion (condition-case nil
+ (set-buffer gnus-summary-buffer)
+ (error))
+ gnus-newsgroup-ignored-charsets)))
(save-excursion
(set-buffer nntp-server-buffer)
;; Translate all TAB characters into SPACE characters.
(subst-char-in-region (point-min) (point-max) ?\t ? t)
+ (subst-char-in-region (point-min) (point-max) ?\r ? t)
(gnus-run-hooks 'gnus-parse-headers-hook)
(let ((case-fold-search t)
in-reply-to header p lines chars)
(progn
(goto-char p)
(if (search-forward "\nsubject: " nil t)
- (funcall
- gnus-unstructured-field-decoder (nnheader-header-value))
+ (funcall gnus-decode-encoded-word-function
+ (nnheader-header-value))
"(none)"))
;; From.
(progn
(goto-char p)
- (if (search-forward "\nfrom: " nil t)
- (funcall
- gnus-structured-field-decoder (nnheader-header-value))
+ (if (or (search-forward "\nfrom: " nil t)
+ (search-forward "\nfrom:" nil t))
+ (funcall gnus-decode-encoded-word-function
+ (nnheader-header-value))
"(nobody)"))
;; Date.
(progn
(setq ref2 (substring in-reply-to (match-beginning 0)
(match-end 0)))
(when (> (length ref2) (length ref))
- (setq ref ref2))))
+ (setq ref ref2)))
+ ref)
(setq ref nil))))
;; Chars.
(progn
(progn
(goto-char p)
(and (search-forward "\nxref: " nil t)
- (nnheader-header-value)))))
+ (nnheader-header-value)))
+ ;; Extra.
+ (when gnus-extra-headers
+ (let ((extra gnus-extra-headers)
+ out)
+ (while extra
+ (goto-char p)
+ (when (search-forward
+ (concat "\n" (symbol-name (car extra)) ": ") nil t)
+ (push (cons (car extra) (nnheader-header-value))
+ out))
+ (pop extra))
+ out))))
(when (equal id ref)
(setq ref nil))
(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')."
+ "Parse the news overview data in the server buffer.
+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)
+ (let ((mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
+ (cur nntp-server-buffer)
(dependencies (or dependencies gnus-newsgroup-dependencies))
number headers header)
(save-excursion
(set-buffer nntp-server-buffer)
+ (subst-char-in-region (point-min) (point-max) ?\r ? t)
;; Allow the user to mangle the headers before parsing them.
(gnus-run-hooks 'gnus-parse-headers-hook)
(goto-char (point-min))
(save-restriction
(nnheader-narrow-to-headers)
(goto-char (point-min))
- (when (or (and (eq (downcase (following-char)) ?x)
+ (when (or (and (not (eobp))
+ (eq (downcase (char-after)) ?x)
(looking-at "Xref:"))
(search-forward "\nXref:" nil t))
(goto-char (1+ (match-end 0)))
(let* ((line (and (numberp old-header) old-header))
(old-header (and (vectorp old-header) old-header))
(header (cond ((and old-header use-old-header)
- old-header)
- ((and (numberp id)
- (gnus-number-to-header id))
- (gnus-number-to-header id))
- (t
- (gnus-read-header id))))
- (number (and (numberp id) id))
- pos d)
+ old-header)
+ ((and (numberp id)
+ (gnus-number-to-header id))
+ (gnus-number-to-header id))
+ (t
+ (gnus-read-header id))))
+ (number (and (numberp id) id))
+ d)
(when header
;; Rebuild the thread that this article is part of and go to the
;; article we have fetched.
;; Just return the current article.
(list (gnus-summary-article-number))))))
+(defmacro gnus-summary-iterate (arg &rest forms)
+ "Iterate over the process/prefixed articles and do FORMS.
+ARG is the interactive prefix given to the command. FORMS will be
+executed with point over the summary line of the articles."
+ (let ((articles (make-symbol "gnus-summary-iterate-articles")))
+ `(let ((,articles (gnus-summary-work-articles ,arg)))
+ (while ,articles
+ (gnus-summary-goto-subject (car ,articles))
+ ,@forms
+ (pop ,articles)))))
+
+(put 'gnus-summary-iterate 'lisp-indent-function 1)
+(put 'gnus-summary-iterate 'edebug-form-spec '(form body))
+
(defun gnus-summary-save-process-mark ()
"Push the current set of process marked articles on the stack."
(interactive)
displayed, no centering will be performed."
;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
+ (interactive)
(let* ((top (cond ((< (window-height) 4) 0)
((< (window-height) 7) 1)
- (t 2)))
+ (t (if (numberp gnus-auto-center-summary)
+ gnus-auto-center-summary
+ 2))))
(height (1- (window-height)))
(bottom (save-excursion (goto-char (point-max))
(forward-line (- height))
;; Set the window start to either `bottom', which is the biggest
;; possible valid number, or the second line from the top,
;; whichever is the least.
- (set-window-start
- window (min bottom (save-excursion
- (forward-line (- top)) (point)))))
+ (let ((top-pos (save-excursion (forward-line (- top)) (point))))
+ (if (> bottom top-pos)
+ ;; Keep the second line from the top visible
+ (set-window-start window top-pos t)
+ ;; Try to keep the bottom line visible; if it's partially
+ ;; obscured, either scroll one more line to make it fully
+ ;; visible, or revert to using TOP-POS.
+ (save-excursion
+ (goto-char (point-max))
+ (forward-line -1)
+ (let ((last-line-start (point)))
+ (goto-char bottom)
+ (set-window-start window (point) t)
+ (when (not (pos-visible-in-window-p last-line-start window))
+ (forward-line 1)
+ (set-window-start window (min (point) top-pos) t)))))))
;; Do horizontal recentering while we're at it.
(when (and (get-buffer-window (current-buffer) t)
(not (eq gnus-auto-center-summary 'vertical)))
;; If the range of read articles is a single range, then the
;; first unread article is the article after the last read
;; article. Sounds logical, doesn't it?
- (if (not (listp (cdr read)))
- (setq first (1+ (cdr read)))
+ (if (and (not (listp (cdr read)))
+ (or (< (car read) (car active))
+ (progn (setq read (list read))
+ nil)))
+ (setq first (max (car active) (1+ (cdr read))))
;; `read' is a list of ranges.
(when (/= (setq nlast (or (and (numberp (car read)) (car read))
(caar read)))
1)
- (setq first 1))
+ (setq first (car active)))
(while read
(when first
(while (< first nlast)
(key-binding
(read-key-sequence
(substitute-command-keys
- "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"
- ))))
+ "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"))))
'undefined)
(gnus-error 1 "Undefined key")
(save-excursion
(gnus-update-read-articles
group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
;; Set the current article marks.
- (let ((gnus-newsgroup-scored
+ (let ((gnus-newsgroup-scored
(if (and (not gnus-save-score)
(not non-destructive))
nil
(defun gnus-summary-exit (&optional temporary)
"Exit reading current newsgroup, and then return to group selection mode.
-gnus-exit-group-hook is called with no arguments if that value is non-nil."
+`gnus-exit-group-hook' is called with no arguments if that value is non-nil."
(interactive)
(gnus-set-global-variables)
+ (when (gnus-buffer-live-p gnus-article-buffer)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (mm-destroy-parts gnus-article-mime-handles)
+ ;; Set it to nil for safety reason.
+ (setq gnus-article-mime-handle-alist nil)
+ (setq gnus-article-mime-handles nil)))
(gnus-kill-save-kill-buffer)
(gnus-async-halt-prefetch)
(let* ((group gnus-newsgroup-name)
(mode major-mode)
(group-point nil)
(buf (current-buffer)))
+ (unless quit-config
+ ;; Do adaptive scoring, and possibly save score files.
+ (when gnus-newsgroup-adaptive
+ (gnus-score-adaptive))
+ (when gnus-use-scoring
+ (gnus-score-save)))
(gnus-run-hooks 'gnus-summary-prepare-exit-hook)
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-dup-enter-articles))
(when gnus-use-trees
(gnus-tree-close group))
+ (when gnus-use-cache
+ (gnus-cache-write-active))
;; Remove entries for this group.
(nnmail-purge-split-history (gnus-group-real-name group))
;; Make all changes in this group permanent.
(unless quit-config
(gnus-run-hooks 'gnus-exit-group-hook)
- (gnus-summary-update-info)
- ;; Do adaptive scoring, and possibly save score files.
- (when gnus-newsgroup-adaptive
- (gnus-score-adaptive))
- (when gnus-use-scoring
- (gnus-score-save)))
+ (gnus-summary-update-info))
(gnus-close-group group)
;; Make sure where we were, and go to next newsgroup.
(set-buffer gnus-group-buffer)
;; not garbage-collected, it seems. This would the lead to en
;; ever-growing Emacs.
(gnus-summary-clear-local-variables)
+ (let ((gnus-summary-local-variables gnus-newsgroup-variables))
+ (gnus-summary-clear-local-variables))
(when (get-buffer gnus-article-buffer)
(bury-buffer gnus-article-buffer))
;; We clear the global counterparts of the buffer-local
;; variables as well, just to be on the safe side.
(set-buffer gnus-group-buffer)
(gnus-summary-clear-local-variables)
+ (let ((gnus-summary-local-variables gnus-newsgroup-variables))
+ (gnus-summary-clear-local-variables))
;; Return to group mode buffer.
(when (eq mode 'gnus-summary-mode)
(gnus-kill-buffer buf)))
(setq gnus-current-select-method gnus-select-method)
(pop-to-buffer gnus-group-buffer)
- ;; Clear the current group name.
(if (not quit-config)
(progn
(goto-char group-point)
(gnus-configure-windows 'group 'force))
(gnus-handle-ephemeral-exit quit-config))
+ ;; Clear the current group name.
(unless quit-config
(setq gnus-newsgroup-name nil)))))
gnus-expert-user
(gnus-y-or-n-p "Discard changes to this group and exit? "))
(gnus-async-halt-prefetch)
- (gnus-run-hooks 'gnus-summary-prepare-exit-hook)
+ (mapcar 'funcall
+ (delq 'gnus-summary-expire-articles
+ (copy-sequence gnus-summary-prepare-exit-hook)))
+ (when (gnus-buffer-live-p gnus-article-buffer)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (mm-destroy-parts gnus-article-mime-handles)
+ ;; Set it to nil for safety reason.
+ (setq gnus-article-mime-handle-alist nil)
+ (setq gnus-article-mime-handles nil)))
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-article-buffer)
(gnus-deaden-summary)
(gnus-close-group group)
(gnus-summary-clear-local-variables)
+ (let ((gnus-summary-local-variables gnus-newsgroup-variables))
+ (gnus-summary-clear-local-variables))
(set-buffer gnus-group-buffer)
(gnus-summary-clear-local-variables)
+ (let ((gnus-summary-local-variables gnus-newsgroup-variables))
+ (gnus-summary-clear-local-variables))
(when (get-buffer gnus-summary-buffer)
(kill-buffer gnus-summary-buffer)))
(unless gnus-single-article-buffer
(rename-buffer
(concat (substring name 0 (match-beginning 0)) "Dead "
(substring name (match-beginning 0)))
- t))))
+ t)
+ (bury-buffer))))
(defun gnus-kill-or-deaden-summary (buffer)
"Kill or deaden the summary BUFFER."
(defun gnus-summary-describe-briefly ()
"Describe summary mode commands briefly."
(interactive)
- (gnus-message 6
- (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
+ (gnus-message 6 (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
;; Walking around group mode buffer from summary mode.
(if backward
(gnus-summary-find-prev unread)
(gnus-summary-find-next unread)))
- (gnus-summary-show-thread)
- (setq n (1- n)))
+ (unless (zerop (setq n (1- n)))
+ (gnus-summary-show-thread)))
(when (/= 0 n)
(gnus-message 7 "No more%s articles"
(if unread " unread" "")))
(defun gnus-summary-display-article (article &optional all-header)
"Display ARTICLE in article buffer."
+ (when (gnus-buffer-live-p gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
+ (mm-enable-multibyte-mule4)))
(gnus-set-global-variables)
+ (when (gnus-buffer-live-p gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
+ (setq gnus-article-charset gnus-newsgroup-charset)
+ (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets)
+ (mm-enable-multibyte-mule4)))
(if (null article)
nil
(prog1
(set-buffer gnus-summary-buffer))
(let ((article (or article (gnus-summary-article-number)))
(all-headers (not (not all-headers))) ;Must be T or NIL.
- gnus-summary-display-article-function
- did)
+ gnus-summary-display-article-function)
(and (not pseudo)
(gnus-summary-article-pseudo-p article)
(error "This is a pseudo-article"))
- (prog1
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (if (or (and gnus-single-article-buffer
- (or (null gnus-current-article)
- (null gnus-article-current)
- (null (get-buffer gnus-article-buffer))
- (not (eq article (cdr gnus-article-current)))
- (not (equal (car gnus-article-current)
- gnus-newsgroup-name))))
- (and (not gnus-single-article-buffer)
- (or (null gnus-current-article)
- (not (eq gnus-current-article article))))
- force)
- ;; The requested article is different from the current article.
- (prog1
- (gnus-summary-display-article article all-headers)
- (setq did article))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (if (or (and gnus-single-article-buffer
+ (or (null gnus-current-article)
+ (null gnus-article-current)
+ (null (get-buffer gnus-article-buffer))
+ (not (eq article (cdr gnus-article-current)))
+ (not (equal (car gnus-article-current)
+ gnus-newsgroup-name))))
+ (and (not gnus-single-article-buffer)
+ (or (null gnus-current-article)
+ (not (eq gnus-current-article article))))
+ force)
+ ;; The requested article is different from the current article.
+ (progn
+ (gnus-summary-display-article article all-headers)
+ (when (gnus-buffer-live-p gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
+ (if (not gnus-article-decoded-p) ;; a local variable
+ (mm-disable-multibyte-mule4))))
(when (or all-headers gnus-show-all-headers)
(gnus-article-show-all-headers))
- 'old))
- (when did
- (gnus-article-set-window-start
- (cdr (assq article gnus-newsgroup-bookmarks)))))))
+ (gnus-article-set-window-start
+ (cdr (assq article gnus-newsgroup-bookmarks)))
+ article)
+ (when (or all-headers gnus-show-all-headers)
+ (gnus-article-show-all-headers))
+ 'old))))
+
+(defun gnus-summary-force-verify-and-decrypt ()
+ (interactive)
+ (let ((mm-verify-option 'known)
+ (mm-decrypt-option 'known))
+ (gnus-summary-select-article nil 'force)))
(defun gnus-summary-set-current-mark (&optional current-mark)
"Obsolete function."
(gnus-summary-recenter)
(gnus-summary-position-point))
+(defun gnus-summary-scroll-down (lines)
+ "Scroll down (or up) one line current article.
+Argument LINES specifies lines to be scrolled down (or up if negative)."
+ (interactive "p")
+ (gnus-summary-scroll-up (- lines)))
+
(defun gnus-summary-next-same-subject ()
"Select next article which has the same subject as current one."
(interactive)
(gnus-summary-display-article (gnus-summary-article-number)))
(gnus-summary-position-point)))
+(defun gnus-summary-first-unread-subject ()
+ "Place the point on the subject line of the first unread article.
+Return nil if there are no unread articles."
+ (interactive)
+ (prog1
+ (when (gnus-summary-first-subject t)
+ (gnus-summary-show-thread)
+ (gnus-summary-first-subject t))
+ (gnus-summary-position-point)))
+
(defun gnus-summary-first-article ()
"Select the first article.
Return nil if there are no articles."
(interactive)
(prog1
(when (gnus-summary-first-subject)
- (gnus-summary-show-thread)
- (gnus-summary-first-subject)
- (gnus-summary-display-article (gnus-summary-article-number)))
+ (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 ()
"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")
+ (interactive
+ (let ((younger current-prefix-arg)
+ (days-got nil)
+ days)
+ (while (not days-got)
+ (setq days (if younger
+ (read-string "Limit to articles within (in days): ")
+ (read-string "Limit to articles older than (in days): ")))
+ (when (> (length days) 0)
+ (setq days (read days)))
+ (if (numberp days)
+ (setq days-got t)
+ (message "Please enter a number.")
+ (sleep-for 1)))
+ (list days younger)))
(prog1
(let ((data gnus-newsgroup-data)
- (cutoff (nnmail-days-to-time age))
+ (cutoff (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))
+ (setq is-younger (time-less-p
+ (time-since (condition-case ()
+ (date-to-time date)
+ (error '(0 0))))
cutoff))
(when (if younger-p
is-younger
(gnus-summary-limit (nreverse articles)))
(gnus-summary-position-point)))
+(defun gnus-summary-limit-to-extra (header regexp)
+ "Limit the summary buffer to articles that match an 'extra' header."
+ (interactive
+ (let ((header
+ (intern
+ (gnus-completing-read
+ (symbol-name (car gnus-extra-headers))
+ "Limit extra header:"
+ (mapcar (lambda (x)
+ (cons (symbol-name x) x))
+ gnus-extra-headers)
+ nil
+ t))))
+ (list header
+ (read-string (format "Limit to header %s (regexp): " header)))))
+ (when (not (equal "" regexp))
+ (prog1
+ (let ((articles (gnus-summary-find-matching
+ (cons 'extra header) regexp 'all)))
+ (unless articles
+ (error "Found no matches for \"%s\"" regexp))
+ (gnus-summary-limit 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)
'<)
(sort gnus-newsgroup-limit '<)))
article)
- (setq gnus-newsgroup-unreads gnus-newsgroup-limit)
+ (setq gnus-newsgroup-unreads
+ (gnus-intersection gnus-newsgroup-unreads gnus-newsgroup-limit))
(if all
(setq gnus-newsgroup-dormant nil
gnus-newsgroup-marked nil
;; after the current one.
(goto-char (point-max))
(gnus-summary-find-prev))
+ (gnus-set-mode-line 'summary)
;; We return how many articles were removed from the summary
;; buffer as a result of the new limit.
(- total (length gnus-newsgroup-data))))
(defsubst gnus-cut-thread (thread)
"Go forwards in the thread until we find an article that we want to display."
(when (or (eq gnus-fetch-old-headers 'some)
- (eq gnus-fetch-old-headers 'invisible)
+ (eq gnus-fetch-old-headers 'invisible)
+ (numberp gnus-fetch-old-headers)
(eq gnus-build-sparse-threads 'some)
(eq gnus-build-sparse-threads 'more))
;; Deal with old-fetched headers and sparse threads.
"Cut off all uninteresting articles from the beginning of threads."
(when (or (eq gnus-fetch-old-headers 'some)
(eq gnus-fetch-old-headers 'invisible)
+ (numberp gnus-fetch-old-headers)
(eq gnus-build-sparse-threads 'some)
(eq gnus-build-sparse-threads 'more))
(let ((th threads))
(if (or gnus-inhibit-limiting
(and (null gnus-newsgroup-dormant)
(not (eq gnus-fetch-old-headers 'some))
+ (not (numberp gnus-fetch-old-headers))
(not (eq gnus-fetch-old-headers 'invisible))
(null gnus-summary-expunge-below)
(not (eq gnus-build-sparse-threads 'some))
(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)
+ (and (or (eq gnus-fetch-old-headers 'some)
+ (numberp gnus-fetch-old-headers))
(gnus-summary-article-ancient-p number)
(zerop children))
;; If this is "fetch-old-headered" and `invisible', then
(interactive "P")
(let ((id (mail-header-id (gnus-summary-article-header)))
(limit (if limit (prefix-numeric-value limit)
- gnus-refer-thread-limit))
- fmethod root)
+ gnus-refer-thread-limit)))
;; We want to fetch LIMIT *old* headers, but we also have to
;; re-fetch all the headers in the current buffer, because many of
;; them may be undisplayed. So we adjust LIMIT.
(gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name))
(gnus-summary-limit-include-thread id)))
-(defun gnus-summary-refer-article (message-id &optional arg)
- "Fetch an article specified by MESSAGE-ID.
-If ARG (the prefix), fetch the article using `gnus-refer-article-method'
-or `gnus-select-method', no matter what backend the article comes from."
- (interactive "sMessage-ID: \nP")
+(defun gnus-summary-refer-article (message-id)
+ "Fetch an article specified by MESSAGE-ID."
+ (interactive "sMessage-ID: ")
(when (and (stringp message-id)
(not (zerop (length message-id))))
;; Construct the correct Message-ID if necessary.
(mail-header-number header))
(memq (mail-header-number header)
gnus-newsgroup-limit)))
- h)
+ number)
(cond
;; If the article is present in the buffer we just go to it.
((and header
(when sparse
(gnus-summary-update-article (mail-header-number header)))))
(t
- ;; We fetch the article
- (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-news-group-p gnus-newsgroup-name))
- (gnus-check-server gnus-refer-article-method))
- ;; Fetch the header, and display the article.
- (if (setq number (gnus-summary-insert-subject message-id))
+ ;; We fetch the article.
+ (catch 'found
+ (dolist (gnus-override-method (gnus-refer-article-methods))
+ (gnus-check-server gnus-override-method)
+ ;; Fetch the header, and display the article.
+ (when (setq number (gnus-summary-insert-subject message-id))
(gnus-summary-select-article nil nil nil number)
- (gnus-message 3 "Couldn't fetch article %s" message-id))))))))
+ (throw 'found t)))
+ (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
+
+(defun gnus-refer-article-methods ()
+ "Return a list of referrable methods."
+ (cond
+ ;; No method, so we default to current and native.
+ ((null gnus-refer-article-method)
+ (list gnus-current-select-method gnus-select-method))
+ ;; Current.
+ ((eq 'current gnus-refer-article-method)
+ (list gnus-current-select-method))
+ ;; List of select methods.
+ ((not (and (symbolp (car gnus-refer-article-method))
+ (assq (car gnus-refer-article-method) nnoo-definition-alist)))
+ (let (out)
+ (dolist (method gnus-refer-article-method)
+ (push (if (eq 'current method)
+ gnus-current-select-method
+ method)
+ out))
+ (nreverse out)))
+ ;; One single select method.
+ (t
+ (list gnus-refer-article-method))))
(defun gnus-summary-edit-parameters ()
"Edit the group parameters of the current group."
(interactive)
(gnus-group-edit-group gnus-newsgroup-name 'params))
+(defun gnus-summary-customize-parameters ()
+ "Customize the group parameters of the current group."
+ (interactive)
+ (gnus-group-customize gnus-newsgroup-name))
+
(defun gnus-summary-enter-digest-group (&optional force)
"Enter an nndoc group based on the current article.
If FORCE, force a digest interpretation. If not, try
(list (cons 'save-article-group ogroup))))
(case-fold-search t)
(buf (current-buffer))
- dig)
+ dig to-address)
(save-excursion
+ (set-buffer gnus-original-article-buffer)
+ ;; Have the digest group inherit the main mail address of
+ ;; the parent article.
+ (when (setq to-address (or (message-fetch-field "reply-to")
+ (message-fetch-field "from")))
+ (setq params (append
+ (list (cons 'to-address
+ (funcall gnus-decode-encoded-word-function
+ to-address))))))
(setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
(insert-buffer-substring gnus-original-article-buffer)
;; Remove lines that may lead nndoc to misinterpret the
(goto-char (point-min))
(or (search-forward "\n\n" nil t) (point)))
(goto-char (point-min))
- (delete-matching-lines "^\\(Path\\):\\|^From ")
+ (delete-matching-lines "^Path:\\|^From ")
(widen))
(unwind-protect
- (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.
+ (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset)
+ (gnus-newsgroup-ephemeral-ignored-charsets
+ gnus-newsgroup-ignored-charsets))
+ (gnus-group-read-ephemeral-group
+ name `(nndoc ,name (nndoc-address ,(get-buffer dig))
+ (nndoc-article-type
+ ,(if force 'mbox '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.
(gnus-summary-remove-process-mark article)
(when (gnus-summary-display-article article)
(save-excursion
- (nnheader-temp-write nil
+ (with-temp-buffer
(insert-buffer-substring gnus-original-article-buffer)
;; Remove some headers that may lead nndoc to make
;; the wrong guess.
current-prefix-arg))
(if (string-equal regexp "")
(setq regexp (or gnus-last-search-regexp ""))
- (setq gnus-last-search-regexp regexp))
- (if (gnus-summary-search-article regexp backward)
- (gnus-summary-show-thread)
- (error "Search failed: \"%s\"" regexp)))
+ (setq gnus-last-search-regexp regexp)
+ (setq gnus-article-before-search gnus-current-article))
+ ;; Intentionally set gnus-last-article.
+ (setq gnus-last-article gnus-article-before-search)
+ (let ((gnus-last-article gnus-last-article))
+ (if (gnus-summary-search-article regexp backward)
+ (gnus-summary-show-thread)
+ (error "Search failed: \"%s\"" regexp))))
(defun gnus-summary-search-article-backward (regexp)
"Search for an article containing REGEXP backward."
;; We have to require this here to make sure that the following
;; dynamic binding isn't shadowed by autoloading.
(require 'gnus-async)
+ (require 'gnus-art)
(let ((gnus-select-article-hook nil) ;Disable hook.
- (gnus-article-display-hook nil)
+ (gnus-article-prepare-hook nil)
(gnus-mark-article-hook nil) ;Inhibit marking as read.
(gnus-use-article-prefetch nil)
(gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay.
(gnus-use-trees nil) ;Inhibit updating tree buffer.
(sum (current-buffer))
+ (gnus-display-mime-function nil)
(found nil)
point)
(gnus-save-hidden-threads
(gnus-summary-select-article)
(set-buffer gnus-article-buffer)
+ (goto-char (window-point (get-buffer-window (current-buffer))))
(when backward
(forward-line -1))
(while (not found)
(get-buffer-window (current-buffer))
(point))
(forward-line 1)
+ (set-window-point
+ (get-buffer-window (current-buffer))
+ (point))
(set-buffer sum)
(setq point (point)))
;; We didn't find it, so we go to the next article.
(let ((data (if (eq backward 'all) gnus-newsgroup-data
(gnus-data-find-list
(gnus-summary-article-number) (gnus-data-list backward))))
- (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
(case-fold-search (not not-case-fold))
- articles d)
- (unless (fboundp (intern (concat "mail-header-" header)))
- (error "%s is not a valid header" header))
+ articles d func)
+ (if (consp header)
+ (if (eq (car header) 'extra)
+ (setq func
+ `(lambda (h)
+ (or (cdr (assq ',(cdr header) (mail-header-extra h)))
+ "")))
+ (error "%s is an invalid header" header))
+ (unless (fboundp (intern (concat "mail-header-" header)))
+ (error "%s is not a valid header" header))
+ (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h))))
(while data
(setq d (car data))
(and (or (not unread) ; We want all articles...
If N is negative, print the N previous articles. If N is nil and articles
have been marked with the process mark, print these instead.
-If the optional second argument FILENAME is nil, send the image to the
+If the optional first argument FILENAME is nil, send the image to the
printer. If FILENAME is a string, save the PostScript image in a file with
that name. If FILENAME is a number, prompt the user for the name of the file
to save in."
(set-buffer buffer)
(gnus-article-delete-invisible-text)
(let ((ps-left-header
- (list
+ (list
(concat "("
(mail-header-subject gnus-current-headers) ")")
(concat "("
(mail-header-from gnus-current-headers) ")")))
- (ps-right-header
- (list
- "/pagenumberstring load"
+ (ps-right-header
+ (list
+ "/pagenumberstring load"
(concat "("
(mail-header-date gnus-current-headers) ")"))))
(gnus-run-hooks 'gnus-ps-print-hook)
(defun gnus-summary-show-article (&optional arg)
"Force re-fetching of the current article.
-If ARG (the prefix) is non-nil, show the raw article without any
-article massaging functions being run."
+If ARG (the prefix) is a number, show the article with the charset
+defined in `gnus-summary-show-article-charset-alist', or the charset
+inputed.
+If ARG (the prefix) is non-nil and not a number, show the raw article
+without any article massaging functions being run."
(interactive "P")
- (if (not arg)
- ;; Select the article the normal way.
+ (cond
+ ((numberp arg)
+ (let ((gnus-newsgroup-charset
+ (or (cdr (assq arg gnus-summary-show-article-charset-alist))
+ (read-coding-system "Charset: ")))
+ (gnus-newsgroup-ignored-charsets 'gnus-all))
(gnus-summary-select-article nil 'force)
+ (let ((deps gnus-newsgroup-dependencies)
+ head header)
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (save-restriction
+ (message-narrow-to-head)
+ (setq head (buffer-string)))
+ (with-temp-buffer
+ (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 deps t))))))
+ (gnus-data-set-header
+ (gnus-data-find (cdr gnus-article-current))
+ header)
+ (gnus-summary-update-article-line
+ (cdr gnus-article-current) header))))
+ ((not arg)
+ ;; Select the article the normal way.
+ (gnus-summary-select-article nil 'force))
+ (t
+ ;; We have to require this here to make sure that the following
+ ;; dynamic binding isn't shadowed by autoloading.
+ (require 'gnus-async)
+ (require 'gnus-art)
;; Bind the article treatment functions to nil.
(let ((gnus-have-all-headers t)
- gnus-article-display-hook
gnus-article-prepare-hook
- gnus-break-pages
- gnus-show-mime
- gnus-visual)
- (gnus-summary-select-article nil 'force)))
+ gnus-article-decode-hook
+ gnus-display-mime-function
+ gnus-break-pages)
+ ;; Destroy any MIME parts.
+ (when (gnus-buffer-live-p gnus-article-buffer)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (mm-destroy-parts gnus-article-mime-handles)
+ ;; Set it to nil for safety reason.
+ (setq gnus-article-mime-handle-alist nil)
+ (setq gnus-article-mime-handles nil)))
+ (gnus-summary-select-article nil 'force))))
(gnus-summary-goto-subject gnus-current-article)
(gnus-summary-position-point))
(interactive "P")
(save-excursion
(set-buffer gnus-article-buffer)
- (let* ((buffer-read-only nil)
- (inhibit-point-motion-hooks t)
- (hidden (text-property-any
- (goto-char (point-min)) (search-forward "\n\n")
- 'invisible t))
- e)
- (goto-char (point-min))
- (when (search-forward "\n\n" nil t)
- (delete-region (point-min) (1- (point))))
- (goto-char (point-min))
- (save-excursion
- (set-buffer gnus-original-article-buffer)
+ (save-restriction
+ (let* ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t)
+ hidden e)
+ (setq hidden
+ (if (numberp arg)
+ (>= arg 0)
+ (save-restriction
+ (article-narrow-to-head)
+ (gnus-article-hidden-text-p 'headers))))
(goto-char (point-min))
- (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
- (insert-buffer-substring gnus-original-article-buffer 1 e)
- (let ((article-inhibit-hiding t))
- (gnus-run-hooks 'gnus-article-display-hook))
- (when (or (not hidden) (and (numberp arg) (< arg 0)))
- (gnus-article-hide-headers)))))
+ (when (search-forward "\n\n" nil t)
+ (delete-region (point-min) (1- (point))))
+ (goto-char (point-min))
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (goto-char (point-min))
+ (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
+ (insert-buffer-substring gnus-original-article-buffer 1 e)
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (article-decode-encoded-words)
+ (if hidden
+ (let ((gnus-treat-hide-headers nil)
+ (gnus-treat-hide-boring-headers nil))
+ (setq gnus-article-wash-types
+ (delq 'headers gnus-article-wash-types))
+ (gnus-treat-article 'head))
+ (gnus-treat-article 'head)))
+ (gnus-set-mode-line 'article)))))
(defun gnus-summary-show-all-headers ()
"Make all header lines visible."
(interactive)
(gnus-article-show-all-headers))
-(defun gnus-summary-toggle-mime (&optional arg)
- "Toggle MIME processing.
-If ARG is a positive number, turn MIME processing on."
- (interactive "P")
- (setq gnus-show-mime
- (if (null arg) (not gnus-show-mime)
- (> (prefix-numeric-value arg) 0)))
- (gnus-summary-select-article t 'force))
-
(defun gnus-summary-caesar-message (&optional arg)
"Caesar rotate the current article by 13.
The numerical prefix specifies how many places to rotate each letter
For this function to work, both the current newsgroup and the
newsgroup that you want to move to have to support the `request-move'
-and `request-accept' functions."
+and `request-accept' functions.
+
+ACTION can be either `move' (the default), `crosspost' or `copy'."
(interactive "P")
(unless action
(setq action 'move))
'request-replace-article gnus-newsgroup-name)))
(error "The current group does not support article editing")))
(let ((articles (gnus-summary-work-articles n))
- (prefix (gnus-group-real-prefix gnus-newsgroup-name))
+ (prefix (if (gnus-check-backend-function
+ 'request-move-article gnus-newsgroup-name)
+ (gnus-group-real-prefix gnus-newsgroup-name)
+ ""))
(names '((move "Move" "Moving")
(copy "Copy" "Copying")
(crosspost "Crosspost" "Crossposting")))
articles prefix))
(set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
(setq to-method (or select-method
- (gnus-group-name-to-method to-newsgroup)))
+ (gnus-server-to-method
+ (gnus-group-method to-newsgroup))))
;; Check the method we are to move this article to...
(unless (gnus-check-backend-function
'request-accept-article (car to-method))
gnus-newsgroup-name)) ; Server
(list 'gnus-request-accept-article
to-newsgroup (list 'quote select-method)
- (not articles)) ; Accept form
+ (not articles) t) ; Accept form
(not articles))) ; Only save nov last time
;; Copy the article.
((eq action 'copy)
(set-buffer copy-buf)
(when (gnus-request-article-this-buffer article gnus-newsgroup-name)
(gnus-request-accept-article
- to-newsgroup select-method (not articles)))))
+ to-newsgroup select-method (not articles) t))))
;; Crosspost the article.
((eq action 'crosspost)
(let ((xref (message-tokenize-header
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))
+ (gnus-message 1 "Couldn't %s article %s: %s"
+ (cadr (assq action names)) article
+ (nnheader-get-report (car to-method))))
+ ((eq art-group 'junk)
+ (when (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
- (gnus-find-method-for-group to-newsgroup)))
- gnus-newsrc-hashtb)))
+ (let* ((pto-group (gnus-group-prefixed-name
+ (car art-group) to-method))
+ (entry
+ (gnus-gethash pto-group gnus-newsrc-hashtb))
(info (nth 2 entry))
- (to-group (gnus-info-group info)))
+ (to-group (gnus-info-group info))
+ to-marks)
;; Update the group that has been moved to.
(when (and info
(memq action '(move copy)))
(push to-group to-groups))
(unless (memq article gnus-newsgroup-unreads)
+ (push 'read to-marks)
(gnus-info-set-read
info (gnus-add-to-range (gnus-info-read info)
(list (cdr art-group)))))
- ;; Copy any marks over to the new group.
+ ;; See whether the article is to be put in the cache.
(let ((marks gnus-article-mark-lists)
(to-article (cdr art-group)))
- ;; See whether the article is to be put in the cache.
+ ;; Enter the article into the cache in the new group,
+ ;; if that is required.
(when gnus-use-cache
(gnus-cache-possibly-enter-article
to-group to-article
- (let ((header (copy-sequence
- (gnus-summary-article-header article))))
- (mail-header-set-number header to-article)
- header)
(memq article gnus-newsgroup-marked)
(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"
- (caar marks)))))
- ;; If the other group is the same as this group,
- ;; then we have to add the mark to the list.
- (when (equal to-group gnus-newsgroup-name)
- (set (intern (format "gnus-newsgroup-%s" (caar marks)))
- (cons to-article
- (symbol-value
- (intern (format "gnus-newsgroup-%s"
- (caar marks)))))))
- ;; Copy the marks to other group.
- (gnus-add-marked-articles
- to-group (cdar marks) (list to-article) info))
- (setq marks (cdr marks)))
+ (when gnus-preserve-marks
+ ;; Copy any marks over to the new group.
+ (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"
+ (caar marks)))))
+ (push (cdar marks) to-marks)
+ ;; If the other group is the same as this group,
+ ;; then we have to add the mark to the list.
+ (when (equal to-group gnus-newsgroup-name)
+ (set (intern (format "gnus-newsgroup-%s" (caar marks)))
+ (cons to-article
+ (symbol-value
+ (intern (format "gnus-newsgroup-%s"
+ (caar marks)))))))
+ ;; Copy the marks to other group.
+ (gnus-add-marked-articles
+ to-group (cdar marks) (list to-article) info))
+ (setq marks (cdr marks)))
+
+ (gnus-request-set-mark to-group (list (list (list to-article)
+ 'set
+ to-marks))))
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
;;;!!!Why is this necessary?
(set-buffer gnus-summary-buffer)
-
+
(gnus-summary-goto-subject article)
(when (eq action 'move)
(gnus-summary-mark-article article gnus-canceled-mark))))
(defcustom gnus-summary-respool-default-method nil
"Default method for respooling an article.
If nil, use to the current newsgroup method."
- :type `(choice (gnus-select-method :value (nnml ""))
+ :type '(choice (gnus-select-method :value (nnml ""))
(const nil))
:group 'gnus-summary-mail)
(not (file-regular-p file))
(error "Can't read %s" file))
(save-excursion
- (set-buffer (get-buffer-create " *import file*"))
- (buffer-disable-undo (current-buffer))
+ (set-buffer (gnus-get-buffer-create " *import file*"))
(erase-buffer)
- (insert-file-contents file)
+ (nnheader-insert-file-contents file)
(goto-char (point-min))
(unless (nnheader-article-p)
;; This doesn't look like an article, so we fudge some headers.
lines (count-lines (point-min) (point-max)))
(insert "From: " (read-string "From: ") "\n"
"Subject: " (read-string "Subject: ") "\n"
- "Date: " (timezone-make-date-arpa-standard
- (current-time-string (nth 5 atts))
- (current-time-zone now)
- (current-time-zone now))
+ "Date: " (message-make-date (nth 5 atts))
"\n"
"Message-ID: " (message-make-message-id) "\n"
"Lines: " (int-to-string lines) "\n"
(kill-buffer (current-buffer)))))
(defun gnus-summary-article-posted-p ()
- "Say whether the current (mail) article is available from `gnus-select-method' as well.
+ "Say whether the current (mail) article is available from news as well.
This will be the case if the article has both been mailed and posted."
(interactive)
(let ((id (mail-header-references (gnus-summary-article-header)))
- (gnus-override-method
- (or gnus-refer-article-method gnus-select-method)))
+ (gnus-override-method (car (gnus-refer-article-methods))))
(if (gnus-request-head id "")
(gnus-message 2 "The current message was found on %s"
gnus-override-method)
(expiry-wait (if now 'immediate
(gnus-group-find-parameter
gnus-newsgroup-name 'expiry-wait)))
+ (nnmail-expiry-target
+ (or (gnus-group-find-parameter gnus-newsgroup-name 'expiry-target)
+ nnmail-expiry-target))
es)
(when expirable
;; There are expirable articles in this group, so we run them
;; through the expiry process.
(gnus-message 6 "Expiring articles...")
+ (unless (gnus-check-group gnus-newsgroup-name)
+ (error "Can't open server for %s" gnus-newsgroup-name))
;; The list of articles that weren't expired is returned.
(save-excursion
(if expiry-wait
(setq es (gnus-request-expire-articles
expirable gnus-newsgroup-name)))
(setq es (gnus-request-expire-articles
- expirable gnus-newsgroup-name))))
- (unless total
- (setq gnus-newsgroup-expirable es))
- ;; We go through the old list of expirable, and mark all
- ;; really expired articles as nonexistent.
- (unless (eq es expirable) ;If nothing was expired, we don't mark.
- (let ((gnus-use-cache nil))
- (while expirable
- (unless (memq (car expirable) es)
- (when (gnus-data-find (car expirable))
- (gnus-summary-mark-article
- (car expirable) gnus-canceled-mark)))
- (setq expirable (cdr expirable)))))
+ expirable gnus-newsgroup-name)))
+ (unless total
+ (setq gnus-newsgroup-expirable es))
+ ;; We go through the old list of expirable, and mark all
+ ;; really expired articles as nonexistent.
+ (unless (eq es expirable) ;If nothing was expired, we don't mark.
+ (let ((gnus-use-cache nil))
+ (while expirable
+ (unless (memq (car expirable) es)
+ (when (gnus-data-find (car expirable))
+ (gnus-summary-mark-article
+ (car expirable) gnus-canceled-mark)))
+ (setq expirable (cdr expirable))))))
(gnus-message 6 "Expiring articles...done")))))
(defun gnus-summary-expire-articles-now ()
(unless (gnus-check-backend-function 'request-expire-articles
gnus-newsgroup-name)
(error "The current newsgroup does not support article deletion"))
+ (unless (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
+ (error "Couldn't open server"))
;; Compute the list of articles to delete.
(let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<))
not-deleted)
(gnus-set-mode-line 'summary)
not-deleted))
-(defun gnus-summary-edit-article (&optional force)
+(defun gnus-summary-edit-article (&optional arg)
"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
+If ARG is nil, edit the decoded articles.
+If ARG is 1, edit the raw articles.
+If ARG is 2, edit the raw articles even in read-only groups.
+If ARG is 3, edit the articles with the current handles.
+Otherwise, allow editing of articles even in read-only
groups."
(interactive "P")
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-set-global-variables)
- (when (and (not force)
- (gnus-group-read-only-p))
- (error "The current newsgroup does not support article editing"))
- ;; Select article if needed.
- (unless (eq (gnus-summary-article-number)
- gnus-current-article)
- (gnus-summary-select-article t))
- (gnus-article-date-original)
- (gnus-article-edit-article
- `(lambda (no-highlight)
- (gnus-summary-edit-article-done
- ,(or (mail-header-references gnus-current-headers) "")
- ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight)))))
+ (let (force raw current-handles)
+ (cond
+ ((null arg))
+ ((eq arg 1) (setq raw t))
+ ((eq arg 2) (setq raw t
+ force t))
+ ((eq arg 3) (setq current-handles
+ (and (gnus-buffer-live-p gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
+ (prog1
+ gnus-article-mime-handles
+ (setq gnus-article-mime-handles nil))))))
+ (t (setq force t)))
+ (if (and raw (not force) (equal gnus-newsgroup-name "nndraft:drafts"))
+ (error "Can't edit the raw article in group nndraft:drafts."))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (let ((mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets))
+ (gnus-set-global-variables)
+ (when (and (not force)
+ (gnus-group-read-only-p))
+ (error "The current newsgroup does not support article editing"))
+ (gnus-summary-show-article t)
+ (when (and (not raw) (gnus-buffer-live-p gnus-article-buffer))
+ (with-current-buffer gnus-article-buffer
+ (mm-enable-multibyte-mule4)))
+ (if (equal gnus-newsgroup-name "nndraft:drafts")
+ (setq raw t))
+ (gnus-article-edit-article
+ (if raw 'ignore
+ `(lambda ()
+ (let ((mbl mml-buffer-list))
+ (setq mml-buffer-list nil)
+ (mime-to-mml ,'current-handles)
+ (make-local-hook 'kill-buffer-hook)
+ (let ((mbl1 mml-buffer-list))
+ (setq mml-buffer-list mbl)
+ (set (make-local-variable 'mml-buffer-list) mbl1))
+ (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))))
+ `(lambda (no-highlight)
+ (let ((mail-parse-charset ',gnus-newsgroup-charset)
+ (message-options message-options)
+ (message-options-set-recipient)
+ (mail-parse-ignored-charsets
+ ',gnus-newsgroup-ignored-charsets))
+ ,(if (not raw) '(progn
+ (mml-to-mime)
+ (mml-destroy-buffers)
+ (remove-hook 'kill-buffer-hook
+ 'mml-destroy-buffers t)
+ (kill-local-variable 'mml-buffer-list)))
+ (gnus-summary-edit-article-done
+ ,(or (mail-header-references gnus-current-headers) "")
+ ,(gnus-group-read-only-p)
+ ,gnus-summary-buffer no-highlight))))))))
(defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit)
no-highlight)
"Make edits to the current article permanent."
(interactive)
+ (save-excursion
+ ;; The buffer restriction contains the entire article if it exists.
+ (when (article-goto-body)
+ (let ((lines (count-lines (point) (point-max)))
+ (length (- (point-max) (point)))
+ (case-fold-search t)
+ (body (copy-marker (point))))
+ (goto-char (point-min))
+ (when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t)
+ (delete-region (match-beginning 1) (match-end 1))
+ (insert (number-to-string length)))
+ (goto-char (point-min))
+ (when (re-search-forward
+ "^x-content-length:[ \t]\\([0-9]+\\)" body t)
+ (delete-region (match-beginning 1) (match-end 1))
+ (insert (number-to-string length)))
+ (goto-char (point-min))
+ (when (re-search-forward "^lines:[ \t]\\([0-9]+\\)" body t)
+ (delete-region (match-beginning 1) (match-end 1))
+ (insert (number-to-string lines))))))
;; Replace the article.
(let ((buf (current-buffer)))
- (nnheader-temp-write nil
- (insert-buffer buf)
+ (with-temp-buffer
+ (insert-buffer-substring buf)
+
(if (and (not read-only)
(not (gnus-request-replace-article
(cdr gnus-article-current) (car gnus-article-current)
- (current-buffer))))
+ (current-buffer) t)))
(error "Couldn't replace article")
;; Update the summary buffer.
(if (and references
(message-narrow-to-head)
(let ((head (buffer-string))
header)
- (nnheader-temp-write nil
+ (with-temp-buffer
(insert (format "211 %d Article retrieved.\n"
(cdr gnus-article-current)))
(insert head)
(unless no-highlight
(save-excursion
(set-buffer gnus-article-buffer)
- (gnus-run-hooks 'gnus-article-display-hook)
+ ;;;!!! Fix this -- article should be rehighlighted.
+ ;;;(gnus-run-hooks 'gnus-article-display-hook)
(set-buffer gnus-original-article-buffer)
(gnus-request-article
(cdr gnus-article-current)
;;; Respooling
-(defun gnus-summary-respool-query (&optional silent)
+(defun gnus-summary-respool-query (&optional silent trace)
"Query where the respool algorithm would put this article."
(interactive)
(let (gnus-mark-article-hook)
(set-buffer gnus-original-article-buffer)
(save-restriction
(message-narrow-to-head)
- (let ((groups (nnmail-article-group 'identity)))
+ (let ((groups (nnmail-article-group 'identity trace)))
(unless silent
(if groups
(message "This message would go to %s"
(message "This message would go to no groups"))
groups))))))
+(defun gnus-summary-respool-trace ()
+ "Trace where the respool algorithm would put this article.
+Display a buffer showing all fancy splitting patterns which matched."
+ (interactive)
+ (gnus-summary-respool-query nil t))
+
;; Summary marking commands.
(defun gnus-summary-kill-same-subject-and-select (&optional unmark)
"Mark ARTICLE replied and update the summary line."
(push article gnus-newsgroup-replied)
(let ((buffer-read-only nil))
- (when (gnus-summary-goto-subject article)
+ (when (gnus-summary-goto-subject article nil t)
(gnus-summary-update-secondary-mark article))))
(defun gnus-summary-set-bookmark (article)
(delq article gnus-newsgroup-processable)))
(when (gnus-summary-goto-subject article)
(gnus-summary-show-thread)
+ (gnus-summary-goto-subject article)
(gnus-summary-update-secondary-mark article)))
(defun gnus-summary-remove-process-mark (article)
(setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
(when (gnus-summary-goto-subject article)
(gnus-summary-show-thread)
+ (gnus-summary-goto-subject article)
(gnus-summary-update-secondary-mark article)))
(defun gnus-summary-set-saved-mark (article)
"Mark N articles as read forwards.
If N is negative, mark backwards instead. Mark with MARK, ?r by default.
The difference between N and the actual number of articles marked is
-returned."
+returned.
+Iff NO-EXPIRE, auto-expiry will be inhibited."
(interactive "p")
+ (gnus-summary-show-thread)
(let ((backward (< n 0))
(gnus-summary-goto-unread
(and gnus-summary-goto-unread
(setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
;; Check for auto-expiry.
(when (and gnus-newsgroup-auto-expire
- (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
- (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
- (= mark gnus-ancient-mark)
- (= mark gnus-read-mark) (= mark gnus-souped-mark)
- (= mark gnus-duplicate-mark)))
+ (memq mark gnus-auto-expirable-marks))
(setq mark gnus-expirable-mark)
+ ;; Let the backend know about the mark change.
+ (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
(push article gnus-newsgroup-expirable))
;; Set the mark in the buffer.
(gnus-summary-update-mark mark 'unread)
"Mark the current article quickly as unread with MARK."
(let* ((article (gnus-summary-article-number))
(old-mark (gnus-summary-article-mark article)))
+ ;; Allow the backend to change the mark.
+ (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
(if (eq mark old-mark)
t
(if (<= article 0)
(save-excursion
(gnus-cache-possibly-enter-article
gnus-newsgroup-name article
- (gnus-summary-article-header article)
(= mark gnus-ticked-mark)
(= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
"Mark ARTICLE with MARK. MARK can be any character.
Four MARK strings are reserved: `? ' (unread), `?!' (ticked),
`??' (dormant) and `?E' (expirable).
-If MARK is nil, then the default character `?D' is used.
+If MARK is nil, then the default character `?r' is used.
If ARTICLE is nil, then the article on the current line will be
-marked."
+marked.
+Iff NO-EXPIRE, auto-expiry will be inhibited."
;; The mark might be a string.
(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 (gnus-characterp mark)
- (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
- (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
- (= mark gnus-read-mark) (= mark gnus-souped-mark)
- (= mark gnus-duplicate-mark))))
- (setq mark gnus-expirable-mark))
- (let* ((mark (or mark gnus-del-mark))
- (article (or article (gnus-summary-article-number)))
- (old-mark (gnus-summary-article-mark article)))
+ (when (null mark)
+ (setq mark gnus-del-mark))
+ (when (and (not no-expire)
+ gnus-newsgroup-auto-expire
+ (memq mark gnus-auto-expirable-marks))
+ (setq mark gnus-expirable-mark))
+ (let ((article (or article (gnus-summary-article-number)))
+ (old-mark (gnus-summary-article-mark article)))
+ ;; Allow the backend to change the mark.
+ (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
(if (eq mark old-mark)
t
(unless article
(save-excursion
(gnus-cache-possibly-enter-article
gnus-newsgroup-name article
- (gnus-summary-article-header article)
(= mark gnus-ticked-mark)
(= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
(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")
- (incf forward))
- (when (and forward
- (<= (+ forward (point)) (point-max)))
- ;; Go to the right position on the line.
- (goto-char (+ forward (point)))
- ;; Replace the old mark with the new mark.
- (subst-char-in-region (point) (1+ (point)) (following-char) mark)
- ;; Optionally update the marks by some user rule.
- (when (eq type 'unread)
- (gnus-data-set-mark
- (gnus-data-find (gnus-summary-article-number)) mark)
- (gnus-summary-update-line (eq mark gnus-unread-mark))))))
+ (when forward
+ (when (looking-at "\r")
+ (incf forward))
+ (when (<= (+ forward (point)) (point-max))
+ ;; Go to the right position on the line.
+ (goto-char (+ forward (point)))
+ ;; Replace the old mark with the new mark.
+ (subst-char-in-region (point) (1+ (point)) (char-after) mark)
+ ;; Optionally update the marks by some user rule.
+ (when (eq type 'unread)
+ (gnus-data-set-mark
+ (gnus-data-find (gnus-summary-article-number)) mark)
+ (gnus-summary-update-line (eq mark gnus-unread-mark)))))))
(defun gnus-mark-article-as-read (article &optional mark)
"Enter ARTICLE in the pertinent lists and remove it from others."
The difference between N and the actual number of articles marked is
returned."
(interactive "p")
- (gnus-summary-mark-forward n gnus-del-mark t))
+ (gnus-summary-mark-forward n gnus-del-mark gnus-inhibit-user-auto-expire))
(defun gnus-summary-mark-as-read-backward (n)
"Mark the N articles as read backwards.
The difference between N and the actual number of articles marked is
returned."
(interactive "p")
- (gnus-summary-mark-forward (- n) gnus-del-mark t))
+ (gnus-summary-mark-forward
+ (- n) gnus-del-mark gnus-inhibit-user-auto-expire))
(defun gnus-summary-mark-as-read (&optional article mark)
"Mark current article as read.
(gnus-summary-catchup t quietly))
(defun gnus-summary-catchup-and-exit (&optional all quietly)
- "Mark all articles not marked as unread in this newsgroup as read, then exit.
+ "Mark all unread articles in this group as read, then exit.
If prefix argument ALL is non-nil, all articles are marked as read."
(interactive "P")
(when (gnus-summary-catchup all quietly nil 'fast)
(interactive "P")
(gnus-summary-catchup-and-exit t quietly))
-;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
(defun gnus-summary-catchup-and-goto-next-group (&optional all)
"Mark all articles in this group as read and select the next group.
If given a prefix, mark all articles, unread as well as ticked, as
(interactive "P")
(save-excursion
(gnus-summary-catchup all))
- (gnus-summary-next-article t nil nil t))
+ (gnus-summary-next-group))
+
+;;;
+;;; with article
+;;;
+
+(defmacro gnus-with-article (article &rest forms)
+ "Select ARTICLE and perform FORMS in the original article buffer.
+Then replace the article with the result."
+ `(progn
+ ;; We don't want the article to be marked as read.
+ (let (gnus-mark-article-hook)
+ (gnus-summary-select-article t t nil ,article))
+ (set-buffer gnus-original-article-buffer)
+ ,@forms
+ (if (not (gnus-check-backend-function
+ 'request-replace-article (car gnus-article-current)))
+ (gnus-message 5 "Read-only group; not replacing")
+ (unless (gnus-request-replace-article
+ ,article (car gnus-article-current)
+ (current-buffer) t)
+ (error "Couldn't replace article")))
+ ;; The cache and backlog have to be flushed somewhat.
+ (when gnus-keep-backlog
+ (gnus-backlog-remove-article
+ (car gnus-article-current) (cdr gnus-article-current)))
+ (when gnus-use-cache
+ (gnus-cache-update-article
+ (car gnus-article-current) (cdr gnus-article-current)))))
+
+(put 'gnus-with-article 'lisp-indent-function 1)
+(put 'gnus-with-article 'edebug-form-spec '(form body))
;; Thread-based commands.
(gnus-summary-article-header parent-article))))
(unless (and message-id (not (equal message-id "")))
(error "No message-id in desired parent"))
- ;; We don't want the article to be marked as read.
- (let (gnus-mark-article-hook)
- (gnus-summary-select-article t t nil current-article))
- (set-buffer gnus-original-article-buffer)
- (let ((buf (format "%s" (buffer-string))))
- (nnheader-temp-write nil
- (insert buf)
+ (gnus-with-article current-article
+ (save-restriction
(goto-char (point-min))
+ (message-narrow-to-head)
(if (re-search-forward "^References: " nil t)
(progn
(re-search-forward "^[^ \t]" nil t)
(forward-line -1)
(end-of-line)
(insert " " message-id))
- (insert "References: " message-id "\n"))
- (unless (gnus-request-replace-article
- current-article (car gnus-article-current)
- (current-buffer))
- (error "Couldn't replace article"))))
+ (insert "References: " message-id "\n"))))
(set-buffer gnus-summary-buffer)
(gnus-summary-unmark-all-processable)
(gnus-summary-update-article current-article)
(subst-char-in-region start (point) ?\n ?\^M)
(gnus-summary-goto-subject article))
(goto-char start)
- nil)
- ;;(gnus-summary-position-point)
- ))))
+ nil)))))
(defun gnus-summary-go-to-next-thread (&optional previous)
"Go to the same level (or less) next thread.
(defun gnus-summary-sort-by-author (&optional reverse)
"Sort the summary buffer by author name alphabetically.
-If case-fold-search is non-nil, case of letters is ignored.
+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 the summary buffer by subject alphabetically. `Re:'s are ignored.
-If case-fold-search is non-nil, case of letters is 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))
(gnus-summary-sort 'score reverse))
(defun gnus-summary-sort-by-lines (&optional reverse)
- "Sort the summary buffer by article length.
+ "Sort the summary buffer by the number of lines.
Argument REVERSE means reverse order."
(interactive "P")
(gnus-summary-sort 'lines reverse))
+(defun gnus-summary-sort-by-chars (&optional reverse)
+ "Sort the summary buffer by article length.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'chars reverse))
+
(defun gnus-summary-sort (predicate reverse)
"Sort summary buffer by PREDICATE. REVERSE means reverse order."
(let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
(article (intern (format "gnus-article-sort-by-%s" predicate)))
(gnus-thread-sort-functions
- (list
- (if (not reverse)
- thread
- `(lambda (t1 t2)
- (,thread t2 t1)))))
+ (if (not reverse)
+ thread
+ `(lambda (t1 t2)
+ (,thread t2 t1))))
+ (gnus-sort-gathered-threads-function
+ gnus-thread-sort-functions)
(gnus-article-sort-functions
- (list
- (if (not reverse)
- article
- `(lambda (t1 t2)
- (,article t2 t1)))))
+ (if (not reverse)
+ article
+ `(lambda (t1 t2)
+ (,article t2 t1))))
(buffer-read-only)
(gnus-summary-prepare-hook nil))
;; We do the sorting by regenerating the threads.
(save-buffer (save-excursion
(nnheader-set-temp-buffer " *Gnus Save*")))
(num (length articles))
- header article file)
- (while articles
- (setq header (gnus-summary-article-header
- (setq article (pop articles))))
+ header file)
+ (dolist (article articles)
+ (setq header (gnus-summary-article-header article))
(if (not (vectorp header))
;; This is a pseudo-article.
(if (assq 'name header)
"Pipe the current article through PROGRAM."
(interactive "sProgram: ")
(gnus-summary-select-article)
- (let ((mail-header-separator "")
- (art-buf (get-buffer gnus-article-buffer)))
+ (let ((mail-header-separator ""))
(gnus-eval-in-buffer-window gnus-article-buffer
(save-restriction
(widen)
(set-buffer gnus-original-article-buffer)
(save-restriction
(nnheader-narrow-to-headers)
- (while methods
+ (while (and methods (not split-name))
(goto-char (point-min))
(setq method (pop methods))
(setq match (car method))
(save-restriction
(widen)
(setq result (eval match)))))
- (setq split-name (append (cdr method) split-name))
+ (setq split-name (cdr method))
(cond ((stringp result)
(push (expand-file-name
result gnus-article-save-directory)
split-name))
((consp result)
(setq split-name (append result split-name)))))))))
- split-name))
+ (nreverse 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))))
+ (symbol-value group)
+ (gnus-get-function (gnus-find-method-for-group
+ (symbol-name group)) 'request-accept-article t)))
(defun gnus-read-move-group-name (prompt default articles prefix)
"Read a group name."
(mapcar (lambda (el) (list el))
(nreverse split-name))
nil nil nil
- 'gnus-group-history)))))
+ 'gnus-group-history))))
+ (to-method (gnus-server-to-method (gnus-group-method to-newsgroup))))
(when to-newsgroup
(if (or (string= to-newsgroup "")
(string= to-newsgroup prefix))
(unless to-newsgroup
(error "No group name entered"))
(or (gnus-active to-newsgroup)
- (gnus-activate-group to-newsgroup)
+ (gnus-activate-group to-newsgroup nil nil to-method)
(if (gnus-y-or-n-p (format "No such group: %s. Create it? "
to-newsgroup))
- (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
- to-newsgroup)))
+ (or (and (gnus-request-create-group to-newsgroup to-method)
+ (gnus-activate-group
+ to-newsgroup nil nil to-method)
+ (gnus-subscribe-group to-newsgroup))
(error "Couldn't create group %s" to-newsgroup)))
(error "No such group: %s" to-newsgroup)))
to-newsgroup))
+(defun gnus-summary-save-parts (type dir n &optional reverse)
+ "Save parts matching TYPE to DIR.
+If REVERSE, save parts that do not match TYPE."
+ (interactive
+ (list (read-string "Save parts of type: "
+ (or (car gnus-summary-save-parts-type-history)
+ gnus-summary-save-parts-default-mime)
+ 'gnus-summary-save-parts-type-history)
+ (setq gnus-summary-save-parts-last-directory
+ (read-file-name "Save to directory: "
+ gnus-summary-save-parts-last-directory
+ nil t))
+ current-prefix-arg))
+ (gnus-summary-iterate n
+ (let ((gnus-display-mime-function nil)
+ (gnus-inhibit-treatment t))
+ (gnus-summary-select-article))
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let ((handles (or gnus-article-mime-handles
+ (mm-dissect-buffer) (mm-uu-dissect))))
+ (when handles
+ (gnus-summary-save-parts-1 type dir handles reverse)
+ (unless gnus-article-mime-handles ;; Don't destroy this case.
+ (mm-destroy-parts handles)))))))
+
+(defun gnus-summary-save-parts-1 (type dir handle reverse)
+ (if (stringp (car handle))
+ (mapcar (lambda (h) (gnus-summary-save-parts-1 type dir h reverse))
+ (cdr handle))
+ (when (if reverse
+ (not (string-match type (mm-handle-media-type handle)))
+ (string-match type (mm-handle-media-type handle)))
+ (let ((file (expand-file-name
+ (file-name-nondirectory
+ (or
+ (mail-content-type-get
+ (mm-handle-disposition handle) 'filename)
+ (concat gnus-newsgroup-name
+ "." (number-to-string
+ (cdr gnus-article-current)))))
+ dir)))
+ (unless (file-exists-p file)
+ (mm-save-part-to-file handle file))))))
+
;; Summary extract commands
(defun gnus-summary-insert-pseudos (pslist &optional not-view)
(lambda (f)
(if (equal f " ")
f
- (gnus-quote-arg-for-sh-or-csh f)))
+ (mm-quote-arg f)))
files " ")))))
(setq ps (cdr ps)))))
(if (and gnus-view-pseudos (not not-view))
"Read the headers of article ID and enter them into the Gnus system."
(let ((group gnus-newsgroup-name)
(gnus-override-method
- (and (gnus-news-group-p gnus-newsgroup-name)
- gnus-refer-article-method))
+ (or
+ gnus-override-method
+ (and (gnus-news-group-p gnus-newsgroup-name)
+ (car (gnus-refer-article-methods)))))
where)
;; First we check to see whether the header in question is already
;; fetched.
;;;
(defun gnus-highlight-selected-summary ()
+ "Highlight selected article in summary buffer."
;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
- ;; Highlight selected article in summary buffer
(when gnus-summary-selected-face
(save-excursion
(let* ((beg (progn (beginning-of-line) (point)))
(setq unread (cdr unread)))
(when (<= prev (cdr active))
(push (cons prev (cdr active)) read))
+ (setq read (if (> (length read) 1) (nreverse read) read))
(if compute
- (if (> (length read) 1) (nreverse read) read)
+ read
(save-excursion
- (set-buffer gnus-group-buffer)
- (gnus-undo-register
- `(progn
- (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
- (gnus-info-set-read ',info ',(gnus-info-read info))
- (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
- (gnus-group-update-group ,group t))))
+ (let (setmarkundo)
+ ;; Propagate the read marks to the backend.
+ (when (gnus-check-backend-function 'request-set-mark group)
+ (let ((del (gnus-remove-from-range (gnus-info-read info) read))
+ (add (gnus-remove-from-range read (gnus-info-read info))))
+ (when (or add del)
+ (unless (gnus-check-group group)
+ (error "Can't open server for %s" group))
+ (gnus-request-set-mark
+ group (delq nil (list (if add (list add 'add '(read)))
+ (if del (list del 'del '(read))))))
+ (setq setmarkundo
+ `(gnus-request-set-mark
+ ,group
+ ',(delq nil (list
+ (if del (list del 'add '(read)))
+ (if add (list add 'del '(read))))))))))
+ (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)
+ ,setmarkundo))))
;; Enter this list into the group info.
- (gnus-info-set-read
- info (if (> (length read) 1) (nreverse read) read))
+ (gnus-info-set-read info read)
;; Set the number of unread articles in gnus-newsrc-hashtb.
(gnus-get-unread-articles-in-group info (gnus-active group))
t))))
(gnus-summary-exit))
buffers)))))
+(defun gnus-summary-setup-default-charset ()
+ "Setup newsgroup default charset."
+ (if (equal gnus-newsgroup-name "nndraft:drafts")
+ (setq gnus-newsgroup-charset nil)
+ (let* ((name (and gnus-newsgroup-name
+ (gnus-group-real-name gnus-newsgroup-name)))
+ (ignored-charsets
+ (or gnus-newsgroup-ephemeral-ignored-charsets
+ (append
+ (and gnus-newsgroup-name
+ (or (gnus-group-find-parameter gnus-newsgroup-name
+ 'ignored-charsets t)
+ (let ((alist gnus-group-ignored-charsets-alist)
+ elem (charsets nil))
+ (while (setq elem (pop alist))
+ (when (and name
+ (string-match (car elem) name))
+ (setq alist nil
+ charsets (cdr elem))))
+ charsets)))
+ gnus-newsgroup-ignored-charsets))))
+ (setq gnus-newsgroup-charset
+ (or gnus-newsgroup-ephemeral-charset
+ (and gnus-newsgroup-name
+ (or (gnus-group-find-parameter gnus-newsgroup-name 'charset)
+ (let ((alist gnus-group-charset-alist)
+ elem charset)
+ (while (setq elem (pop alist))
+ (when (and name
+ (string-match (car elem) name))
+ (setq alist nil
+ charset (cadr elem))))
+ charset)))
+ gnus-default-charset))
+ (set (make-local-variable 'gnus-newsgroup-ignored-charsets)
+ ignored-charsets))))
+
+;;;
+;;; Mime Commands
+;;;
+
+(defun gnus-summary-display-buttonized (&optional show-all-parts)
+ "Display the current article buffer fully MIME-buttonized.
+If SHOW-ALL-PARTS (the prefix) is non-nil, all multipart/* parts are
+treated as multipart/mixed."
+ (interactive "P")
+ (require 'gnus-art)
+ (let ((gnus-unbuttonized-mime-types nil)
+ (gnus-mime-display-multipart-as-mixed show-all-parts))
+ (gnus-summary-show-article)))
+
+(defun gnus-summary-repair-multipart (article)
+ "Add a Content-Type header to a multipart article without one."
+ (interactive (list (gnus-summary-article-number)))
+ (gnus-with-article article
+ (message-narrow-to-head)
+ (message-remove-header "Mime-Version")
+ (goto-char (point-max))
+ (insert "Mime-Version: 1.0\n")
+ (widen)
+ (when (search-forward "\n--" nil t)
+ (let ((separator (buffer-substring (point) (gnus-point-at-eol))))
+ (message-narrow-to-head)
+ (message-remove-header "Content-Type")
+ (goto-char (point-max))
+ (insert (format "Content-Type: multipart/mixed; boundary=\"%s\"\n"
+ separator))
+ (widen))))
+ (let (gnus-mark-article-hook)
+ (gnus-summary-select-article t t nil article)))
+
+(defun gnus-summary-toggle-display-buttonized ()
+ "Toggle the buttonizing of the article buffer."
+ (interactive)
+ (require 'gnus-art)
+ (if (setq gnus-inhibit-mime-unbuttonizing
+ (not gnus-inhibit-mime-unbuttonizing))
+ (let ((gnus-unbuttonized-mime-types nil))
+ (gnus-summary-show-article))
+ (gnus-summary-show-article)))
+
+;;;
+;;; Generic summary marking commands
+;;;
+
+(defvar gnus-summary-marking-alist
+ '((read gnus-del-mark "d")
+ (unread gnus-unread-mark "u")
+ (ticked gnus-ticked-mark "!")
+ (dormant gnus-dormant-mark "?")
+ (expirable gnus-expirable-mark "e"))
+ "An alist of names/marks/keystrokes.")
+
+(defvar gnus-summary-generic-mark-map (make-sparse-keymap))
+(defvar gnus-summary-mark-map)
+
+(defun gnus-summary-make-all-marking-commands ()
+ (define-key gnus-summary-mark-map "M" gnus-summary-generic-mark-map)
+ (dolist (elem gnus-summary-marking-alist)
+ (apply 'gnus-summary-make-marking-command elem)))
+
+(defun gnus-summary-make-marking-command (name mark keystroke)
+ (let ((map (make-sparse-keymap)))
+ (define-key gnus-summary-generic-mark-map keystroke map)
+ (dolist (lway `((next "next" next nil "n")
+ (next-unread "next unread" next t "N")
+ (prev "previous" prev nil "p")
+ (prev-unread "previous unread" prev t "P")
+ (nomove "" nil nil ,keystroke)))
+ (let ((func (gnus-summary-make-marking-command-1
+ mark (car lway) lway name)))
+ (setq func (eval func))
+ (define-key map (nth 4 lway) func)))))
+
+(defun gnus-summary-make-marking-command-1 (mark way lway name)
+ `(defun ,(intern
+ (format "gnus-summary-put-mark-as-%s%s"
+ name (if (eq way 'nomove)
+ ""
+ (concat "-" (symbol-name way)))))
+ (n)
+ ,(format
+ "Mark the current article as %s%s.
+If N, the prefix, then repeat N times.
+If N is negative, move in reverse order.
+The difference between N and the actual number of articles marked is
+returned."
+ name (cadr lway))
+ (interactive "p")
+ (gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway))))
+
+(defun gnus-summary-generic-mark (n mark move unread)
+ "Mark N articles with MARK."
+ (unless (eq major-mode 'gnus-summary-mode)
+ (error "This command can only be used in the summary buffer"))
+ (gnus-summary-show-thread)
+ (let ((nummove
+ (cond
+ ((eq move 'next) 1)
+ ((eq move 'prev) -1)
+ (t 0))))
+ (if (zerop nummove)
+ (setq n 1)
+ (when (< n 0)
+ (setq n (abs n)
+ nummove (* -1 nummove))))
+ (while (and (> n 0)
+ (gnus-summary-mark-article nil mark)
+ (zerop (gnus-summary-next-subject nummove unread t)))
+ (setq n (1- n)))
+ (when (/= 0 n)
+ (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
+ (gnus-summary-recenter)
+ (gnus-summary-position-point)
+ (gnus-set-mode-line 'summary)
+ n))
+
+(gnus-summary-make-all-marking-commands)
+
(gnus-ems-redefine)
(provide 'gnus-sum)