gnus-art.el: Don't assume Date header begins with "Date"

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f0f9873..441773b 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
+2013-06-04  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * gnus-art.el (article-date-ut, article-update-date-lapsed): Don't
+       assume Date header begins with "Date", that may be customized into
+       something like "X-Sent" using gnus-article-time-format.
+       (article-transform-date): Allow multi-line Date header.
+
 2013-06-02  David Engster  <deng@randomsample.de>
 
        * registry.el (initialize-instance, registry-lookup)

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index d76d37a..076f949 100644 (file)
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -3431,15 +3431,13 @@ possible values."
         (visible-date (mail-fetch-field "Date"))
         pos date bface eface)
     (save-excursion
-      (goto-char (point-min))
-      (when (re-search-forward "^Date:" nil t)
-       (setq bface (get-text-property (point-at-bol) 'face)
-             eface (get-text-property (1- (point-at-eol)) 'face)))
-      ;; Delete any old Date headers.
       (if date-position
          (progn
            (goto-char date-position)
            (setq date (get-text-property (point) 'original-date))
+           (when (looking-at "[^:]+:[\t ]*")
+             (setq bface (get-text-property (match-beginning 0) 'face)
+                   eface (get-text-property (match-end 0) 'face)))
            (delete-region (point)
                           (progn
                             (gnus-article-forward-header)
@@ -3455,12 +3453,26 @@ possible values."
            (narrow-to-region pos (if (search-forward "\n\n" nil t)
                                      (1+ (match-beginning 0))
                                    (point-max)))
-           (goto-char (point-min))
-           (while (re-search-forward "^Date:" nil t)
-             (setq date (get-text-property (match-beginning 0) 'original-date))
-             (delete-region (point-at-bol) (progn
-                                             (gnus-article-forward-header)
-                                             (point))))
+           (while (setq pos (text-property-not-all pos (point-max)
+                                                   'gnus-date-type nil))
+             (setq date (get-text-property pos 'original-date))
+             (goto-char pos)
+             (when (looking-at "[^:]+:[\t ]*")
+               (setq bface (get-text-property (match-beginning 0) 'face)
+                     eface (get-text-property (match-end 0) 'face)))
+             (delete-region pos (or (text-property-any pos (point-max)
+                                                       'gnus-date-type nil)
+                                    (point-max))))
+           (unless date ;; the 1st time
+             (goto-char (point-min))
+             (while (re-search-forward "^Date:[\t ]*" nil t)
+               (setq date (get-text-property (match-beginning 0)
+                                             'original-date)
+                     bface (get-text-property (match-beginning 0) 'face)
+                     eface (get-text-property (match-end 0) 'face))
+               (delete-region (point-at-bol) (progn
+                                               (gnus-article-forward-header)
+                                               (point)))))
            (when (and (not date)
                       visible-date)
              (setq date visible-date))
@@ -3477,20 +3489,25 @@ possible values."
                       (list type))
                      (t
                       type)))
-    (insert (article-make-date-line date (or this-type 'ut)) "\n")
-    (forward-line -1)
-    (beginning-of-line)
-    (put-text-property (point) (1+ (point))
-                      'original-date date)
-    (put-text-property (point) (1+ (point))
-                      'gnus-date-type this-type)
+    (goto-char
+     (prog1
+        (point)
+       (add-text-properties
+       (point)
+       (progn
+         (insert (article-make-date-line date (or this-type 'ut)) "\n")
+         (point))
+       (list 'original-date date 'gnus-date-type this-type))))
     ;; Do highlighting.
-    (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))
-    (forward-line 1)))
+    (when (looking-at
+          "\\([^:]+:\\)[\t ]*\\(\\(?:[^\t\n ]+[\t ]+\\)*[^\t\n ]+\\)?")
+      (put-text-property (match-beginning 1) (match-end 1) 'face bface)
+      (when (match-beginning 2)
+       (put-text-property (match-beginning 2) (match-end 2) 'face eface))
+      (while (and (zerop (forward-line 1))
+                 (looking-at "[\t ]+\\(\\(?:[^\t\n ]+[\t ]+\\)*[^\t\n ]+\\)?"))
+       (when (match-beginning 1)
+         (put-text-property (match-beginning 1) (match-end 1) 'face eface))))))
 
 (defun article-make-date-line (date type)
   "Return a DATE line of TYPE."
@@ -3670,25 +3687,26 @@ function and want to see what the date was before converting."
           (when (eq major-mode 'gnus-article-mode)
             (let ((old-line (count-lines (point-min) (point)))
                   (old-column (- (point) (line-beginning-position)))
-                  (window-start
-                   (window-start (get-buffer-window (current-buffer)))))
-              (goto-char (point-min))
-              (while (re-search-forward "^Date:" nil t)
-                (let ((type (get-text-property (match-beginning 0)
-                                               'gnus-date-type)))
-                  (when (memq type '(lapsed combined-lapsed user-format))
-                    (when (and window-start
-                               (not (= window-start
-                                       (save-excursion
-                                         (forward-line 1)
-                                         (point)))))
-                      (setq window-start nil))
-                    (save-excursion
-                      (article-date-ut type t (match-beginning 0)))
-                    (forward-line 1)
-                    (when window-start
-                      (set-window-start (get-buffer-window (current-buffer))
-                                        (point))))))
+                  (window-start (window-start w))
+                  (pos (point-min))
+                  type next end)
+              (while (setq pos (text-property-not-all pos (point-max)
+                                                      'gnus-date-type nil))
+                (setq next (or (next-single-property-change pos
+                                                            'gnus-date-type)
+                               (point-max)))
+                (setq type (get-text-property pos 'gnus-date-type))
+                (when (memq type '(lapsed combined-lapsed user-defined))
+                  (article-date-ut type t pos)
+                  (setq end (or (next-single-property-change pos
+                                                             'gnus-date-type)
+                                (point-max)))
+                  (when window-start
+                    (if (/= window-start next)
+                        (setq window-start nil)
+                      (set-window-start w end)))
+                  (setq next end))
+                (setq pos next))
               (goto-char (point-min))
               (when (> old-column 0)
                 (setq old-line (1- old-line)))