mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-07 15:21:46 +00:00
gnus-art.el: Don't assume Date header begins with "Date"
This commit is contained in:
Katsumi Yamaoka
parent
c362f19508
commit
923c1bfc1e
@ -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)
|
||||
|
||||
@ -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)))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user