From: yamaoka <yamaoka>
Date: Fri, 22 Apr 2005 12:19:47 +0000 (+0000)
Subject: Synch to No Gnus 200504221124.
X-Git-Tag: t-gnus-6_17_4-quimby-~501
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=1e2d98affe74e153048447806d718ed78abd2467;p=elisp%2Fgnus.git-

Synch to No Gnus 200504221124.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 8d7d006..eab7c90 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,15 @@
+2005-04-22  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* gnus-art.el (article-date-ut): Support converting date in
+	forwarded parts as well.
+	(gnus-article-save-original-date): New function.
+	(gnus-display-mime): Use it.
+
+2005-04-22  David Hansen  <david.hansen@physik.fu-berlin.de>
+
+	* nnrss.el (nnrss-check-group, nnrss-request-article): Support the
+	enclosure element of <item>.
+
 2005-04-21  Reiner Steib  <Reiner.Steib@gmx.de>
 
 	* message.el (message-kill-buffer-query): Renamed from
diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index caf46cf..0b80072 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -3007,81 +3007,72 @@ lines forward."
 	  (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
-		     (and (eq 1 (point-min))
-			  (mail-header-date (save-excursion
-					      (set-buffer gnus-summary-buffer)
-					      gnus-current-headers)))
-		     (message-fetch-field "date")
-		     ""))
-	 (date (if (vectorp header) (mail-header-date header)
-		 header))
+  (let* ((tdate-regexp "^Date:[ \t]\\|^X-Sent:[ \t]")
+	 (date-regexp (if (and gnus-article-date-lapsed-new-header
+			       (eq type 'lapsed))
+			  "^X-Sent:[ \t]"
+			tdate-regexp))
+	 (case-fold-search t)
+	 (inhibit-read-only t)
 	 (inhibit-point-motion-hooks t)
-	 bface eface date-pos)
-    (when (and date (not (string= date "")))
-      (save-excursion
-	(save-restriction
-	  (article-narrow-to-head)
-	  (when (or (and (eq type 'lapsed)
-			 gnus-article-date-lapsed-new-header
-			 ;; Attempt to get the face of X-Sent first.
-			 (re-search-forward "^X-Sent:[ \t]" nil t))
-		    (re-search-forward "^Date:[ \t]" nil t)
-		    ;; If Date is missing, try again for X-Sent.
-		    (re-search-forward "^X-Sent:[ \t]" nil t))
+	 pos date bface eface)
+    (save-excursion
+      (save-restriction
+	(widen)
+	(goto-char (point-min))
+	(while (and (or (setq date (get-text-property (setq pos (point))
+						      'original-date))
+			(and (setq pos (next-single-property-change
+					(point) 'original-date))
+			     (setq date (get-text-property pos
+							   'original-date))))
+		    (not (string-equal date "")))
+	  (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 (point-at-bol) 'face)
-		  date (or (get-text-property (point-at-bol)
-					      'original-date)
-			   date)
-		  eface (get-text-property (1- (point-at-eol))
-					   'face)))
-	  (let ((inhibit-read-only t))
-	    ;; Delete any old X-Sent headers.
-	    (when (setq date-pos
-			(text-property-any (point-min) (point-max)
-					   'article-date-lapsed t))
-	      (goto-char (setq date-pos (set-marker (make-marker) date-pos)))
-	      (delete-region (match-beginning 0)
-			     (progn (forward-line 1) (point))))
-	    (goto-char (point-min))
-	    ;; Delete any old Date headers.
-	    (while (re-search-forward "^Date:[ \t]" nil t)
-	      (unless date-pos
-		(setq date-pos (match-beginning 0)))
-	      (unless (and (eq type 'lapsed)
-			   gnus-article-date-lapsed-new-header)
-		(delete-region (match-beginning 0)
-			       (progn (message-next-header) (point)))))
-	    (if date-pos
-		(progn
-		  (goto-char date-pos)
-		  (unless (bolp)
-		    ;; Possibly, Date has been deleted.
-		    (insert "\n"))
-		  (when (and (eq type 'lapsed)
-			     gnus-article-date-lapsed-new-header
-			     (looking-at "Date:"))
-		    (forward-line 1)))
-	      (goto-char (point-min)))
-	    (insert (article-make-date-line date type))
-	    (when (eq type 'lapsed)
-	      (put-text-property (point-at-bol) (point)
-				 'article-date-lapsed t))
+		  eface (get-text-property (1- (point-at-eol)) 'face)))
+	  (goto-char (point-min))
+	  (setq pos nil)
+	  ;; Delete any old Date headers.
+	  (while (re-search-forward date-regexp nil t)
+	    (if pos
+		(delete-region (point-at-bol) (progn
+						(gnus-article-forward-header)
+						(point)))
+	      (delete-region (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.
-	    (when (looking-at "\\([^:]+\\): *\\(.*\\)$")
-	      (add-text-properties (match-beginning 1) (1+ (match-end 1))
-				   (list 'original-date date 'face bface))
-	      (put-text-property (match-beginning 2) (match-end 2)
-				 'face eface))))))))
+	    (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."
@@ -3266,6 +3257,22 @@ This format is defined by the `gnus-article-time-format' variable."
   (interactive (list t))
   (article-date-ut 'iso8601 highlight))
 
+(defun gnus-article-save-original-date ()
+  "Save the original date as a text property."
+  ;;(goto-char (point-max))
+  (skip-chars-backward "\n")
+  (let (start
+	(end (point))
+	(case-fold-search t))
+    (goto-char (point-min))
+    (when (and (re-search-forward "^date:[\t\n ]+" nil t)
+	       (progn
+		 (setq start (match-end 0))
+		 (re-search-forward "[\t ]*\n\\(?:[^\t ]\\|\\'\\)" nil t)))
+      (put-text-property
+       (point-min) end 'original-date
+       (buffer-substring-no-properties start (match-beginning 0))))))
+
 ;; (defun article-show-all ()
 ;;   "Show all hidden text in the article buffer."
 ;;   (interactive)
@@ -4204,6 +4211,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
 			(if (search-forward "\n\n" nil t)
 			    (point)
 			  (point-max)))
+      (gnus-article-save-original-date)
       (gnus-treat-article 'head)
       (put-text-property (point-min) (point-max) 'article-treated-header t)
       (goto-char (point-max)))
@@ -4299,6 +4307,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
 			  (if (search-forward "\n\n" nil t)
 			      (point)
 			    (point-max)))
+	(gnus-article-save-original-date)
 	(gnus-treat-article 'head)
 	(put-text-property (point-min) (point-max) 'article-treated-header t)
 	(goto-char (point-max))
@@ -5058,6 +5067,7 @@ N is the numerical prefix."
 	    (save-restriction
 	      (article-goto-body)
 	      (narrow-to-region (point-min) (point))
+	      (gnus-article-save-original-date)
 	      (gnus-treat-article 'head))))))))
 
 (defcustom gnus-mime-display-multipart-as-mixed nil
diff --git a/lisp/nnrss.el b/lisp/nnrss.el
index 9e8eff6..a585468 100644
--- a/lisp/nnrss.el
+++ b/lisp/nnrss.el
@@ -203,54 +203,61 @@ The return value will be `html' or `text'."
 	(nntp-server-buffer (or buffer nntp-server-buffer))
 	post err)
     (when e
-      (catch 'error
-	(with-current-buffer nntp-server-buffer
-	  (erase-buffer)
-	  (if group
-	      (mm-with-unibyte-current-buffer
-		(insert "Newsgroups: "
-			(if (mm-coding-system-p 'utf-8)
-			    (mm-encode-coding-string group 'utf-8)
-			  group)
-			"\n")))
-	  (if (nth 3 e)
-	      (insert "Subject: " (nth 3 e) "\n"))
-	  (if (nth 4 e)
-	      (insert "From: " (nth 4 e) "\n"))
-	  (if (nth 5 e)
-	      (insert "Date: " (nnrss-format-string (nth 5 e)) "\n"))
-	  (insert (format "Message-ID: <%d@%s.nnrss>\n"
-			  (car e)
-			  (gnus-replace-in-string group "[\t\n ]+" "_")))
-	  (insert "\n")
-	  (let ((text (if (nth 6 e)
-			  (mapconcat 'identity
-				     (delete "" (split-string (nth 6 e) "\n+"))
-				     " ")))
-		(link (nth 2 e))
-		(mail-header-separator "")
-		mime-edit-insert-user-agent-field)
-	    (when (or text link)
-	      (if (eq 'html (nnrss-body-presentation-method))
-		  (progn
-		    (mime-edit-insert-text "html")
-		    (insert "<html><head></head><body>\n")
-		    (when text
-		      (insert text "\n"))
-		    (when link
-		      (insert "<p><a href=\"" link "\">link</a></p>\n"))
-		    (insert "</body></html>\n"))
-		(mime-edit-insert-text "plain")
-		(if text
-		    (progn
-		      (insert text "\n")
-		      (when link
-			(insert "\n" link "\n")))
+      (with-current-buffer nntp-server-buffer
+	(erase-buffer)
+	(if group
+	    (mm-with-unibyte-current-buffer
+	      (insert "Newsgroups: "
+		      (if (mm-coding-system-p 'utf-8)
+			  (mm-encode-coding-string group 'utf-8)
+			group)
+		      "\n")))
+	(if (nth 3 e)
+	    (insert "Subject: " (nth 3 e) "\n"))
+	(if (nth 4 e)
+	    (insert "From: " (nth 4 e) "\n"))
+	(if (nth 5 e)
+	    (insert "Date: " (nnrss-format-string (nth 5 e)) "\n"))
+	(insert (format "Message-ID: <%d@%s.nnrss>\n"
+			(car e)
+			(gnus-replace-in-string group "[\t\n ]+" "_")))
+	(insert "\n")
+	(let ((text (if (nth 6 e)
+			(mapconcat 'identity
+				   (delete "" (split-string (nth 6 e) "\n+"))
+				   " ")))
+	      (link (nth 2 e))
+	      (enclosure (nth 7 e))
+	      (mail-header-separator "")
+	      mime-edit-insert-user-agent-field)
+	  (when (or text link enclosure)
+	    (if (eq 'html (nnrss-body-presentation-method))
+		(progn
+		  (mime-edit-insert-text "html")
+		  (insert "<html><head></head><body>\n")
+		  (when text
+		    (insert text "\n"))
 		  (when link
-		    (insert link "\n"))))
-	      (mime-edit-translate-body)))
-	  (when nnrss-content-function
-	    (funcall nnrss-content-function e group article)))))
+		    (insert "<p><a href=\"" link "\">link</a></p>\n"))
+		  (when enclosure
+		    (insert "<p><a href=\"" (car enclosure) "\">"
+			    (cadr enclosure) "</a> " (nth 2 enclosure)
+			    " " (nth 3 enclosure) "</p>\n"))
+		  (insert "</body></html>\n"))
+	      (mime-edit-insert-text "plain")
+	      (when text
+		(insert text "\n")
+		(when (or link enclosure)
+		  (insert "\n")))
+	      (when link
+		(insert link "\n"))
+	      (when enclosure
+		(insert (car enclosure) " "
+			(nth 2 enclosure) " "
+			(nth 3 enclosure) "\n")))
+	    (mime-edit-translate-body)))
+	(when nnrss-content-function
+	  (funcall nnrss-content-function e group article))))
     (cond
      (err
       (nnheader-report 'nnrss err))
@@ -520,8 +527,8 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
 ;;; Snarf functions
 
 (defun nnrss-check-group (group server)
-  (let (file xml subject url extra changed author
-	     date rss-ns rdf-ns content-ns dc-ns)
+  (let (file xml subject url extra changed author date
+	     enclosure rss-ns rdf-ns content-ns dc-ns)
     (if (and nnrss-use-local
 	     (file-exists-p (setq file (expand-file-name
 					(nnrss-translate-file-chars
@@ -569,6 +576,27 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
 	(setq date (or (nnrss-node-text dc-ns 'date item)
 		       (nnrss-node-text rss-ns 'pubDate item)
 		       (message-make-date)))
+	(when (setq enclosure (cadr (assq (intern (concat rss-ns "enclosure")) item)))
+	  (let ((url (cdr (assq 'url enclosure)))
+		(len (cdr (assq 'length enclosure)))
+		(type (cdr (assq 'type enclosure)))
+		(name))
+	    (setq len
+		  (if (and len (integerp (setq len (string-to-number len))))
+		      ;; actually already in `ls-lisp-format-file-size' but
+		      ;; probably not worth to require it for one function
+		      (do ((size (/ len 1.0) (/ size 1024.0))
+			   (post-fixes (list "" "k" "M" "G" "T" "P" "E")
+				       (cdr post-fixes)))
+			  ((< size 1024)
+			   (format "%.1f%s" size (car post-fixes))))
+		    "0"))
+	    (setq url (or url ""))
+	    (setq name (if (string-match "/\\([^/]*\\)$" url)
+			   (match-string 1 url)
+			 "file"))
+	    (setq type (or type ""))
+	    (setq enclosure (list url name len type))))
 	(push
 	 (list
 	  (incf nnrss-group-max)
@@ -577,7 +605,8 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
 	  (and subject (nnrss-mime-encode-string subject))
 	  (and author (nnrss-mime-encode-string author))
 	  date
-	  (and extra (nnrss-decode-entities-string extra)))
+	  (and extra (nnrss-decode-entities-string extra))
+	  enclosure)
 	 nnrss-group-data)
 	(puthash (or url extra) t nnrss-group-hashtb)
 	(setq changed t))