* gnus-art.el (gnus-article-time-format): Exchange the order of day and month

 in the default value;
 fix customization type.
(article-date-ut): Use add-text-properties.
(article-make-date-line): Use message-make-date instead of current-time-string.

* message.el (message-fetch-field): Don't use set-text-properties.
(message-make-date): Simplify.

* messagexmas.el (message-xmas-make-date): New function.
(message-xmas-redefine): Defalias message-make-date to it.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b673491..83f7fea 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,17 @@
+2004-06-18  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * gnus-art.el (gnus-article-time-format): Exchange the order of
+       day and month in the default value; fix customization type.
+       (article-date-ut): Use add-text-properties.
+       (article-make-date-line): Use message-make-date instead of
+       current-time-string.
+
+       * message.el (message-fetch-field): Don't use set-text-properties.
+       (message-make-date): Simplify.
+
+       * messagexmas.el (message-xmas-make-date): New function.
+       (message-xmas-redefine): Defalias message-make-date to it.
+
 2004-06-17  Katsumi Yamaoka  <yamaoka@jpl.org>
 
        * rfc2047.el (rfc2047-syntax-table): Treat `(' and `)' as is.

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 7bc1775..9be84cd 100644 (file)
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -408,14 +408,14 @@ Example: (_/*word*/_)."
   "Face used for displaying highlighted words."
   :group 'gnus-article-emphasis)
 
-(defcustom gnus-article-time-format "%a, %b %d %Y %T %Z"
+(defcustom gnus-article-time-format "%a, %d %b %Y %T %Z"
   "Format for display of Date headers in article bodies.
 See `format-time-string' for the possible values.
 
 The variable can also be function, which should return a complete Date
 header.  The function is called with one argument, the time, which can
 be fed to `format-time-string'."
-  :type '(choice string symbol)
+  :type '(choice string function)
   :link '(custom-manual "(gnus)Article Date")
   :group 'gnus-article-washing)
 
@@ -2837,10 +2837,8 @@ should replace the \"Date:\" one, or should be added below it."
            ;; Do highlighting.
            (beginning-of-line)
            (when (looking-at "\\([^:]+\\): *\\(.*\\)$")
-             (put-text-property (match-beginning 1) (1+ (match-end 1))
-                                'original-date date)
-             (put-text-property (match-beginning 1) (1+ (match-end 1))
-                                'face bface)
+             (add-text-properties (match-beginning 1) (1+ (match-end 1))
+                                  (list 'original-date date 'face bface))
              (put-text-property (match-beginning 2) (match-end 2)
                                 'face eface))))))))
 
@@ -2853,22 +2851,21 @@ should replace the \"Date:\" one, or should be added below it."
        (cond
         ;; Convert to the local timezone.
         ((eq type 'local)
-         (let ((tz (car (current-time-zone time))))
-           (format "Date: %s %s%02d%02d" (current-time-string time)
-                   (if (> tz 0) "+" "-") (/ (abs tz) 3600)
-                   (/ (% (abs tz) 3600) 60))))
+         (concat "Date: " (message-make-date time)))
         ;; Convert to Universal Time.
         ((eq type 'ut)
          (concat "Date: "
-                 (current-time-string
-                  (let* ((e (parse-time-string date))
-                         (tm (apply 'encode-time e))
-                         (ms (car tm))
-                         (ls (- (cadr tm) (car (current-time-zone time)))))
-                    (cond ((< ls 0) (list (1- ms) (+ ls 65536)))
-                          ((> ls 65535) (list (1+ ms) (- ls 65536)))
-                          (t (list ms ls)))))
-                 " UT"))
+                 (substring
+                  (message-make-date
+                   (let* ((e (parse-time-string date))
+                          (tm (apply 'encode-time e))
+                          (ms (car tm))
+                          (ls (- (cadr tm) (car (current-time-zone time)))))
+                     (cond ((< ls 0) (list (1- ms) (+ ls 65536)))
+                           ((> ls 65535) (list (1+ ms) (- ls 65536)))
+                           (t (list ms ls)))))
+                  0 -5)
+                 "UT"))
         ;; Get the original date from the article.
         ((eq type 'original)
          (concat "Date: " (if (string-match "\n+$" date)

diff --git a/lisp/message.el b/lisp/message.el
index 2fc4205..4a6597f 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -1642,7 +1642,6 @@ see `message-narrow-to-headers-or-head'."
     (when value
       (while (string-match "\n[\t ]+" value)
        (setq value (replace-match " " t t value)))
-      (set-text-properties 0 (length value) nil value)
       value)))
 
 (defun message-field-value (header &optional not-all)
@@ -4565,24 +4564,8 @@ Otherwise, generate and save a value for `canlock-password' first."
 (defun message-make-date (&optional now)
   "Make a valid data header.
 If NOW, use that time instead."
-  (let* ((now (or now (current-time)))
-        (zone (nth 8 (decode-time now)))
-        (sign "+"))
-    (when (< zone 0)
-      (setq sign "-")
-      (setq zone (- zone)))
-    (concat
-     ;; The day name of the %a spec is locale-specific.  Pfff.
-     (format "%s, " (capitalize (car (rassoc (nth 6 (decode-time now))
-                                            parse-time-weekdays))))
-     (format-time-string "%d" now)
-     ;; The month name of the %b spec is locale-specific.  Pfff.
-     (format " %s "
-            (capitalize (car (rassoc (nth 4 (decode-time now))
-                                     parse-time-months))))
-     (format-time-string "%Y %H:%M:%S " now)
-     ;; We do all of this because XEmacs doesn't have the %z spec.
-     (format "%s%02d%02d" sign (/ zone 3600) (/ (% zone 3600) 60)))))
+  (let ((system-time-locale "C"))
+    (format-time-string "%a, %d %b %Y %T %z" now)))
 
 (defun message-make-message-id ()
   "Make a unique Message-ID."

diff --git a/lisp/messagexmas.el b/lisp/messagexmas.el
index 150a8a0..facbf88 100644 (file)
--- a/lisp/messagexmas.el
+++ b/lisp/messagexmas.el
@@ -1,6 +1,6 @@
 ;;; messagexmas.el --- XEmacs extensions to message
 
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2003
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2003, 2004
 ;;      Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -114,6 +114,21 @@ If it is non-nil, it must be a toolbar.  The five valid values are
      (substring table a (+ a n))
      (substring table (+ a 26) 255))))
 
+(defun message-xmas-make-date (&optional now)
+  "Make a valid data header.
+If NOW, use that time instead."
+  (let ((zone (car (current-time-zone)))
+       sign)
+    (if (>= zone 0)
+       (setq sign "+")
+      (setq sign "-"
+           zone (- zone)))
+    (format "%s %s%02d%02d"
+           (format-time-string "%a, %d %b %Y %T" now)
+           sign
+           (/ zone 3600)
+           (/ (% zone 3600) 60))))
+
 (add-hook 'message-mode-hook 'message-xmas-maybe-fontify)
 
 (defun message-xmas-redefine ()
@@ -126,7 +141,8 @@ If it is non-nil, it must be a toolbar.  The five valid values are
     'message-xmas-make-caesar-translation-table)
   (defalias 'message-make-overlay 'make-extent)
   (defalias 'message-delete-overlay 'delete-extent)
-  (defalias 'message-overlay-put 'set-extent-property))
+  (defalias 'message-overlay-put 'set-extent-property)
+  (defalias 'message-make-date 'message-xmas-make-date))
 
 (message-xmas-redefine)