X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=6c3e5c46edc195684d3234332d710cb6ae32dffd;hb=8b4dd1da397e1318e77eee3dd337a271db699e5a;hp=52c558479b6277b775b45ca9e83274877955e488;hpb=d14bd1a9c69a77dfcb3c52b9960cf1d73610f9ed;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 52c5584..6c3e5c4 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1,5 +1,6 @@ ;;; gnus-sum.el --- summary mode commands for Semi-gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -40,15 +41,15 @@ (eval-when-compile (require 'mime-play) - ;; Avoid byte-compile warnings. - (defvar gnus-article-decoded-p) - (defvar gnus-decode-encoded-word-function) - ) + (require 'static)) (eval-and-compile - (autoload 'gnus-cache-articles-in-group "gnus-cache")) + (autoload 'gnus-cache-articles-in-group "gnus-cache") + (autoload 'pgg-decrypt-region "pgg" nil t) + (autoload 'pgg-verify-region "pgg" nil t)) (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t) +(autoload 'gnus-cache-write-active "gnus-cache") (autoload 'gnus-set-summary-default-charset "gnus-i18n" nil t) (defcustom gnus-kill-summary-on-exit t @@ -182,10 +183,15 @@ This variable will only be used if the value of :type 'string) (defcustom gnus-summary-goto-unread t - "*If t, marking commands will go to the next unread article. -If `never', commands that usually go to the next unread article, will -go to the next article, whether it is read or not. -If nil, only the marking commands will go to the next (un)read article." + "*If t, many commands will go to the next unread article. +This applies to marking commands as well as other commands that +\"naturally\" select the next article, like, for instance, `SPC' at +the end of an article. + +If nil, the marking commands do NOT go to the next unread article +(they go to the next article instead). If `never', commands that +usually go to the next unread article, will go to the next article, +whether it is read or not." :group 'gnus-summary-marks :link '(custom-manual "(gnus)Setting Marks") :type '(choice (const :tag "off" nil) @@ -285,6 +291,14 @@ in some newsgroups, set the variable to nil in (function-item gnus-summary-first-unread-article) (function-item gnus-summary-best-unread-article))) +(defcustom gnus-dont-select-after-jump-to-other-group nil + "If non-nil, don't select the first unread article after entering the +other group by the command `gnus-summary-jump-to-other-group'. If nil, +it is depend on the value of `gnus-auto-select-first' whether to select +or not." + :group 'gnus-group-select + :type 'boolean) + (defcustom gnus-auto-select-next t "*If non-nil, offer to go to the next group from the end of the previous. If the value is t and the next newsgroup is empty, Gnus will exit @@ -366,7 +380,7 @@ It uses the same syntax as the `gnus-split-methods' variable." (cons :value ("" "") regexp (repeat string)) (sexp :value nil)))) -(defcustom gnus-unread-mark ? ;Whitespace +(defcustom gnus-unread-mark ? ;Whitespace "*Mark used for unread articles." :group 'gnus-summary-marks :type 'character) @@ -481,7 +495,7 @@ It uses the same syntax as the `gnus-split-methods' variable." :group 'gnus-summary-marks :type 'character) -(defcustom gnus-empty-thread-mark ? ;Whitespace +(defcustom gnus-empty-thread-mark ? ;Whitespace "*There is no thread under the article." :group 'gnus-summary-marks :type 'character) @@ -563,6 +577,15 @@ with some simple extensions: :group 'gnus-summary-format :type 'string) +(defcustom gnus-list-identifiers nil + "Regexp that matches list identifiers to be removed from subject. +This can also be a list of regexps." + :group 'gnus-summary-format + :group 'gnus-article-hiding + :type '(choice (const :tag "none" nil) + (regexp :value ".*") + (repeat :value (".*") regexp))) + (defcustom gnus-summary-mark-below 0 "*Mark all articles with a score below this variable as read. This variable is local to each summary buffer and usually set by the @@ -705,7 +728,8 @@ is not run if `gnus-visual' is nil." :type 'hook) (defcustom gnus-exit-group-hook nil - "*A hook called when exiting (not quitting) summary mode." + "*A hook called when exiting summary mode. +This hook is not called from the non-updating exit commands like `Q'." :group 'gnus-various :type 'hook) @@ -766,6 +790,9 @@ automatically when it is selected." . gnus-summary-high-unread-face) ((and (< score default) (= mark gnus-unread-mark)) . gnus-summary-low-unread-face) + ((and (memq article gnus-newsgroup-incorporated) + (= mark gnus-unread-mark)) + . gnus-summary-incorporated-face) ((= mark gnus-unread-mark) . gnus-summary-normal-unread-face) ((and (> score default) (memq mark (list gnus-downloadable-mark @@ -804,6 +831,10 @@ 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 + (mime-find-field-decoder 'From 'nov) + "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 @@ -819,10 +850,14 @@ which it may alter in any way.") '(("^hk\\>\\|^tw\\>\\|\\" cn-big5) ("^cn\\>\\|\\" cn-gb-2312) ("^fj\\>\\|^japan\\>" iso-2022-jp-2) + ("^tnn\\>\\|^pin\\>\\|^sci.lang.japan" iso-2022-7bit) ("^relcom\\>" koi8-r) + ("^fido7\\>" koi8-r) ("^\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2) ("^israel\\>" iso-8859-1) ("^han\\>" euc-kr) + ("^alt.chinese.text.big5\\>" chinese-big5) + ("^soc.culture.vietnamese\\>" vietnamese-viqr) ("^\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1) (".*" iso-8859-1)) "Alist of regexps (to match group names) and default charsets to be used when reading." @@ -830,13 +865,22 @@ which it may alter in any way.") (symbol :tag "Charset"))) :group 'gnus-charset) -(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit) +(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown) "List of charsets that should be ignored. When these charsets are used in the \"charset\" parameter, the default charset will be used instead." :type '(repeat symbol) :group 'gnus-charset) +(defcustom gnus-group-ignored-charsets-alist + '(("alt\\.chinese\\.text" iso-8859-1)) + "Alist of regexps (to match group names) and charsets that should be ignored. +When these charsets are used in the \"charset\" parameter, the +default charset will be used instead." + :type '(repeat (cons (regexp :tag "Group") + (repeat symbol))) + :group 'gnus-charset) + (defcustom gnus-group-highlight-words-alist nil "Alist of group regexps and highlight regexps. This variable uses the same syntax as `gnus-emphasis-alist'." @@ -844,12 +888,67 @@ This variable uses the same syntax as `gnus-emphasis-alist'." (repeat (list (regexp :tag "Highlight regexp") (number :tag "Group for entire word" 0) (number :tag "Group for displayed part" 0) - (symbol :tag "Face" + (symbol :tag "Face" gnus-emphasis-highlight-words))))) :group 'gnus-summary-visual) +(defcustom gnus-use-wheel nil + "Use Intelli-mouse on summary movement" + :type 'boolean + :group 'gnus-summary-maneuvering) + +(defcustom gnus-wheel-scroll-amount '(5 . 1) + "Amount to scroll messages by spinning the mouse wheel. +This is actually a cons cell, where the first item is the amount to scroll +on a normal wheel event, and the second is the amount to scroll when the +wheel is moved with the shift key depressed." + :type '(cons (integer :tag "Shift") integer) + :group 'gnus-summary-maneuvering) + +(defcustom gnus-wheel-edge-resistance 2 + "How hard it should be to change the current article +by moving the mouse over the edge of the article window." + :type 'integer + :group 'gnus-summary-maneuvering) + +(defcustom gnus-summary-show-article-charset-alist + nil + "Alist of number and charset. +The article will be shown with the charset corresponding to the +numbered argument. +For example: ((1 . cn-gb-2312) (2 . big5))." + :type '(repeat (cons (number :tag "Argument" 1) + (symbol :tag "Charset"))) + :group 'gnus-charset) + +(defcustom gnus-preserve-marks t + "Whether marks are preserved when moving, copying and respooling messages." + :type 'boolean + :group 'gnus-summary-marks) + +(defcustom gnus-alter-articles-to-read-function nil + "Function to be called to alter the list of articles to be selected." + :type 'function + :group 'gnus-summary) + +(defcustom gnus-orphan-score nil + "*All orphans get this score added. Set in the score file." + :group 'gnus-score-default + :type '(choice (const nil) + integer)) + +(defcustom gnus-summary-save-parts-default-mime "image/.*" + "*A regexp to match MIME parts when saving multiple parts of a message +with gnus-summary-save-parts (X m). This regexp will be used by default +when prompting the user for which type of files to save." + :group 'gnus-summary + :type 'regexp) + + ;;; 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) @@ -860,6 +959,11 @@ This variable uses the same syntax as `gnus-emphasis-alist'." (defvar gnus-thread-indent-array nil) (defvar gnus-thread-indent-array-level gnus-thread-indent-level) +(defvar gnus-sort-gathered-threads-function 'gnus-thread-sort-by-number + "Function called to sort the articles within a thread after it has been gathered together.") + +(defvar gnus-summary-save-parts-type-history nil) +(defvar gnus-summary-save-parts-last-directory nil) ;; Avoid highlighting in kill files. (defvar gnus-summary-inhibit-highlight nil) @@ -883,9 +987,9 @@ This variable uses the same syntax as `gnus-emphasis-alist'." (?s gnus-tmp-subject-or-nil ?s) (?n gnus-tmp-name ?s) (?A (std11-address-string - (car (mime-read-field 'From gnus-tmp-header))) ?s) + (car (mime-entity-read-field gnus-tmp-header 'From))) ?s) (?a (or (std11-full-name-string - (car (mime-read-field 'From gnus-tmp-header))) + (car (mime-entity-read-field gnus-tmp-header 'From))) gnus-tmp-from) ?s) (?F gnus-tmp-from ?s) (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s) @@ -917,9 +1021,9 @@ This variable uses the same syntax as `gnus-emphasis-alist'." ?c) (?u gnus-tmp-user-defined ?s) (?P (gnus-pick-line-number) ?d)) - "An alist of format specifications that can appear in summary lines, -and what variables they correspond with, along with the type of the -variable (string, integer, character, etc).") + "An alist of format specifications that can appear in summary lines. +These are paired with what variables they correspond with, along with +the type of the variable (string, integer, character, etc).") (defvar gnus-summary-dummy-line-format-alist `((?S gnus-tmp-subject ?s) @@ -947,6 +1051,11 @@ variable (string, integer, character, etc).") (defvar gnus-last-search-regexp nil "Default regexp for article search command.") +(defvar gnus-summary-search-article-matched-data nil + "Last matched data of article search command. It is the local variable +in `gnus-article-buffer' which consists of the list of start position, +end position and text.") + (defvar gnus-last-shell-command nil "Default shell command on article.") @@ -1016,6 +1125,9 @@ variable (string, integer, character, etc).") (defvar gnus-newsgroup-scored nil "List of scored articles in the current newsgroup.") +(defvar gnus-newsgroup-incorporated nil + "List of incorporated articles in the current newsgroup.") + (defvar gnus-newsgroup-headers nil "List of article headers in the current newsgroup.") @@ -1036,7 +1148,8 @@ variable (string, integer, character, etc).") (defvar gnus-last-article nil) (defvar gnus-newsgroup-history nil) (defvar gnus-newsgroup-charset nil) -(defvar gnus-newsgroup-emphasis-alist nil) +(defvar gnus-newsgroup-ephemeral-charset nil) +(defvar gnus-newsgroup-ephemeral-ignored-charsets nil) (defconst gnus-summary-local-variables '(gnus-newsgroup-name @@ -1061,6 +1174,7 @@ variable (string, integer, character, etc).") gnus-score-alist gnus-current-score-file (gnus-summary-expunge-below . global) (gnus-summary-mark-below . global) + (gnus-orphan-score . global) gnus-newsgroup-active gnus-scores-exclude-files gnus-newsgroup-history gnus-newsgroup-ancient gnus-newsgroup-sparse gnus-newsgroup-process-stack @@ -1070,7 +1184,8 @@ variable (string, integer, character, etc).") gnus-cache-removable-articles gnus-newsgroup-cached gnus-newsgroup-data gnus-newsgroup-data-reverse gnus-newsgroup-limit gnus-newsgroup-limits - gnus-newsgroup-charset gnus-newsgroup-emphasis-alist) + gnus-newsgroup-charset + gnus-newsgroup-incorporated) "Variables that are buffer-local to the summary buffers.") ;; Byte-compiler warning. @@ -1079,7 +1194,7 @@ variable (string, integer, character, etc).") ;; Subject simplification. (defun gnus-simplify-whitespace (str) - "Remove excessive whitespace." + "Remove excessive whitespace from STR." (let ((mystr str)) ;; Multiple spaces. (while (string-match "[ \t][ \t]+" mystr) @@ -1124,7 +1239,7 @@ If RE-ONLY is non-nil, strip leading `Re:'s only." (defsubst gnus-simplify-buffer-fuzzy-step (regexp &optional newtext) (goto-char (point-min)) (while (re-search-forward regexp nil t) - (replace-match (or newtext "")))) + (replace-match (or newtext "")))) (defun gnus-simplify-buffer-fuzzy () "Simplify string in the buffer fuzzily. @@ -1132,7 +1247,7 @@ The string in the accessible portion of the current buffer is simplified. It is assumed to be a single-line subject. Whitespace is generally cleaned up, and miscellaneous leading/trailing matter is removed. Additional things can be deleted by setting -gnus-simplify-subject-fuzzy-regexp." +`gnus-simplify-subject-fuzzy-regexp'." (let ((case-fold-search t) (modified-tick)) (gnus-simplify-buffer-fuzzy-step "\t" " ") @@ -1256,6 +1371,8 @@ increase the score of each group you read." "\M-\C-h" gnus-summary-hide-thread "\M-\C-f" gnus-summary-next-thread "\M-\C-b" gnus-summary-prev-thread + [(meta down)] gnus-summary-next-thread + [(meta up)] gnus-summary-prev-thread "\M-\C-u" gnus-summary-up-thread "\M-\C-d" gnus-summary-down-thread "&" gnus-summary-execute-command @@ -1306,7 +1423,7 @@ increase the score of each group you read." "\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 + "\M-\C-a" gnus-summary-customize-parameters "\C-c\C-b" gnus-bug "*" gnus-cache-enter-article "\M-*" gnus-cache-remove-article @@ -1365,7 +1482,7 @@ increase the score of each group you read." "T" gnus-summary-limit-include-thread "d" gnus-summary-limit-exclude-dormant "t" gnus-summary-limit-to-age - "x" gnus-summary-limit-to-extra + "x" gnus-summary-limit-to-extra "E" gnus-summary-limit-include-expunged "c" gnus-summary-limit-exclude-childless-dormant "C" gnus-summary-limit-mark-excluded-as-read) @@ -1413,6 +1530,7 @@ increase the score of each group you read." "c" gnus-summary-catchup-and-exit "C" gnus-summary-catchup-all-and-exit "E" gnus-summary-exit-no-update + "J" gnus-summary-jump-to-other-group "Q" gnus-summary-exit "Z" gnus-summary-exit "n" gnus-summary-catchup-and-goto-next-group @@ -1442,7 +1560,9 @@ increase the score of each group you read." "g" gnus-summary-show-article "s" gnus-summary-isearch-article "P" gnus-summary-print-article - "t" gnus-article-babel) + "t" gnus-article-babel + "d" gnus-summary-decrypt-article + "v" gnus-summary-verify-article) (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map) "b" gnus-article-add-buttons @@ -1453,15 +1573,16 @@ increase the score of each group you read." "Q" gnus-article-fill-long-lines "C" gnus-article-capitalize-sentences "c" gnus-article-remove-cr + "Z" gnus-article-decode-HZ "f" gnus-article-display-x-face "l" gnus-summary-stop-page-breaking "r" gnus-summary-caesar-message "t" gnus-article-toggle-headers "v" gnus-summary-verbose-headers "m" gnus-summary-toggle-mime - "h" gnus-article-treat-html "H" gnus-article-strip-headers-in-body - "d" gnus-article-treat-dumbquotes) + "d" gnus-article-treat-dumbquotes + "s" gnus-smiley-display) (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) "a" gnus-article-hide @@ -1470,6 +1591,7 @@ increase the score of each group you read." "s" gnus-article-hide-signature "c" gnus-article-hide-citation "C" gnus-article-hide-citation-in-followups + "l" gnus-article-hide-list-identifiers "p" gnus-article-hide-pgp "B" gnus-article-strip-banner "P" gnus-article-hide-pem @@ -1511,6 +1633,7 @@ increase the score of each group you read." "\M-\C-e" gnus-summary-expire-articles-now "\177" gnus-summary-delete-article [delete] gnus-summary-delete-article + [backspace] gnus-summary-delete-article "m" gnus-summary-move-article "r" gnus-summary-respool-article "w" gnus-summary-edit-article @@ -1541,8 +1664,7 @@ increase the score of each group you read." "c" gnus-article-copy-part "e" gnus-article-externalize-part "i" gnus-article-inline-part - "|" gnus-article-pipe-part) - ) + "|" gnus-article-pipe-part)) (defun gnus-summary-make-menu-bar () (gnus-turn-off-edit-menu 'summary) @@ -1585,6 +1707,7 @@ increase the score of each group you read." ["Headers" gnus-article-toggle-headers t] ["Signature" gnus-article-hide-signature t] ["Citation" gnus-article-hide-citation t] + ["List identifiers" gnus-article-hide-list-identifiers t] ["PGP" gnus-article-hide-pgp t] ["Banner" gnus-article-strip-banner t] ["Boring headers" gnus-article-hide-boring-headers t]) @@ -1617,7 +1740,6 @@ increase the score of each group you read." ["Capitalize sentences" gnus-article-capitalize-sentences t] ["CR" gnus-article-remove-cr t] ["Show X-Face" gnus-article-display-x-face 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] @@ -1625,7 +1747,9 @@ increase the score of each group you read." ["Stop page breaking" gnus-summary-stop-page-breaking t] ["Toggle MIME" gnus-summary-toggle-mime t] ["Verbose header" gnus-summary-verbose-headers t] - ["Toggle header" gnus-summary-toggle-header t]) + ["Toggle header" gnus-summary-toggle-header t] + ["Toggle smileys" gnus-smiley-display t] + ["HZ" gnus-article-decode-HZ t]) ("Output" ["Save in default format" gnus-summary-save-article t] ["Save in file" gnus-summary-save-article-file t] @@ -1704,8 +1828,7 @@ increase the score of each group you read." ["Mark thread as read" gnus-summary-kill-thread t] ["Lower thread score" gnus-summary-lower-thread t] ["Raise thread score" gnus-summary-raise-thread t] - ["Rethread current" gnus-summary-rethread-current t] - )) + ["Rethread current" gnus-summary-rethread-current t])) (easy-menu-define gnus-summary-post-menu gnus-summary-mode-map "" @@ -1721,8 +1844,8 @@ increase the score of each group you read." ["Wide reply and yank" gnus-summary-wide-reply-with-original t] ["Mail forward" gnus-summary-mail-forward t] ["Post forward" gnus-summary-post-forward t] - ["Digest and mail" gnus-summary-mail-digest t] - ["Digest and post" gnus-summary-post-digest t] + ["Digest and mail" gnus-uu-digest-mail-forward t] + ["Digest and post" gnus-uu-digest-post-forward t] ["Resend message" gnus-summary-resend-message t] ["Send bounced mail" gnus-summary-resend-bounced-mail t] ["Send a mail" gnus-summary-mail-other-window t] @@ -1928,7 +2051,8 @@ increase the score of each group you read." (list 'gnus-summary-header (nth 1 header))) (list 'quote (nth 1 (car ts))) - (list 'gnus-score-default nil) + (list 'gnus-score-delta-default + nil) (nth 1 (car ps)) t) t) @@ -1983,6 +2107,9 @@ The following commands are available: (gnus-summary-set-display-table) (gnus-set-default-directory) (setq gnus-newsgroup-name group) + (unless (gnus-news-group-p group) + (setq gnus-newsgroup-incorporated + (nnmail-new-mail-numbers (gnus-group-real-name group)))) (make-local-variable 'gnus-summary-line-format) (make-local-variable 'gnus-summary-line-format-spec) (make-local-variable 'gnus-summary-dummy-line-format) @@ -2043,7 +2170,7 @@ The following commands are available: `(nth 3 ,data)) (defmacro gnus-data-set-header (data header) - `(setf (nth 3 ,data) ,header)) + `(setcar (nthcdr 3 ,data) ,header)) (defmacro gnus-data-level (data) `(nth 4 ,data)) @@ -2327,12 +2454,13 @@ marks of articles." (defun gnus-restore-hidden-threads-configuration (config) "Restore hidden threads configuration from CONFIG." - (let (point buffer-read-only) - (while (setq point (pop config)) - (when (and (< point (point-max)) - (goto-char point) - (eq (char-after) ?\n)) - (subst-char-in-region point (1+ point) ?\n ?\r))))) + (save-excursion + (let (point buffer-read-only) + (while (setq point (pop config)) + (when (and (< point (point-max)) + (goto-char point) + (eq (char-after) ?\n)) + (subst-char-in-region point (1+ point) ?\n ?\r)))))) ;; Various summary mode internalish functions. @@ -2342,9 +2470,10 @@ marks of articles." (gnus-summary-next-page nil t)) (defun gnus-summary-set-display-table () - ;; Change the display table. Odd characters have a tendency to mess - ;; up nicely formatted displays - we make all possible glyphs - ;; display only a single character. + "Change the display table. +Odd characters have a tendency to mess +up nicely formatted displays - we make all possible glyphs +display only a single character." ;; We start from the standard display table, if any. (let ((table (or (copy-sequence standard-display-table) @@ -2388,9 +2517,9 @@ marks of articles." t))) (defun gnus-set-global-variables () - ;; Set the global equivalents of the summary buffer-local variables - ;; to the latest values they had. These reflect the summary buffer - ;; that was in action when the last article was fetched. + "Set the global equivalents of the buffer-local variables. +They are set to the latest values they had. These reflect the summary +buffer that was in action when the last article was fetched." (when (eq major-mode 'gnus-summary-mode) (setq gnus-summary-buffer (current-buffer)) (let ((name gnus-newsgroup-name) @@ -2404,8 +2533,7 @@ marks of articles." (gac gnus-article-current) (reffed gnus-reffed-article-number) (score-file gnus-current-score-file) - (default-charset gnus-newsgroup-charset) - (emphasis-alist gnus-newsgroup-emphasis-alist)) + (default-charset gnus-newsgroup-charset)) (save-excursion (set-buffer gnus-group-buffer) (setq gnus-newsgroup-name name @@ -2419,8 +2547,7 @@ marks of articles." gnus-original-article-buffer original gnus-reffed-article-number reffed gnus-current-score-file score-file - gnus-newsgroup-charset default-charset - gnus-newsgroup-emphasis-alist emphasis-alist) + 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) @@ -2470,7 +2597,7 @@ marks of articles." (let ((gnus-summary-line-format-spec spec) (gnus-newsgroup-downloadable '((0 . t)))) (gnus-summary-insert-line - (make-full-mail-header 0 "" "" "" "" "" 0 0 "" nil) + (make-full-mail-header 0 "" "nobody" "" "" "" 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) @@ -2498,7 +2625,8 @@ marks of articles." (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)) + (default-mime-charset (with-current-buffer gnus-summary-buffer + default-mime-charset))) (cond ((and to gnus-ignored-from-addresses @@ -2532,7 +2660,7 @@ marks of articles." (if (or (null gnus-summary-default-score) (<= (abs (- gnus-tmp-score gnus-summary-default-score)) gnus-summary-zcore-fuzz)) - ? ;Whitespace + ? ;Whitespace (if (< gnus-tmp-score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark))) (gnus-tmp-replied @@ -2548,9 +2676,8 @@ marks of articles." (cond ((string-match "<[^>]+> *$" gnus-tmp-from) (let ((beg (match-beginning 0))) - (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) - (substring gnus-tmp-from (1+ (match-beginning 0)) - (1- (match-end 0)))) + (or (and (string-match "^\".+\"" gnus-tmp-from) + (substring gnus-tmp-from 1 (1- (match-end 0)))) (substring gnus-tmp-from 0 beg)))) ((string-match "(.+)" gnus-tmp-from) (substring gnus-tmp-from @@ -2575,7 +2702,7 @@ marks of articles." (forward-line 1)))) (defun gnus-summary-update-line (&optional dont-update) - ;; Update summary line after change. + "Update summary line after change." (when (and gnus-summary-default-score (not gnus-summary-inhibit-highlight)) (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion. @@ -2597,7 +2724,7 @@ marks of articles." (if (or (null gnus-summary-default-score) (<= (abs (- score gnus-summary-default-score)) gnus-summary-zcore-fuzz)) - ? ;Whitespace + ? ;Whitespace (if (< score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark)) 'score)) @@ -2679,6 +2806,26 @@ If NO-DISPLAY, don't generate a summary buffer." (setq group nil))) result)) +(defun gnus-summary-jump-to-other-group (group &optional show-all) + "Directly jump to the other GROUP from summary buffer. +If SHOW-ALL is non-nil, already read articles are also listed." + (interactive + (if (eq gnus-summary-buffer (current-buffer)) + (list (completing-read + "Group: " gnus-active-hashtb nil t + (when (and gnus-newsgroup-name + (string-match "[.:][^.:]+$" gnus-newsgroup-name)) + (substring gnus-newsgroup-name 0 (1+ (match-beginning 0)))) + 'gnus-group-history) + current-prefix-arg) + (error "%s must be invoked from a gnus summary buffer." this-command))) + (unless (or (zerop (length group)) + (and gnus-newsgroup-name + (string-equal gnus-newsgroup-name group))) + (gnus-summary-exit) + (gnus-summary-read-group group show-all + gnus-dont-select-after-jump-to-other-group))) + (defun gnus-summary-read-group-1 (group show-all no-article kill-buffer no-display &optional select-articles) @@ -2748,6 +2895,7 @@ If NO-DISPLAY, don't generate a summary buffer." (gnus-summary-set-local-parameters gnus-newsgroup-name) (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy) + (gnus-update-summary-mark-positions) ;; Do score processing. (when gnus-use-scoring (gnus-possibly-score-headers)) @@ -2760,6 +2908,7 @@ If NO-DISPLAY, don't generate a summary buffer." (let ((gnus-newsgroup-dormant nil)) (gnus-summary-initial-limit show-all)) (gnus-summary-initial-limit show-all)) + ;; When untreaded, all articles are always shown. (setq gnus-newsgroup-limit (mapcar (lambda (header) (mail-header-number header)) @@ -2884,7 +3033,8 @@ If NO-DISPLAY, don't generate a summary buffer." "Query where the respool algorithm would put this article." (interactive) (gnus-summary-select-article) - (message (gnus-general-simplify-subject (gnus-summary-article-subject)))) + (message "%s" + (gnus-general-simplify-subject (gnus-summary-article-subject)))) (defun gnus-gather-threads-by-subject (threads) "Gather threads by looking at Subject headers." @@ -2958,12 +3108,12 @@ If NO-DISPLAY, don't generate a summary buffer." result)) (defun gnus-sort-gathered-threads (threads) - "Sort subtreads inside each gathered thread by article number." + "Sort subtreads inside each gathered thread by `gnus-sort-gathered-threads-function'." (let ((result threads)) (while threads (when (stringp (caar threads)) (setcdr (car threads) - (sort (cdar threads) 'gnus-thread-sort-by-number))) + (sort (cdar threads) gnus-sort-gathered-threads-function))) (setq threads (cdr threads))) result)) @@ -3098,6 +3248,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (defun gnus-build-sparse-threads () (let ((headers gnus-newsgroup-headers) + (mail-parse-charset gnus-newsgroup-charset) (gnus-summary-ignore-duplicates t) header references generation relations subject child end new-child date) @@ -3131,7 +3282,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (mapcar (lambda (relation) (when (gnus-dependencies-add-header - (make-full-mail-header + (make-full-mail-header-from-decoded-header gnus-reffed-article-number (nth 3 relation) "" (or (nth 4 relation) "") (nth 1 relation) @@ -3150,7 +3301,8 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." ;; fetch the headers for the articles that aren't there. This will ;; build complete threads - if the roots haven't been expired by the ;; server, that is. - (let (id heads) + (let ((mail-parse-charset gnus-newsgroup-charset) + id heads) (mapatoms (lambda (refs) (when (not (car (symbol-value refs))) @@ -3173,31 +3325,38 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." header) ;; overview: [num subject from date id refs chars lines misc] - (unless (eobp) - (forward-char)) - - (setq header - (make-full-mail-header - number ; number - (nnheader-nov-field) ; subject - (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 + (unwind-protect + (progn + (narrow-to-region (point) eol) + (unless (eobp) + (forward-char)) + + (setq header + (make-full-mail-header + number ; number + (nnheader-nov-field) ; subject + (nnheader-nov-field) ; from + (nnheader-nov-field) ; date + (nnheader-nov-read-message-id) ; id + (nnheader-nov-field) ; refs + (nnheader-nov-read-integer) ; chars + (nnheader-nov-read-integer) ; lines + (unless (eobp) + (if (looking-at "Xref: ") + (goto-char (match-end 0))) + (nnheader-nov-field)) ; Xref + (nnheader-nov-parse-extra)))) ; extra + + (widen)) (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 - ;; the id of the parent article (if any). + "Look through the buffer of NOV lines and find the header to ID. +Enter this line into the dependencies hash table, and return +the id of the parent article (if any)." (let ((deps gnus-newsgroup-dependencies) found header) (prog1 @@ -3232,6 +3391,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (defun gnus-build-all-threads () "Read all the headers." (let ((gnus-summary-ignore-duplicates t) + (mail-parse-charset gnus-newsgroup-charset) (dependencies gnus-newsgroup-dependencies) header article) (save-excursion @@ -3241,8 +3401,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (while (not (eobp)) (ignore-errors (setq article (read (current-buffer)) - header (gnus-nov-parse-line - article dependencies))) + header (gnus-nov-parse-line article dependencies))) (when header (save-excursion (set-buffer gnus-summary-buffer) @@ -3279,17 +3438,19 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (memq article gnus-newsgroup-expirable) ;; Only insert the Subject string when it's different ;; from the previous Subject string. - (if (gnus-subject-equal - (condition-case () - (mail-header-subject - (gnus-data-header - (cadr - (gnus-data-find-list - article - (gnus-data-list t))))) - ;; Error on the side of excessive subjects. - (error "")) - (mail-header-subject header)) + (if (and + gnus-show-threads + (gnus-subject-equal + (condition-case () + (mail-header-subject + (gnus-data-header + (cadr + (gnus-data-find-list + article + (gnus-data-list t))))) + ;; Error on the side of excessive subjects. + (error "")) + (mail-header-subject header))) "" (mail-header-subject header)) nil (cdr (assq article gnus-newsgroup-scored)) @@ -3503,7 +3664,6 @@ If LINE, insert the rebuilt thread starting on line LINE." (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) @@ -3515,6 +3675,7 @@ If LINE, insert the rebuilt thread starting on line LINE." (gnus-remove-thread-1 (pop thread))) (when (setq d (gnus-data-find number)) (goto-char (gnus-data-pos d)) + (gnus-summary-show-thread) (gnus-data-remove number (- (gnus-point-at-bol) @@ -3522,13 +3683,22 @@ If LINE, insert the rebuilt thread starting on line LINE." (1+ (gnus-point-at-eol)) (gnus-delete-line))))))) +(defun gnus-sort-threads-1 (threads func) + (sort (mapcar (lambda (thread) + (cons (car thread) + (and (cdr thread) + (gnus-sort-threads-1 (cdr thread) func)))) + threads) func)) + (defun gnus-sort-threads (threads) "Sort THREADS." (if (not gnus-thread-sort-functions) threads (gnus-message 8 "Sorting threads...") (prog1 - (sort threads (gnus-make-sort-function gnus-thread-sort-functions)) + (gnus-sort-threads-1 + threads + (gnus-make-sort-function gnus-thread-sort-functions)) (gnus-message 8 "Sorting threads...done")))) (defun gnus-sort-articles (articles) @@ -3543,12 +3713,12 @@ If LINE, insert the rebuilt thread starting on line LINE." ;; Written by Hallvard B Furuseth . (defmacro gnus-thread-header (thread) - ;; Return header of first article in THREAD. - ;; Note that THREAD must never, ever be anything else than a variable - - ;; using some other form will lead to serious barfage. + "Return header of first article in THREAD. +Note that THREAD must never, ever be anything else than a variable - +using some other form will lead to serious barfage." (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread))) ;; (8% speedup to gnus-summary-prepare, just for fun :-) - (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ; + (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" (vector thread) 2)) (defsubst gnus-article-sort-by-number (h1 h2) @@ -3584,11 +3754,11 @@ If LINE, insert the rebuilt thread starting on line LINE." (defsubst gnus-article-sort-by-author (h1 h2) "Sort articles by root author." (string-lessp - (let ((addr (car (mime-read-field 'From h1)))) + (let ((addr (car (mime-entity-read-field h1 'From)))) (or (std11-full-name-string addr) (std11-address-string addr) "")) - (let ((addr (car (mime-read-field 'From h2)))) + (let ((addr (car (mime-entity-read-field h2 'From)))) (or (std11-full-name-string addr) (std11-address-string addr) "")) @@ -3876,7 +4046,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 + ? ;Whitespace (if (< gnus-tmp-score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark)) gnus-tmp-replied @@ -3894,9 +4064,8 @@ or a straight list of headers." (cond ((string-match "<[^>]+> *$" gnus-tmp-from) (setq beg-match (match-beginning 0)) - (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) - (substring gnus-tmp-from (1+ (match-beginning 0)) - (1- (match-end 0)))) + (or (and (string-match "^\".+\"" gnus-tmp-from) + (substring gnus-tmp-from 1 (1- (match-end 0)))) (substring gnus-tmp-from 0 beg-match))) ((string-match "(.+)" gnus-tmp-from) (substring gnus-tmp-from @@ -3960,6 +4129,24 @@ or a straight list of headers." (cdr (assq number gnus-newsgroup-scored)) (memq number gnus-newsgroup-processable)))))) +(defun gnus-summary-remove-list-identifiers () + "Remove list identifiers in `gnus-list-identifiers' from articles in the current group." + (let ((regexp (if (stringp gnus-list-identifiers) + gnus-list-identifiers + (mapconcat 'identity gnus-list-identifiers " *\\|")))) + (dolist (header gnus-newsgroup-headers) + (when (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp + " *\\)\\)+\\(Re: +\\)?\\)") + (mail-header-subject header)) + (mail-header-set-subject + header (concat (substring (mail-header-subject header) + 0 (match-beginning 1)) + (or + (match-string 3 (mail-header-subject header)) + (match-string 5 (mail-header-subject header))) + (substring (mail-header-subject header) + (match-end 1)))))))) + (defun gnus-select-newsgroup (group &optional read-all select-articles) "Select newsgroup GROUP. If READ-ALL is non-nil, all articles in the group are selected. @@ -3996,7 +4183,6 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq gnus-newsgroup-unselected nil) (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) (gnus-summary-setup-default-charset) - (gnus-summary-setup-highlight-words) ;; Adjust and set lists of article marks. (when info @@ -4077,6 +4263,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; Let the Gnus agent mark articles as read. (when gnus-agent (gnus-agent-get-undownloaded-list)) + ;; Remove list identifiers from subject + (when gnus-list-identifiers + (gnus-summary-remove-list-identifiers)) ;; Check whether auto-expire is to be done in this group. (setq gnus-newsgroup-auto-expire (gnus-group-auto-expirable-p group)) @@ -4094,7 +4283,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (or gnus-newsgroup-headers t))))) (defun gnus-articles-to-read (group &optional read-all) - ;; Find out what articles the user wants to read. + "Find out what articles the user wants to read." (let* ((articles ;; Select all articles if `read-all' is non-nil, or if there ;; are no unread articles. @@ -4103,7 +4292,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." (zerop (length gnus-newsgroup-unreads))) (eq (gnus-group-find-parameter group 'display) 'all)) - (gnus-uncompress-range (gnus-active group)) + (or + (gnus-uncompress-range (gnus-active group)) + (gnus-cache-articles-in-group group)) (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked (copy-sequence gnus-newsgroup-unreads)) '<))) @@ -4122,15 +4313,14 @@ If SELECT-ARTICLES, only select those articles from GROUP." ((and (or (<= scored marked) (= scored number)) (natnump gnus-large-newsgroup) (> number gnus-large-newsgroup)) - (let* ((minibuffer-setup-hook (append - minibuffer-setup-hook - '(beginning-of-line))) - (input (read-string + (let* ((cursor-in-echo-area nil) + (input (read-from-minibuffer (format "How many articles from %s (max %d): " (gnus-limit-string gnus-newsgroup-name 35) number) - (number-to-string gnus-large-newsgroup)))) + (cons (number-to-string gnus-large-newsgroup) + 0)))) (if (string-match "^[ \t]*$" input) number input))) @@ -4144,7 +4334,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." (if (string-match "^[ \t]*$" input) number input))) (t number)) - (quit nil)))))) + (quit + (message "Quit getting the articles to read") + nil)))))) (setq select (if (stringp select) (string-to-number select) select)) (if (or (null select) (zerop select)) select @@ -4164,6 +4356,12 @@ If SELECT-ARTICLES, only select those articles from GROUP." (gnus-sorted-intersection gnus-newsgroup-unreads (gnus-sorted-complement gnus-newsgroup-unreads articles))) + (when gnus-alter-articles-to-read-function + (setq gnus-newsgroup-unreads + (sort + (funcall gnus-alter-articles-to-read-function + gnus-newsgroup-name gnus-newsgroup-unreads) + '<))) articles))) (defun gnus-killed-articles (killed articles) @@ -4249,9 +4447,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; Add all marks lists to the list of marks lists. (while (setq type (pop types)) (setq list (symbol-value - (setq symbol - (intern (format "gnus-newsgroup-%s" - (car type)))))) + (setq symbol + (intern (format "gnus-newsgroup-%s" + (car type)))))) (when list ;; Get rid of the entries of the articles that have the @@ -4270,30 +4468,36 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq arts (cdr arts))) (setq list (cdr all))))) - (or (memq (cdr type) uncompressed) - (setq list (gnus-compress-sequence (set symbol (sort list '<)) t))) - - (when (gnus-check-backend-function 'request-set-mark - gnus-newsgroup-name) - ;; uncompressed:s are not proper flags (they are cons cells) - ;; cache is a internal gnus flag - (unless (memq (cdr type) (cons 'cache uncompressed)) - (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) - (del (gnus-remove-from-range (gnus-copy-sequence old) list)) - (add (gnus-remove-from-range (gnus-copy-sequence list) old))) - (if add - (push (list add 'add (list (cdr type))) delta-marks)) - (if del - (push (list del 'del (list (cdr type))) delta-marks))))) - + (unless (memq (cdr type) uncompressed) + (setq list (gnus-compress-sequence (set symbol (sort list '<)) t))) + + (when (gnus-check-backend-function + 'request-set-mark gnus-newsgroup-name) + ;; propagate flags to server, with the following exceptions: + ;; uncompressed:s are not proper flags (they are cons cells) + ;; cache is a internal gnus flag + ;; download are local to one gnus installation (well) + ;; unsend are for nndraft groups only + ;; xxx: generality of this? this suits nnimap anyway + (unless (memq (cdr type) (append '(cache download unsend) + uncompressed)) + (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) + (del (gnus-remove-from-range (gnus-copy-sequence old) list)) + (add (gnus-remove-from-range + (gnus-copy-sequence list) old))) + (when add + (push (list add 'add (list (cdr type))) delta-marks)) + (when del + (push (list del 'del (list (cdr type))) delta-marks))))) + (when list - (push (cons (cdr type) list) newmarked))) + (push (cons (cdr type) list) newmarked))) (when delta-marks (unless (gnus-check-group gnus-newsgroup-name) (error "Can't open server for %s" gnus-newsgroup-name)) (gnus-request-set-mark gnus-newsgroup-name delta-marks)) - + ;; Enter these new marks into the info of the group. (if (nthcdr 3 info) (setcar (nthcdr 3 info) newmarked) @@ -4309,7 +4513,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setcdr (nthcdr i info) nil))))))) (defun gnus-set-mode-line (where) - "This function sets the mode line of the article or summary buffers. + "Set the mode line of the article or summary buffers. If WHERE is `summary', the summary mode line format will be used." ;; Is this mode line one we keep updated? (when (and (memq where gnus-updated-mode-lines) @@ -4325,7 +4529,11 @@ If WHERE is `summary', the summary mode line format will be used." (let* ((mformat (symbol-value (intern (format "gnus-%s-mode-line-format-spec" where)))) - (gnus-tmp-group-name gnus-newsgroup-name) + (gnus-tmp-group-name (gnus-group-name-decode + gnus-newsgroup-name + (gnus-group-name-charset + nil + gnus-newsgroup-name))) (gnus-tmp-article-number (or gnus-current-article 0)) (gnus-tmp-unread gnus-newsgroup-unreads) (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads)) @@ -4520,7 +4728,12 @@ The resulting hash table is returned, or nil if no Xrefs were found." (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-dependencies))) headers id end ref - (mail-parse-charset gnus-newsgroup-charset)) + (mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets + (save-excursion (condition-case nil + (set-buffer gnus-summary-buffer) + (error)) + gnus-newsgroup-ignored-charsets))) (save-excursion (set-buffer nntp-server-buffer) ;; Translate all TAB characters into SPACE characters. @@ -4557,19 +4770,20 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (goto-char p) (if (search-forward "\nsubject: " nil t) - (buffer-substring (match-end 0) (std11-field-end)) + (nnheader-header-value) "(none)")) ;; From. (progn (goto-char p) - (if (search-forward "\nfrom: " nil t) - (buffer-substring (match-end 0) (std11-field-end)) + (if (or (search-forward "\nfrom: " nil t) + (search-forward "\nfrom:" nil t)) + (nnheader-header-value) "(nobody)")) ;; Date. (progn (goto-char p) (if (search-forward "\ndate: " nil t) - (buffer-substring (match-end 0) (std11-field-end)) + (nnheader-header-value) "")) ;; Message-ID. (progn @@ -4590,7 +4804,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (setq end (point)) (prog1 - (buffer-substring (match-end 0) (std11-field-end)) + (nnheader-header-value) (setq ref (buffer-substring (progn @@ -4604,9 +4818,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; were no references and the in-reply-to header looks ;; promising. (if (and (search-forward "\nin-reply-to: " nil t) - (setq in-reply-to - (buffer-substring (match-end 0) - (std11-field-end))) + (setq in-reply-to (nnheader-header-value)) (string-match "<[^>]+>" in-reply-to)) (let (ref2) (setq ref (substring in-reply-to (match-beginning 0) @@ -4636,7 +4848,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (goto-char p) (and (search-forward "\nxref: " nil t) - (buffer-substring (match-end 0) (std11-field-end)))) + (nnheader-header-value))) ;; Extra. (when gnus-extra-headers (let ((extra gnus-extra-headers) @@ -4645,16 +4857,12 @@ The resulting hash table is returned, or nil if no Xrefs were found." (goto-char p) (when (search-forward (concat "\n" (symbol-name (car extra)) ": ") nil t) - (push (cons (car extra) - (buffer-substring (match-end 0) - (std11-field-end))) - out)) + (push (cons (car extra) (nnheader-header-value)) out)) (pop extra)) out)))) (goto-char p) (if (and (search-forward "\ncontent-type: " nil t) - (setq ctype - (buffer-substring (match-end 0) (std11-field-end)))) + (setq ctype (nnheader-header-value))) (mime-entity-set-content-type-internal header (mime-parse-Content-Type ctype))) (when (equal id ref) @@ -4677,12 +4885,14 @@ The resulting hash table is returned, or nil if no Xrefs were found." (defun gnus-get-newsgroup-headers-xover (sequence &optional force-new dependencies group also-fetch-heads) - "Parse the news overview data in the server buffer, and return a -list of headers that match SEQUENCE (see `nntp-retrieve-headers')." + "Parse the news overview data in the server buffer. +Return a list of headers that match SEQUENCE (see +`nntp-retrieve-headers')." ;; Get the Xref when the users reads the articles since most/some ;; NNTP servers do not include Xrefs when using XOVER. (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) (let ((mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) (cur nntp-server-buffer) (dependencies (or dependencies gnus-newsgroup-dependencies)) number headers header) @@ -4742,7 +4952,8 @@ 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 (char-after)) ?x) + (when (or (and (not (eobp)) + (eq (downcase (char-after)) ?x) (looking-at "Xref:")) (search-forward "\nXref:" nil t)) (goto-char (1+ (match-end 0))) @@ -5005,6 +5216,7 @@ If `gnus-auto-center-summary' is nil, or the article buffer isn't displayed, no centering will be performed." ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. + (interactive) (let* ((top (cond ((< (window-height) 4) 0) ((< (window-height) 7) 1) (t (if (numberp gnus-auto-center-summary) @@ -5024,7 +5236,8 @@ displayed, no centering will be performed." ;; whichever is the least. (set-window-start window (min bottom (save-excursion - (forward-line (- top)) (point))))) + (forward-line (- top)) (point))) + t)) ;; Do horizontal recentering while we're at it. (when (and (get-buffer-window (current-buffer) t) (not (eq gnus-auto-center-summary 'vertical))) @@ -5064,7 +5277,10 @@ displayed, no centering will be performed." ;; If the range of read articles is a single range, then the ;; first unread article is the article after the last read ;; article. Sounds logical, doesn't it? - (if (not (listp (cdr read))) + (if (and (not (listp (cdr read))) + (or (< (car read) (car active)) + (progn (setq read (list read)) + nil))) (setq first (max (car active) (1+ (cdr read)))) ;; `read' is a list of ranges. (when (/= (setq nlast (or (and (numberp (car read)) (car read)) @@ -5121,8 +5337,7 @@ displayed, no centering will be performed." (key-binding (read-key-sequence (substitute-command-keys - "\\\\[gnus-summary-universal-argument]" - )))) + "\\\\[gnus-summary-universal-argument]")))) 'undefined) (gnus-error 1 "Undefined key") (save-excursion @@ -5157,7 +5372,10 @@ The prefix argument ALL means to select all articles." (gnus-summary-jump-to-group group) (when rescan (save-excursion - (gnus-group-get-new-news-this-group 1))) + (save-window-excursion + ;; Don't show group contents. + (set-window-start (selected-window) (point-max)) + (gnus-group-get-new-news-this-group 1)))) (gnus-group-read-group all t) (gnus-summary-goto-subject current-subject nil t))) @@ -5218,7 +5436,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (defun gnus-summary-exit (&optional temporary) "Exit reading current newsgroup, and then return to group selection mode. -gnus-exit-group-hook is called with no arguments if that value is non-nil." +`gnus-exit-group-hook' is called with no arguments if that value is non-nil." (interactive) (gnus-set-global-variables) (gnus-kill-save-kill-buffer) @@ -5247,6 +5465,8 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (gnus-dup-enter-articles)) (when gnus-use-trees (gnus-tree-close group)) + (when gnus-use-cache + (gnus-cache-write-active)) ;; Remove entries for this group. (nnmail-purge-split-history (gnus-group-real-name group)) ;; Make all changes in this group permanent. @@ -5294,7 +5514,14 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (if (not quit-config) (progn (goto-char group-point) - (gnus-configure-windows 'group 'force)) + (gnus-configure-windows 'group 'force) + (unless (pos-visible-in-window-p) + (forward-line (/ (static-if (featurep 'xemacs) + (window-displayed-height) + (1- (window-height))) + -2)) + (set-window-start (selected-window) (point)) + (goto-char group-point))) (gnus-handle-ephemeral-exit quit-config)) ;; Clear the current group name. (unless quit-config @@ -5312,7 +5539,7 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (gnus-async-halt-prefetch) (mapcar 'funcall (delq 'gnus-summary-expire-articles - (copy-list gnus-summary-prepare-exit-hook))) + (copy-sequence gnus-summary-prepare-exit-hook))) ;; If we have several article buffers, we kill them at exit. (unless gnus-single-article-buffer (gnus-kill-buffer gnus-article-buffer) @@ -5428,7 +5655,8 @@ The state which existed when entering the ephemeral is reset." (rename-buffer (concat (substring name 0 (match-beginning 0)) "Dead " (substring name (match-beginning 0))) - t)))) + t) + (bury-buffer)))) (defun gnus-kill-or-deaden-summary (buffer) "Kill or deaden the summary BUFFER." @@ -5595,8 +5823,8 @@ returned." (if backward (gnus-summary-find-prev unread) (gnus-summary-find-next unread))) - (gnus-summary-show-thread) - (setq n (1- n))) + (unless (zerop (setq n (1- n))) + (gnus-summary-show-thread))) (when (/= 0 n) (gnus-message 7 "No more%s articles" (if unread " unread" ""))) @@ -5664,6 +5892,9 @@ Given a prefix, will force an `article' buffer configuration." (if gnus-summary-display-article-function (funcall gnus-summary-display-article-function article all-header) (gnus-article-prepare article all-header)) + (with-current-buffer gnus-article-buffer + (set (make-local-variable 'gnus-summary-search-article-matched-data) + nil)) (gnus-run-hooks 'gnus-select-article-hook) (when (and gnus-current-article (not (zerop gnus-current-article))) @@ -5687,37 +5918,34 @@ be displayed." (set-buffer gnus-summary-buffer)) (let ((article (or article (gnus-summary-article-number))) (all-headers (not (not all-headers))) ;Must be T or NIL. - gnus-summary-display-article-function - did) + gnus-summary-display-article-function) (and (not pseudo) (gnus-summary-article-pseudo-p article) (error "This is a pseudo-article")) - (prog1 - (save-excursion - (set-buffer gnus-summary-buffer) - (if (or (and gnus-single-article-buffer - (or (null gnus-current-article) - (null gnus-article-current) - (null (get-buffer gnus-article-buffer)) - (not (eq article (cdr gnus-article-current))) - (not (equal (car gnus-article-current) - gnus-newsgroup-name)))) - (and (not gnus-single-article-buffer) - (or (null gnus-current-article) - (not (eq gnus-current-article article)))) - force) - ;; The requested article is different from the current article. - (prog1 - (gnus-summary-display-article article all-headers) - (setq did article) - (when (or all-headers gnus-show-all-headers) - (gnus-article-show-all-headers))) + (save-excursion + (set-buffer gnus-summary-buffer) + (if (or (and gnus-single-article-buffer + (or (null gnus-current-article) + (null gnus-article-current) + (null (get-buffer gnus-article-buffer)) + (not (eq article (cdr gnus-article-current))) + (not (equal (car gnus-article-current) + gnus-newsgroup-name)))) + (and (not gnus-single-article-buffer) + (or (null gnus-current-article) + (not (eq gnus-current-article article)))) + force) + ;; The requested article is different from the current article. + (progn + (gnus-summary-display-article article all-headers) (when (or all-headers gnus-show-all-headers) (gnus-article-show-all-headers)) - 'old)) - (when did - (gnus-article-set-window-start - (cdr (assq article gnus-newsgroup-bookmarks))))))) + (gnus-article-set-window-start + (cdr (assq article gnus-newsgroup-bookmarks))) + article) + (when (or all-headers gnus-show-all-headers) + (gnus-article-show-all-headers)) + 'old)))) (defun gnus-summary-set-current-mark (&optional current-mark) "Obsolete function." @@ -6129,7 +6357,21 @@ If given a prefix, remove all limits." "Limit the summary buffer to articles that are older than (or equal) AGE days. If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to articles that are younger than AGE days." - (interactive "nLimit to articles older than (in days): \nP") + (interactive + (let ((younger current-prefix-arg) + (days-got nil) + days) + (while (not days-got) + (setq days (if younger + (read-string "Limit to articles within (in days): ") + (read-string "Limit to articles old than (in days): "))) + (when (> (length days) 0) + (setq days (read days))) + (if (numberp days) + (setq days-got t) + (message "Please enter a number.") + (sleep-for 1))) + (list days younger))) (prog1 (let ((data gnus-newsgroup-data) (cutoff (days-to-time age)) @@ -6138,7 +6380,9 @@ articles that are younger than AGE days." (when (and (vectorp (gnus-data-header d)) (setq date (mail-header-date (gnus-data-header d)))) (setq is-younger (time-less-p - (time-since (date-to-time date)) + (time-since (condition-case () + (date-to-time date) + (error '(0 0)))) cutoff)) (when (if younger-p is-younger @@ -6153,12 +6397,12 @@ articles that are younger than AGE days." (let ((header (intern (gnus-completing-read - (symbol-name (car gnus-extra-headers)) - "Score extra header:" - (mapcar (lambda (x) + (symbol-name (car gnus-extra-headers)) + "Limit extra header:" + (mapcar (lambda (x) (cons (symbol-name x) x)) gnus-extra-headers) - nil + nil t)))) (list header (read-string (format "Limit to header %s (regexp): " header))))) @@ -6368,6 +6612,7 @@ If ALL, mark even excluded ticked and dormants as read." "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) + (numberp gnus-fetch-old-headers) (eq gnus-build-sparse-threads 'some) (eq gnus-build-sparse-threads 'more)) ;; Deal with old-fetched headers and sparse threads. @@ -6397,6 +6642,7 @@ If ALL, mark even excluded ticked and dormants as read." "Cut off all uninteresting articles from the beginning of threads." (when (or (eq gnus-fetch-old-headers 'some) (eq gnus-fetch-old-headers 'invisible) + (numberp gnus-fetch-old-headers) (eq gnus-build-sparse-threads 'some) (eq gnus-build-sparse-threads 'more)) (let ((th threads)) @@ -6414,6 +6660,7 @@ fetch-old-headers verbiage, and so on." (if (or gnus-inhibit-limiting (and (null gnus-newsgroup-dormant) (not (eq gnus-fetch-old-headers 'some)) + (not (numberp gnus-fetch-old-headers)) (not (eq gnus-fetch-old-headers 'invisible)) (null gnus-summary-expunge-below) (not (eq gnus-build-sparse-threads 'some)) @@ -6467,7 +6714,8 @@ fetch-old-headers verbiage, and so on." (zerop children)) ;; If this is "fetch-old-headered" and there is no ;; visible children, then we don't want this article. - (and (eq gnus-fetch-old-headers 'some) + (and (or (eq gnus-fetch-old-headers 'some) + (numberp gnus-fetch-old-headers)) (gnus-summary-article-ancient-p number) (zerop children)) ;; If this is "fetch-old-headered" and `invisible', then @@ -6618,11 +6866,9 @@ of what's specified by the `gnus-refer-thread-limit' variable." (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)) (gnus-summary-limit-include-thread id))) -(defun gnus-summary-refer-article (message-id &optional arg) - "Fetch an article specified by MESSAGE-ID. -If ARG (the prefix), fetch the article using `gnus-refer-article-method' -or `gnus-select-method', no matter what backend the article comes from." - (interactive "sMessage-ID: \nP") +(defun gnus-summary-refer-article (message-id) + "Fetch an article specified by MESSAGE-ID." + (interactive "sMessage-ID: ") (when (and (stringp message-id) (not (zerop (length message-id)))) ;; Construct the correct Message-ID if necessary. @@ -6636,7 +6882,8 @@ 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)))) + gnus-newsgroup-limit))) + number) (cond ;; If the article is present in the buffer we just go to it. ((and header @@ -6649,22 +6896,38 @@ or `gnus-select-method', no matter what backend the article comes from." (when sparse (gnus-summary-update-article (mail-header-number header))))) (t - ;; We fetch the article - (let ((gnus-override-method - (cond ((gnus-news-group-p gnus-newsgroup-name) - gnus-refer-article-method) - (arg - (or gnus-refer-article-method gnus-select-method)) - (t nil))) - number) - ;; Start the special refer-article method, if necessary. - (when (and gnus-refer-article-method - (gnus-news-group-p gnus-newsgroup-name)) - (gnus-check-server gnus-refer-article-method)) - ;; Fetch the header, and display the article. - (if (setq number (gnus-summary-insert-subject message-id)) + ;; We fetch the article. + (catch 'found + (dolist (gnus-override-method (gnus-refer-article-methods)) + (gnus-check-server gnus-override-method) + ;; Fetch the header, and display the article. + (when (setq number (gnus-summary-insert-subject message-id)) (gnus-summary-select-article nil nil nil number) - (gnus-message 3 "Couldn't fetch article %s" message-id)))))))) + (throw 'found t))) + (gnus-message 3 "Couldn't fetch article %s" message-id))))))) + +(defun gnus-refer-article-methods () + "Return a list of referrable methods." + (cond + ;; No method, so we default to current and native. + ((null gnus-refer-article-method) + (list gnus-current-select-method gnus-select-method)) + ;; Current. + ((eq 'current gnus-refer-article-method) + (list gnus-current-select-method)) + ;; List of select methods. + ((not (and (symbolp (car gnus-refer-article-method)) + (assq (car gnus-refer-article-method) nnoo-definition-alist))) + (let (out) + (dolist (method gnus-refer-article-method) + (push (if (eq 'current method) + gnus-current-select-method + method) + out)) + (nreverse out))) + ;; One single select method. + (t + (list gnus-refer-article-method)))) (defun gnus-summary-edit-parameters () "Edit the group parameters of the current group." @@ -6697,8 +6960,17 @@ to guess what the document format is." (list (cons 'save-article-group ogroup)))) (case-fold-search t) (buf (current-buffer)) - dig) + dig to-address) (save-excursion + (set-buffer gnus-original-article-buffer) + ;; Have the digest group inherit the main mail address of + ;; the parent article. + (when (setq to-address (or (message-fetch-field "reply-to") + (message-fetch-field "from"))) + (setq params (append + (list (cons 'to-address + (funcall gnus-decode-encoded-word-function + to-address)))))) (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*")) (insert-buffer-substring gnus-original-article-buffer) ;; Remove lines that may lead nndoc to misinterpret the @@ -6707,14 +6979,17 @@ to guess what the document format is." (goto-char (point-min)) (or (search-forward "\n\n" nil t) (point))) (goto-char (point-min)) - (delete-matching-lines "^\\(Path\\):\\|^From ") + (delete-matching-lines "^Path:\\|^From ") (widen)) (unwind-protect - (if (gnus-group-read-ephemeral-group - name `(nndoc ,name (nndoc-address ,(get-buffer dig)) - (nndoc-article-type - ,(if force 'digest 'guess))) t) - ;; Make all postings to this group go to the parent group. + (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset) + (gnus-newsgroup-ephemeral-ignored-charsets + gnus-newsgroup-ignored-charsets)) + (gnus-group-read-ephemeral-group + name `(nndoc ,name (nndoc-address ,(get-buffer dig)) + (nndoc-article-type + ,(if force 'mbox 'guess))) t)) + ;; Make all postings to this group go to the parent group. (nconc (gnus-info-params (gnus-get-info name)) params) ;; Couldn't select this doc group. @@ -6778,12 +7053,16 @@ Obeys the standard process/prefix convention." "Do incremental search forward on the current article. If REGEXP-P (the prefix) is non-nil, do regexp isearch." (interactive "P") - (gnus-summary-select-article) - (gnus-configure-windows 'article) - (gnus-eval-in-buffer-window gnus-article-buffer - (save-restriction - (widen) - (isearch-forward regexp-p)))) + (let* ((gnus-inhibit-treatment t) + (old (gnus-summary-select-article))) + (gnus-configure-windows 'article) + (gnus-eval-in-buffer-window gnus-article-buffer + (save-restriction + (widen) + (when (eq 'old old) + (gnus-article-show-all-headers)) + (goto-char (point-min)) + (isearch-forward regexp-p))))) (defun gnus-summary-search-article-forward (regexp &optional backward) "Search for an article containing REGEXP forward. @@ -6813,6 +7092,84 @@ If BACKWARD, search backward instead." ""))))) (gnus-summary-search-article-forward regexp 'backward)) +(eval-when-compile + (defmacro gnus-summary-search-article-position-point (regexp backward) + "Dehighlight the last matched text and goto the beginning position." + (` (if (and gnus-summary-search-article-matched-data + (let ((text (caddr gnus-summary-search-article-matched-data)) + (inhibit-read-only t) + buffer-read-only) + (delete-region + (goto-char (car gnus-summary-search-article-matched-data)) + (cadr gnus-summary-search-article-matched-data)) + (insert text) + (string-match (, regexp) text))) + (if (, backward) (beginning-of-line) (end-of-line)) + (goto-char (if (, backward) (point-max) (point-min)))))) + + (defmacro gnus-summary-search-article-highlight-goto-x-face (opoint) + "Place point where X-Face image is displayed." + (if (featurep 'xemacs) + (` (let ((end (if (search-forward "\n\n" nil t) + (goto-char (1- (point))) + (point-min))) + extent) + (or (search-backward "\n\n" nil t) (goto-char (point-min))) + (unless (and (re-search-forward "^From:" end t) + (setq extent (extent-at (point))) + (extent-begin-glyph extent)) + (goto-char (, opoint))))) + (` (let ((end (if (search-forward "\n\n" nil t) + (goto-char (1- (point))) + (point-min)))) + (goto-char + (or (text-property-any (or (search-backward "\n\n" nil t) + (point-min)) + end 'x-face-mule-bitmap-image t) + (, opoint))))))) + + (defmacro gnus-summary-search-article-highlight-matched-text + (backward treated x-face) + "Highlight matched text in the function `gnus-summary-search-article'." + (` (let ((start (set-marker (make-marker) (match-beginning 0))) + (end (set-marker (make-marker) (match-end 0))) + (inhibit-read-only t) + buffer-read-only) + (unless treated + (let ((,@ + (let ((items (mapcar 'car gnus-treatment-function-alist))) + (mapcar + (lambda (item) (setq items (delq item items))) + '(gnus-treat-buttonize + gnus-treat-fill-article + gnus-treat-fill-long-lines + gnus-treat-emphasize + gnus-treat-highlight-headers + gnus-treat-highlight-citation + gnus-treat-highlight-signature + gnus-treat-overstrike + gnus-treat-display-xface + gnus-treat-buttonize-head + gnus-treat-decode-article-as-default-mime-charset)) + (static-if (featurep 'xemacs) + items + (cons '(x-face-mule-delete-x-face-field + (quote never)) + items)))) + (gnus-treat-display-xface + (when (, x-face) gnus-treat-display-xface))) + (gnus-article-prepare-mime-display))) + (goto-char (if (, backward) start end)) + (when (, x-face) + (gnus-summary-search-article-highlight-goto-x-face (point))) + (setq gnus-summary-search-article-matched-data + (list start end (buffer-substring start end))) + (unless (eq start end);; matched text has been deleted. :-< + (put-text-property start end 'face + (or (find-face 'isearch) + 'secondary-selection)))))) + ) + (defun gnus-summary-search-article (regexp &optional backward) "Search for an article containing REGEXP. Optional argument BACKWARD means do search for backward. @@ -6823,18 +7180,44 @@ Optional argument BACKWARD means do search for backward. (require 'gnus-art) (let ((gnus-select-article-hook nil) ;Disable hook. (gnus-article-display-hook nil) + (gnus-article-prepare-hook nil) (gnus-mark-article-hook nil) ;Inhibit marking as read. (gnus-use-article-prefetch nil) (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay. (gnus-use-trees nil) ;Inhibit updating tree buffer. (sum (current-buffer)) (found nil) - point) + point treated) (gnus-save-hidden-threads - (gnus-summary-select-article) + (static-if (featurep 'xemacs) + (let ((gnus-inhibit-treatment t)) + (setq treated (eq 'old (gnus-summary-select-article))) + (when (and treated + (not (and (gnus-buffer-live-p gnus-article-buffer) + (window-live-p (get-buffer-window + gnus-article-buffer t))))) + (gnus-summary-select-article nil t) + (setq treated nil))) + (let ((gnus-inhibit-treatment t) + (x-face-mule-delete-x-face-field 'never)) + (setq treated (eq 'old (gnus-summary-select-article))) + (when (and treated + (not + (and (gnus-buffer-live-p gnus-article-buffer) + (window-live-p (get-buffer-window + gnus-article-buffer t)) + (or (not (string-match "^\\^X-Face:" regexp)) + (with-current-buffer gnus-article-buffer + gnus-summary-search-article-matched-data))))) + (gnus-summary-select-article nil t) + (setq treated nil)))) (set-buffer gnus-article-buffer) - (when backward - (forward-line -1)) + (widen) + (if treated + (progn + (gnus-article-show-all-headers) + (gnus-summary-search-article-position-point regexp backward)) + (goto-char (if backward (point-max) (point-min)))) (while (not found) (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current)) (if (if backward @@ -6842,12 +7225,16 @@ Optional argument BACKWARD means do search for backward. (re-search-forward regexp nil t)) ;; We found the regexp. (progn + (gnus-summary-search-article-highlight-matched-text + backward treated (string-match "^\\^X-Face:" regexp)) (setq found 'found) - (beginning-of-line) + (forward-line + (/ (- 2 (window-height + (get-buffer-window gnus-article-buffer t))) + 2)) (set-window-start (get-buffer-window (current-buffer)) (point)) - (forward-line 1) (set-buffer sum) (setq point (point))) ;; We didn't find it, so we go to the next article. @@ -6862,7 +7249,9 @@ Optional argument BACKWARD means do search for backward. (unless (gnus-summary-article-sparse-p (gnus-summary-article-number)) (setq found nil) - (gnus-summary-select-article) + (let ((gnus-inhibit-treatment t)) + (gnus-summary-select-article)) + (setq treated nil) (set-buffer gnus-article-buffer) (widen) (goto-char (if backward (point-max) (point-min)))))))) @@ -6999,12 +7388,42 @@ to save in." (defun gnus-summary-show-article (&optional arg) "Force re-fetching of the current article. -If ARG (the prefix) is non-nil, show the raw article without any -article massaging functions being run." +If ARG (the prefix) is a number, show the article with the charset +defined in `gnus-summary-show-article-charset-alist', or the charset +inputed. +If ARG (the prefix) is non-nil and not a number, show the raw article +without any article massaging functions being run." (interactive "P") - (if (not arg) - ;; Select the article the normal way. + (cond + ((numberp arg) + (let ((gnus-newsgroup-charset + (or (cdr (assq arg gnus-summary-show-article-charset-alist)) + (read-coding-system "Charset: "))) + (gnus-newsgroup-ignored-charsets 'gnus-all)) (gnus-summary-select-article nil 'force) + (let ((deps gnus-newsgroup-dependencies) + head header) + (save-excursion + (set-buffer gnus-original-article-buffer) + (save-restriction + (message-narrow-to-head) + (setq head (buffer-string))) + (with-temp-buffer + (insert (format "211 %d Article retrieved.\n" + (cdr gnus-article-current))) + (insert head) + (insert ".\n") + (let ((nntp-server-buffer (current-buffer))) + (setq header (car (gnus-get-newsgroup-headers deps t)))))) + (gnus-data-set-header + (gnus-data-find (cdr gnus-article-current)) + header) + (gnus-summary-update-article-line + (cdr gnus-article-current) header)))) + ((not arg) + ;; Select the article the normal way. + (gnus-summary-select-article nil 'force)) + (t ;; We have to require this here to make sure that the following ;; dynamic binding isn't shadowed by autoloading. (require 'gnus-async) @@ -7015,9 +7434,8 @@ article massaging functions being run." gnus-article-prepare-hook gnus-article-decode-hook gnus-break-pages - gnus-show-mime - gnus-visual) - (gnus-summary-select-article nil 'force))) + gnus-show-mime) + (gnus-summary-select-article nil 'force)))) (gnus-summary-goto-subject gnus-current-article) (gnus-summary-position-point)) @@ -7045,9 +7463,12 @@ If ARG is a negative number, hide the unwanted header lines." (let* ((buffer-read-only nil) (inhibit-point-motion-hooks t) hidden e) - (save-restriction - (article-narrow-to-head) - (setq hidden (gnus-article-hidden-text-p 'headers))) + (setq hidden + (if (numberp arg) + (>= arg 0) + (save-restriction + (article-narrow-to-head) + (gnus-article-hidden-text-p 'headers)))) (goto-char (point-min)) (when (search-forward "\n\n" nil t) (delete-region (point-min) (1- (point)))) @@ -7060,12 +7481,14 @@ If ARG is a negative number, hide the unwanted header lines." (save-restriction (narrow-to-region (point-min) (point)) (article-decode-encoded-words) - (if (or hidden - (and (numberp arg) (< arg 0))) + (if hidden (let ((gnus-treat-hide-headers nil) (gnus-treat-hide-boring-headers nil)) + (setq gnus-article-wash-types + (delq 'headers gnus-article-wash-types)) (gnus-treat-article 'head)) - (gnus-treat-article 'head))))))) + (gnus-treat-article 'head))) + (gnus-set-mode-line 'article))))) (defun gnus-summary-show-all-headers () "Make all header lines visible." @@ -7122,7 +7545,9 @@ re-spool using this method. For this function to work, both the current newsgroup and the newsgroup that you want to move to have to support the `request-move' -and `request-accept' functions." +and `request-accept' functions. + +ACTION can be either `move' (the default), `crosspost' or `copy'." (interactive "P") (unless action (setq action 'move)) @@ -7140,7 +7565,10 @@ and `request-accept' functions." 'request-replace-article gnus-newsgroup-name))) (error "The current group does not support article editing"))) (let ((articles (gnus-summary-work-articles n)) - (prefix (gnus-group-real-prefix gnus-newsgroup-name)) + (prefix (if (gnus-check-backend-function + 'request-move-article gnus-newsgroup-name) + (gnus-group-real-prefix gnus-newsgroup-name) + "")) (names '((move "Move" "Moving") (copy "Copy" "Copying") (crosspost "Crosspost" "Crossposting"))) @@ -7162,7 +7590,8 @@ and `request-accept' functions." articles prefix)) (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) (setq to-method (or select-method - (gnus-group-name-to-method to-newsgroup))) + (gnus-server-to-method + (gnus-group-method to-newsgroup)))) ;; Check the method we are to move this article to... (unless (gnus-check-backend-function 'request-accept-article (car to-method)) @@ -7188,7 +7617,7 @@ and `request-accept' functions." gnus-newsgroup-name)) ; Server (list 'gnus-request-accept-article to-newsgroup (list 'quote select-method) - (not articles) t) ; Accept form + (not articles) t) ; Accept form (not articles))) ; Only save nov last time ;; Copy the article. ((eq action 'copy) @@ -7229,19 +7658,21 @@ and `request-accept' functions." art-group)))))) (cond ((not art-group) - (gnus-message 1 "Couldn't %s article %s" - (cadr (assq action names)) article)) - ((and (eq art-group 'junk) - (eq action 'move)) - (gnus-summary-mark-article article gnus-canceled-mark) - (gnus-message 4 "Deleted article %s" article)) + (gnus-message 1 "Couldn't %s article %s: %s" + (cadr (assq action names)) article + (nnheader-get-report (car to-method)))) + ((eq art-group 'junk) + (when (eq action 'move) + (gnus-summary-mark-article article gnus-canceled-mark) + (gnus-message 4 "Deleted article %s" article))) (t (let* ((pto-group (gnus-group-prefixed-name (car art-group) to-method)) (entry (gnus-gethash pto-group gnus-newsrc-hashtb)) (info (nth 2 entry)) - (to-group (gnus-info-group info))) + (to-group (gnus-info-group info)) + to-marks) ;; Update the group that has been moved to. (when (and info (memq action '(move copy))) @@ -7249,47 +7680,60 @@ and `request-accept' functions." (push to-group to-groups)) (unless (memq article gnus-newsgroup-unreads) + (push 'read to-marks) (gnus-info-set-read info (gnus-add-to-range (gnus-info-read info) (list (cdr art-group))))) - ;; Copy any marks over to the new group. + ;; See whether the article is to be put in the cache. (let ((marks (if (gnus-group-auto-expirable-p to-group) default-marks no-expire-marks)) (to-article (cdr art-group))) - ;; See whether the article is to be put in the cache. + ;; Enter the article into the cache in the new group, + ;; if that is required. (when gnus-use-cache (gnus-cache-possibly-enter-article to-group to-article + (let ((header (copy-sequence + (gnus-summary-article-header article)))) + (mail-header-set-number header to-article) + header) (memq article gnus-newsgroup-marked) (memq article gnus-newsgroup-dormant) (memq article gnus-newsgroup-unreads))) - (when (and (equal to-group gnus-newsgroup-name) - (not (memq article gnus-newsgroup-unreads))) - ;; Mark this article as read in this group. - (push (cons to-article gnus-read-mark) gnus-newsgroup-reads) - (setcdr (gnus-active to-group) to-article) - (setcdr gnus-newsgroup-active to-article)) - - (while marks - (when (memq article (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks))))) - ;; If the other group is the same as this group, - ;; then we have to add the mark to the list. - (when (equal to-group gnus-newsgroup-name) - (set (intern (format "gnus-newsgroup-%s" (caar marks))) - (cons to-article - (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks))))))) - ;; Copy the marks to other group. - (gnus-add-marked-articles - to-group (cdar marks) (list to-article) info)) - (setq marks (cdr marks))) + (when gnus-preserve-marks + ;; Copy any marks over to the new group. + (when (and (equal to-group gnus-newsgroup-name) + (not (memq article gnus-newsgroup-unreads))) + ;; Mark this article as read in this group. + (push (cons to-article gnus-read-mark) gnus-newsgroup-reads) + (setcdr (gnus-active to-group) to-article) + (setcdr gnus-newsgroup-active to-article)) + + (while marks + (when (memq article (symbol-value + (intern (format "gnus-newsgroup-%s" + (caar marks))))) + (push (cdar marks) to-marks) + ;; If the other group is the same as this group, + ;; then we have to add the mark to the list. + (when (equal to-group gnus-newsgroup-name) + (set (intern (format "gnus-newsgroup-%s" (caar marks))) + (cons to-article + (symbol-value + (intern (format "gnus-newsgroup-%s" + (caar marks))))))) + ;; Copy the marks to other group. + (gnus-add-marked-articles + to-group (cdar marks) (list to-article) info)) + (setq marks (cdr marks))) + + (gnus-request-set-mark to-group (list (list (list to-article) + 'set + to-marks)))) (gnus-dribble-enter (concat "(gnus-group-set-info '" @@ -7420,12 +7864,11 @@ latter case, they will be copied into the relevant groups." (kill-buffer (current-buffer))))) (defun gnus-summary-article-posted-p () - "Say whether the current (mail) article is available from `gnus-select-method' as well. + "Say whether the current (mail) article is available from news as well. This will be the case if the article has both been mailed and posted." (interactive) (let ((id (mail-header-references (gnus-summary-article-header))) - (gnus-override-method - (or gnus-refer-article-method gnus-select-method))) + (gnus-override-method (car (gnus-refer-article-methods)))) (if (gnus-request-head id "") (gnus-message 2 "The current message was found on %s" gnus-override-method) @@ -7453,6 +7896,9 @@ This will be the case if the article has both been mailed and posted." (expiry-wait (if now 'immediate (gnus-group-find-parameter gnus-newsgroup-name 'expiry-wait))) + (nnmail-expiry-target + (or (gnus-group-find-parameter gnus-newsgroup-name 'expiry-target) + nnmail-expiry-target)) es) (when expirable ;; There are expirable articles in this group, so we run them @@ -7468,19 +7914,19 @@ This will be the case if the article has both been mailed and posted." (setq es (gnus-request-expire-articles expirable gnus-newsgroup-name))) (setq es (gnus-request-expire-articles - expirable gnus-newsgroup-name)))) - (unless total - (setq gnus-newsgroup-expirable es)) - ;; We go through the old list of expirable, and mark all - ;; really expired articles as nonexistent. - (unless (eq es expirable) ;If nothing was expired, we don't mark. - (let ((gnus-use-cache nil)) - (while expirable - (unless (memq (car expirable) es) - (when (gnus-data-find (car expirable)) - (gnus-summary-mark-article - (car expirable) gnus-canceled-mark))) - (setq expirable (cdr expirable))))) + expirable gnus-newsgroup-name))) + (unless total + (setq gnus-newsgroup-expirable es)) + ;; We go through the old list of expirable, and mark all + ;; really expired articles as nonexistent. + (unless (eq es expirable) ;If nothing was expired, we don't mark. + (let ((gnus-use-cache nil)) + (while expirable + (unless (memq (car expirable) es) + (when (gnus-data-find (car expirable)) + (gnus-summary-mark-article + (car expirable) gnus-canceled-mark))) + (setq expirable (cdr expirable)))))) (gnus-message 6 "Expiring articles...done"))))) (defun gnus-summary-expire-articles-now () @@ -7507,6 +7953,8 @@ delete these instead." (unless (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name) (error "The current newsgroup does not support article deletion")) + (unless (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) + (error "Couldn't open server")) ;; Compute the list of articles to delete. (let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<)) not-deleted) @@ -7539,9 +7987,10 @@ 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") - (let ((mail-parse-charset gnus-newsgroup-charset)) - (save-excursion - (set-buffer gnus-summary-buffer) + (save-excursion + (set-buffer gnus-summary-buffer) + (let ((mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)) (gnus-set-global-variables) (when (and (not force) (gnus-group-read-only-p)) @@ -7550,7 +7999,11 @@ groups." (gnus-article-edit-article 'ignore `(lambda (no-highlight) - (let ((mail-parse-charset ',gnus-newsgroup-charset)) + (let ((mail-parse-charset ',gnus-newsgroup-charset) + (message-options message-options) + (message-options-set-recipient) + (mail-parse-ignored-charsets + ',gnus-newsgroup-ignored-charsets)) (gnus-summary-edit-article-done ,(or (mail-header-references gnus-current-headers) "") ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight))))))) @@ -7850,7 +8303,8 @@ the actual number of articles marked is returned." "Mark N articles as read forwards. If N is negative, mark backwards instead. Mark with MARK, ?r by default. The difference between N and the actual number of articles marked is -returned." +returned. +Iff NO-EXPIRE, auto-expiry will be inhibited." (interactive "p") (gnus-summary-show-thread) (let ((backward (< n 0)) @@ -7929,6 +8383,7 @@ returned." (save-excursion (gnus-cache-possibly-enter-article gnus-newsgroup-name article + (gnus-summary-article-header article) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) @@ -7942,7 +8397,8 @@ Four MARK strings are reserved: `? ' (unread), `?!' (ticked), `??' (dormant) and `?E' (expirable). If MARK is nil, then the default character `?r' is used. If ARTICLE is nil, then the article on the current line will be -marked." +marked. +Iff NO-EXPIRE, auto-expiry will be inhibited." ;; The mark might be a string. (when (stringp mark) (setq mark (aref mark 0))) @@ -7974,6 +8430,7 @@ marked." (save-excursion (gnus-cache-possibly-enter-article gnus-newsgroup-name article + (gnus-summary-article-header article) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) @@ -8287,7 +8744,7 @@ If ALL is non-nil, also mark ticked and dormant articles as read." (gnus-summary-catchup t quietly)) (defun gnus-summary-catchup-and-exit (&optional all quietly) - "Mark all articles not marked as unread in this newsgroup as read, then exit. + "Mark all unread articles in this group as read, then exit. If prefix argument ALL is non-nil, all articles are marked as read." (interactive "P") (when (gnus-summary-catchup all quietly nil 'fast) @@ -8302,7 +8759,6 @@ If prefix argument ALL is non-nil, all articles are marked as read." (interactive "P") (gnus-summary-catchup-and-exit t quietly)) -;; Suggested by "Arne Eofsson" . (defun gnus-summary-catchup-and-goto-next-group (&optional all) "Mark all articles in this group as read and select the next group. If given a prefix, mark all articles, unread as well as ticked, as @@ -8310,7 +8766,38 @@ read." (interactive "P") (save-excursion (gnus-summary-catchup all)) - (gnus-summary-next-article t nil nil t)) + (gnus-summary-next-group)) + +;;; +;;; with article +;;; + +(defmacro gnus-with-article (article &rest forms) + "Select ARTICLE and perform FORMS in the original article buffer. +Then replace the article with the result." + `(progn + ;; We don't want the article to be marked as read. + (let (gnus-mark-article-hook) + (gnus-summary-select-article t t nil ,article)) + (set-buffer gnus-original-article-buffer) + ,@forms + (if (not (gnus-check-backend-function + 'request-replace-article (car gnus-article-current))) + (gnus-message 5 "Read-only group; not replacing") + (unless (gnus-request-replace-article + ,article (car gnus-article-current) + (current-buffer) t) + (error "Couldn't replace article"))) + ;; The cache and backlog have to be flushed somewhat. + (when gnus-keep-backlog + (gnus-backlog-remove-article + (car gnus-article-current) (cdr gnus-article-current))) + (when gnus-use-cache + (gnus-cache-update-article + (car gnus-article-current) (cdr gnus-article-current))))) + +(put 'gnus-with-article 'lisp-indent-function 1) +(put 'gnus-with-article 'edebug-form-spec '(form body)) ;; Thread-based commands. @@ -8390,14 +8877,16 @@ is non-nil or the Subject: of both articles are the same." (unless (and message-id (not (equal message-id ""))) (error "No message-id in desired parent")) (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"))) + (save-restriction + (goto-char (point-min)) + (message-narrow-to-head) + (if (re-search-forward "^References: " nil t) + (progn + (re-search-forward "^[^ \t]" nil t) + (forward-line -1) + (end-of-line) + (insert " " message-id)) + (insert "References: " message-id "\n")))) (set-buffer gnus-summary-buffer) (gnus-summary-unmark-all-processable) (gnus-summary-update-article current-article) @@ -8472,9 +8961,7 @@ Returns nil if no threads were there to be hidden." (subst-char-in-region start (point) ?\n ?\^M) (gnus-summary-goto-subject article)) (goto-char start) - nil) - ;;(gnus-summary-position-point) - )))) + nil))))) (defun gnus-summary-go-to-next-thread (&optional previous) "Go to the same level (or less) next thread. @@ -8606,14 +9093,14 @@ Argument REVERSE means reverse order." (defun gnus-summary-sort-by-author (&optional reverse) "Sort the summary buffer by author name alphabetically. -If case-fold-search is non-nil, case of letters is ignored. +If `case-fold-search' is non-nil, case of letters is ignored. Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'author reverse)) (defun gnus-summary-sort-by-subject (&optional reverse) "Sort the summary buffer by subject alphabetically. `Re:'s are ignored. -If case-fold-search is non-nil, case of letters is ignored. +If `case-fold-search' is non-nil, case of letters is ignored. Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'subject reverse)) @@ -8640,7 +9127,7 @@ Argument REVERSE means reverse order." "Sort the summary buffer by article length. Argument REVERSE means reverse order." (interactive "P") - (gnus-summary-sort 'chars reverse)) + (gnus-summary-sort 'chars reverse)) (defun gnus-summary-sort (predicate reverse) "Sort summary buffer by PREDICATE. REVERSE means reverse order." @@ -8651,6 +9138,8 @@ Argument REVERSE means reverse order." thread `(lambda (t1 t2) (,thread t2 t1)))) + (gnus-sort-gathered-threads-function + gnus-thread-sort-functions) (gnus-article-sort-functions (if (not reverse) article @@ -8784,7 +9273,7 @@ save those articles instead." (set-buffer gnus-original-article-buffer) (save-restriction (nnheader-narrow-to-headers) - (while methods + (while (and methods (not split-name)) (goto-char (point-min)) (setq method (pop methods)) (setq match (car method)) @@ -8803,7 +9292,7 @@ save those articles instead." (save-restriction (widen) (setq result (eval match))))) - (setq split-name (append (cdr method) split-name)) + (setq split-name (cdr method)) (cond ((stringp result) (push (expand-file-name result gnus-article-save-directory) @@ -8848,7 +9337,8 @@ save those articles instead." (mapcar (lambda (el) (list el)) (nreverse split-name)) nil nil nil - 'gnus-group-history))))) + 'gnus-group-history)))) + (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))) (when to-newsgroup (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) @@ -8856,24 +9346,29 @@ save those articles instead." (unless to-newsgroup (error "No group name entered")) (or (gnus-active to-newsgroup) - (gnus-activate-group to-newsgroup) + (gnus-activate-group to-newsgroup nil nil to-method) (if (gnus-y-or-n-p (format "No such group: %s. Create it? " to-newsgroup)) - (or (and (gnus-request-create-group - to-newsgroup (gnus-group-name-to-method to-newsgroup)) - (gnus-activate-group to-newsgroup nil nil - (gnus-group-name-to-method - to-newsgroup))) + (or (and (gnus-request-create-group to-newsgroup to-method) + (gnus-activate-group + to-newsgroup nil nil to-method) + (gnus-subscribe-group to-newsgroup)) (error "Couldn't create group %s" to-newsgroup))) (error "No such group: %s" to-newsgroup))) to-newsgroup)) -(defun gnus-summary-save-parts (type dir n reverse) +(defun gnus-summary-save-parts (type dir n &optional reverse) "Save parts matching TYPE to DIR. If REVERSE, save parts that do not match TYPE." (interactive - (list (read-string "Save parts of type: " "image/.*") - (read-file-name "Save to directory: " t nil t) + (list (read-string "Save parts of type: " + (or (car gnus-summary-save-parts-type-history) + gnus-summary-save-parts-default-mime) + 'gnus-summary-save-parts-type-history) + (setq gnus-summary-save-parts-last-directory + (read-file-name "Save to directory: " + gnus-summary-save-parts-last-directory + nil t)) current-prefix-arg)) (gnus-summary-iterate n (let ((gnus-display-mime-function nil) @@ -8881,23 +9376,28 @@ If REVERSE, save parts that do not match TYPE." (gnus-summary-select-article)) (save-excursion (set-buffer gnus-article-buffer) - (let ((handles (or (mm-dissect-buffer) (mm-uu-dissect)))) + (let ((handles (or gnus-article-mime-handles + (mm-dissect-buffer) (mm-uu-dissect)))) (when handles - (gnus-summary-save-parts-1 type dir handles reverse)))))) + (gnus-summary-save-parts-1 type dir handles reverse) + (unless gnus-article-mime-handles ;; Don't destroy this case. + (mm-destroy-parts handles))))))) (defun gnus-summary-save-parts-1 (type dir handle reverse) (if (stringp (car handle)) (mapcar (lambda (h) (gnus-summary-save-parts-1 type dir h reverse)) (cdr handle)) (when (if reverse - (not (string-match type (car (mm-handle-type handle)))) - (string-match type (car (mm-handle-type handle)))) + (not (string-match type (mm-handle-media-type handle))) + (string-match type (mm-handle-media-type handle))) (let ((file (expand-file-name (file-name-nondirectory (or (mail-content-type-get (mm-handle-disposition handle) 'filename) - (concat gnus-newsgroup-name "." gnus-current-article))) + (concat gnus-newsgroup-name + "." (number-to-string + (cdr gnus-article-current))))) dir))) (unless (file-exists-p file) (mm-save-part-to-file handle file)))))) @@ -9014,8 +9514,10 @@ If REVERSE, save parts that do not match TYPE." "Read the headers of article ID and enter them into the Gnus system." (let ((group gnus-newsgroup-name) (gnus-override-method - (and (gnus-news-group-p gnus-newsgroup-name) - gnus-refer-article-method)) + (or + gnus-override-method + (and (gnus-news-group-p gnus-newsgroup-name) + (car (gnus-refer-article-methods))))) where) ;; First we check to see whether the header in question is already ;; fetched. @@ -9089,8 +9591,8 @@ If REVERSE, save parts that do not match TYPE." ;;; (defun gnus-highlight-selected-summary () + "Highlight selected article in summary buffer." ;; Added by Per Abrahamsen . - ;; Highlight selected article in summary buffer (when gnus-summary-selected-face (save-excursion (let* ((beg (progn (beginning-of-line) (point))) @@ -9185,23 +9687,32 @@ If REVERSE, save parts that do not match TYPE." (if compute read (save-excursion - (set-buffer gnus-group-buffer) - (gnus-undo-register - `(progn - (gnus-info-set-marks ',info ',(gnus-info-marks info) t) - (gnus-info-set-read ',info ',(gnus-info-read info)) - (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) - (gnus-group-update-group ,group t)))) - ;; 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) - (unless (gnus-check-group group) - (error "Can't open server for %s" group)) - (gnus-request-set-mark - group (delq nil (list (if add (list add 'add '(read))) - (if del (list del 'del '(read))))))))) + (let (setmarkundo) + ;; Propagate the read marks to the backend. + (when (gnus-check-backend-function 'request-set-mark group) + (let ((del (gnus-remove-from-range (gnus-info-read info) read)) + (add (gnus-remove-from-range read (gnus-info-read info)))) + (when (or add del) + (unless (gnus-check-group group) + (error "Can't open server for %s" group)) + (gnus-request-set-mark + group (delq nil (list (if add (list add 'add '(read))) + (if del (list del 'del '(read)))))) + (setq setmarkundo + `(gnus-request-set-mark + ,group + ',(delq nil (list + (if del (list del 'add '(read))) + (if add (list add 'del '(read)))))))))) + (set-buffer gnus-group-buffer) + (gnus-undo-register + `(progn + (gnus-info-set-marks ',info ',(gnus-info-marks info) t) + (gnus-info-set-read ',info ',(gnus-info-read info)) + (gnus-get-unread-articles-in-group ',info + (gnus-active ,group)) + (gnus-group-update-group ,group t) + ,setmarkundo)))) ;; Enter this list into the group info. (gnus-info-set-read info read) ;; Set the number of unread articles in gnus-newsrc-hashtb. @@ -9270,40 +9781,31 @@ If REVERSE, save parts that do not match TYPE." (defun gnus-mime-extract-message/rfc822 (entity situation) (let (group article num cwin swin cur) - (with-current-buffer (mime-entity-buffer entity) - (save-restriction - (narrow-to-region (mime-entity-body-start entity) - (mime-entity-body-end entity)) - (setq group (or (cdr (assq 'group situation)) - (completing-read "Group: " - gnus-active-hashtb - nil - (gnus-read-active-file-p) - gnus-newsgroup-name)) - article (gnus-request-accept-article group) - ) - )) + (with-temp-buffer + (mime-insert-entity-content entity) + (setq group (or (cdr (assq 'group situation)) + (completing-read "Group: " + gnus-active-hashtb + nil + (gnus-read-active-file-p) + gnus-newsgroup-name)) + article (gnus-request-accept-article group))) (when (and (consp article) (numberp (setq article (cdr article)))) (setq num (1+ (or (cdr (assq 'number situation)) 0)) - cwin (get-buffer-window (current-buffer) t) - ) + cwin (get-buffer-window (current-buffer) t)) (save-window-excursion (if (setq swin (get-buffer-window gnus-summary-buffer t)) (select-window swin) - (set-buffer gnus-summary-buffer) - ) + (set-buffer gnus-summary-buffer)) (setq cur gnus-current-article) (forward-line num) (let (gnus-show-threads) - (gnus-summary-goto-subject article t) - ) + (gnus-summary-goto-subject article t)) (gnus-summary-clear-mark-forward 1) - (gnus-summary-goto-subject cur) - ) + (gnus-summary-goto-subject cur)) (when (and cwin (window-frame cwin)) - (select-frame (window-frame cwin)) - ) + (select-frame (window-frame cwin))) (when (boundp 'mime-acting-situation-to-override) (set-alist 'mime-acting-situation-to-override 'group @@ -9313,15 +9815,11 @@ If REVERSE, save parts that do not match TYPE." `(progn (save-current-buffer (set-buffer gnus-group-buffer) - (gnus-activate-group ,group) - ) + (gnus-activate-group ,group)) (gnus-summary-goto-article ,cur - gnus-show-all-headers) - )) + gnus-show-all-headers))) (set-alist 'mime-acting-situation-to-override - 'number num) - ) - ))) + 'number num))))) (mime-add-condition 'action '((type . message)(subtype . rfc822) @@ -9349,7 +9847,7 @@ If REVERSE, save parts that do not match TYPE." (if (setq f (cdr (assq 'after-method mime-acting-situation-to-override))) (eval f) - ))) + ))) (mime-add-condition 'action '((type . multipart) @@ -9364,21 +9862,40 @@ If REVERSE, save parts that do not match TYPE." (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)))) + (if (equal gnus-newsgroup-name "nndraft:drafts") + (setq gnus-newsgroup-charset nil) + (let* ((name (and gnus-newsgroup-name + (gnus-group-real-name gnus-newsgroup-name))) + (ignored-charsets + (or gnus-newsgroup-ephemeral-ignored-charsets + (append + (and gnus-newsgroup-name + (or (gnus-group-find-parameter gnus-newsgroup-name + 'ignored-charsets t) + (let ((alist gnus-group-ignored-charsets-alist) + elem (charsets nil)) + (while (setq elem (pop alist)) + (when (and name + (string-match (car elem) name)) + (setq alist nil + charsets (cdr elem)))) + charsets))) + gnus-newsgroup-ignored-charsets)))) + (setq gnus-newsgroup-charset + (or gnus-newsgroup-ephemeral-charset + (and gnus-newsgroup-name + (or (gnus-group-find-parameter gnus-newsgroup-name 'charset) + (let ((alist gnus-group-charset-alist) + elem charset) + (while (setq elem (pop alist)) + (when (and name + (string-match (car elem) name)) + (setq alist nil + charset (cadr elem)))) + charset))) + gnus-default-charset)) + (set (make-local-variable 'gnus-newsgroup-ignored-charsets) + ignored-charsets)))) ;;; ;;; Mime Commands @@ -9425,35 +9942,102 @@ treated as multipart/mixed." (gnus-summary-show-article))) ;;; -;;; with article +;;; Intelli-mouse commmands ;;; -(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))))) +(defun gnus-wheel-summary-scroll (event) + (interactive "e") + (let ((amount (if (memq 'shift (event-modifiers event)) + (car gnus-wheel-scroll-amount) + (cdr gnus-wheel-scroll-amount))) + (direction (- (* (static-if (featurep 'xemacs) + (event-button event) + (cond ((eq 'mouse-4 (event-basic-type event)) + 4) + ((eq 'mouse-5 (event-basic-type event)) + 5))) + 2) 9)) + edge) + (gnus-summary-scroll-up (* amount direction)) + (when (gnus-eval-in-buffer-window gnus-article-buffer + (save-restriction + (widen) + (and (if (< 0 direction) + (gnus-article-next-page 0) + (gnus-article-prev-page 0) + (bobp)) + (if (setq edge (get-text-property + (point-min) 'gnus-wheel-edge)) + (setq edge (* edge direction)) + (setq edge -1)) + (or (plusp edge) + (let ((buffer-read-only nil) + (inhibit-read-only t)) + (put-text-property (point-min) (point-max) + 'gnus-wheel-edge direction) + nil)) + (or (> edge gnus-wheel-edge-resistance) + (let ((buffer-read-only nil) + (inhibit-read-only t)) + (put-text-property (point-min) (point-max) + 'gnus-wheel-edge + (* (1+ edge) direction)) + nil)) + (eq last-command 'gnus-wheel-summary-scroll)))) + (gnus-summary-next-article nil nil (minusp direction))))) + +(defun gnus-wheel-install () + "Enable mouse wheel support on summary window." + (when gnus-use-wheel + (let ((keys + '([(mouse-4)] [(shift mouse-4)] [(mouse-5)] [(shift mouse-5)]))) + (dolist (key keys) + (define-key gnus-summary-mode-map key + 'gnus-wheel-summary-scroll))))) + +(add-hook 'gnus-summary-mode-hook 'gnus-wheel-install) -(put 'gnus-with-article 'lisp-indent-function 1) -(put 'gnus-with-article 'edebug-form-spec '(form body)) +;;; +;;; Traditional PGP commmands +;;; + +(defun gnus-summary-decrypt-article (&optional force) + "Decrypt the current article in traditional PGP way. +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") + (gnus-summary-select-article t) + (gnus-eval-in-buffer-window gnus-article-buffer + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (unless (re-search-forward (car pgg-armor-header-lines) nil t) + (error "Not a traditional PGP message!")) + (let ((armor-start (match-beginning 0))) + (if (and (pgg-decrypt-region armor-start (point-max)) + (or force (not (gnus-group-read-only-p)))) + (let ((inhibit-read-only t) + buffer-read-only) + (delete-region armor-start + (progn + (re-search-forward "^-+END PGP" nil t) + (beginning-of-line 2) + (point))) + (insert-buffer-substring pgg-output-buffer)))))))) + +(defun gnus-summary-verify-article () + "Verify the current article in traditional PGP way." + (interactive) + (save-excursion + (set-buffer gnus-original-article-buffer) + (goto-char (point-min)) + (unless (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE" nil t) + (error "Not a traditional PGP message!")) + (re-search-forward "^-+END PGP" nil t) + (beginning-of-line 2) + (call-interactively (function pgg-verify-region)))) ;;; ;;; Generic summary marking commands @@ -9487,8 +10071,8 @@ Then replace the article with the result." mark (car lway) lway name))) (setq func (eval func)) (define-key map (nth 4 lway) func))))) - -(defun gnus-summary-make-marking-command-1 (mark way lway name) + +(defun gnus-summary-make-marking-command-1 (mark way lway name) `(defun ,(intern (format "gnus-summary-put-mark-as-%s%s" name (if (eq way 'nomove) @@ -9501,10 +10085,10 @@ If N, the prefix, then repeat N times. If N is negative, move in reverse order. The difference between N and the actual number of articles marked is returned." - name (cadr lway)) + name (car (cdr lway))) (interactive "p") (gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway)))) - + (defun gnus-summary-generic-mark (n mark move unread) "Mark N articles with MARK." (unless (eq major-mode 'gnus-summary-mode) @@ -9531,25 +10115,6 @@ returned." (gnus-set-mode-line 'summary) n)) -;; Added by Shenghuo Zhu -(defun gnus-summary-setup-highlight-words (&optional highlight-words) - "Setup newsgroup emphasis alist." - (let ((name (and gnus-newsgroup-name - (gnus-group-real-name gnus-newsgroup-name)))) - (setq gnus-newsgroup-emphasis-alist - (nconc - (let ((alist gnus-group-highlight-words-alist) elem highlight) - (while (setq elem (pop alist)) - (when (and name (string-match (car elem) name)) - (setq alist nil - highlight (copy-list (cdr elem))))) - highlight) - (copy-list highlight-words) - (if gnus-newsgroup-name - (copy-list (gnus-group-find-parameter - gnus-newsgroup-name 'highlight-words t))) - gnus-emphasis-alist)))) - (gnus-summary-make-all-marking-commands) (gnus-ems-redefine)