From 12e3ca0a34ec4848dd22eee4ec4c8a239dc6e09c Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 31 Jan 2011 02:01:24 +0000 Subject: [PATCH] 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). --- doc/misc/ChangeLog | 5 ++ doc/misc/gnus.texi | 62 +++++++------ lisp/gnus/ChangeLog | 17 ++++ lisp/gnus/gnus-art.el | 239 +++++++++++++++++++++----------------------------- 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 + + * gnus.texi (Customizing Articles): Document the new way of customizing + the date headers(s). + 2011-01-30 Lars Ingebrigtsen * 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 + + * 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 * 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 -- 2.11.4.GIT