[gnus git] branch master updated: m0-7-33-g3f02a79 =1= gnus-art.el: Don't assume Date header begins with "Date"
Katsumi Yamaoka <[email protected]>
| Newsgroups | gmane.emacs.gnus.cvs |
|---|---|
| Message-ID | <[email protected]> |
via 3f02a79eb3c0ff6ef96ebf9de0d24f677ec944cf (commit)
from dc4b49c9acf9b7f6411f8bb923c14f2c13560f49 (commit)
- Log -----------------------------------------------------------------
commit 3f02a79eb3c0ff6ef96ebf9de0d24f677ec944cf
Author: Katsumi Yamaoka <[email protected]>
Date: Tue Jun 4 08:14:08 2013 +0000
gnus-art.el: Don't assume Date header begins with "Date"
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f0f9873..441773b 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
+2013-06-04 Katsumi Yamaoka <[email protected]>
+
+ * 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 <[email protected]>
* registry.el (initialize-instance, registry-lookup)
diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index d76d37a..076f949 100644
--- 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)))
+ (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:" nil t)
- (setq date (get-text-property (match-beginning 0) 'original-date))
+ (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))))
+ (point)))))
(when (and (not date)
visible-date)
(setq date visible-date))
@@ -3477,20 +3489,25 @@ possible values."
(list type))
(t
type)))
+ (goto-char
+ (prog1
+ (point)
+ (add-text-properties
+ (point)
+ (progn
(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)
+ (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)
+ (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
- (set-window-start (get-buffer-window (current-buffer))
- (point))))))
+ (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)))
-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.
Summary of changes:
lisp/ChangeLog | 7 ++++
lisp/gnus-art.el | 104 +++++++++++++++++++++++++++++++----------------------
2 files changed, 68 insertions(+), 43 deletions(-)
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".
The branch, master has been updated
hooks/post-receive
--
Gnus Project