X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=9a8a28c86b76995b0c6fe45edb786adf433d99c8;hb=9b2fb1b90d4ff43730e19ffbfd10f5f91f98a2e9;hp=439d814173a970207459df61869ab9b3245662cd;hpb=1fe5dcd40dc84880069ffc178924e6d1ae809bea;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 439d814..9a8a28c 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1,7 +1,7 @@ ;;; gnus-sum.el --- summary mode commands for Gnus -;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. +;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen +;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. @@ -33,6 +33,8 @@ (require 'gnus-range) (require 'gnus-int) (require 'gnus-undo) +(require 'gnus-util) +(require 'mm-decode) (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t) (defcustom gnus-kill-summary-on-exit t @@ -122,9 +124,12 @@ comparing subjects." (defcustom gnus-simplify-subject-functions nil "List of functions taking a string argument that simplify subjects. -The functions are applied recursively." +The functions are applied recursively. + +Useful functions to put in this list include: `gnus-simplify-subject-re', +`gnus-simplify-subject-fuzzy' and `gnus-simplify-whitespace'." :group 'gnus-thread - :type '(repeat (list function))) + :type '(repeat function)) (defcustom gnus-simplify-ignored-prefixes nil "*Regexp, matches for which are removed from subject lines when simplifying fuzzily." @@ -214,10 +219,10 @@ to expose hidden threads." :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) @@ -248,8 +253,12 @@ equal will be included." (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 @@ -257,7 +266,10 @@ 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. @@ -278,7 +290,9 @@ will go to the next group without confirmation." (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) @@ -296,6 +310,7 @@ and non-`vertical', do both horizontal and vertical recentering." :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 @@ -308,7 +323,7 @@ and non-`vertical', do both horizontal and vertical recentering." "*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." @@ -322,13 +337,6 @@ variable." :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." @@ -337,7 +345,7 @@ It uses the same syntax as the `gnus-split-methods' variable." (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) @@ -452,7 +460,7 @@ It uses the same syntax as the `gnus-split-methods' variable." :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) @@ -467,6 +475,19 @@ It uses the same syntax as the `gnus-split-methods' variable." :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." + :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." + :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 @@ -498,7 +519,7 @@ with some simple extensions. :group 'gnus-threading :type 'string) -(defcustom gnus-summary-mode-line-format "Gnus: %%b [%A] %Z" +(defcustom gnus-summary-mode-line-format "Gnus: %g [%A] %Z" "*The format specification for the summary mode line. It works along the same lines as a normal formatting string, with some simple extensions: @@ -506,6 +527,7 @@ with some simple extensions: %G Group name %p Unprefixed group name %A Current article number +%z Current article score %V Gnus version %U Number of unread articles in the group %e Number of unselected articles in the group @@ -584,7 +606,7 @@ See `gnus-thread-score-function' for en explanation of what a \"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)) @@ -656,18 +678,7 @@ is not run if `gnus-visual' is nil." :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) @@ -772,10 +783,49 @@ mark: The articles mark." The function is called with one parameter, the article header vector, which it may alter in any way.") +(defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string + "Variable that says which function should be used to decode a string with encoded words.") + +(defcustom gnus-extra-headers nil + "*Extra headers to parse." + :group 'gnus-summary + :type '(repeat symbol)) + +(defcustom gnus-ignored-from-addresses + (and user-mail-address (regexp-quote user-mail-address)) + "*Regexp of From headers that may be suppressed in favor of To headers." + :group 'gnus-summary + :type 'regexp) + +(defcustom gnus-group-charset-alist + '(("^hk\\>\\|^tw\\>\\|\\" cn-big5) + ("^cn\\>\\|\\" cn-gb-2312) + ("^fj\\>\\|^japan\\>" iso-2022-jp-2) + ("^relcom\\>" koi8-r) + ("^\\(cz\\|hun\\|pl\\|sk\\)\\>" iso-8859-2) + ("^israel\\>" iso-8859-1) + ("^han\\>" euc-kr) + ("^\\(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) + "List of charsets that should be ignored. +When these charsets are used in the \"charset\" parameter, the +default charset will be used instead." + :type '(repeat symbol) + :group 'gnus-charset) + ;;; Internal variables +(defvar gnus-article-mime-handles nil) +(defvar gnus-article-decoded-p nil) (defvar gnus-scores-exclude-files nil) (defvar gnus-page-broken nil) +(defvar gnus-inhibit-mime-unbuttonizing nil) (defvar gnus-original-article nil) (defvar gnus-article-internal-prepare-hook nil) @@ -813,7 +863,7 @@ which it may alter in any way.") (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s) (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s) (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s) - (?o (gnus-date-iso8601 gnus-tmp-header) ?s) + (?o (gnus-date-iso8601 (mail-header-date gnus-tmp-header)) ?s) (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s) (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s) (?c (or (mail-header-chars gnus-tmp-header) 0) ?d) @@ -830,6 +880,7 @@ which it may alter in any way.") (?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) @@ -861,6 +912,7 @@ variable (string, integer, character, etc).") (?d (length gnus-newsgroup-dormant) ?d) (?t (length gnus-newsgroup-marked) ?d) (?r (length gnus-newsgroup-reads) ?d) + (?z (gnus-summary-article-score gnus-tmp-article-number) ?d) (?E gnus-newsgroup-expunged-tally ?d) (?s (gnus-current-score-file-nondirectory) ?s))) @@ -955,6 +1007,7 @@ variable (string, integer, character, etc).") (defvar gnus-have-all-headers nil) (defvar gnus-last-article nil) (defvar gnus-newsgroup-history nil) +(defvar gnus-newsgroup-charset nil) (defconst gnus-summary-local-variables '(gnus-newsgroup-name @@ -986,12 +1039,52 @@ variable (string, integer, character, etc).") (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.") ;; Byte-compiler warning. (defvar gnus-article-mode-map) +;; MIME stuff. + +(defvar gnus-decode-encoded-word-methods + '(mail-decode-encoded-word-string) + "List of methods used to decode encoded words. + +This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is +FUNCTION, FUNCTION will be apply to all newsgroups. If item is a +(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups +whose names match REGEXP. + +For example: +((\"chinese\" . gnus-decode-encoded-word-string-by-guess) + mail-decode-encoded-word-string + (\"chinese\" . rfc1843-decode-string)) +") + +(defvar gnus-decode-encoded-word-methods-cache nil) + +(defun gnus-multi-decode-encoded-word-string (string) + "Apply the functions from `gnus-encoded-word-methods' that match." + (unless (and gnus-decode-encoded-word-methods-cache + (eq gnus-newsgroup-name + (car gnus-decode-encoded-word-methods-cache))) + (setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name)) + (mapc '(lambda (x) + (if (symbolp x) + (nconc gnus-decode-encoded-word-methods-cache (list x)) + (if (and gnus-newsgroup-name + (string-match (car x) gnus-newsgroup-name)) + (nconc gnus-decode-encoded-word-methods-cache + (list (cdr x)))))) + gnus-decode-encoded-word-methods)) + (let ((xlist gnus-decode-encoded-word-methods-cache)) + (pop xlist) + (while xlist + (setq string (funcall (pop xlist) string)))) + string) + ;; Subject simplification. (defun gnus-simplify-whitespace (str) @@ -1134,6 +1227,7 @@ increase the score of each group you read." [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 @@ -1181,6 +1275,7 @@ increase the score of each group you read." "\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 @@ -1190,7 +1285,6 @@ increase the score of each group you read." "\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 @@ -1212,13 +1306,14 @@ increase the score of each group you read." "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-g" gnus-summary-customize-parameters "\C-c\C-b" gnus-bug "*" gnus-cache-enter-article "\M-*" gnus-cache-remove-article @@ -1228,7 +1323,10 @@ increase the score of each group you read." "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) @@ -1270,6 +1368,7 @@ increase the score of each group you read." "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 @@ -1339,6 +1438,7 @@ increase the score of each group you 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 @@ -1357,6 +1457,8 @@ increase the score of each group you read." "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 "f" gnus-article-display-x-face @@ -1364,7 +1466,6 @@ increase the score of each group you read." "r" gnus-summary-caesar-message "t" gnus-article-hide-headers "v" gnus-summary-verbose-headers - "m" gnus-summary-toggle-mime "h" gnus-article-treat-html "d" gnus-article-treat-dumbquotes) @@ -1374,7 +1475,9 @@ increase the score of each group you read." "b" gnus-article-hide-boring-headers "s" gnus-article-hide-signature "c" gnus-article-hide-citation + "C" gnus-article-hide-citation-in-followups "p" gnus-article-hide-pgp + "B" gnus-article-strip-banner "P" gnus-article-hide-pem "\C-c" gnus-article-hide-citation-maybe) @@ -1384,6 +1487,12 @@ increase the score of each group you read." "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 @@ -1399,7 +1508,8 @@ increase the score of each group you read." "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 @@ -1419,6 +1529,7 @@ increase the score of each group you read." "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) @@ -1432,7 +1543,18 @@ increase the score of each group you read." "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 + "e" gnus-article-externalize-part + "i" gnus-article-inline-part + "|" gnus-article-pipe-part) + ) (defun gnus-summary-make-menu-bar () (gnus-turn-off-edit-menu 'summary) @@ -1467,212 +1589,120 @@ increase the score of each group you read." ["Increase score..." gnus-summary-increase-score t] ["Lower score..." gnus-summary-lower-score t])))) - '(("Default header" - ["Ask" (gnus-score-set-default 'gnus-score-default-header nil) - :style radio - :selected (null gnus-score-default-header)] - ["From" (gnus-score-set-default 'gnus-score-default-header 'a) - :style radio - :selected (eq gnus-score-default-header 'a)] - ["Subject" (gnus-score-set-default 'gnus-score-default-header 's) - :style radio - :selected (eq gnus-score-default-header 's)] - ["Article body" - (gnus-score-set-default 'gnus-score-default-header 'b) - :style radio - :selected (eq gnus-score-default-header 'b )] - ["All headers" - (gnus-score-set-default 'gnus-score-default-header 'h) - :style radio - :selected (eq gnus-score-default-header 'h )] - ["Message-ID" (gnus-score-set-default 'gnus-score-default-header 'i) - :style radio - :selected (eq gnus-score-default-header 'i )] - ["Thread" (gnus-score-set-default 'gnus-score-default-header 't) - :style radio - :selected (eq gnus-score-default-header 't )] - ["Crossposting" - (gnus-score-set-default 'gnus-score-default-header 'x) - :style radio - :selected (eq gnus-score-default-header 'x )] - ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l) - :style radio - :selected (eq gnus-score-default-header 'l )] - ["Date" (gnus-score-set-default 'gnus-score-default-header 'd) - :style radio - :selected (eq gnus-score-default-header 'd )] - ["Followups to author" - (gnus-score-set-default 'gnus-score-default-header 'f) - :style radio - :selected (eq gnus-score-default-header 'f )]) - ("Default type" - ["Ask" (gnus-score-set-default 'gnus-score-default-type nil) - :style radio - :selected (null gnus-score-default-type)] - ;; The `:active' key is commented out in the following, - ;; because the GNU Emacs hack to support radio buttons use - ;; active to indicate which button is selected. - ["Substring" (gnus-score-set-default 'gnus-score-default-type 's) - :style radio - ;; :active (not (memq gnus-score-default-header '(l d))) - :selected (eq gnus-score-default-type 's)] - ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r) - :style radio - ;; :active (not (memq gnus-score-default-header '(l d))) - :selected (eq gnus-score-default-type 'r)] - ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e) - :style radio - ;; :active (not (memq gnus-score-default-header '(l d))) - :selected (eq gnus-score-default-type 'e)] - ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f) - :style radio - ;; :active (not (memq gnus-score-default-header '(l d))) - :selected (eq gnus-score-default-type 'f)] - ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b) - :style radio - ;; :active (eq (gnus-score-default-header 'd)) - :selected (eq gnus-score-default-type 'b)] - ["At date" (gnus-score-set-default 'gnus-score-default-type 'n) - :style radio - ;; :active (eq (gnus-score-default-header 'd)) - :selected (eq gnus-score-default-type 'n)] - ["After date" (gnus-score-set-default 'gnus-score-default-type 'a) - :style radio - ;; :active (eq (gnus-score-default-header 'd)) - :selected (eq gnus-score-default-type 'a)] - ["Less than number" - (gnus-score-set-default 'gnus-score-default-type '<) - :style radio - ;; :active (eq (gnus-score-default-header 'l)) - :selected (eq gnus-score-default-type '<)] - ["Equal to number" - (gnus-score-set-default 'gnus-score-default-type '=) - :style radio - ;; :active (eq (gnus-score-default-header 'l)) - :selected (eq gnus-score-default-type '=)] - ["Greater than number" - (gnus-score-set-default 'gnus-score-default-type '>) - :style radio - ;; :active (eq (gnus-score-default-header 'l)) - :selected (eq gnus-score-default-type '>)]) - ["Default fold" gnus-score-default-fold-toggle - :style toggle - :selected gnus-score-default-fold] - ("Default duration" - ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil) - :style radio - :selected (null gnus-score-default-duration)] - ["Permanent" - (gnus-score-set-default 'gnus-score-default-duration 'p) - :style radio - :selected (eq gnus-score-default-duration 'p)] - ["Temporary" - (gnus-score-set-default 'gnus-score-default-duration 't) - :style radio - :selected (eq gnus-score-default-duration 't)] - ["Immediate" - (gnus-score-set-default 'gnus-score-default-duration 'i) - :style radio - :selected (eq gnus-score-default-duration 'i)])) - - (easy-menu-define - gnus-summary-article-menu gnus-summary-mode-map "" - '("Article" - ("Hide" - ["All" gnus-article-hide t] - ["Headers" gnus-article-hide-headers t] - ["Signature" gnus-article-hide-signature t] - ["Citation" gnus-article-hide-citation t] - ["PGP" gnus-article-hide-pgp 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]) - ("Date" - ["Local" gnus-article-date-local t] - ["ISO8601" gnus-article-date-iso8601 t] - ["UT" gnus-article-date-ut t] - ["Original" gnus-article-date-original t] - ["Lapsed" gnus-article-date-lapsed t] - ["User-defined" gnus-article-date-user t]) - ("Washing" - ("Remove Blanks" - ["Leading" gnus-article-strip-leading-blank-lines t] - ["Multiple" gnus-article-strip-multiple-blank-lines t] - ["Trailing" gnus-article-remove-trailing-blank-lines t] - ["All of the above" gnus-article-strip-blank-lines t] - ["All" gnus-article-strip-all-blank-lines t] - ["Leading space" gnus-article-strip-leading-space t]) - ["Overstrike" gnus-article-treat-overstrike t] - ["Dumb quotes" gnus-article-treat-dumbquotes t] - ["Emphasis" gnus-article-emphasize t] - ["Word wrap" gnus-article-fill-cited-article t] - ["CR" gnus-article-remove-cr t] - ["Show X-Face" gnus-article-display-x-face t] - ["Quoted-Printable" gnus-article-de-quoted-unreadable t] - ["UnHTMLize" gnus-article-treat-html t] - ["Rot 13" gnus-summary-caesar-message t] - ["Unix pipe" gnus-summary-pipe-message t] - ["Add buttons" gnus-article-add-buttons t] - ["Add buttons to head" gnus-article-add-buttons-to-head t] - ["Stop page breaking" gnus-summary-stop-page-breaking t] - ["Toggle MIME" gnus-summary-toggle-mime t] - ["Verbose header" gnus-summary-verbose-headers t] - ["Toggle header" gnus-summary-toggle-header t]) - ("Output" - ["Save in default format" gnus-summary-save-article t] - ["Save in file" gnus-summary-save-article-file t] - ["Save in Unix mail format" gnus-summary-save-article-mail t] - ["Save in MH folder" gnus-summary-save-article-folder t] - ["Save in VM folder" gnus-summary-save-article-vm t] - ["Save in RMAIL mbox" gnus-summary-save-article-rmail t] - ["Save body in file" gnus-summary-save-article-body-file t] - ["Pipe through a filter" gnus-summary-pipe-output t] - ["Add to SOUP packet" gnus-soup-add-article t] - ["Print" gnus-summary-print-article t]) - ("Backend" - ["Respool article..." gnus-summary-respool-article t] - ["Move article..." gnus-summary-move-article - (gnus-check-backend-function - 'request-move-article gnus-newsgroup-name)] - ["Copy article..." gnus-summary-copy-article t] - ["Crosspost article..." gnus-summary-crosspost-article - (gnus-check-backend-function - 'request-replace-article gnus-newsgroup-name)] - ["Import file..." gnus-summary-import-article t] - ["Check if posted" gnus-summary-article-posted-p t] - ["Edit article" gnus-summary-edit-article - (not (gnus-group-read-only-p))] - ["Delete article" gnus-summary-delete-article - (gnus-check-backend-function - 'request-expire-articles gnus-newsgroup-name)] - ["Query respool" gnus-summary-respool-query 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 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] - ["Save" gnus-uu-decode-save t] - ["Binhex" gnus-uu-decode-binhex t] - ["Postscript" gnus-uu-decode-postscript t]) - ("Cache" - ["Enter article" gnus-cache-enter-article t] - ["Remove article" gnus-cache-remove-article t]) - ["Select article buffer" gnus-summary-select-article-buffer t] - ["Enter digest buffer" gnus-summary-enter-digest-group t] - ["Isearch article..." gnus-summary-isearch-article t] - ["Beginning of the article" gnus-summary-beginning-of-article t] - ["End of the article" gnus-summary-end-of-article t] - ["Fetch parent of article" gnus-summary-refer-parent-article t] - ["Fetch referenced articles" gnus-summary-refer-references t] - ["Fetch current thread" gnus-summary-refer-thread t] - ["Fetch article with id..." gnus-summary-refer-article t] - ["Redisplay" gnus-summary-show-article t])) + ;; Define both the Article menu in the summary buffer and the equivalent + ;; Commands menu in the article buffer here for consistency. + (let ((innards + '(("Hide" + ["All" gnus-article-hide t] + ["Headers" gnus-article-hide-headers t] + ["Signature" gnus-article-hide-signature t] + ["Citation" gnus-article-hide-citation 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] + ["View all" gnus-mime-view-all-parts t]) + ("Date" + ["Local" gnus-article-date-local t] + ["ISO8601" gnus-article-date-iso8601 t] + ["UT" gnus-article-date-ut t] + ["Original" gnus-article-date-original t] + ["Lapsed" gnus-article-date-lapsed t] + ["User-defined" gnus-article-date-user t]) + ("Washing" + ("Remove Blanks" + ["Leading" gnus-article-strip-leading-blank-lines t] + ["Multiple" gnus-article-strip-multiple-blank-lines t] + ["Trailing" gnus-article-remove-trailing-blank-lines t] + ["All of the above" gnus-article-strip-blank-lines t] + ["All" gnus-article-strip-all-blank-lines 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] + ["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] + ["Verbose header" gnus-summary-verbose-headers t] + ["Toggle header" gnus-summary-toggle-header t]) + ("Output" + ["Save in default format" gnus-summary-save-article t] + ["Save in file" gnus-summary-save-article-file t] + ["Save in Unix mail format" gnus-summary-save-article-mail t] + ["Save in MH folder" gnus-summary-save-article-folder t] + ["Save in VM folder" gnus-summary-save-article-vm t] + ["Save in RMAIL mbox" gnus-summary-save-article-rmail t] + ["Save body in file" gnus-summary-save-article-body-file t] + ["Pipe through a filter" gnus-summary-pipe-output t] + ["Add to SOUP packet" gnus-soup-add-article t] + ["Print" gnus-summary-print-article t]) + ("Backend" + ["Respool article..." gnus-summary-respool-article t] + ["Move article..." gnus-summary-move-article + (gnus-check-backend-function + 'request-move-article gnus-newsgroup-name)] + ["Copy article..." gnus-summary-copy-article t] + ["Crosspost article..." gnus-summary-crosspost-article + (gnus-check-backend-function + 'request-replace-article gnus-newsgroup-name)] + ["Import file..." gnus-summary-import-article t] + ["Check if posted" gnus-summary-article-posted-p t] + ["Edit article" gnus-summary-edit-article + (not (gnus-group-read-only-p))] + ["Delete article" gnus-summary-delete-article + (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 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] + ["Save" gnus-uu-decode-save t] + ["Binhex" gnus-uu-decode-binhex t] + ["Postscript" gnus-uu-decode-postscript t]) + ("Cache" + ["Enter article" gnus-cache-enter-article t] + ["Remove article" gnus-cache-remove-article t]) + ["Select article buffer" gnus-summary-select-article-buffer t] + ["Enter digest buffer" gnus-summary-enter-digest-group t] + ["Isearch article..." gnus-summary-isearch-article t] + ["Beginning of the article" gnus-summary-beginning-of-article t] + ["End of the article" gnus-summary-end-of-article t] + ["Fetch parent of article" gnus-summary-refer-parent-article t] + ["Fetch referenced articles" gnus-summary-refer-references t] + ["Fetch current thread" gnus-summary-refer-thread t] + ["Fetch article with id..." gnus-summary-refer-article t] + ["Redisplay" gnus-summary-show-article t]))) + (easy-menu-define + gnus-summary-article-menu gnus-summary-mode-map "" + (cons "Article" innards)) + + (easy-menu-define + gnus-article-commands-menu gnus-article-mode-map "" + (cons "Commands" innards))) (easy-menu-define gnus-summary-thread-menu gnus-summary-mode-map "" @@ -1755,6 +1785,7 @@ increase the score of each group you read." ["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] @@ -1763,7 +1794,9 @@ increase the score of each group you read." ["Mark above" gnus-uu-mark-over t] ["Mark series" gnus-uu-mark-series t] ["Mark region" gnus-uu-mark-region t] + ["Unmark region" gnus-uu-unmark-region t] ["Mark by regexp..." gnus-uu-mark-by-regexp t] + ["Unmark by regexp..." gnus-uu-unmark-by-regexp t] ["Mark all" gnus-uu-mark-all t] ["Mark buffer" gnus-uu-mark-buffer t] ["Mark sparse" gnus-uu-mark-sparse t] @@ -1799,7 +1832,8 @@ increase the score of each group you read." ["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] @@ -1823,9 +1857,11 @@ increase the score of each group you read." ["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 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 without updating" gnus-summary-exit-no-update t] @@ -1852,6 +1888,7 @@ increase the score of each group you read." ("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" <) @@ -1953,7 +1990,7 @@ The following commands are available: (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) @@ -1966,19 +2003,17 @@ The following commands are available: (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) + (mm-enable-multibyte) (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) @@ -1986,11 +2021,9 @@ The following commands are available: (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)) @@ -2064,21 +2097,26 @@ The following commands are available: (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) @@ -2107,21 +2145,11 @@ The following commands are available: (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))))) @@ -2289,6 +2317,21 @@ marks of articles." ,@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 @@ -2304,7 +2347,7 @@ marks of articles." (while (setq point (pop config)) (when (and (< point (point-max)) (goto-char point) - (= (following-char) ?\n)) + (eq (char-after) ?\n)) (subst-char-in-region point (1+ point) ?\n ?\r))))) ;; Various summary mode internalish functions. @@ -2349,8 +2392,7 @@ marks of articles." (setq gnus-summary-buffer (current-buffer)) (not gnus-newsgroup-prepared)) ;; Fix by Sudish Joseph - (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)) @@ -2377,7 +2419,8 @@ marks of articles." (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)) (save-excursion (set-buffer gnus-group-buffer) (setq gnus-newsgroup-name name @@ -2390,7 +2433,8 @@ marks of articles." 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) ;; The article buffer also has local variables. (when (gnus-buffer-live-p gnus-article-buffer) (set-buffer gnus-article-buffer) @@ -2409,7 +2453,8 @@ marks of articles." (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 () @@ -2426,22 +2471,20 @@ marks of articles." (defun gnus-update-summary-mark-positions () "Compute where the summary marks are to go." (save-excursion - (when (and gnus-summary-buffer - (get-buffer gnus-summary-buffer) - (buffer-name (get-buffer gnus-summary-buffer))) + (when (gnus-buffer-exists-p gnus-summary-buffer) (set-buffer gnus-summary-buffer)) (let ((gnus-replied-mark 129) (gnus-score-below-mark 130) (gnus-score-over-mark 130) (gnus-download-mark 131) (spec gnus-summary-line-format-spec) - thread gnus-visual pos) + 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))))) @@ -2465,6 +2508,30 @@ marks of articles." (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)) + (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 @@ -2478,7 +2545,7 @@ marks of articles." (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 @@ -2543,7 +2610,7 @@ marks of articles." (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)) @@ -2591,14 +2658,14 @@ the thread are to be displayed." (and (consp elem) ; Has to be a cons. (consp (cdr elem)) ; The cdr has to be a list. (symbolp (car elem)) ; Has to be a symbol in there. - (not (memq (car elem) - '(quit-config to-address to-list to-group))) + (not (memq (car elem) '(quit-config))) ; Ignore quit-config. (ignore-errors ; So we set it. (make-local-variable (car elem)) (set (car elem) (eval (nth 1 elem)))))))) (defun gnus-summary-read-group (group &optional show-all no-article - kill-buffer no-display) + 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. @@ -2609,17 +2676,25 @@ If NO-DISPLAY, don't generate a summary buffer." (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 + ;; group automatically, so we go two groups back + ;; if we are searching for the previous group. + (when backward + (gnus-group-prev-unread-group 2)) (if (not (equal group (gnus-group-group-name))) (setq group (gnus-group-group-name)) (setq group nil))) result)) (defun gnus-summary-read-group-1 (group show-all no-article - kill-buffer no-display) + 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))) @@ -2627,7 +2702,8 @@ If NO-DISPLAY, don't generate a summary buffer." (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) @@ -2742,16 +2818,21 @@ If NO-DISPLAY, don't generate a summary buffer." (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. @@ -2950,11 +3031,89 @@ If NO-DISPLAY, don't generate a summary buffer." gnus-newsgroup-dependencies))) threads)) +;; Build the thread tree. +(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 +if it was already present. + +If `gnus-summary-ignore-duplicates' is nil then duplicate Message-IDs +will not be entered in the DEPENDENCIES table. Otherwise duplicate +Message-IDs will be renamed be renamed to a unique Message-ID before +being entered. + +Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." + (let* ((id (mail-header-id header)) + (id-dep (and id (intern id dependencies))) + ref ref-dep ref-header) + ;; Enter this `header' in the `dependencies' table. + (cond + ((not id-dep) + (setq header nil)) + ;; The first two cases do the normal part: enter a new `header' + ;; in the `dependencies' table. + ((not (boundp id-dep)) + (set id-dep (list header))) + ((null (car (symbol-value id-dep))) + (setcar (symbol-value id-dep) header)) + + ;; From here the `header' was already present in the + ;; `dependencies' table. + (force-new + ;; Overrides an existing entry; + ;; just set the header part of the entry. + (setcar (symbol-value id-dep) header)) + + ;; Renames the existing `header' to a unique Message-ID. + ((not gnus-summary-ignore-duplicates) + ;; An article with this Message-ID has already been seen. + ;; We rename the Message-ID. + (set (setq id-dep (intern (setq id (nnmail-message-id)) dependencies)) + (list header)) + (mail-header-set-id header id)) + + ;; The last case ignores an existing entry, except it adds any + ;; additional Xrefs (in case the two articles came from different + ;; servers. + ;; Also sets `header' to `nil' meaning that the `dependencies' + ;; table was *not* modified. + (t + (mail-header-set-xref + (car (symbol-value id-dep)) + (concat (or (mail-header-xref (car (symbol-value id-dep))) + "") + (or (mail-header-xref header) ""))) + (setq header nil))) + + (when header + ;; First check if that we are not creating a References loop. + (setq ref (gnus-parent-id (mail-header-references header))) + (while (and ref + (setq ref-dep (intern-soft ref dependencies)) + (boundp ref-dep) + (setq ref-header (car (symbol-value ref-dep)))) + (if (string= id ref) + ;; Yuk! This is a reference loop. Make the article be a + ;; root article. + (progn + (mail-header-set-references (car (symbol-value id-dep)) "none") + (setq ref nil)) + (setq ref (gnus-parent-id (mail-header-references ref-header))))) + (setq ref (gnus-parent-id (mail-header-references header))) + (setq ref-dep (intern (or ref "none") dependencies)) + (if (boundp ref-dep) + (setcdr (symbol-value ref-dep) + (nconc (cdr (symbol-value ref-dep)) + (list (symbol-value id-dep)))) + (set ref-dep (list nil (symbol-value id-dep))))) + header)) + (defun gnus-build-sparse-threads () (let ((headers gnus-newsgroup-headers) - (deps gnus-newsgroup-dependencies) + (gnus-summary-ignore-duplicates t) header references generation relations - cthread subject child end pthread relation new-child) + 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. @@ -2966,47 +3125,37 @@ If NO-DISPLAY, don't generate a summary buffer." (not (string= references ""))) (insert references) (setq child (mail-header-id header) - subject (mail-header-subject header)) - (setq generation 0) + subject (mail-header-subject header) + date (mail-header-date header) + generation 0) (while (search-backward ">" nil t) (setq end (1+ (point))) (when (search-backward "<" nil t) - (unless (string= (setq new-child (buffer-substring (point) end)) - child) - (push (list (incf generation) - child (setq child new-child) - subject) - relations)))) - (push (list (1+ generation) child nil subject) relations) + (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. - (setq relations (sort relations 'car-less-than-car)) - (while (setq relation (pop relations)) - (when (if (boundp (setq cthread (intern (cadr relation) deps))) - (unless (car (symbol-value cthread)) - ;; Make this article the parent of these threads. - (setcar (symbol-value cthread) - (vector gnus-reffed-article-number - (cadddr relation) - "" "" - (cadr relation) - (or (caddr relation) "") 0 0 ""))) - (set cthread (list (vector gnus-reffed-article-number - (cadddr relation) - "" "" (cadr relation) - (or (caddr relation) "") 0 0 "")))) - (push gnus-reffed-article-number gnus-newsgroup-limit) - (push gnus-reffed-article-number gnus-newsgroup-sparse) - (push (cons gnus-reffed-article-number gnus-sparse-mark) - gnus-newsgroup-reads) - (decf gnus-reffed-article-number) - ;; Make this new thread the child of its parent. - (if (boundp (setq pthread (intern (or (caddr relation) "none") deps))) - (setcdr (symbol-value pthread) - (nconc (cdr (symbol-value pthread)) - (list (symbol-value cthread)))) - (set pthread (list nil (symbol-value cthread)))))) + (mapcar + (lambda (relation) + (when (gnus-dependencies-add-header + (make-full-mail-header + gnus-reffed-article-number + (nth 3 relation) "" (or (nth 4 relation) "") + (nth 1 relation) + (or (nth 2 relation) "") 0 0 "") + gnus-newsgroup-dependencies nil) + (push gnus-reffed-article-number gnus-newsgroup-limit) + (push gnus-reffed-article-number gnus-newsgroup-sparse) + (push (cons gnus-reffed-article-number gnus-sparse-mark) + gnus-newsgroup-reads) + (decf gnus-reffed-article-number))) + (sort relations 'car-less-than-car)) (gnus-message 7 "Making sparse threads...done"))) (defun gnus-build-old-threads () @@ -3025,11 +3174,46 @@ If NO-DISPLAY, don't generate a summary buffer." (setq heads (cdr heads)) (setq id (symbol-name refs)) (while (and (setq id (gnus-build-get-header id)) - (not (car (gnus-gethash - id gnus-newsgroup-dependencies))))) + (not (car (gnus-id-to-thread id))))) (setq heads nil))))) gnus-newsgroup-dependencies))) +;; 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) + (let ((eol (gnus-point-at-eol)) + (buffer (current-buffer)) + header) + + ;; overview: [num subject from date id refs chars lines misc] + (unwind-protect + (progn + (narrow-to-region (point) eol) + (unless (eobp) + (forward-char)) + + (setq header + (make-full-mail-header + number ; number + (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) + (nnheader-nov-field)) ; misc + (nnheader-nov-parse-extra)))) ; extra + + (widen)) + + (when gnus-alter-header-function + (funcall gnus-alter-header-function header)) + (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 @@ -3067,26 +3251,29 @@ If NO-DISPLAY, don't generate a summary buffer." (defun gnus-build-all-threads () "Read all the headers." - (let ((deps gnus-newsgroup-dependencies) - (gnus-summary-ignore-duplicates t) - found header article) + (let ((gnus-summary-ignore-duplicates t) + (dependencies gnus-newsgroup-dependencies) + header article) (save-excursion (set-buffer nntp-server-buffer) (let ((case-fold-search nil)) (goto-char (point-min)) (while (not (eobp)) (ignore-errors - (setq article (read (current-buffer))) - (setq header (gnus-nov-parse-line article deps))) + (setq article (read (current-buffer)) + 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) @@ -3134,7 +3321,7 @@ If NO-DISPLAY, don't generate a summary buffer." (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)) @@ -3147,23 +3334,21 @@ If NO-DISPLAY, don't generate a summary buffer." 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) nil)))) -(defun gnus-rebuild-thread (id) - "Rebuild the thread containing ID." +(defun gnus-rebuild-thread (id &optional line) + "Rebuild the thread containing ID. +If LINE, insert the rebuilt thread starting on line LINE." (let ((buffer-read-only nil) old-pos current thread data) (if (not gnus-show-threads) @@ -3193,6 +3378,9 @@ If NO-DISPLAY, don't generate a summary buffer." (setq thread (cons subject (gnus-sort-threads roots)))))) (let (threads) ;; We then insert this thread into the summary buffer. + (when line + (goto-char (point-min)) + (forward-line (1- line))) (let (gnus-newsgroup-data gnus-newsgroup-threads) (if gnus-show-threads (gnus-summary-prepare-threads (gnus-cut-threads (list thread))) @@ -3200,8 +3388,15 @@ If NO-DISPLAY, don't generate a summary buffer." (setq data (nreverse gnus-newsgroup-data)) (setq threads gnus-newsgroup-threads)) ;; We splice the new data into the data structure. - (gnus-data-enter-list current data (- (point) old-pos)) - (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads))))) + ;;!!! This is kinda bogus. We assume that in LINE is non-nil, + ;;!!! 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)) + (gnus-data-compute-positions)))) (defun gnus-number-to-header (number) "Return the header for article NUMBER." @@ -3212,19 +3407,23 @@ If NO-DISPLAY, don't generate a summary buffer." (when headers (car headers)))) -(defun gnus-parent-headers (headers &optional generation) +(defun gnus-parent-headers (in-headers &optional generation) "Return the headers of the GENERATIONeth parent of HEADERS." (unless generation (setq generation 1)) (let ((parent t) + (headers in-headers) references) - (while (and parent headers (not (zerop generation))) - (setq references (mail-header-references headers)) - (when (and references - (setq parent (gnus-parent-id references)) - (setq headers (car (gnus-id-to-thread parent)))) - (decf generation))) - headers)) + (while (and parent + (not (zerop generation)) + (setq references (mail-header-references headers))) + (setq headers (if (and references + (setq parent (gnus-parent-id references))) + (car (gnus-id-to-thread parent)) + nil)) + (decf generation)) + (and (not (eq headers in-headers)) + headers))) (defun gnus-id-to-thread (id) "Return the (sub-)thread where ID appears." @@ -3259,8 +3458,7 @@ If NO-DISPLAY, don't generate a summary buffer." (defun gnus-root-id (id) "Return the id of the root of the thread where ID appears." (let (last-id prev) - (while (and id (setq prev (car (gnus-gethash - id gnus-newsgroup-dependencies)))) + (while (and id (setq prev (car (gnus-id-to-thread id)))) (setq last-id id id (gnus-parent-id (mail-header-references prev)))) last-id)) @@ -3272,12 +3470,10 @@ If NO-DISPLAY, don't generate a summary buffer." (defun gnus-remove-thread (id &optional dont-remove) "Remove the thread that has ID in it." - (let ((dep gnus-newsgroup-dependencies) - headers thread last-id) + (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. @@ -3306,7 +3502,7 @@ If NO-DISPLAY, don't generate a summary buffer." (if thread (unless dont-remove (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads))) - (setq thread (gnus-gethash last-id dep))) + (setq thread (gnus-id-to-thread last-id))) (when thread (prog1 thread ; We return this thread. @@ -3316,12 +3512,18 @@ If NO-DISPLAY, don't generate a summary buffer." ;; If we use dummy roots, then we have to remove the ;; dummy root as well. (when (eq gnus-summary-make-false-root 'dummy) + ;; We go to the dummy root by going to + ;; the first sub-"thread", and then one line up. + (gnus-summary-goto-article + (mail-header-number (caadr thread))) + (forward-line -1) (gnus-delete-line) (gnus-data-compute-positions)) (setq thread (cdr thread)) (while thread (gnus-remove-thread-1 (car thread)) (setq thread (cdr thread)))) + (gnus-summary-show-all-threads) (gnus-remove-thread-1 thread)))))))) (defun gnus-remove-thread-1 (thread) @@ -3344,10 +3546,10 @@ If NO-DISPLAY, don't generate a summary buffer." "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-message 8 "Sorting threads...done")))) (defun gnus-sort-articles (articles) "Sort ARTICLES." @@ -3389,6 +3591,16 @@ If NO-DISPLAY, don't generate a summary buffer." (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 @@ -3419,7 +3631,7 @@ If NO-DISPLAY, don't generate a summary buffer." (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)))) @@ -3449,7 +3661,7 @@ Unscored articles will be counted as having a score of zero." (> (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) @@ -3466,8 +3678,7 @@ Unscored articles will be counted as having a score of zero." (apply gnus-thread-score-function (or (append (mapcar 'gnus-thread-total-score - (cdr (gnus-gethash (mail-header-id root) - gnus-newsgroup-dependencies))) + (cdr (gnus-id-to-thread (mail-header-id root)))) (when (> (mail-header-number root) 0) (list (or (cdr (assq (mail-header-number root) gnus-newsgroup-scored)) @@ -3481,6 +3692,12 @@ Unscored articles will be counted as having a score of zero." (defvar gnus-tmp-root-expunged nil) (defvar gnus-tmp-dummy-line nil) +(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 ...]...) ...])' @@ -3514,7 +3731,6 @@ or a straight list of headers." (while (or threads stack gnus-tmp-new-adopts new-roots) (if (and (= gnus-tmp-level 0) - (not (setq gnus-tmp-dummy-line nil)) (or (not stack) (= (caar stack) 0)) (not gnus-tmp-false-parent) @@ -3629,7 +3845,10 @@ or a straight list of headers." (when gnus-tmp-header ;; We may have an old dummy line to output before this ;; article. - (when gnus-tmp-dummy-line + (when (and gnus-tmp-dummy-line + (gnus-subject-equal + gnus-tmp-dummy-line + (mail-header-subject gnus-tmp-header))) (gnus-summary-insert-dummy-line gnus-tmp-dummy-line (mail-header-number gnus-tmp-header)) (setq gnus-tmp-dummy-line nil)) @@ -3676,7 +3895,7 @@ or a straight list of headers." (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 @@ -3760,13 +3979,14 @@ or a straight list of headers." (cdr (assq number gnus-newsgroup-scored)) (memq number gnus-newsgroup-processable)))))) -(defun gnus-select-newsgroup (group &optional read-all) +(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)) @@ -3794,6 +4014,7 @@ If READ-ALL is non-nil, all articles in the group are selected." (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 @@ -3811,10 +4032,13 @@ If READ-ALL is non-nil, all articles in the group are selected." (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) @@ -3825,6 +4049,7 @@ If READ-ALL is non-nil, all articles in the group are selected." ;; 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 @@ -3834,11 +4059,11 @@ If READ-ALL is non-nil, all articles in the group are selected." articles gnus-newsgroup-name ;; We might want to fetch old headers, but ;; not if there is only 1 article. - (and gnus-fetch-old-headers - (or (and + (and (or (and (not (eq gnus-fetch-old-headers 'some)) (not (numberp gnus-fetch-old-headers))) - (> (length articles) 1)))))) + (> (length articles) 1)) + gnus-fetch-old-headers)))) (gnus-get-newsgroup-headers-xover articles nil nil gnus-newsgroup-name t) (gnus-get-newsgroup-headers))) @@ -3864,15 +4089,15 @@ If READ-ALL is non-nil, all articles in the group are selected." ;; 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)) ;; Check whether auto-expire is to be done in this group. (setq gnus-newsgroup-auto-expire (gnus-group-auto-expirable-p group)) @@ -3977,7 +4202,7 @@ If READ-ALL is non-nil, all articles in the group are selected." 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)) @@ -4035,7 +4260,7 @@ If READ-ALL is non-nil, all articles in the group are selected." (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. (while (setq type (pop types)) @@ -4060,12 +4285,28 @@ If READ-ALL is non-nil, all articles in the group are selected." (setq arts (cdr arts))) (setq list (cdr all)))) + (when (gnus-check-backend-function 'request-set-mark + gnus-newsgroup-name) + ;; score & bookmark are not proper flags (they are cons cells) + ;; cache is a internal gnus flag + (unless (memq (cdr type) '(cache score bookmark)) + (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) + (del (gnus-remove-from-range old list)) + (add (gnus-remove-from-range list old))) + (if add + (push (list add 'add (list (cdr type))) delta-marks)) + (if del + (push (list del 'del (list (cdr type))) delta-marks))))) + (push (cons (cdr type) (if (memq (cdr type) uncompressed) list (gnus-compress-sequence (set symbol (sort list '<)) t))) newmarked))) + (if delta-marks + (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) @@ -4084,7 +4325,9 @@ If READ-ALL is non-nil, all articles in the group are selected." "This function sets 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 @@ -4134,7 +4377,7 @@ If WHERE is `summary', the summary mode line format will be used." ;; 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)))) @@ -4212,7 +4455,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (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) @@ -4240,7 +4483,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; 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) @@ -4281,15 +4524,6 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; 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) @@ -4298,14 +4532,16 @@ The resulting hash table is returned, or nil if no Xrefs were found." (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)) (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) + in-reply-to header p lines chars) (goto-char (point-min)) ;; Search to the beginning of the next header. Error messages ;; do not begin with 2 or 3. @@ -4334,15 +4570,15 @@ The resulting hash table is returned, or nil if no Xrefs were found." (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)) + (funcall gnus-decode-encoded-word-function + (nnheader-header-value)) "(nobody)")) ;; Date. (progn @@ -4391,10 +4627,16 @@ The resulting hash table is returned, or nil if no Xrefs were found." (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. - 0 + (progn + (goto-char p) + (if (search-forward "\nchars: " nil t) + (if (numberp (setq chars (ignore-errors (read cur)))) + chars 0) + 0)) ;; Lines. (progn (goto-char p) @@ -4406,7 +4648,19 @@ The resulting hash table is returned, or nil if no Xrefs were found." (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)) @@ -4414,151 +4668,15 @@ The resulting hash table is returned, or nil if no Xrefs were found." (funcall gnus-alter-header-function header) (setq id (mail-header-id header) ref (gnus-parent-id (mail-header-references header)))) - - ;; We do the threading while we read the headers. The - ;; message-id and the last reference are both entered into - ;; the same hash table. Some tippy-toeing around has to be - ;; done in case an article has arrived before the article - ;; which it refers to. - (if (boundp (setq id-dep (intern id dependencies))) - (if (and (car (symbol-value id-dep)) - (not force-new)) - ;; An article with this Message-ID has already been seen. - (if gnus-summary-ignore-duplicates - ;; We ignore this one, except we add - ;; any additional Xrefs (in case the two articles - ;; came from different servers). - (progn - (mail-header-set-xref - (car (symbol-value id-dep)) - (concat (or (mail-header-xref - (car (symbol-value id-dep))) - "") - (or (mail-header-xref header) ""))) - (setq header nil)) - ;; We rename the Message-ID. - (set - (setq id-dep (intern (setq id (nnmail-message-id)) - dependencies)) - (list header)) - (mail-header-set-id header id)) - (setcar (symbol-value id-dep) header)) - (set id-dep (list header))) - (when header - (if (boundp (setq ref-dep (intern (or ref "none") dependencies))) - (setcdr (symbol-value ref-dep) - (nconc (cdr (symbol-value ref-dep)) - (list (symbol-value id-dep)))) - (set ref-dep (list nil (symbol-value id-dep)))) + + (when (setq header + (gnus-dependencies-add-header + header dependencies force-new)) (push header headers)) (goto-char (point-max)) (widen)) (nreverse headers))))) -;; The following macros and functions were written by Felix Lee -;; . - -(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))) - -;; (defvar gnus-nov-none-counter 0) - -;; This function has to be called with point after the article number -;; on the beginning of the line. -(defun gnus-nov-parse-line (number dependencies &optional force-new) - (let ((eol (gnus-point-at-eol)) - (buffer (current-buffer)) - header ref id id-dep ref-dep) - - ;; overview: [num subject from date id refs chars lines misc] - (unwind-protect - (progn - (narrow-to-region (point) eol) - (unless (eobp) - (forward-char)) - - (setq header - (vector - number ; number - (funcall - gnus-unstructured-field-decoder (gnus-nov-field)) ; subject - (funcall - gnus-structured-field-decoder (gnus-nov-field)) ; from - (gnus-nov-field) ; date - (setq id (or (gnus-nov-field) - (nnheader-generate-fake-message-id))) ; id - (progn - (let ((beg (point))) - (search-forward "\t" eol) - (if (search-backward ">" beg t) - (setq ref - (buffer-substring - (1+ (point)) - (or (search-backward "<" beg t) beg))) - (setq ref nil)) - (goto-char beg)) - (gnus-nov-field)) ; refs - (gnus-nov-read-integer) ; chars - (gnus-nov-read-integer) ; lines - (if (= (following-char) ?\n) - nil - (gnus-nov-field))))) ; misc - - (widen)) - - (when gnus-alter-header-function - (funcall gnus-alter-header-function header) - (setq id (mail-header-id header) - ref (gnus-parent-id (mail-header-references header)))) - - ;; We build the thread tree. - (when (equal id ref) - ;; This article refers back to itself. Naughty, naughty. - (setq ref nil)) - (if (boundp (setq id-dep (intern id dependencies))) - (if (and (car (symbol-value id-dep)) - (not force-new)) - ;; An article with this Message-ID has already been seen. - (if gnus-summary-ignore-duplicates - ;; We ignore this one, except we add any additional - ;; Xrefs (in case the two articles came from different - ;; servers. - (progn - (mail-header-set-xref - (car (symbol-value id-dep)) - (concat (or (mail-header-xref - (car (symbol-value id-dep))) - "") - (or (mail-header-xref header) ""))) - (setq header nil)) - ;; We rename the Message-ID. - (set - (setq id-dep (intern (setq id (nnmail-message-id)) - dependencies)) - (list header)) - (mail-header-set-id header id)) - (setcar (symbol-value id-dep) header)) - (set id-dep (list header))) - (when header - (if (boundp (setq ref-dep (intern (or ref "none") dependencies))) - (setcdr (symbol-value ref-dep) - (nconc (cdr (symbol-value ref-dep)) - (list (symbol-value id-dep)))) - (set ref-dep (list nil (symbol-value id-dep))))) - header)) - ;; Goes through the xover lines and returns a list of vectors (defun gnus-get-newsgroup-headers-xover (sequence &optional force-new dependencies @@ -4568,11 +4686,13 @@ 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) + (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)) @@ -4626,7 +4746,7 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (save-restriction (nnheader-narrow-to-headers) (goto-char (point-min)) - (when (or (and (eq (downcase (following-char)) ?x) + (when (or (and (eq (downcase (char-after)) ?x) (looking-at "Xref:")) (search-forward "\nXref:" nil t)) (goto-char (1+ (match-end 0))) @@ -4635,22 +4755,27 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (mail-header-set-xref headers xref))))))) (defun gnus-summary-insert-subject (id &optional old-header use-old-header) - "Find article ID and insert the summary line for that article." - (let ((header (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) + "Find article ID and insert the summary line for that article. +OLD-HEADER can either be a header or a line number to insert +the subject line on." + (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)) + d) (when header ;; Rebuild the thread that this article is part of and go to the ;; article we have fetched. (when (and (not gnus-show-threads) old-header) - (when (setq d (gnus-data-find (mail-header-number old-header))) + (when (and number + (setq d (gnus-data-find (mail-header-number old-header)))) (goto-char (gnus-data-pos d)) (gnus-data-remove number @@ -4665,7 +4790,7 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." gnus-newsgroup-sparse)) (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient)) (push number gnus-newsgroup-limit) - (gnus-rebuild-thread (mail-header-id header)) + (gnus-rebuild-thread (mail-header-id header) line) (gnus-summary-goto-subject number nil t)) (when (and (numberp number) (> number 0)) @@ -4685,9 +4810,9 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." ;;; Process/prefix in the summary buffer (defun gnus-summary-work-articles (n) - "Return a list of articles to be worked upon. The prefix argument, -the list of process marked articles, and the current article will be -taken into consideration." + "Return a list of articles to be worked upon. +The prefix argument, the list of process marked articles, and the +current article will be taken into consideration." (save-excursion (set-buffer gnus-summary-buffer) (cond @@ -4730,6 +4855,19 @@ taken into consideration." ;; 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)))) + +(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) @@ -4774,7 +4912,7 @@ If EXCLUDE-GROUP, do not go to this group." (save-excursion (gnus-group-best-unread-group exclude-group)))) -(defun gnus-summary-find-next (&optional unread article backward) +(defun gnus-summary-find-next (&optional unread article backward undownloaded) (if backward (gnus-summary-find-prev) (let* ((dummy (gnus-summary-article-intangible-p)) (article (or article (gnus-summary-article-number))) @@ -4789,7 +4927,10 @@ If EXCLUDE-GROUP, do not go to this group." (if unread (progn (while arts - (when (gnus-data-unread-p (car arts)) + (when (or (and undownloaded + (eq gnus-undownloaded-mark + (gnus-data-mark (car arts)))) + (gnus-data-unread-p (car arts))) (setq result (car arts) arts nil)) (setq arts (cdr arts))) @@ -4869,7 +5010,9 @@ displayed, no centering will be performed." ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. (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)) @@ -4925,12 +5068,12 @@ displayed, no centering will be performed." ;; 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))) + (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) @@ -5044,9 +5187,6 @@ The prefix argument ALL means to select all articles." (unless (listp (cdr gnus-newsgroup-killed)) (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) (let ((headers gnus-newsgroup-headers)) - (when (and (not gnus-save-score) - (not non-destructive)) - (setq gnus-newsgroup-scored nil)) ;; Set the new ranges of read articles. (save-excursion (set-buffer gnus-group-buffer) @@ -5054,7 +5194,13 @@ The prefix argument ALL means to select all articles." (gnus-update-read-articles group (append gnus-newsgroup-unreads gnus-newsgroup-unselected)) ;; Set the current article marks. - (gnus-update-marks) + (let ((gnus-newsgroup-scored + (if (and (not gnus-save-score) + (not non-destructive)) + nil + gnus-newsgroup-scored))) + (save-excursion + (gnus-update-marks))) ;; Do the cross-ref thing. (when gnus-use-cross-reference (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads)) @@ -5078,6 +5224,10 @@ If FORCE (the prefix), also save the .newsrc file(s)." 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))) (gnus-kill-save-kill-buffer) (gnus-async-halt-prefetch) (let* ((group gnus-newsgroup-name) @@ -5085,6 +5235,12 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (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 @@ -5103,12 +5259,7 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." ;; 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) @@ -5147,12 +5298,12 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (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))))) @@ -5166,6 +5317,13 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." gnus-expert-user (gnus-y-or-n-p "Discard changes to this group and exit? ")) (gnus-async-halt-prefetch) + (mapcar 'funcall + (delq 'gnus-summary-expire-articles + (copy-list 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))) ;; If we have several article buffers, we kill them at exit. (unless gnus-single-article-buffer (gnus-kill-buffer gnus-article-buffer) @@ -5196,8 +5354,8 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (gnus-handle-ephemeral-exit quit-config))))) (defun gnus-handle-ephemeral-exit (quit-config) - "Handle movement when leaving an ephemeral group. The state -which existed when entering the ephemeral is reset." + "Handle movement when leaving an ephemeral group. +The state which existed when entering the ephemeral is reset." (if (not (buffer-name (car quit-config))) (gnus-configure-windows 'group 'force) (set-buffer (car quit-config)) @@ -5286,14 +5444,12 @@ which existed when entering the ephemeral is reset." (gnus-kill-buffer gnus-original-article-buffer))) (cond (gnus-kill-summary-on-exit (when (and gnus-use-trees - (and (get-buffer buffer) - (buffer-name (get-buffer buffer)))) + (gnus-buffer-exists-p buffer)) (save-excursion - (set-buffer (get-buffer buffer)) + (set-buffer buffer) (gnus-tree-close gnus-newsgroup-name))) (gnus-kill-buffer buffer)) - ((and (get-buffer buffer) - (buffer-name (get-buffer buffer))) + ((gnus-buffer-exists-p buffer) (save-excursion (set-buffer buffer) (gnus-deaden-summary)))))) @@ -5336,8 +5492,7 @@ in." (defun gnus-summary-describe-briefly () "Describe summary mode commands briefly." (interactive) - (gnus-message 6 - (substitute-command-keys "\\\\[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-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. @@ -5383,7 +5538,8 @@ previous group instead." (and unreads (not (zerop unreads)))) (gnus-summary-read-group target-group nil no-article - (and (buffer-name current-buffer) current-buffer))) + (and (buffer-name current-buffer) current-buffer) + nil backward)) (setq entered t) (setq current-group target-group target-group nil))))))) @@ -5396,7 +5552,7 @@ If prefix argument NO-ARTICLE is non-nil, no article is selected initially." ;; Walking around summary lines. -(defun gnus-summary-first-subject (&optional unread) +(defun gnus-summary-first-subject (&optional unread undownloaded) "Go to the first unread subject. If UNREAD is non-nil, go to the first unread article. Returns the article selected or nil if there are no unread articles." @@ -5419,7 +5575,10 @@ Returns the article selected or nil if there are no unread articles." (t (let ((data gnus-newsgroup-data)) (while (and data - (not (gnus-data-unread-p (car data)))) + (and (not (and undownloaded + (eq gnus-undownloaded-mark + (gnus-data-mark (car data))))) + (not (gnus-data-unread-p (car data))))) (setq data (cdr data))) (when data (goto-char (gnus-data-pos (car data))) @@ -5439,6 +5598,7 @@ returned." (if backward (gnus-summary-find-prev unread) (gnus-summary-find-next unread))) + (gnus-summary-show-thread) (setq n (1- n))) (when (/= 0 n) (gnus-message 7 "No more%s articles" @@ -5473,7 +5633,10 @@ If FORCE, also allow jumping to articles not currently shown." ;; We read in the article if we have to. (and (not data) force - (gnus-summary-insert-subject article (and (vectorp force) force) t) + (gnus-summary-insert-subject + article + (if (or (numberp force) (vectorp force)) force) + t) (setq data (gnus-data-find article))) (goto-char b) (if (not data) @@ -5482,6 +5645,7 @@ If FORCE, also allow jumping to articles not currently shown." (gnus-message 3 "Can't find article %d" article)) nil) (goto-char (gnus-data-pos data)) + (gnus-summary-position-point) article))) ;; Walking around summary lines with displaying articles. @@ -5548,7 +5712,9 @@ be displayed." ;; The requested article is different from the current article. (prog1 (gnus-summary-display-article article all-headers) - (setq did article)) + (setq did article) + (when (or all-headers gnus-show-all-headers) + (gnus-article-show-all-headers))) (when (or all-headers gnus-show-all-headers) (gnus-article-show-all-headers)) 'old)) @@ -5583,7 +5749,7 @@ If BACKWARD, the previous article is selected instead of the next." (not unread) (not subject)) (gnus-summary-goto-article (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end)) - nil t)) + nil (count-lines (point-min) (point)))) ;; Go to next/previous group. (t (unless (gnus-ephemeral-group-p gnus-newsgroup-name) @@ -5705,6 +5871,9 @@ article." (let ((article (gnus-summary-article-number)) (article-window (get-buffer-window gnus-article-buffer t)) endp) + ;; If the buffer is empty, we have no article. + (unless article + (error "No article to select")) (gnus-configure-windows 'article) (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark) (if (and (eq gnus-summary-goto-unread 'never) @@ -5786,6 +5955,12 @@ Argument LINES specifies lines to be scrolled up (or down if negative)." (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) @@ -5817,15 +5992,25 @@ Return nil if there are no unread articles." (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 () @@ -5856,7 +6041,9 @@ Return nil if there are no articles." (defun gnus-summary-goto-article (article &optional all-headers force) "Fetch ARTICLE (article number or Message-ID) and display it if it exists. -If ALL-HEADERS is non-nil, no header lines are hidden." +If ALL-HEADERS is non-nil, no header lines are hidden. +If FORCE, go to the article even if it isn't displayed. If FORCE +is a number, it is the line the article is to be displayed on." (interactive (list (completing-read @@ -5948,15 +6135,17 @@ articles that are younger than AGE days." (interactive "nTime in days: \nP") (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 (date-to-time date)) cutoff)) - (when (if younger-p is-younger (not is-younger)) + (when (if younger-p + is-younger + (not is-younger)) (push (gnus-data-number d) articles)))) (gnus-summary-limit (nreverse articles))) (gnus-summary-position-point))) @@ -6092,7 +6281,8 @@ If ALL, mark even excluded ticked and dormants as read." '<) (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 @@ -6140,6 +6330,7 @@ If ALL, mark even excluded ticked and dormants as read." ;; 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)))) @@ -6155,7 +6346,7 @@ If ALL, mark even excluded ticked and dormants as read." (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) (eq gnus-build-sparse-threads 'some) (eq gnus-build-sparse-threads 'more)) ;; Deal with old-fetched headers and sparse threads. @@ -6389,8 +6580,7 @@ of what's specified by the `gnus-refer-thread-limit' variable." (interactive "P") (let ((id (mail-header-id (gnus-summary-article-header))) (limit (if limit (prefix-numeric-value limit) - gnus-refer-thread-limit)) - fmethod root) + 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. @@ -6425,8 +6615,7 @@ or `gnus-select-method', no matter what backend the article comes from." (gnus-summary-article-sparse-p (mail-header-number header)) (memq (mail-header-number header) - gnus-newsgroup-limit))) - h) + gnus-newsgroup-limit)))) (cond ;; If the article is present in the buffer we just go to it. ((and header @@ -6458,8 +6647,14 @@ or `gnus-select-method', no matter what backend the article comes from." (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 @@ -6524,7 +6719,7 @@ Obeys the standard process/prefix convention." (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. @@ -6604,13 +6799,14 @@ Optional argument BACKWARD means do search for 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-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 @@ -6742,7 +6938,7 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead." 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." @@ -6758,18 +6954,19 @@ 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) - (ps-print-buffer-with-faces filename))) + (save-excursion + (ps-print-buffer-with-faces filename)))) (kill-buffer buffer)))))) (defun gnus-summary-show-article (&optional arg) @@ -6780,13 +6977,22 @@ article massaging functions being run." (if (not arg) ;; Select the article the normal way. (gnus-summary-select-article nil 'force) + ;; 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-article-decode-hook + gnus-display-mime-function gnus-break-pages - gnus-show-mime gnus-visual) + ;; 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))) (gnus-summary-select-article nil 'force))) (gnus-summary-goto-subject gnus-current-article) (gnus-summary-position-point)) @@ -6811,40 +7017,36 @@ If ARG is a negative number, hide the unwanted header lines." (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) + (save-restriction + (message-narrow-to-head) + (setq hidden (gnus-article-hidden-text-p 'headers))) + (goto-char (point-min)) + (when (search-forward "\n\n" nil t) + (delete-region (point-min) (1- (point)))) (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))))) + (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)) + (if (or hidden + (and (numberp arg) (< arg 0))) + (let ((gnus-treat-hide-headers nil) + (gnus-treat-hide-boring-headers nil)) + (gnus-treat-article 'head)) + (gnus-treat-article 'head))))))) (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 @@ -6948,7 +7150,7 @@ and `request-accept' functions." 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) @@ -6956,7 +7158,7 @@ and `request-accept' functions." (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 @@ -6996,15 +7198,10 @@ and `request-accept' functions." (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))) ;; Update the group that has been moved to. @@ -7075,7 +7272,7 @@ and `request-accept' functions." ;;;!!!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)))) @@ -7108,7 +7305,7 @@ re-spool using this method." (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) @@ -7157,7 +7354,7 @@ latter case, they will be copied into the relevant groups." (gnus-summary-copy-article n nil method))) (defun gnus-summary-import-article (file) - "Import a random file into a mail newsgroup." + "Import an arbitrary file into a mail newsgroup." (interactive "fImport file: ") (let ((group gnus-newsgroup-name) (now (current-time)) @@ -7168,8 +7365,7 @@ latter case, they will be copied into the relevant groups." (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) (goto-char (point-min)) @@ -7179,10 +7375,7 @@ latter case, they will be copied into the relevant groups." 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" @@ -7257,10 +7450,10 @@ This will be the case if the article has both been mailed and posted." This means that *all* articles that are marked as expirable will be deleted forever, right now." (interactive) - (unless gnus-expert-user - (gnus-yes-or-no-p - "Are you really, really, really sure you want to delete all these messages? ") - (error "Phew!")) + (or gnus-expert-user + (gnus-yes-or-no-p + "Are you really, really, really sure you want to delete all these messages? ") + (error "Phew!")) (gnus-summary-expire-articles t)) ;; Suggested by Jack Vinson . @@ -7277,7 +7470,7 @@ delete these instead." gnus-newsgroup-name) (error "The current newsgroup does not support article deletion")) ;; Compute the list of articles to delete. - (let ((articles (gnus-summary-work-articles n)) + (let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<)) not-deleted) (if (and gnus-novice-user (not (gnus-yes-or-no-p @@ -7308,22 +7501,22 @@ This will have permanent effect only in mail groups. If FORCE is non-nil, 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 ((mail-parse-charset gnus-newsgroup-charset)) + (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")) + (gnus-summary-show-article t) + (gnus-article-edit-article + 'mime-to-mml + `(lambda (no-highlight) + (let ((mail-parse-charset ',gnus-newsgroup-charset)) + (mml-to-mime) + (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) @@ -7332,58 +7525,62 @@ groups." "Make edits to the current article permanent." (interactive) ;; Replace the article. - (if (and (not read-only) - (not (gnus-request-replace-article - (cdr gnus-article-current) (car gnus-article-current) - (current-buffer)))) - (error "Couldn't replace article") - ;; Update the summary buffer. - (if (and references - (equal (message-tokenize-header references " ") - (message-tokenize-header - (or (message-fetch-field "references") "") " "))) - ;; We only have to update this line. - (save-excursion - (save-restriction - (message-narrow-to-head) - (let ((head (buffer-string)) - header) - (nnheader-temp-write nil - (insert (format "211 %d Article retrieved.\n" - (cdr gnus-article-current))) - (insert head) - (insert ".\n") - (let ((nntp-server-buffer (current-buffer))) - (setq header (car (gnus-get-newsgroup-headers - (save-excursion - (set-buffer gnus-summary-buffer) - gnus-newsgroup-dependencies) - t)))) - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-data-set-header - (gnus-data-find (cdr gnus-article-current)) - header) - (gnus-summary-update-article-line - (cdr gnus-article-current) header)))))) - ;; Update threads. - (set-buffer (or buffer gnus-summary-buffer)) - (gnus-summary-update-article (cdr gnus-article-current))) - ;; Prettify the article buffer again. - (unless no-highlight - (save-excursion - (set-buffer gnus-article-buffer) - (gnus-run-hooks 'gnus-article-display-hook) - (set-buffer gnus-original-article-buffer) - (gnus-request-article - (cdr gnus-article-current) - (car gnus-article-current) (current-buffer)))) - ;; Prettify the summary buffer line. - (when (gnus-visual-p 'summary-highlight 'highlight) - (gnus-run-hooks 'gnus-visual-mark-article-hook)))) + (let ((buf (current-buffer))) + (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) t))) + (error "Couldn't replace article") + ;; Update the summary buffer. + (if (and references + (equal (message-tokenize-header references " ") + (message-tokenize-header + (or (message-fetch-field "references") "") " "))) + ;; We only have to update this line. + (save-excursion + (save-restriction + (message-narrow-to-head) + (let ((head (buffer-string)) + header) + (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 + (save-excursion + (set-buffer gnus-summary-buffer) + gnus-newsgroup-dependencies) + t)))) + (save-excursion + (set-buffer gnus-summary-buffer) + (gnus-data-set-header + (gnus-data-find (cdr gnus-article-current)) + header) + (gnus-summary-update-article-line + (cdr gnus-article-current) header)))))) + ;; Update threads. + (set-buffer (or buffer gnus-summary-buffer)) + (gnus-summary-update-article (cdr gnus-article-current))) + ;; Prettify the article buffer again. + (unless no-highlight + (save-excursion + (set-buffer gnus-article-buffer) + ;;;!!! 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) + (car gnus-article-current) (current-buffer)))) + ;; Prettify the summary buffer line. + (when (gnus-visual-p 'summary-highlight 'highlight) + (gnus-run-hooks 'gnus-visual-mark-article-hook)))))) (defun gnus-summary-edit-wash (key) - "Perform editing command in the article buffer." + "Perform editing command KEY in the article buffer." (interactive (list (progn @@ -7396,7 +7593,7 @@ groups." ;;; 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) @@ -7405,7 +7602,7 @@ groups." (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" @@ -7413,6 +7610,12 @@ groups." (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) @@ -7530,7 +7733,7 @@ the actual number of articles marked is returned." "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) @@ -7589,6 +7792,7 @@ the actual number of articles marked is returned." (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) @@ -7596,6 +7800,7 @@ the actual number of articles marked is returned." (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) @@ -7610,6 +7815,7 @@ 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." (interactive "p") + (gnus-summary-show-thread) (let ((backward (< n 0)) (gnus-summary-goto-unread (and gnus-summary-goto-unread @@ -7647,12 +7853,10 @@ returned." (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) @@ -7662,6 +7866,8 @@ returned." "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) @@ -7678,9 +7884,7 @@ returned." (push article gnus-newsgroup-dormant)) (t (push article gnus-newsgroup-unreads))) - (setq gnus-newsgroup-reads - (delq (assq article gnus-newsgroup-reads) - gnus-newsgroup-reads)) + (gnus-pull article gnus-newsgroup-reads) ;; See whether the article is to be put in the cache. (and gnus-use-cache @@ -7700,25 +7904,23 @@ returned." "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." ;; 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 @@ -7768,19 +7970,19 @@ marked." (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." @@ -7821,9 +8023,7 @@ marked." (push article gnus-newsgroup-dormant)) (t (push article gnus-newsgroup-unreads))) - (setq gnus-newsgroup-reads - (delq (assq article gnus-newsgroup-reads) - gnus-newsgroup-reads)) + (gnus-pull article gnus-newsgroup-reads) t))) (defalias 'gnus-summary-mark-as-unread-forward @@ -7863,14 +8063,15 @@ If N is negative, mark backwards instead. 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. @@ -8024,11 +8225,11 @@ The number of articles marked as read is returned." ;; We actually mark all articles as canceled, which we ;; have to do when using auto-expiry or adaptive scoring. (gnus-summary-show-all-threads) - (when (gnus-summary-first-subject (not all)) + (when (gnus-summary-first-subject (not all) t) (while (and (if to-here (< (point) to-here) t) (gnus-summary-mark-article-as-read gnus-catchup-mark) - (gnus-summary-find-next (not all))))) + (gnus-summary-find-next (not all) nil nil t)))) (gnus-set-mode-line 'summary)) t)) (gnus-summary-position-point))) @@ -8056,7 +8257,8 @@ If prefix argument ALL is non-nil, all articles are marked as read." (interactive "P") (when (gnus-summary-catchup all quietly nil 'fast) ;; Select next newsgroup or exit. - (if (eq gnus-auto-select-next 'quietly) + (if (and (not (gnus-group-quit-config gnus-newsgroup-name)) + (eq gnus-auto-select-next 'quietly)) (gnus-summary-next-group nil) (gnus-summary-exit)))) @@ -8152,25 +8354,15 @@ is non-nil or the Subject: of both articles are the same." (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) - (goto-char (point-min)) - (if (re-search-forward "^References: " nil t) - (progn - (re-search-forward "^[^ \t]" nil t) - (forward-line -1) - (end-of-line) - (insert " " message-id)) - (insert "References: " message-id "\n")) - (unless (gnus-request-replace-article - current-article (car gnus-article-current) - (current-buffer)) - (error "Couldn't replace article")))) + (gnus-with-article current-article + (goto-char (point-min)) + (if (re-search-forward "^References: " nil t) + (progn + (re-search-forward "^[^ \t]" nil t) + (forward-line -1) + (end-of-line) + (insert " " message-id)) + (insert "References: " message-id "\n"))) (set-buffer gnus-summary-buffer) (gnus-summary-unmark-all-processable) (gnus-summary-update-article current-article) @@ -8404,27 +8596,31 @@ Argument REVERSE means reverse order." (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-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. @@ -8447,10 +8643,9 @@ The variable `gnus-default-article-saver' specifies the saver function." (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) @@ -8500,7 +8695,7 @@ If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." (interactive "P") - (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail)) + (let ((gnus-default-article-saver 'rmail-output-to-rmail-file)) (gnus-summary-save-article arg))) (defun gnus-summary-save-article-file (&optional arg) @@ -8537,8 +8732,7 @@ save those articles instead." "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) @@ -8586,6 +8780,7 @@ save those articles instead." (defun gnus-valid-move-group-p (group) (and (boundp group) (symbol-name group) + (symbol-value group) (memq 'respool (assoc (symbol-name (car (gnus-find-method-for-group @@ -8676,7 +8871,7 @@ save those articles instead." (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)) @@ -8772,9 +8967,7 @@ save those articles instead." (when (and header (gnus-summary-article-sparse-p (mail-header-number header))) (let* ((parent (gnus-parent-id (mail-header-references header))) - (thread - (and parent - (gnus-gethash parent gnus-newsgroup-dependencies)))) + (thread (and parent (gnus-id-to-thread parent)))) (when thread (delq (assq header thread) thread)))) ;; We have to really fetch the header to this article. @@ -8883,7 +9076,7 @@ save those articles instead." (setq list (cdr list)))) (let ((face (cdar list))) (unless (eq face (get-text-property beg 'face)) - (gnus-put-text-property + (gnus-put-text-property-excluding-characters-with-faces beg end 'face (setq face (if (boundp face) (symbol-value face) face))) (when gnus-summary-highlight-line-function @@ -8922,8 +9115,9 @@ save those articles instead." (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 @@ -8932,9 +9126,16 @@ save those articles instead." (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)))) + ;; Propagate the read marks to the backend. + (if (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) + (gnus-request-set-mark + group (delq nil (list (if add (list add 'add '(read))) + (if del (list del 'del '(read))))))))) ;; 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)))) @@ -8967,6 +9168,100 @@ save those articles instead." (gnus-summary-exit)) buffers))))) +(defun gnus-summary-setup-default-charset () + "Setup newsgroup default charset." + (let ((name (and gnus-newsgroup-name + (gnus-group-real-name gnus-newsgroup-name)))) + (setq gnus-newsgroup-charset + (or (and gnus-newsgroup-name + (or (gnus-group-find-parameter gnus-newsgroup-name + 'charset) + (let ((alist gnus-group-charset-alist) + elem (charset nil)) + (while (setq elem (pop alist)) + (when (and name + (string-match (car elem) name)) + (setq alist nil + charset (cadr elem)))) + charset))) + gnus-default-charset)))) + +;;; +;;; 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) + (goto-char (point-max)) + (widen) + (when (search-forward "\n--" nil t) + (let ((separator (buffer-substring (point) (gnus-point-at-eol)))) + (message-narrow-to-head) + (message-remove-header "Mime-Version") + (message-remove-header "Content-Type") + (goto-char (point-max)) + (insert (format "Content-Type: multipart/mixed; boundary=\"%s\"\n" + separator)) + (insert "Mime-Version: 1.0\n") + (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))) + +;;; +;;; 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)) + + (gnus-ems-redefine) (provide 'gnus-sum)