Commit 923c1bfc authored by Katsumi Yamaoka's avatar Katsumi Yamaoka
Browse files

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

parent c362f195
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)
......
......@@ -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)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment