Mercurial > emacs

changeset 62099:d1245d218964

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Revision: miles@gnu.org--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 <yamaoka@jpl.org> * 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 <david.hansen@physik.fu-berlin.de> * lisp/gnus/nnrss.el (nnrss-check-group, nnrss-request-article): Support the enclosure element of <item>.
author Miles Bader <miles@gnu.org>
date Fri, 06 May 2005 00:27:50 +0000
parents bc3a702b646e
children e5deb8b3a701 b151ec53c504
files lisp/gnus/ChangeLog lisp/gnus/gnus-art.el lisp/gnus/nnrss.el
diffstat 3 files changed, 137 insertions(+), 69 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog	Thu May 05 23:19:02 2005 +0000
+++ b/lisp/gnus/ChangeLog	Fri May 06 00:27:50 2005 +0000
@@ -1,3 +1,15 @@
+2005-04-28  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 macro.
+	(gnus-display-mime): Use it.
+
+2005-04-28  David Hansen  <david.hansen@physik.fu-berlin.de>
+
+	* nnrss.el (nnrss-check-group, nnrss-request-article): Support the
+	enclosure element of <item>.
+
 2005-04-24  Teodor Zlatanov  <tzz@lifelogs.com>
 
 	* spam-report.el (spam-report-unplug-agent)
@@ -18,7 +30,7 @@
 	Process requests from `spam-report-requests-file'.
 	(spam-report-url-ping-mm-url): Autoload.
 	[Added missing offline functionality from trunk.]
-	
+
 2005-04-18  Katsumi Yamaoka  <yamaoka@jpl.org>
 
 	* qp.el (quoted-printable-encode-region): Save excursion.
--- 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\".
--- a/lisp/gnus/nnrss.el	Thu May 05 23:19:02 2005 +0000
+++ b/lisp/gnus/nnrss.el	Fri May 06 00:27:50 2005 +0000
@@ -195,6 +195,7 @@
 				   (delete "" (split-string (nth 6 e) "\n+"))
 				   " ")))
 	      (link (nth 2 e))
+	      (enclosure (nth 7 e))
 	      ;; Enable encoding of Newsgroups header in XEmacs.
 	      (default-enable-multibyte-characters t)
 	      (rfc2047-header-encoding-alist
@@ -203,18 +204,21 @@
 			 rfc2047-header-encoding-alist)
 		 rfc2047-header-encoding-alist))
 	      rfc2047-encode-encoded-words body)
-	  (when (or text link)
+	  (when (or text link enclosure)
 	    (insert "\n")
 	    (insert "<#multipart type=alternative>\n"
 		    "<#part type=\"text/plain\">\n")
 	    (setq body (point))
-	    (if text
-		(progn
-		  (insert text "\n")
-		  (when link
-		    (insert "\n" link "\n")))
-	      (when link
-		(insert link "\n")))
+	    (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"))
 	    (setq body (buffer-substring body (point)))
 	    (insert "<#/part>\n"
 		    "<#part type=\"text/html\">\n"
@@ -223,6 +227,10 @@
 	      (insert text "\n"))
 	    (when link
 	      (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"
 		    "<#/part>\n"
 		    "<#/multipart>\n"))
@@ -518,8 +526,8 @@
 ;;; 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
@@ -567,6 +575,27 @@
 	(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)
@@ -575,7 +604,8 @@
 	  (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)
 	(gnus-sethash (or url extra) t nnrss-group-hashtb)
 	(setq changed t))