diff lisp/gnus/gnus-art.el @ 62099:d1245d218964

Revision: [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-291 Merge from gnus--rel--5.10 Patches applied: * gnus--rel--5.10 (patch 68) - Update from CVS 2005-04-28 Katsumi Yamaoka <[e-mail]> * lisp/gnus/gnus-art.el (article-date-ut): Support converting date in forwarded parts as well. (gnus-article-save-original-date): New macro. (gnus-display-mime): Use it. 2005-04-28 David Hansen <[e-mail]> * lisp/gnus/nnrss.el (nnrss-check-group, nnrss-request-article): Support the enclosure element of <item>.

--- a/lisp/gnus/gnus-art.el	Thu May 05 23:19:02 2005 +0000
+++ b/lisp/gnus/gnus-art.el	Fri May 06 00:27:50 2005 +0000
@@ -2824,72 +2824,76 @@
 	  (forward-line 1)
 	(setq ended t)))))
 
-(defun article-date-ut (&optional type highlight header)
+(defun article-date-ut (&optional type highlight)
   "Convert DATE date to universal time in the current article.
 If TYPE is `local', convert to local time; if it is `lapsed', output
 how much time has lapsed since DATE.  For `lapsed', the value of
 `gnus-article-date-lapsed-new-header' says whether the \"X-Sent:\" header
 should replace the \"Date:\" one, or should be added below it."
   (interactive (list 'ut t))
-  (let* ((header (or header
-		     (message-fetch-field "date")
-		     ""))
-	 (tdate-regexp "^Date:[ \t]\\|^X-Sent:[ \t]")
-	 (date-regexp
-	  (cond
-	   ((not gnus-article-date-lapsed-new-header)
-	    tdate-regexp)
-	   ((eq type 'lapsed)
-	    "^X-Sent:[ \t]")
-	   (t
-	    "^Date:[ \t]")))
-	 (date (if (vectorp header) (mail-header-date header)
-		 header))
+  (let* ((tdate-regexp "^Date:[ \t]\\|^X-Sent:[ \t]")
+	 (date-regexp (cond ((not gnus-article-date-lapsed-new-header)
+			     tdate-regexp)
+			    ((eq type 'lapsed)
+			     "^X-Sent:[ \t]")
+			    (article-lapsed-timer
+			     "^Date:[ \t]")
+			    (t
+			     tdate-regexp)))
+	 (case-fold-search t)
+	 (inhibit-read-only t)
 	 (inhibit-point-motion-hooks t)
-	 pos
-	 bface eface)
+	 pos date bface eface)
     (save-excursion
       (save-restriction
-	(article-narrow-to-head)
-	(when (re-search-forward tdate-regexp nil t)
-	  (setq bface (get-text-property (gnus-point-at-bol) 'face)
-		date (or (get-text-property (gnus-point-at-bol)
-					    'original-date)
-			 date)
-		eface (get-text-property (1- (gnus-point-at-eol)) 'face))
-	  (forward-line 1))
-	(when (and date (not (string= date "")))
+	(widen)
+	(goto-char (point-min))
+	(while (or (setq date (get-text-property (setq pos (point))
+						 'original-date))
+		   (when (setq pos (next-single-property-change
+				    (point) 'original-date))
+		     (setq date (get-text-property pos 'original-date))
+		     t))
+	  (narrow-to-region pos (or (text-property-any pos (point-max)
+						       'original-date nil)
+				    (point-max)))
+	  (goto-char (point-min))
+	  (when (re-search-forward tdate-regexp nil t)
+	    (setq bface (get-text-property (gnus-point-at-bol) 'face)
+		  eface (get-text-property (1- (gnus-point-at-eol)) 'face)))
 	  (goto-char (point-min))
-	  (let ((inhibit-read-only t))
-	    ;; Delete any old Date headers.
-	    (while (re-search-forward date-regexp nil t)
-	      (if pos
-		  (delete-region (progn (beginning-of-line) (point))
-				 (progn (gnus-article-forward-header)
-					(point)))
-		(delete-region (progn (beginning-of-line) (point))
-				 (progn (gnus-article-forward-header)
-					(forward-char -1)
-					(point)))
-		(setq pos (point))))
-	    (when (and (not pos)
-		       (re-search-forward tdate-regexp nil t))
-	      (forward-line 1))
-	    (when pos
-	      (goto-char pos))
-	    (insert (article-make-date-line date (or type 'ut)))
-	    (unless pos
-	      (insert "\n")
-	      (forward-line -1))
-	    ;; Do highlighting.
-	    (beginning-of-line)
-	    (when (looking-at "\\([^:]+\\): *\\(.*\\)$")
-	      (put-text-property (match-beginning 1) (1+ (match-end 1))
-				 'original-date date)
-	      (put-text-property (match-beginning 1) (1+ (match-end 1))
-				 'face bface)
-	      (put-text-property (match-beginning 2) (match-end 2)
-				 'face eface))))))))
+	  (setq pos nil)
+	  ;; Delete any old Date headers.
+	  (while (re-search-forward date-regexp nil t)
+	    (if pos
+		(delete-region (gnus-point-at-bol)
+			       (progn
+				 (gnus-article-forward-header)
+				 (point)))
+	      (delete-region (gnus-point-at-bol)
+			     (progn
+			       (gnus-article-forward-header)
+			       (forward-char -1)
+			       (point)))
+	      (setq pos (point))))
+	  (when (and (not pos)
+		     (re-search-forward tdate-regexp nil t))
+	    (forward-line 1))
+	  (gnus-goto-char pos)
+	  (insert (article-make-date-line date (or type 'ut)))
+	  (unless pos
+	    (insert "\n")
+	    (forward-line -1))
+	  ;; Do highlighting.
+	  (beginning-of-line)
+	  (when (looking-at "\\([^:]+\\): *\\(.*\\)$")
+	    (put-text-property (match-beginning 1) (1+ (match-end 1))
+			       'face bface)
+	    (put-text-property (match-beginning 2) (match-end 2)
+			       'face eface))
+	  (put-text-property (point-min) (1- (point-max)) 'original-date date)
+	  (goto-char (point-max))
+	  (widen))))))
 
 (defun article-make-date-line (date type)
   "Return a DATE line of TYPE."
@@ -3075,6 +3079,27 @@
   (interactive (list t))
   (article-date-ut 'iso8601 highlight))
 
+(defmacro gnus-article-save-original-date (&rest forms)
+  "Save the original date as a text property and evaluate FORMS."
+  `(let* ((case-fold-search t)
+	  (start (progn
+		   (goto-char (point-min))
+		   (when (and (re-search-forward "^date:[\t\n ]+" nil t)
+			      (not (bolp)))
+		     (match-end 0))))
+	  (date (when (and start
+			   (re-search-forward "[\t ]*\n\\([^\t ]\\|\\'\\)"
+					      nil t))
+		  (buffer-substring-no-properties start
+						  (match-beginning 0)))))
+     (goto-char (point-max))
+     (skip-chars-backward "\n")
+     (put-text-property (point-min) (point) 'original-date date)
+     ,@forms
+     (goto-char (point-max))
+     (skip-chars-backward "\n")
+     (put-text-property (point-min) (point) 'original-date date)))
+
 ;; (defun article-show-all ()
 ;;   "Show all hidden text in the article buffer."
 ;;   (interactive)
@@ -4686,7 +4711,8 @@
 	    (save-restriction
 	      (article-goto-body)
 	      (narrow-to-region (point-min) (point))
-	      (gnus-treat-article 'head))))))))
+	      (gnus-article-save-original-date
+	       (gnus-treat-article 'head)))))))))
 
 (defcustom gnus-mime-display-multipart-as-mixed nil
   "Display \"multipart\" parts as  \"multipart/mixed\".