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))