Mercurial > hg > xemacs-beta
diff lisp/gnus/gnus-sum.el @ 114:8619ce7e4c50 r20-1b9
Import from CVS: tag r20-1b9
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:21:54 +0200 |
parents | 48d667d6f17f |
children | 9f59509498e1 |
line wrap: on
line diff
--- a/lisp/gnus/gnus-sum.el Mon Aug 13 09:20:50 2007 +0200 +++ b/lisp/gnus/gnus-sum.el Mon Aug 13 09:21:54 2007 +0200 @@ -288,6 +288,11 @@ :group 'gnus-article-headers :type 'boolean) +(defcustom gnus-summary-ignore-duplicates nil + "*If non-nil, ignore articles with identical Message-ID headers." + :group 'gnus-summary + :type 'boolean) + (defcustom gnus-single-article-buffer t "*If non-nil, display all articles in the same buffer. If nil, each group will get its own article buffer." @@ -1312,7 +1317,8 @@ "t" gnus-article-remove-trailing-blank-lines "l" gnus-article-strip-leading-blank-lines "m" gnus-article-strip-multiple-blank-lines - "a" gnus-article-strip-blank-lines) + "a" gnus-article-strip-blank-lines + "s" gnus-article-strip-leading-space) (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map) "v" gnus-version @@ -1514,7 +1520,8 @@ ["Leading" gnus-article-strip-leading-blank-lines t] ["Multiple" gnus-article-strip-multiple-blank-lines t] ["Trailing" gnus-article-remove-trailing-blank-lines t] - ["All of the above" gnus-article-strip-blank-lines t]) + ["All of the above" gnus-article-strip-blank-lines t] + ["Leading space" gnus-article-strip-leading-space t]) ["Overstrike" gnus-article-treat-overstrike t] ["Emphasis" gnus-article-emphasize t] ["Word wrap" gnus-article-fill-cited-article t] @@ -2460,6 +2467,22 @@ If SHOW-ALL is non-nil, already read articles are also listed. If NO-ARTICLE is non-nil, no article is selected initially. If NO-DISPLAY, don't generate a summary buffer." + (let (result) + (while (and group + (null (setq result + (let ((gnus-auto-select-next nil)) + (gnus-summary-read-group-1 + group show-all no-article + kill-buffer no-display)))) + (eq gnus-auto-select-next 'quietly)) + (set-buffer gnus-group-buffer) + (if (not (equal group (gnus-group-group-name))) + (setq group (gnus-group-group-name)) + (setq group nil))) + result)) + +(defun gnus-summary-read-group-1 (group show-all no-article + kill-buffer no-display) ;; Killed foreign groups can't be entered. (when (and (not (gnus-group-native-p group)) (not (gnus-gethash group gnus-newsrc-hashtb))) @@ -2560,7 +2583,7 @@ (not no-display)) (progn ;; This newsgroup is empty. - (gnus-summary-catchup-and-exit nil t) ;Without confirmations. + (gnus-summary-catchup-and-exit nil t) (gnus-message 6 "No unread news") (when kill-buffer (gnus-kill-or-deaden-summary kill-buffer)) @@ -2596,10 +2619,10 @@ (select-window (get-buffer-window gnus-group-buffer t)) (when (gnus-group-goto-group group) (recenter)) - (select-window owin)))) - ;; Mark this buffer as "prepared". - (setq gnus-newsgroup-prepared t) - t)))) + (select-window owin))) + ;; Mark this buffer as "prepared". + (setq gnus-newsgroup-prepared t) + t))))) (defun gnus-summary-prepare () "Generate the summary buffer." @@ -2869,19 +2892,21 @@ (prog1 (save-excursion (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while (and (not found) (search-forward id nil t)) - (beginning-of-line) - (setq found (looking-at - (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s" - (regexp-quote id)))) - (or found (beginning-of-line 2))) - (when found - (beginning-of-line) - (and - (setq header (gnus-nov-parse-line - (read (current-buffer)) deps)) - (gnus-parent-id (mail-header-references header))))) + (let ((case-fold-search nil)) + (goto-char (point-min)) + (while (and (not found) + (search-forward id nil t)) + (beginning-of-line) + (setq found (looking-at + (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s" + (regexp-quote id)))) + (or found (beginning-of-line 2))) + (when found + (beginning-of-line) + (and + (setq header (gnus-nov-parse-line + (read (current-buffer)) deps)) + (gnus-parent-id (mail-header-references header)))))) (when header (let ((number (mail-header-number header))) (push number gnus-newsgroup-limit) @@ -2916,17 +2941,18 @@ (memq article gnus-newsgroup-expirable) ;; Only insert the Subject string when it's different ;; from the previous Subject string. - (unless (gnus-subject-equal - (condition-case () - (mail-header-subject - (gnus-data-header - (cadr - (gnus-data-find-list - article - (gnus-data-list t))))) - (error "")) - (mail-header-subject header)) - (mail-header-subject header)) + (if (gnus-subject-equal + (condition-case () + (mail-header-subject + (gnus-data-header + (cadr + (gnus-data-find-list + article + (gnus-data-list t))))) + (error "")) + (mail-header-subject header)) + (mail-header-subject header) + "") nil (cdr (assq article gnus-newsgroup-scored)) (memq article gnus-newsgroup-processable)) (when length @@ -3832,7 +3858,7 @@ gnus-save-score list) (let* ((arts list) - (prev (cons nil articles)) + (prev (cons nil list)) (all prev)) (while arts (if (or (not (consp (car arts))) @@ -4178,9 +4204,20 @@ (if (boundp (setq id-dep (intern id dependencies))) (if (and (car (symbol-value id-dep)) (not force-new)) - ;; An article with this Message-ID has already been seen, - ;; so we rename the Message-ID. - (progn + ;; An article with this Message-ID has already been seen. + (if gnus-summary-ignore-duplicates + ;; We ignore this one, except we add + ;; any additional Xrefs (in case the two articles + ;; came from different servers). + (progn + (mail-header-set-xref + (car (symbol-value id-dep)) + (concat (or (mail-header-xref + (car (symbol-value id-dep))) + "") + (or (mail-header-xref header) ""))) + (setq header nil)) + ;; We rename the Message-ID. (set (setq id-dep (intern (setq id (nnmail-message-id)) dependencies)) @@ -4267,9 +4304,20 @@ (if (boundp (setq id-dep (intern id dependencies))) (if (and (car (symbol-value id-dep)) (not force-new)) - ;; An article with this Message-ID has already been seen, - ;; so we rename the Message-ID. - (progn + ;; An article with this Message-ID has already been seen. + (if gnus-summary-ignore-duplicates + ;; We ignore this one, except we add any additional + ;; Xrefs (in case the two articles came from different + ;; servers. + (progn + (mail-header-set-xref + (car (symbol-value id-dep)) + (concat (or (mail-header-xref + (car (symbol-value id-dep))) + "") + (or (mail-header-xref header) ""))) + (setq header nil)) + ;; We rename the Message-ID. (set (setq id-dep (intern (setq id (nnmail-message-id)) dependencies))