Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

message.el (message-insert-formatted-citation-line): Use the original…

… author's time zone to express a date string
  • Loading branch information...
commit 9b715a1bb01321f7753340c00552ab7e3c48637d 1 parent 735b42e
yamaoka authored April 15, 2014
7  lisp/ChangeLog
... ...
@@ -1,3 +1,10 @@
  1
+2014-04-15  Katsumi Yamaoka  <yamaoka@jpl.org>
  2
+
  3
+	* gmm-utils.el (gmm-format-time-string): New function.
  4
+
  5
+	* message.el (message-insert-formatted-citation-line): Use the original
  6
+	author's time zone to express a date string.
  7
+
1 8
 2014-04-06  Stefan Monnier  <monnier@iro.umontreal.ca>
2 9
 
3 10
 	* gnus-srvr.el (gnus-tmp-how, gnus-tmp-name, gnus-tmp-where)
32  lisp/gmm-utils.el
@@ -460,6 +460,38 @@ rather than relying on `lexical-binding'.
460 460
 (put 'gmm-labels 'lisp-indent-function 1)
461 461
 (put 'gmm-labels 'edebug-form-spec '((&rest (sexp sexp &rest form)) &rest form))
462 462
 
  463
+(defun gmm-format-time-string (format-string &optional time tz)
  464
+  "Use FORMAT-STRING to format the time TIME, or now if omitted.
  465
+The optional TZ specifies the time zone in a number of seconds; any
  466
+other non-nil value will be treated as 0.  Note that both the format
  467
+specifiers `%Z' and `%z' will be replaced with a numeric form. "
  468
+;; FIXME: is there a smart way to replace %Z with a time zone name?
  469
+  (if (and (numberp tz) (not (zerop tz)))
  470
+      (let ((st 0)
  471
+	    (case-fold-search t)
  472
+	    ls nd rest)
  473
+	(setq time (if time
  474
+		       (copy-sequence time)
  475
+		     (current-time)))
  476
+	(if (>= (setq ls (- (cadr time) (car (current-time-zone)) (- tz))) 0)
  477
+	    (setcar (cdr time) ls)
  478
+	  (setcar (cdr time) (+ ls 65536))
  479
+	  (setcar time (1- (car time))))
  480
+	(setq tz (format "%s%02d%02d"
  481
+			 (if (>= tz 0) "+" "-")
  482
+			 (/ (abs tz) 3600)
  483
+			 (/ (% (abs tz) 3600) 60)))
  484
+	(while (string-match "%+z" format-string st)
  485
+	  (if (zerop (% (- (setq nd (match-end 0)) (match-beginning 0)) 2))
  486
+	      (progn
  487
+		(push (substring format-string st (- nd 2)) rest)
  488
+		(push tz rest))
  489
+	    (push (substring format-string st nd) rest))
  490
+	  (setq st nd))
  491
+	(push (substring format-string st) rest)
  492
+	(format-time-string (apply 'concat (nreverse rest)) time))
  493
+    (format-time-string format-string time tz)))
  494
+
463 495
 (provide 'gmm-utils)
464 496
 
465 497
 ;;; gmm-utils.el ends here
74  lisp/message.el
@@ -1010,8 +1010,8 @@ configuration.  See the variable `gnus-cite-attribution-suffix'."
1010 1010
 (defcustom message-citation-line-format "On %a, %b %d %Y, %N wrote:\n"
1011 1011
   "Format of the \"Whomever writes:\" line.
1012 1012
 
1013  
-The string is formatted using `format-spec'.  The following
1014  
-constructs are replaced:
  1013
+The string is formatted using `format-spec'.  The following constructs
  1014
+are replaced:
1015 1015
 
1016 1016
   %f   The full From, e.g. \"John Doe <john.doe@example.invalid>\".
1017 1017
   %n   The mail address, e.g. \"john.doe@example.invalid\".
@@ -1019,11 +1019,14 @@ constructs are replaced:
1019 1019
        back to the mail address.
1020 1020
   %F   The first name if present, e.g.: \"John\".
1021 1021
   %L   The last name if present, e.g.: \"Doe\".
  1022
+  %Z, %z   The time zone in the numeric form, e.g.:\"+0000\".
1022 1023
 
1023 1024
 All other format specifiers are passed to `format-time-string'
1024  
-which is called using the date from the article your replying to.
1025  
-Extracting the first (%F) and last name (%L) is done
1026  
-heuristically, so you should always check it yourself.
  1025
+which is called using the date from the article your replying to, but
  1026
+the date in the formatted string will be expressed in the author's
  1027
+time zone as much as possible.
  1028
+Extracting the first (%F) and last name (%L) is done heuristically,
  1029
+so you should always check it yourself.
1027 1030
 
1028 1031
 Please also read the note in the documentation of
1029 1032
 `message-citation-line-function'."
@@ -3964,9 +3967,13 @@ This function uses `mail-citation-hook' if that is non-nil."
3964 3967
 (defvar gnus-extract-address-components)
3965 3968
 
3966 3969
 (autoload 'format-spec "format-spec")
  3970
+(autoload 'gnus-date-get-time "gnus-util")
3967 3971
 
3968  
-(defun message-insert-formatted-citation-line (&optional from date)
  3972
+(defun message-insert-formatted-citation-line (&optional from date tz)
3969 3973
   "Function that inserts a formatted citation line.
  3974
+The optional FROM, and DATE are strings containing the contents of
  3975
+the From header and the Date header respectively.  The optional TZ
  3976
+is a number of seconds, overrides the time zone of DATE.
3970 3977
 
3971 3978
 See `message-citation-line-format'."
3972 3979
   ;; The optional args are for testing/debugging.  They will disappear later.
@@ -3974,7 +3981,7 @@ See `message-citation-line-format'."
3974 3981
   ;; (with-temp-buffer
3975 3982
   ;;   (message-insert-formatted-citation-line
3976 3983
   ;;    "John Doe <john.doe@example.invalid>"
3977  
-  ;;    (current-time))
  3984
+  ;;    (message-make-date))
3978 3985
   ;;   (buffer-string))
3979 3986
   (when (or message-reply-headers (and from date))
3980 3987
     (unless from
@@ -3991,28 +3998,43 @@ See `message-citation-line-format'."
3991 3998
 	   (net (car (cdr data)))
3992 3999
 	   (name-or-net (or (car data)
3993 4000
 			    (car (cdr data)) from))
3994  
-	   (replydate
3995  
-	    (or
3996  
-	     date
3997  
-	     ;; We need Gnus functionality if the user wants date or time from
3998  
-	     ;; the original article:
3999  
-	     (when (string-match "%[^fnNFL]" message-citation-line-format)
4000  
-	       (autoload 'gnus-date-get-time "gnus-util")
4001  
-	       (gnus-date-get-time (mail-header-date message-reply-headers)))))
  4001
+	   (time
  4002
+	    (when (string-match "%[^fnNFL]" message-citation-line-format)
  4003
+	      (cond ((numberp (car-safe date)) date) ;; backward compatibility
  4004
+		    (date (gnus-date-get-time date))
  4005
+		    (t
  4006
+		     (gnus-date-get-time
  4007
+		      (setq date (mail-header-date message-reply-headers)))))))
  4008
+	   (tz (or tz
  4009
+		   (when (stringp date)
  4010
+		     (nth 8 (parse-time-string date)))))
4002 4011
 	   (flist
4003 4012
 	    (let ((i ?A) lst)
4004 4013
 	      (when (stringp name)
4005 4014
 		;; Guess first name and last name:
4006  
-                (let* ((names (delq nil (mapcar (lambda (x)
4007  
-                                                 (if (string-match "\\`\\(\\w\\|[-.]\\)+\\'" x) x nil))
4008  
-                                               (split-string name "[ \t]+"))))
4009  
-                      (count (length names)))
4010  
-                  (cond ((= count 1) (setq fname (car names)
4011  
-                                           lname ""))
4012  
-                        ((or (= count 2) (= count 3)) (setq fname (car names)
4013  
-                                                            lname (mapconcat 'identity (cdr names) " ")))
4014  
-                        ((> count 3) (setq fname (mapconcat 'identity (butlast names (- count 2)) " ")
4015  
-                                           lname (mapconcat 'identity (nthcdr 2 names) " "))) )
  4015
+		(let* ((names (delq
  4016
+			       nil
  4017
+			       (mapcar
  4018
+				(lambda (x)
  4019
+				  (if (string-match "\\`\\(\\w\\|[-.]\\)+\\'"
  4020
+						    x)
  4021
+				      x
  4022
+				    nil))
  4023
+				(split-string name "[ \t]+"))))
  4024
+		       (count (length names)))
  4025
+		  (cond ((= count 1)
  4026
+			 (setq fname (car names)
  4027
+			       lname ""))
  4028
+			((or (= count 2) (= count 3))
  4029
+			 (setq fname (car names)
  4030
+			       lname (mapconcat 'identity (cdr names) " ")))
  4031
+			((> count 3)
  4032
+			 (setq fname (mapconcat 'identity
  4033
+						(butlast names (- count 2))
  4034
+						" ")
  4035
+			       lname (mapconcat 'identity
  4036
+						(nthcdr 2 names)
  4037
+						" "))))
4016 4038
                   (when (string-match "\\(.*\\),\\'" fname)
4017 4039
                     (let ((newlname (match-string 1 fname)))
4018 4040
                       (setq fname lname lname newlname)))))
@@ -4042,7 +4064,7 @@ See `message-citation-line-format'."
4042 4064
 			       (>= i ?a)))
4043 4065
 		  (push i lst)
4044 4066
 		  (push (condition-case nil
4045  
-			    (format-time-string (format "%%%c" i) replydate)
  4067
+			    (gmm-format-time-string (format "%%%c" i) time tz)
4046 4068
 			  (error (format ">%c<" i)))
4047 4069
 			lst))
4048 4070
 		(setq i (1+ i)))

0 notes on commit 9b715a1

Please sign in to comment.
Something went wrong with that request. Please try again.