From: Katsumi Yamaoka Date: Tue, 4 Jun 2013 08:14:23 +0000 (+0000) Subject: gnus-art.el: Don't assume Date header begins with "Date" X-Git-Tag: emacs-24.3.90~173^2^2~42^2~45^2~387^2~2026^2~84 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=923c1bfc1e100f993f5acaca89051f14aa5fb4f6;p=emacs.git gnus-art.el: Don't assume Date header begins with "Date" --- diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 59e3e398788..0156894c902 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,10 @@ +2013-06-04 Katsumi Yamaoka + + * 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 * registry.el (initialize-instance, registry-lookup) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 23603bc7722..65f4b76ad19 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -3430,15 +3430,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) @@ -3454,12 +3452,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)) @@ -3476,20 +3488,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." @@ -3669,25 +3686,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)))