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

3 files changed, 137 insertions, 69 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index a5c403f0d7d..9f3a114adbe 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -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.
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 30ac3c6ccd8..55aaed15d90 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -2824,72 +2824,76 @@ 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
-                     (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))
-          (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))))))))
+          (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))
+          (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 @@ This format is defined by the `gnus-article-time-format' variable."
   (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 @@ N is the numerical prefix."
             (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\".
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index 04bebec79a6..42ab072f438 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -195,6 +195,7 @@ for decoding when the cdr that the data specify is not available.")
                                    (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 @@ for decoding when the cdr that the data specify is not available.")
                          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 @@ for decoding when the cdr that the data specify is not available.")
               (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 @@ 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
@@ -567,6 +575,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)
@@ -575,7 +604,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)
         (gnus-sethash (or url extra) t nnrss-group-hashtb)
         (setq changed t))