X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fgnus-sum.el;h=9b0539a4a5717a5a7a01ad9eb12f2e0b585a3cb2;hb=b74fac078f05fa78c65ef6ac22a644331120f096;hp=8ca471e99b275a6c588f80c470c058d77ad1cf28;hpb=b57e3755533260df7d47ebbccc324da0adfe8308;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 8ca471e..9b0539a 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1,6 +1,7 @@ ;;; gnus-sum.el --- summary mode commands for gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 -;; Free Software Foundation, Inc. + +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -21,8 +22,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -71,17 +72,21 @@ it will be killed sometime later." (defcustom gnus-fetch-old-headers nil "*Non-nil means that Gnus will try to build threads by grabbing old headers. -If an unread article in the group refers to an older, already read (or -just marked as read) article, the old article will not normally be -displayed in the Summary buffer. If this variable is t, Gnus -will attempt to grab the headers to the old articles, and thereby -build complete threads. If it has the value `some', only enough -headers to connect otherwise loose threads will be displayed. This -variable can also be a number. In that case, no more than that number -of old headers will be fetched. If it has the value `invisible', all +If an unread article in the group refers to an older, already +read (or just marked as read) article, the old article will not +normally be displayed in the Summary buffer. If this variable is +t, Gnus will attempt to grab the headers to the old articles, and +thereby build complete threads. If it has the value `some', all +old headers will be fetched but only enough headers to connect +otherwise loose threads will be displayed. This variable can +also be a number. In that case, no more than that number of old +headers will be fetched. If it has the value `invisible', all old headers will be fetched, but none will be displayed. -The server has to support NOV for any of this to work." +The server has to support NOV for any of this to work. + +This feature can seriously impact performance it ignores all +locally cached header entries." :group 'gnus-thread :type '(choice (const :tag "off" nil) (const :tag "on" t) @@ -265,8 +270,7 @@ simplification is selected." "*If non-nil, hide all threads initially. This can be a predicate specifier which says which threads to hide. If threads are hidden, you have to run the command -`gnus-summary-show-thread' by hand or use `gnus-select-article-hook' -to expose hidden threads." +`gnus-summary-show-thread' by hand or or select an article." :group 'gnus-thread :type '(radio (sexp :format "Non-nil\n" :match (lambda (widget value) @@ -329,7 +333,7 @@ This variable can either be the symbols `first' (place point on the first subject), `unread' (place point on the subject line of the first unread article), `best' (place point on the subject line of the higest-scored article), `unseen' (place point on the subject line of -the first unseen article), 'unseen-or-unread' (place point on the subject +the first unseen article), `unseen-or-unread' (place point on the subject line of the first unseen article or, if all article have been seen, on the subject line of the first unread article), or a function to be called to place point on some subject line." @@ -804,20 +808,21 @@ Each list item can also be a list `(not F)' where F is a function; this specifies reversed sort order. Ready-made functions include `gnus-thread-sort-by-number', -`gnus-thread-sort-by-author', `gnus-thread-sort-by-subject', -`gnus-thread-sort-by-date', `gnus-thread-sort-by-score', -`gnus-thread-sort-by-most-recent-number', -`gnus-thread-sort-by-most-recent-date', -`gnus-thread-sort-by-random', and -`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function'). +`gnus-thread-sort-by-author', `gnus-thread-sort-by-recipient' +`gnus-thread-sort-by-subject', `gnus-thread-sort-by-date', +`gnus-thread-sort-by-score', `gnus-thread-sort-by-most-recent-number', +`gnus-thread-sort-by-most-recent-date', `gnus-thread-sort-by-random', +and `gnus-thread-sort-by-total-score' (see +`gnus-thread-score-function'). When threading is turned off, the variable `gnus-article-sort-functions' controls how articles are sorted." :group 'gnus-summary-sort - :type '(repeat + :type '(repeat (gnus-widget-reversible (choice (function-item gnus-thread-sort-by-number) (function-item gnus-thread-sort-by-author) + (function-item gnus-thread-sort-by-recipient) (function-item gnus-thread-sort-by-subject) (function-item gnus-thread-sort-by-date) (function-item gnus-thread-sort-by-score) @@ -996,7 +1001,7 @@ automatically when it is selected." :group 'gnus-summary :type 'boolean) -(defcustom gnus-summary-selected-face 'gnus-summary-selected-face +(defcustom gnus-summary-selected-face 'gnus-summary-selected "Face used for highlighting the current article in the summary buffer." :group 'gnus-summary-visual :type 'face) @@ -1005,42 +1010,42 @@ automatically when it is selected." (defcustom gnus-summary-highlight '(((eq mark gnus-canceled-mark) - . gnus-summary-cancelled-face) + . gnus-summary-cancelled) ((and uncached (> score default-high)) - . gnus-summary-high-undownloaded-face) + . gnus-summary-high-undownloaded) ((and uncached (< score default-low)) - . gnus-summary-low-undownloaded-face) + . gnus-summary-low-undownloaded) (uncached - . gnus-summary-normal-undownloaded-face) + . gnus-summary-normal-undownloaded) ((and (> score default-high) (or (eq mark gnus-dormant-mark) (eq mark gnus-ticked-mark))) - . gnus-summary-high-ticked-face) + . gnus-summary-high-ticked) ((and (< score default-low) (or (eq mark gnus-dormant-mark) (eq mark gnus-ticked-mark))) - . gnus-summary-low-ticked-face) + . gnus-summary-low-ticked) ((or (eq mark gnus-dormant-mark) (eq mark gnus-ticked-mark)) - . gnus-summary-normal-ticked-face) + . gnus-summary-normal-ticked) ((and (> score default-high) (eq mark gnus-ancient-mark)) - . gnus-summary-high-ancient-face) + . gnus-summary-high-ancient) ((and (< score default-low) (eq mark gnus-ancient-mark)) - . gnus-summary-low-ancient-face) + . gnus-summary-low-ancient) ((eq mark gnus-ancient-mark) - . gnus-summary-normal-ancient-face) + . gnus-summary-normal-ancient) ((and (> score default-high) (eq mark gnus-unread-mark)) - . gnus-summary-high-unread-face) + . gnus-summary-high-unread) ((and (< score default-low) (eq mark gnus-unread-mark)) - . gnus-summary-low-unread-face) + . gnus-summary-low-unread) ((eq mark gnus-unread-mark) - . gnus-summary-normal-unread-face) + . gnus-summary-normal-unread) ((> score default-high) - . gnus-summary-high-read-face) + . gnus-summary-high-read) ((< score default-low) - . gnus-summary-low-read-face) + . gnus-summary-low-read) (t - . gnus-summary-normal-read-face)) + . gnus-summary-normal-read)) "*Controls the highlighting of summary buffer lines. A list of (FORM . FACE) pairs. When deciding how a a particular @@ -1080,12 +1085,28 @@ which it may alter in any way." :type '(repeat symbol)) (defcustom gnus-ignored-from-addresses - (and user-mail-address (regexp-quote user-mail-address)) + (and user-mail-address + (not (string= user-mail-address "")) + (regexp-quote user-mail-address)) "*Regexp of From headers that may be suppressed in favor of To headers." :version "21.1" :group 'gnus-summary :type 'regexp) +(defcustom gnus-summary-to-prefix "-> " + "*String prefixed to the To field in the summary line when +using `gnus-ignored-from-addresses'." + :version "22.1" + :group 'gnus-summary + :type 'string) + +(defcustom gnus-summary-newsgroup-prefix "=> " + "*String prefixed to the Newsgroup field in the summary +line when using `gnus-ignored-from-addresses'." + :version "22.1" + :group 'gnus-summary + :type 'string) + (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 @@ -1908,6 +1929,7 @@ increase the score of each group you read." "Q" gnus-summary-exit "Z" gnus-summary-exit "n" gnus-summary-catchup-and-goto-next-group + "p" gnus-summary-catchup-and-goto-prev-group "R" gnus-summary-reselect-current-group "G" gnus-summary-rescan-group "N" gnus-summary-next-group @@ -1957,7 +1979,6 @@ increase the score of each group you read." "t" gnus-summary-toggle-header "g" gnus-treat-smiley "v" gnus-summary-verbose-headers - "m" gnus-summary-toggle-mime "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive "p" gnus-article-verify-x-pgp-sig "d" gnus-article-treat-dumbquotes @@ -2066,6 +2087,10 @@ increase the score of each group you read." "m" gnus-summary-repair-multipart "v" gnus-article-view-part "o" gnus-article-save-part + "O" gnus-article-save-part-and-strip + "r" gnus-article-replace-part + "d" gnus-article-delete-part + "j" gnus-article-jump-to-part "c" gnus-article-copy-part "C" gnus-article-view-part-as-charset "e" gnus-article-view-part-externally @@ -2576,6 +2601,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) '(:help "Mark unread articles in this group as read, then exit"))] ["Catchup all and exit" gnus-summary-catchup-all-and-exit t] ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] + ["Catchup and goto prev" gnus-summary-catchup-and-goto-prev-group t] ["Exit group" gnus-summary-exit ,@(if (featurep 'xemacs) '(t) '(:help "Exit current group, return to group selection mode"))] @@ -2774,7 +2800,7 @@ The following commands are available: (make-local-variable 'gnus-summary-mark-positions) (gnus-make-local-hook 'pre-command-hook) (add-hook 'pre-command-hook 'gnus-set-global-variables nil t) - (gnus-run-hooks 'gnus-summary-mode-hook) + (gnus-run-mode-hooks 'gnus-summary-mode-hook) (turn-on-gnus-mailing-list-mode) (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy) (gnus-update-summary-mark-positions)) @@ -3359,12 +3385,12 @@ buffer that was in action when the last article was fetched." newsgroups) (cond ((setq to (cdr (assq 'To extra-headers))) - (concat "-> " + (concat gnus-summary-to-prefix (inline (gnus-summary-extract-address-component (funcall gnus-decode-encoded-word-function to))))) ((setq newsgroups (cdr (assq 'Newsgroups extra-headers))) - (concat "=> " newsgroups))))) + (concat gnus-summary-newsgroup-prefix newsgroups))))) (inline (gnus-summary-extract-address-component gnus-tmp-from))))) (defun gnus-summary-insert-line (gnus-tmp-header @@ -4585,6 +4611,11 @@ using some other form will lead to serious barfage." (or (cdr (assq 'To (mail-header-extra h2))) "")))) (or (car extract) (cadr extract))))) +(defun gnus-thread-sort-by-recipient (h1 h2) + "Sort threads by root recipient." + (gnus-article-sort-by-recipient + (gnus-thread-header h1) (gnus-thread-header h2))) + (defsubst gnus-article-sort-by-subject (h1 h2) "Sort articles by root subject." (string-lessp @@ -4705,33 +4736,39 @@ If nil, use subject instead." :version "22.1" :type '(radio (const :format "%v " nil) string) :group 'gnus-thread) + (defcustom gnus-sum-thread-tree-false-root "> " "With %B spec, used for a false root of a thread. If nil, use subject instead." :version "22.1" :type '(radio (const :format "%v " nil) string) :group 'gnus-thread) + (defcustom gnus-sum-thread-tree-single-indent "" "With %B spec, used for a thread with just one message. If nil, use subject instead." :version "22.1" :type '(radio (const :format "%v " nil) string) :group 'gnus-thread) + (defcustom gnus-sum-thread-tree-vertical "| " "With %B spec, used for drawing a vertical line." :version "22.1" :type 'string :group 'gnus-thread) + (defcustom gnus-sum-thread-tree-indent " " "With %B spec, used for indenting." :version "22.1" :type 'string :group 'gnus-thread) + (defcustom gnus-sum-thread-tree-leaf-with-other "+-> " "With %B spec, used for a leaf with brothers." :version "22.1" :type 'string :group 'gnus-thread) + (defcustom gnus-sum-thread-tree-single-leaf "\\-> " "With %B spec, used for a leaf without brothers." :version "22.1" @@ -5719,7 +5756,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (match-end 1))) (substring xrefs (match-beginning 1) (match-end 1)))) (setq number - (string-to-int (substring xrefs (match-beginning 2) + (string-to-number (substring xrefs (match-beginning 2) (match-end 2)))) (if (setq entry (gnus-gethash group xref-hashtb)) (setcdr entry (cons number (cdr entry))) @@ -6727,11 +6764,13 @@ If FORCE (the prefix), also save the .newsrc file(s)." (set-buffer gnus-group-buffer) (if quit-config (gnus-handle-ephemeral-exit quit-config) + (goto-char group-point) + ;; If gnus-group-buffer is already displayed, make sure we also move + ;; the cursor in the window that displays it. + (let ((win (get-buffer-window (current-buffer) 0))) + (if win (set-window-point win (point)))) (unless leave-hidden (gnus-configure-windows 'group 'force)) - ;; Move point after calling gnus-configure-windows to make sure it - ;; moves the window's point as well. - (goto-char group-point) (unless (pos-visible-in-window-p) (forward-line (/ (static-if (featurep 'xemacs) (window-displayed-height) @@ -7785,8 +7824,8 @@ articles that are younger than AGE days." (gnus-completing-read-with-default (symbol-name (car gnus-extra-headers)) (if current-prefix-arg - "Exclude extra header:" - "Limit extra header:") + "Exclude extra header" + "Limit extra header") (mapcar (lambda (x) (cons (symbol-name x) x)) gnus-extra-headers) @@ -8592,7 +8631,6 @@ If BACKWARD, search backward instead." (start (or (search-backward "\n\n" nil t) (point-min)))) (goto-char (or (text-property-any start end 'x-face-image t);; x-face-e21 - (text-property-any start end 'x-face-mule-bitmap-image t) (, opoint))))))) (defmacro gnus-summary-search-article-highlight-matched-text @@ -8618,11 +8656,7 @@ If BACKWARD, search backward instead." gnus-treat-display-x-face 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)))) + items)) (gnus-treat-display-x-face (when (, x-face) gnus-treat-display-x-face))) (gnus-article-prepare-mime-display))) @@ -8670,8 +8704,7 @@ Optional argument BACKWARD means do search for backward. 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)) + (let ((gnus-inhibit-treatment t)) (setq treated (eq 'old (gnus-summary-select-article))) (when (and treated (not @@ -9185,7 +9218,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (crosspost "Crosspost" "Crossposting"))) (copy-buf (save-excursion (nnheader-set-temp-buffer " *copy article*"))) - art-group to-method new-xref article to-groups) + art-group to-method new-xref article to-groups articles-to-update-marks) (unless (assq action names) (error "Unknown action %s" action)) ;; Read the newsgroup name. @@ -9234,7 +9267,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." gnus-newsgroup-name)) (to-method (gnus-find-method-for-group to-newsgroup)) - (gnus-sum-hint-move-is-internal (gnus-method-equal from-method to-method))) + (move-is-internal (gnus-method-equal from-method to-method))) (gnus-request-move-article article ; Article to move gnus-newsgroup-name ; From newsgroup @@ -9243,7 +9276,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (list 'gnus-request-accept-article to-newsgroup (list 'quote select-method) (not articles) t) ; Accept form - (not articles)))) ; Only save nov last time + (not articles) ; Only save nov last time + move-is-internal))) ; is this move internal? ;; Copy the article. ((eq action 'copy) (save-excursion @@ -9397,17 +9431,19 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." ;;;!!!Why is this necessary? (set-buffer gnus-summary-buffer) - + (gnus-summary-goto-subject article) (when (eq action 'move) (gnus-summary-mark-article article gnus-canceled-mark)))) - (gnus-summary-remove-process-mark article)) + (push article articles-to-update-marks)) + + (apply 'gnus-summary-remove-process-mark articles-to-update-marks) ;; Re-activate all groups that have been moved to. (save-excursion (set-buffer gnus-group-buffer) (let ((gnus-group-marked to-groups)) (gnus-group-get-new-news-this-group nil t))) - + (gnus-kill-buffer copy-buf) (gnus-summary-position-point) (gnus-set-mode-line 'summary))) @@ -9467,7 +9503,7 @@ latter case, they will be copied into the relevant groups." gnus-newsgroup-name))))) (method (gnus-completing-read-with-default - methname "What backend do you want to use when respooling?" + methname "Backend to use when respooling" methods nil t nil 'gnus-mail-method-history)) ms) (cond @@ -9761,7 +9797,8 @@ groups." (save-excursion (save-restriction (message-narrow-to-head) - (let ((head (buffer-string)) + (let ((head (buffer-substring-no-properties + (point-min) (point-max))) header) (with-temp-buffer (insert (format "211 %d Article retrieved.\n" @@ -10048,13 +10085,15 @@ the actual number of articles marked is returned." (gnus-summary-goto-subject article) (gnus-summary-update-secondary-mark article))) -(defun gnus-summary-remove-process-mark (article) - "Remove the process mark from ARTICLE and update the summary line." - (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable)) - (when (gnus-summary-goto-subject article) - (gnus-summary-show-thread) - (gnus-summary-goto-subject article) - (gnus-summary-update-secondary-mark article))) +(defun gnus-summary-remove-process-mark (&rest articles) + "Remove the process mark from ARTICLES and update the summary line." + (dolist (article articles) + (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable)) + (when (gnus-summary-goto-subject article) + (gnus-summary-show-thread) + (gnus-summary-goto-subject article) + (gnus-summary-update-secondary-mark article))) + t) (defun gnus-summary-set-saved-mark (article) "Set the process mark on ARTICLE and update the summary line." @@ -10626,6 +10665,15 @@ read." (gnus-summary-catchup all)) (gnus-summary-next-group)) +(defun gnus-summary-catchup-and-goto-prev-group (&optional all) + "Mark all articles in this group as read and select the previous group. +If given a prefix, mark all articles, unread as well as ticked, as +read." + (interactive "P") + (save-excursion + (gnus-summary-catchup all)) + (gnus-summary-next-group nil nil t)) + ;;; ;;; with article ;;; @@ -11251,7 +11299,7 @@ save those articles instead." (let* ((split-name (gnus-get-split-value gnus-move-split-methods)) (minibuffer-confirm-incomplete nil) ; XEmacs (prom - (format "%s %s to:" + (format "%s %s to" prompt (if (> (length articles) 1) (format "these %d articles" (length articles))