X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=76ec96c6f2783adf94878ddb4fcfa4fdee4c26c7;hb=91be7410b775e49969c78fa8719969740c183048;hp=7587108cdfc535f9f6a77ce3efef92e606a7641d;hpb=dab90e322488e20205f3e4c254049f40577275a9;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 7587108..76ec96c 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 @@ -28,6 +29,7 @@ ;;; Code: (eval-when-compile (require 'cl)) + (require 'gnus) (require 'gnus-group) (require 'gnus-spec) @@ -42,7 +44,9 @@ (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-set-summary-default-charset "gnus-i18n" nil t) @@ -178,10 +182,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) @@ -370,7 +379,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) @@ -485,7 +494,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) @@ -718,7 +727,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) @@ -839,11 +849,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." @@ -897,8 +910,30 @@ 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) + ;;; 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) @@ -910,8 +945,7 @@ by moving the mouse over the edge of the article window." (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.") + "Function called to sort the articles within a thread after it has been gathered together.") ;; Avoid highlighting in kill files. (defvar gnus-summary-inhibit-highlight nil) @@ -935,9 +969,9 @@ been gathered together.") (?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) @@ -1186,7 +1220,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. @@ -1318,6 +1352,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 @@ -1368,7 +1404,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 @@ -1505,7 +1541,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 @@ -1606,8 +1644,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) @@ -1691,7 +1728,8 @@ increase the score of each group you read." ["Toggle MIME" gnus-summary-toggle-mime t] ["Verbose header" gnus-summary-verbose-headers t] ["Toggle header" gnus-summary-toggle-header t] - ["Toggle smileys" gnus-smiley-display 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] @@ -1770,8 +1808,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 "" @@ -1994,7 +2031,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) @@ -2600,7 +2638,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 @@ -2665,7 +2703,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)) @@ -2974,7 +3012,8 @@ If SHOW-ALL is non-nil, already read articles are also listed." "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." @@ -3371,17 +3410,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)) @@ -3595,7 +3636,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) @@ -3607,6 +3647,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) @@ -3640,7 +3681,7 @@ If LINE, insert the rebuilt thread starting on line LINE." ;; 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) @@ -3676,11 +3717,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) "")) @@ -3968,7 +4009,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 @@ -4232,16 +4273,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 ((input (read-from-minibuffer - (format - "How many articles from %s (max %d): " - (gnus-limit-string gnus-newsgroup-name 35) - number) - (static-if (< emacs-major-version 20) - (number-to-string gnus-large-newsgroup) - (cons - (number-to-string gnus-large-newsgroup) - 0))))) + (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) + (cons (number-to-string gnus-large-newsgroup) + 0)))) (if (string-match "^[ \t]*$" input) number input))) @@ -4275,6 +4314,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) @@ -4360,9 +4405,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 @@ -4381,24 +4426,25 @@ 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))) + (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) - ;; 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))))) + (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))) + (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) @@ -5112,7 +5158,8 @@ articles with that subject. If BACKWARD, search backward instead." "Center point in window and redisplay frame. Also do horizontal recentering." (interactive "P") - (when (and gnus-auto-center-summary + (when (and nil + gnus-auto-center-summary (not (eq gnus-auto-center-summary 'vertical))) (gnus-horizontal-recenter)) (recenter n)) @@ -5123,6 +5170,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) @@ -5183,7 +5231,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)) @@ -5240,8 +5291,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 @@ -5262,24 +5312,25 @@ With arg, turn line truncation on iff arg is positive." (redraw-display)) (defun gnus-summary-reselect-current-group (&optional all rescan) - "Rescan the current newsgroup, exit and then reselect it. + "Exit and then reselect the current newsgroup. The prefix argument ALL means to select all articles." (interactive "P") (when (gnus-ephemeral-group-p gnus-newsgroup-name) (error "Ephemeral groups can't be reselected")) (let ((current-subject (gnus-summary-article-number)) (group gnus-newsgroup-name)) - (save-excursion - (set-buffer gnus-group-buffer) - ;; We have to adjust the point of group mode buffer because - ;; point was moved to the next unread newsgroup by exiting. - (gnus-summary-jump-to-group group) - (when rescan - (save-excursion - (gnus-group-get-new-news-this-group 1)))) (setq gnus-newsgroup-begin nil) (gnus-summary-exit) - (gnus-group-read-group all t group) + ;; We have to adjust the point of group mode buffer because + ;; point was moved to the next unread newsgroup by exiting. + (gnus-summary-jump-to-group group) + (when rescan + (save-excursion + (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))) (defun gnus-summary-rescan-group (&optional all) @@ -5339,7 +5390,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) @@ -5368,6 +5419,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. @@ -5415,7 +5468,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 @@ -5549,7 +5609,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." @@ -5716,8 +5777,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" ""))) @@ -5811,39 +5872,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) - (if (eq 'gnus-summary-toggle-mime this-command) - (gnus-article-show-all) - (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." @@ -6796,15 +6852,7 @@ of what's specified by the `gnus-refer-thread-limit' variable." (t ;; We fetch the article. (catch 'found - (dolist (gnus-override-method - (cond ((null gnus-refer-article-method) - (list 'current gnus-select-method)) - ((consp (car gnus-refer-article-method)) - gnus-refer-article-method) - (t - (list gnus-refer-article-method)))) - (when (eq 'current gnus-override-method) - (setq gnus-override-method gnus-current-select-method)) + (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)) @@ -6812,6 +6860,28 @@ of what's specified by the `gnus-refer-thread-limit' variable." (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 (stringp (cadr gnus-refer-article-method))) + (let (out) + (dolist (method gnus-refer-article-method) + (push (if (eq 'current method) + gnus-current-select-method + method) + out)) + (nreverse out))) + ;; One single select method. + (t + (list gnus-refer-article-method)))) + (defun gnus-summary-edit-parameters () "Edit the group parameters of the current group." (interactive) @@ -6843,8 +6913,14 @@ 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 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 @@ -7262,12 +7338,23 @@ 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. - (gnus-summary-select-article nil 'force) + (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))) + ((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) @@ -7278,9 +7365,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)) @@ -7329,8 +7415,11 @@ If ARG is a negative number, hide the unwanted header lines." (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." @@ -7387,7 +7476,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)) @@ -7405,7 +7496,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"))) @@ -7427,7 +7521,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)) @@ -7453,7 +7548,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) @@ -7494,13 +7589,13 @@ and `request-accept' functions." art-group)))))) (cond ((not art-group) - (gnus-message 1 "Couldn't %s article %s: %s" - (cadr (assq action names)) article - (nnheader-get-report (car to-method)))) - ((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)) @@ -7521,13 +7616,14 @@ and `request-accept' functions." 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 @@ -7539,34 +7635,36 @@ and `request-accept' functions." (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))))) - (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))) + (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 '" @@ -7697,12 +7795,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) @@ -8130,7 +8227,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)) @@ -8223,7 +8321,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))) @@ -8753,9 +8852,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. @@ -9129,7 +9226,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)) @@ -9137,25 +9235,23 @@ 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)) + (or (and (gnus-request-create-group to-newsgroup to-method) (gnus-activate-group - to-newsgroup nil nil - (gnus-group-name-to-method to-newsgroup)) + 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) + (read-file-name "Save to directory: " nil nil t) current-prefix-arg)) (gnus-summary-iterate n (let ((gnus-display-mime-function nil) @@ -9297,8 +9393,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. @@ -9475,16 +9573,16 @@ If REVERSE, save parts that do not match TYPE." (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))))))))) + ;; 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))))))))) ;; Enter this list into the group info. (gnus-info-set-read info read) ;; Set the number of unread articles in gnus-newsrc-hashtb. @@ -9553,40 +9651,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 @@ -9596,15 +9685,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) @@ -9649,39 +9734,38 @@ If REVERSE, save parts that do not match TYPE." "Setup newsgroup default charset." (if (equal gnus-newsgroup-name "nndraft:drafts") (setq gnus-newsgroup-charset nil) - (let* ((name (and gnus-newsgroup-name - (gnus-group-real-name gnus-newsgroup-name))) - (ignored-charsets - (or gnus-newsgroup-ephemeral-ignored-charsets - (append - (and gnus-newsgroup-name - (or (gnus-group-find-parameter gnus-newsgroup-name - 'ignored-charsets t) - (let ((alist gnus-group-ignored-charsets-alist) - elem (charsets nil)) - (while (setq elem (pop alist)) - (when (and name - (string-match (car elem) name)) - (setq alist nil - charsets (cdr elem)))) - charsets)))) - gnus-newsgroup-ignored-charsets))) - (setq gnus-newsgroup-charset - (or gnus-newsgroup-ephemeral-charset - (and gnus-newsgroup-name - (or (gnus-group-find-parameter gnus-newsgroup-name - 'charset) - (let ((alist gnus-group-charset-alist) - elem (charset nil)) - (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)))) + (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 @@ -9769,10 +9853,8 @@ treated as multipart/mixed." 'gnus-wheel-edge (* (1+ edge) direction)) nil)) - (eq last-command 'gnus-wheel-summary-scroll)) - )) - (gnus-summary-next-article nil nil (minusp direction))) - )) + (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." @@ -9786,6 +9868,48 @@ treated as multipart/mixed." (add-hook 'gnus-summary-mode-hook 'gnus-wheel-install) ;;; +;;; 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)))) + +;;; ;;; with article ;;;