[gnus git] branch master updated: =1= Rewrite the Date header formatting functionality.

Lars Magne Ingebrigtsen <[email protected]>
Newsgroups gmane.emacs.gnus.cvs
Message-ID <[email protected]>
       via  5b81b4b7b447c64f3c09bad8541b3dfa71c392d1 (commit)
      from  5e5df239e889cf9eca1a7f8cbdb0b61159dc7a93 (commit)


- Log -----------------------------------------------------------------
commit 5b81b4b7b447c64f3c09bad8541b3dfa71c392d1
Author: Lars Magne Ingebrigtsen <[email protected]>
Date:   Sun Jan 30 17:55:08 2011 -0800

    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.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 1dfa6c5..a9e26e0 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,20 @@
+2011-01-31  Lars Ingebrigtsen  <[email protected]>
+
+	* 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  <[email protected]>
 
 	* nnmail.el (nnmail-article-group): Check for a direct fancy split
diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 0a9446a..e0ff5f2 100644
--- a/lisp/gnus-art.el
+++ b/lisp/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
+	  (if date-position
+	      (progn
+		(goto-char date-position)
+		(delete-region (point)
+			       (progn
 						(gnus-article-forward-header)
-						(point)))
+				 (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))
+					      (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))
+				 '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
diff --git a/texi/ChangeLog b/texi/ChangeLog
index 5229398..e1afe7f 100644
--- a/texi/ChangeLog
+++ b/texi/ChangeLog
@@ -1,3 +1,8 @@
+2011-01-31  Lars Ingebrigtsen  <[email protected]>
+
+	* gnus.texi (Customizing Articles): Document the new way of customizing
+	the date headers(s).
+
 2011-01-30  Lars Ingebrigtsen  <[email protected]>
 
 	* gnus.texi (Client-Side IMAP Splitting): Add a complete nnimap fancy
diff --git a/texi/gnus.texi b/texi/gnus.texi
index 5f81c38..98c7488 100644
--- a/texi/gnus.texi
+++ b/texi/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}.
 

-----------------------------------------------------------------------
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   |   17 ++++
 lisp/gnus-art.el |  239 +++++++++++++++++++++++-------------------------------
 texi/ChangeLog   |    5 +
 texi/gnus.texi   |   62 +++++++++------
 4 files changed, 160 insertions(+), 163 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
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.