gnus-art.el: Rewrite the Date header formatting functionality.

 The user can now have infinitely many Date headers.
 This change should be pretty much backwards-compatible, even though
 many customisation variables have been removed.

gnus.texi (Customizing Articles): Document the new way of customizing
 the date headers(s).

4 files changed, 160 insertions, 163 deletions

diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index 8e1bba700fd..de63af5a28c 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,8 @@
+2011-01-31  Lars Ingebrigtsen  <larsi@gnus.org>
+
+        * gnus.texi (Customizing Articles): Document the new way of customizing
+        the date headers(s).
+
 2011-01-30  Lars Ingebrigtsen  <larsi@gnus.org>
 
         * gnus.texi (Client-Side IMAP Splitting): Add a complete nnimap fancy
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 26d54477bb4..1dd3efd17d8 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -9492,23 +9492,15 @@ Say how much time has elapsed between the article was posted and now
 (@code{gnus-article-date-lapsed}).  It looks something like:
 
 @example
-X-Sent: 6 weeks, 4 days, 1 hour, 3 minutes, 8 seconds ago
+Date: 6 weeks, 4 days, 1 hour, 3 minutes, 8 seconds ago
 @end example
 
-@vindex gnus-article-date-lapsed-new-header
-The value of @code{gnus-article-date-lapsed-new-header} determines
-whether this header will just be added below the old Date one, or will
-replace it.
-
-An advantage of using Gnus to read mail is that it converts simple bugs
-into wonderful absurdities.
-
 This line is updated continually by default.  If you wish to switch
 that off, say:
 
-@vindex gnus-article-update-lapsed-header
+@vindex gnus-article-update-date-headers
 @lisp
-(setq gnus-article-update-lapsed-header nil)
+(setq gnus-article-update-date-headers nil)
 @end lisp
 
 in your @file{~/.gnus.el} file.  If you want to stop the updating
@@ -11878,13 +11870,7 @@ controlling variable is a predicate list, as described above.
 @vindex gnus-treat-strip-trailing-blank-lines
 @vindex gnus-treat-unsplit-urls
 @vindex gnus-treat-wash-html
-@vindex gnus-treat-date-english
-@vindex gnus-treat-date-iso8601
-@vindex gnus-treat-date-lapsed
-@vindex gnus-treat-date-local
-@vindex gnus-treat-date-original
-@vindex gnus-treat-date-user-defined
-@vindex gnus-treat-date-ut
+@vindex gnus-treat-date
 @vindex gnus-treat-from-picon
 @vindex gnus-treat-mail-picon
 @vindex gnus-treat-newsgroups-picon
@@ -11939,13 +11925,39 @@ possible but those listed are probably sufficient for most people.
 
 @xref{Article Washing}.
 
-@item gnus-treat-date-english (head)
-@item gnus-treat-date-iso8601 (head)
-@item gnus-treat-date-lapsed (head)
-@item gnus-treat-date-local (head)
-@item gnus-treat-date-original (head)
-@item gnus-treat-date-user-defined (head)
-@item gnus-treat-date-ut (head)
+@item gnus-treat-date (head)
+
+This will transform/add date headers according to the
+@code{gnus-article-date-headers} variable.  This is a list of Date
+headers to display.  The formats available are:
+
+@table @code
+@item ut
+Universal time, aka GMT, aka ZULU.
+
+@item local
+The user's local time zone.
+
+@item english
+A semi-readable English sentence.
+
+@item lapsed
+The time elapsed since the message was posted.
+
+@item combined-elapsed
+Both the original date header and a (shortened) elapsed time.
+
+@item original
+The original date header.
+
+@item iso8601
+ISO8601 format, i.e., ``2010-11-23T22:05:21''.
+
+@item user-defined
+A format done according to the @code{gnus-article-time-format}
+variable.
+
+@end table
 
 @xref{Article Date}.
 
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 10cf1a02f05..f8a1577d712 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,20 @@
+2011-01-31  Lars Ingebrigtsen  <larsi@gnus.org>
+
+        * gnus-art.el (gnus-article-date-lapsed-new-header): Removed.
+        (gnus-treat-date-ut): Ditto.
+        (gnus-article-update-date-header): Renamed.
+        (gnus-treat-date-local): Removed.
+        (gnus-treat-date-english): Removed.
+        (gnus-treat-date-lapsed): Removed.
+        (gnus-treat-date-combined-lapsed): Removed.
+        (gnus-treat-date-original): Removed.
+        (gnus-treat-date-iso8601): Removed.
+        (gnus-treat-date-user-defined): Removed.
+        (gnus-article-date-headers): New variable to control all the date
+        header options.
+        (article-date-ut): Rewrite to allow using the new way to format date
+        headers(s).
+
 2011-01-30  Lars Ingebrigtsen  <larsi@gnus.org>
 
         * nnmail.el (nnmail-article-group): Check for a direct fancy split
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 0a9446a061c..e0ff5f2c17e 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -168,7 +168,7 @@ If `gnus-visible-headers' is non-nil, this variable will be ignored."
   :group 'gnus-article-hiding)
 
 (defcustom gnus-visible-headers
-  "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Mail-Followup-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|^X-Sent:"
+  "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Mail-Followup-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:"
   "*All headers that do not match this regexp will be hidden.
 This variable can also be a list of regexp of headers to remain visible.
 If this variable is non-nil, `gnus-ignored-headers' will be ignored."
@@ -1014,17 +1014,46 @@ on parts -- for instance, adding Vcard info to a database."
   :group 'gnus-article-mime
   :type '(repeat (cons :format "%v" (string :tag "MIME type") function)))
 
-(defcustom gnus-article-date-lapsed-new-header nil
-  "Whether the X-Sent and Date headers can coexist.
-When using `gnus-treat-date-lapsed', the \"X-Sent:\" header will
-either replace the old \"Date:\" header (if this variable is nil), or
-be added below it (otherwise)."
-  :version "21.1"
+(defcustom gnus-article-date-headers
+  (let ((types '(ut local english lapsed combined-lapsed
+                    iso8601 original user-defined))
+        default)
+    (dolist (type types)
+      (let ((variable (intern (format "gnus-treat-date-%s" type))))
+        (when (and (boundp variable)
+                   (symbol-value variable))
+          (push type default))))
+    (when (and (or (not (boundp (intern "gnus-article-date-lapsed-new-header")))
+                   (not (symbol-value (intern "gnus-article-date-lapsed-new-header"))))
+               (memq 'lapsed default))
+      (setq default (delq 'lapsed default)))
+    (or default
+        '(combined-lapsed)))
+  "A list of Date header formats to display.
+Valid formats are `ut' (universal time), `local' (local time
+zone), `english' (readable English), `lapsed' (elapsed time),
+`combined-lapsed' (both the original date and the elapsed time),
+`original' (the original date header), `iso8601' (ISO8601
+format), and `user-defined' (a user-defined format defined by the
+`gnus-article-time-format' variable).
+
+You have as many date headers as you want in the article buffer.
+Some of these headers are updated automatically.  See
+`gnus-article-update-date-headers' for details."
+  :version "24.1"
   :group 'gnus-article-headers
-  :type 'boolean)
-
-(defcustom gnus-article-update-lapsed-header 1
-  "How often to update the lapsed date header.
+  :type '(repeat
+          (item :tag "Universal time (UT)" :value 'ut)
+          (item :tag "Local time zone" :value 'local)
+          (item :tag "Readable English" :value 'english)
+          (item :tag "Elapsed time" :value 'lapsed)
+          (item :tag "Original and elapsed time" :value 'combined-lapsed)
+          (item :tag "Original date header" :value 'original)
+          (item :tag "ISO8601 format" :value 'iso8601)
+          (item :tag "User-defined" :value 'user-defined)))
+
+(defcustom gnus-article-update-date-headers 1
+  "How often to update the date header.
 If nil, don't update it at all."
   :version "24.1"
   :group 'gnus-article-headers
@@ -1135,6 +1164,15 @@ predicate.  See Info node `(gnus)Customizing Articles'."
   :type gnus-article-treat-head-custom)
 (put 'gnus-treat-buttonize-head 'highlight t)
 
+(defcustom gnus-treat-date 'head
+  "Display dates according to the `gnus-article-date-headers' variable.
+Valid values are nil, t, `head', `first', `last', an integer or a
+predicate.  See Info node `(gnus)Customizing Articles'."
+  :version "24.1"
+  :group 'gnus-article-treat
+  :link '(custom-manual "(gnus)Customizing Articles")
+  :type gnus-article-treat-head-custom)
+
 (defcustom gnus-treat-emphasize 50000
   "Emphasize text.
 Valid values are nil, t, `head', `first', `last', an integer or a
@@ -1266,73 +1304,6 @@ predicate.  See Info node `(gnus)Customizing Articles'."
   :type gnus-article-treat-custom)
 (put 'gnus-treat-highlight-citation 'highlight t)
 
-(defcustom gnus-treat-date-ut nil
-  "Display the Date in UT (GMT).
-Valid values are nil, t, `head', `first', `last', an integer or a
-predicate.  See Info node `(gnus)Customizing Articles'."
-  :group 'gnus-article-treat
-  :link '(custom-manual "(gnus)Customizing Articles")
-  :type gnus-article-treat-head-custom)
-
-(defcustom gnus-treat-date-local nil
-  "Display the Date in the local timezone.
-Valid values are nil, t, `head', `first', `last', an integer or a
-predicate.  See Info node `(gnus)Customizing Articles'."
-  :group 'gnus-article-treat
-  :link '(custom-manual "(gnus)Customizing Articles")
-  :type gnus-article-treat-head-custom)
-
-(defcustom gnus-treat-date-english nil
-  "Display the Date in a format that can be read aloud in English.
-Valid values are nil, t, `head', `first', `last', an integer or a
-predicate.  See Info node `(gnus)Customizing Articles'."
-  :version "22.1"
-  :group 'gnus-article-treat
-  :link '(custom-manual "(gnus)Customizing Articles")
-  :type gnus-article-treat-head-custom)
-
-(defcustom gnus-treat-date-lapsed nil
-  "Display the Date header in a way that says how much time has elapsed.
-Valid values are nil, t, `head', `first', `last', an integer or a
-predicate.  See Info node `(gnus)Customizing Articles'."
-  :group 'gnus-article-treat
-  :link '(custom-manual "(gnus)Customizing Articles")
-  :type gnus-article-treat-head-custom)
-
-(defcustom gnus-treat-date-combined-lapsed 'head
-  "Display the Date header in a way that says how much time has elapsed.
-Valid values are nil, t, `head', `first', `last', an integer or a
-predicate.  See Info node `(gnus)Customizing Articles'."
-  :group 'gnus-article-treat
-  :link '(custom-manual "(gnus)Customizing Articles")
-  :type gnus-article-treat-head-custom)
-
-(defcustom gnus-treat-date-original nil
-  "Display the date in the original timezone.
-Valid values are nil, t, `head', `first', `last', an integer or a
-predicate.  See Info node `(gnus)Customizing Articles'."
-  :group 'gnus-article-treat
-  :link '(custom-manual "(gnus)Customizing Articles")
-  :type gnus-article-treat-head-custom)
-
-(defcustom gnus-treat-date-iso8601 nil
-  "Display the date in the ISO8601 format.
-Valid values are nil, t, `head', `first', `last', an integer or a
-predicate.  See Info node `(gnus)Customizing Articles'."
-  :version "21.1"
-  :group 'gnus-article-treat
-  :link '(custom-manual "(gnus)Customizing Articles")
-  :type gnus-article-treat-head-custom)
-
-(defcustom gnus-treat-date-user-defined nil
-  "Display the date in a user-defined format.
-The format is defined by the `gnus-article-time-format' variable.
-Valid values are nil, t, `head', `first', `last', an integer or a
-predicate.  See Info node `(gnus)Customizing Articles'."
-  :group 'gnus-article-treat
-  :link '(custom-manual "(gnus)Customizing Articles")
-  :type gnus-article-treat-head-custom)
-
 (defcustom gnus-treat-strip-headers-in-body t
   "Strip the X-No-Archive header line from the beginning of the body.
 Valid values are nil, t, `head', `first', `last', an integer or a
@@ -1690,14 +1661,6 @@ regexp."
     (gnus-treat-fill-long-lines gnus-article-fill-cited-long-lines)
     (gnus-treat-strip-cr gnus-article-remove-cr)
     (gnus-treat-unsplit-urls gnus-article-unsplit-urls)
-    (gnus-treat-date-ut gnus-article-date-ut)
-    (gnus-treat-date-local gnus-article-date-local)
-    (gnus-treat-date-english gnus-article-date-english)
-    (gnus-treat-date-original gnus-article-date-original)
-    (gnus-treat-date-user-defined gnus-article-date-user)
-    (gnus-treat-date-iso8601 gnus-article-date-iso8601)
-    (gnus-treat-date-lapsed gnus-article-date-lapsed)
-    (gnus-treat-date-combined-lapsed gnus-article-date-combined-lapsed)
     (gnus-treat-display-x-face gnus-article-display-x-face)
     (gnus-treat-display-face gnus-article-display-face)
     (gnus-treat-hide-headers gnus-article-maybe-hide-headers)
@@ -1709,6 +1672,7 @@ regexp."
     (gnus-treat-mail-picon gnus-treat-mail-picon)
     (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon)
     (gnus-treat-strip-pem gnus-article-hide-pem)
+    (gnus-treat-date gnus-article-treat-date)
     (gnus-treat-from-gravatar gnus-treat-from-gravatar)
     (gnus-treat-mail-gravatar gnus-treat-mail-gravatar)
     (gnus-treat-highlight-headers gnus-article-highlight-headers)
@@ -3441,25 +3405,18 @@ lines forward."
           (forward-line 1)
         (setq ended t)))))
 
-(defun article-date-ut (&optional type highlight)
-  "Convert DATE date to universal time in the current article.
-If TYPE is `local', convert to local time; if it is `lapsed', output
-how much time has lapsed since DATE.  For `lapsed', the value of
-`gnus-article-date-lapsed-new-header' says whether the \"X-Sent:\" header
-should replace the \"Date:\" one, or should be added below it."
+(defun article-treat-date ()
+  (article-date-ut gnus-article-date-headers t))
+
+(defun article-date-ut (&optional type highlight date-position)
+  "Convert DATE date to TYPE in the current article.
+The default type is `ut'.  See `gnus-article-date-headers' for
+possible values."
   (interactive (list 'ut t))
-  (let* ((tdate-regexp "^Date:[ \t]\\|^X-Sent:[ \t]")
-         (date-regexp (cond ((not gnus-article-date-lapsed-new-header)
-                             tdate-regexp)
-                            ((eq type 'lapsed)
-                             "^X-Sent:[ \t]")
-                            (article-lapsed-timer
-                             "^Date:[ \t]")
-                            (t
-                             tdate-regexp)))
-         (case-fold-search t)
+  (let* ((case-fold-search t)
          (inhibit-read-only t)
          (inhibit-point-motion-hooks t)
+         (first t)
          pos date bface eface)
     (save-excursion
       (save-restriction
@@ -3481,37 +3438,41 @@ should replace the \"Date:\" one, or should be added below it."
                        (1+ (point))))
                  (point-max)))
           (goto-char (point-min))
-          (when (re-search-forward tdate-regexp nil t)
+          (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)))
           (goto-char (point-min))
-          (setq pos nil)
           ;; Delete any old Date headers.
-          (while (re-search-forward date-regexp nil t)
-            (if pos
-                (delete-region (point-at-bol) (progn
-                                                (gnus-article-forward-header)
-                                                (point)))
+          (if date-position
+              (progn
+                (goto-char date-position)
+                (delete-region (point)
+                               (progn
+                                 (gnus-article-forward-header)
+                                 (point))))
+            (while (re-search-forward "^Date:" nil t)
               (delete-region (point-at-bol) (progn
                                               (gnus-article-forward-header)
-                                              (forward-char -1)
-                                              (point)))
-              (setq pos (point))))
-          (when (and (not pos)
-                     (re-search-forward tdate-regexp nil t))
-            (forward-line 1))
-          (gnus-goto-char pos)
-          (insert (article-make-date-line date (or type 'ut)))
-          (unless pos
-            (insert "\n")
-            (forward-line -1))
-          ;; Do highlighting.
-          (beginning-of-line)
-          (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))
+                                              (point)))))
+          (dolist (this-type (cond
+                              ((null type)
+                               (list 'ut))
+                              ((atom type)
+                               (list type))
+                              (t
+                               type)))
+            (insert (article-make-date-line date (or this-type 'ut)) "\n")
+            (forward-line -1)
+            (put-text-property (line-beginning-position)
+                               (1+ (line-beginning-position))
+                               'gnus-date-type this-type)
+            ;; Do highlighting.
+            (beginning-of-line)
+            (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)))
           (put-text-property (point-min) (1- (point-max)) 'original-date date)
           (goto-char (point-max))
           (widen))))))
@@ -3565,9 +3526,9 @@ should replace the \"Date:\" one, or should be added below it."
              (format "%s%02d%02d"
                      (if (> tz 0) "+" "-") (/ (abs tz) 3600)
                      (/ (% (abs tz) 3600) 60)))))
-         ;; Do an X-Sent lapsed format.
+         ;; Do a lapsed format.
          ((eq type 'lapsed)
-          (concat "X-Sent: " (article-lapsed-string time)))
+          (concat "Date: " (article-lapsed-string time)))
          ;; A combined date/lapsed format.
          ((eq type 'combined-lapsed)
           (let ((date-string (article-make-date-line date 'original))
@@ -3695,11 +3656,12 @@ function and want to see what the date was before converting."
               (let ((old-line (count-lines (point-min) (point)))
                     (old-column (current-column)))
                 (goto-char (point-min))
-                (when (re-search-forward "^X-Sent:\\|^Date:" nil t)
-                  (when gnus-treat-date-combined-lapsed
-                    (article-date-combined-lapsed t))
-                  (when gnus-treat-date-lapsed
-                    (article-date-lapsed t)))
+                (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))
+                      (save-excursion
+                        (article-date-ut type t (match-beginning 0)))
+                      (forward-line 1))))
                 (goto-char (point-min))
                 (when (> old-column 0)
                   (setq old-line (1- old-line)))
@@ -3711,7 +3673,7 @@ function and want to see what the date was before converting."
           nil 'visible))))))
 
 (defun gnus-start-date-timer (&optional n)
-  "Start a timer to update the X-Sent header in the article buffers.
+  "Start a timer to update the Date headers in the article buffers.
 The numerical prefix says how frequently (in seconds) the function
 is to run."
   (interactive "p")
@@ -3722,7 +3684,7 @@ is to run."
         (run-at-time 1 n 'article-update-date-lapsed)))
 
 (defun gnus-stop-date-timer ()
-  "Stop the X-Sent timer."
+  "Stop the Date timer."
   (interactive)
   (when article-lapsed-timer
     (nnheader-cancel-timer article-lapsed-timer)
@@ -4347,6 +4309,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
      article-date-english
      article-date-iso8601
      article-date-original
+     article-treat-date
      article-date-ut
      article-decode-mime-words
      article-decode-charset
@@ -4550,9 +4513,9 @@ commands:
         (setq gnus-summary-buffer
               (gnus-summary-buffer-name gnus-newsgroup-name))
         (gnus-summary-set-local-parameters gnus-newsgroup-name)
-        (when (and gnus-article-update-lapsed-header
+        (when (and gnus-article-update-date-headers
                    (not article-lapsed-timer))
-          (gnus-start-date-timer gnus-article-update-lapsed-header))
+          (gnus-start-date-timer gnus-article-update-date-headers))
         (current-buffer)))))
 
 ;; Set article window start at LINE, where LINE is the number of lines