lisp/gnus/message.el (message-insert-formatted-citation-line): Use the original author's time zone to express a date string

3 files changed, 87 insertions, 26 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 17bbff732b6..41ad2875691 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,10 @@
+2014-04-15  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+        * 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  <monnier@iro.umontreal.ca>
 
         * gnus-srvr.el (gnus-tmp-how, gnus-tmp-name, gnus-tmp-where)
diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el
index 63947e5f486..70ef27a7e90 100644
--- a/lisp/gnus/gmm-utils.el
+++ b/lisp/gnus/gmm-utils.el
@@ -443,6 +443,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/gnus/message.el b/lisp/gnus/message.el
index 1f42ccb61f4..ca0280c874f 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -982,8 +982,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 <john.doe@example.invalid>\".
   %n   The mail address, e.g. \"john.doe@example.invalid\".
@@ -991,11 +991,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'."
@@ -3920,9 +3923,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.
@@ -3930,7 +3937,7 @@ See `message-citation-line-format'."
   ;; (with-temp-buffer
   ;;   (message-insert-formatted-citation-line
   ;;    "John Doe <john.doe@example.invalid>"
-  ;;    (current-time))
+  ;;    (message-make-date))
   ;;   (buffer-string))
   (when (or message-reply-headers (and from date))
     (unless from
@@ -3947,28 +3954,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:
-             (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)))))
+           (time
+            (when (string-match "%[^fnNFL]" message-citation-line-format)
+              (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))
-                                               (split-string name "[ \t]+"))))
-                      (count (length names)))
-                  (cond ((= count 1) (setq fname (car names)
-                                           lname ""))
-                        ((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) " "))) )
+                (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)
+                               lname ""))
+                        ((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)
+                                                " "))))
                   (when (string-match "\\(.*\\),\\'" fname)
                     (let ((newlname (match-string 1 fname)))
                       (setq fname lname lname newlname)))))
@@ -3998,7 +4020,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)))