[gnus git] branch master updated: m0-9-81-g9b715a1 =1= message.el (message-insert-formatted-citation-line): Use the original author's time zone to express a date string
Katsumi Yamaoka <[email protected]> Wed, 16 Apr 2014 01:34:35 +0200
| Newsgroups | gmane.emacs.gnus.cvs |
|---|---|
| Message-ID | <[email protected]> |
via 9b715a1bb01321f7753340c00552ab7e3c48637d (commit)
from 735b42e45541f7d9c95521f78dcb762c002110a4 (commit)
- Log -----------------------------------------------------------------
commit 9b715a1bb01321f7753340c00552ab7e3c48637d
Author: Katsumi Yamaoka <[email protected]>
Date: Tue Apr 15 23:34:25 2014 +0000
message.el (message-insert-formatted-citation-line): Use the original author's time zone to express a date string
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 796f03b..c95b94f 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
+2014-04-15 Katsumi Yamaoka <[email protected]>
+
+ * gmm-utils.el (gmm-format-time-string): New function.
+
+ * message.el (message-insert-formatted-citation-line): Use the original
+ author's time zone to express a date string.
+
2014-04-06 Stefan Monnier <[email protected]>
* gnus-srvr.el (gnus-tmp-how, gnus-tmp-name, gnus-tmp-where)
diff --git a/lisp/gmm-utils.el b/lisp/gmm-utils.el
index 1355406..3a1bb03 100644
--- a/lisp/gmm-utils.el
+++ b/lisp/gmm-utils.el
@@ -460,6 +460,38 @@ rather than relying on `lexical-binding'.
(put 'gmm-labels 'lisp-indent-function 1)
(put 'gmm-labels 'edebug-form-spec '((&rest (sexp sexp &rest form)) &rest form))
+(defun gmm-format-time-string (format-string &optional time tz)
+ "Use FORMAT-STRING to format the time TIME, or now if omitted.
+The optional TZ specifies the time zone in a number of seconds; any
+other non-nil value will be treated as 0. Note that both the format
+specifiers `%Z' and `%z' will be replaced with a numeric form. "
+;; FIXME: is there a smart way to replace %Z with a time zone name?
+ (if (and (numberp tz) (not (zerop tz)))
+ (let ((st 0)
+ (case-fold-search t)
+ ls nd rest)
+ (setq time (if time
+ (copy-sequence time)
+ (current-time)))
+ (if (>= (setq ls (- (cadr time) (car (current-time-zone)) (- tz))) 0)
+ (setcar (cdr time) ls)
+ (setcar (cdr time) (+ ls 65536))
+ (setcar time (1- (car time))))
+ (setq tz (format "%s%02d%02d"
+ (if (>= tz 0) "+" "-")
+ (/ (abs tz) 3600)
+ (/ (% (abs tz) 3600) 60)))
+ (while (string-match "%+z" format-string st)
+ (if (zerop (% (- (setq nd (match-end 0)) (match-beginning 0)) 2))
+ (progn
+ (push (substring format-string st (- nd 2)) rest)
+ (push tz rest))
+ (push (substring format-string st nd) rest))
+ (setq st nd))
+ (push (substring format-string st) rest)
+ (format-time-string (apply 'concat (nreverse rest)) time))
+ (format-time-string format-string time tz)))
+
(provide 'gmm-utils)
;;; gmm-utils.el ends here
diff --git a/lisp/message.el b/lisp/message.el
index 32cfe3b..424a56e 100644
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -1010,8 +1010,8 @@ configuration. See the variable `gnus-cite-attribution-suffix'."
(defcustom message-citation-line-format "On %a, %b %d %Y, %N wrote:\n"
"Format of the \"Whomever writes:\" line.
-The string is formatted using `format-spec'. The following
-constructs are replaced:
+The string is formatted using `format-spec'. The following constructs
+are replaced:
%f The full From, e.g. \"John Doe <[email protected]>\".
%n The mail address, e.g. \"[email protected]\".
@@ -1019,11 +1019,14 @@ constructs are replaced:
back to the mail address.
%F The first name if present, e.g.: \"John\".
%L The last name if present, e.g.: \"Doe\".
+ %Z, %z The time zone in the numeric form, e.g.:\"+0000\".
All other format specifiers are passed to `format-time-string'
-which is called using the date from the article your replying to.
-Extracting the first (%F) and last name (%L) is done
-heuristically, so you should always check it yourself.
+which is called using the date from the article your replying to, but
+the date in the formatted string will be expressed in the author's
+time zone as much as possible.
+Extracting the first (%F) and last name (%L) is done heuristically,
+so you should always check it yourself.
Please also read the note in the documentation of
`message-citation-line-function'."
@@ -3964,9 +3967,13 @@ This function uses `mail-citation-hook' if that is non-nil."
(defvar gnus-extract-address-components)
(autoload 'format-spec "format-spec")
+(autoload 'gnus-date-get-time "gnus-util")
-(defun message-insert-formatted-citation-line (&optional from date)
+(defun message-insert-formatted-citation-line (&optional from date tz)
"Function that inserts a formatted citation line.
+The optional FROM, and DATE are strings containing the contents of
+the From header and the Date header respectively. The optional TZ
+is a number of seconds, overrides the time zone of DATE.
See `message-citation-line-format'."
;; The optional args are for testing/debugging. They will disappear later.
@@ -3974,7 +3981,7 @@ See `message-citation-line-format'."
;; (with-temp-buffer
;; (message-insert-formatted-citation-line
;; "John Doe <[email protected]>"
- ;; (current-time))
+ ;; (message-make-date))
;; (buffer-string))
(when (or message-reply-headers (and from date))
(unless from
@@ -3991,28 +3998,43 @@ See `message-citation-line-format'."
(net (car (cdr data)))
(name-or-net (or (car data)
(car (cdr data)) from))
- (replydate
- (or
- date
- ;; We need Gnus functionality if the user wants date or time from
- ;; the original article:
+ (time
(when (string-match "%[^fnNFL]" message-citation-line-format)
- (autoload 'gnus-date-get-time "gnus-util")
- (gnus-date-get-time (mail-header-date message-reply-headers)))))
+ (cond ((numberp (car-safe date)) date) ;; backward compatibility
+ (date (gnus-date-get-time date))
+ (t
+ (gnus-date-get-time
+ (setq date (mail-header-date message-reply-headers)))))))
+ (tz (or tz
+ (when (stringp date)
+ (nth 8 (parse-time-string date)))))
(flist
(let ((i ?A) lst)
(when (stringp name)
;; Guess first name and last name:
- (let* ((names (delq nil (mapcar (lambda (x)
- (if (string-match "\\`\\(\\w\\|[-.]\\)+\\'" x) x nil))
+ (let* ((names (delq
+ nil
+ (mapcar
+ (lambda (x)
+ (if (string-match "\\`\\(\\w\\|[-.]\\)+\\'"
+ x)
+ x
+ nil))
(split-string name "[ \t]+"))))
(count (length names)))
- (cond ((= count 1) (setq fname (car names)
+ (cond ((= count 1)
+ (setq fname (car names)
lname ""))
- ((or (= count 2) (= count 3)) (setq fname (car names)
+ ((or (= count 2) (= count 3))
+ (setq fname (car names)
lname (mapconcat 'identity (cdr names) " ")))
- ((> count 3) (setq fname (mapconcat 'identity (butlast names (- count 2)) " ")
- lname (mapconcat 'identity (nthcdr 2 names) " "))) )
+ ((> count 3)
+ (setq fname (mapconcat 'identity
+ (butlast names (- count 2))
+ " ")
+ lname (mapconcat 'identity
+ (nthcdr 2 names)
+ " "))))
(when (string-match "\\(.*\\),\\'" fname)
(let ((newlname (match-string 1 fname)))
(setq fname lname lname newlname)))))
@@ -4042,7 +4064,7 @@ See `message-citation-line-format'."
(>= i ?a)))
(push i lst)
(push (condition-case nil
- (format-time-string (format "%%%c" i) replydate)
+ (gmm-format-time-string (format "%%%c" i) time tz)
(error (format ">%c<" i)))
lst))
(setq i (1+ i)))
-----------------------------------------------------------------------
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/gmm-utils.el | 32 +++++++++++++++++++++++
lisp/message.el | 74 ++++++++++++++++++++++++++++++++++-------------------
3 files changed, 87 insertions(+), 26 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