aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/gnus/ChangeLog17
-rw-r--r--lisp/gnus/gnus-art.el239
2 files changed, 118 insertions, 138 deletions
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 @@
12011-01-31 Lars Ingebrigtsen <larsi@gnus.org>
2
3 * gnus-art.el (gnus-article-date-lapsed-new-header): Removed.
4 (gnus-treat-date-ut): Ditto.
5 (gnus-article-update-date-header): Renamed.
6 (gnus-treat-date-local): Removed.
7 (gnus-treat-date-english): Removed.
8 (gnus-treat-date-lapsed): Removed.
9 (gnus-treat-date-combined-lapsed): Removed.
10 (gnus-treat-date-original): Removed.
11 (gnus-treat-date-iso8601): Removed.
12 (gnus-treat-date-user-defined): Removed.
13 (gnus-article-date-headers): New variable to control all the date
14 header options.
15 (article-date-ut): Rewrite to allow using the new way to format date
16 headers(s).
17
12011-01-30 Lars Ingebrigtsen <larsi@gnus.org> 182011-01-30 Lars Ingebrigtsen <larsi@gnus.org>
2 19
3 * nnmail.el (nnmail-article-group): Check for a direct fancy split 20 * 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."
168 :group 'gnus-article-hiding) 168 :group 'gnus-article-hiding)
169 169
170(defcustom gnus-visible-headers 170(defcustom gnus-visible-headers
171 "^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:" 171 "^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:"
172 "*All headers that do not match this regexp will be hidden. 172 "*All headers that do not match this regexp will be hidden.
173This variable can also be a list of regexp of headers to remain visible. 173This variable can also be a list of regexp of headers to remain visible.
174If this variable is non-nil, `gnus-ignored-headers' will be ignored." 174If 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."
1014 :group 'gnus-article-mime 1014 :group 'gnus-article-mime
1015 :type '(repeat (cons :format "%v" (string :tag "MIME type") function))) 1015 :type '(repeat (cons :format "%v" (string :tag "MIME type") function)))
1016 1016
1017(defcustom gnus-article-date-lapsed-new-header nil 1017(defcustom gnus-article-date-headers
1018 "Whether the X-Sent and Date headers can coexist. 1018 (let ((types '(ut local english lapsed combined-lapsed
1019When using `gnus-treat-date-lapsed', the \"X-Sent:\" header will 1019 iso8601 original user-defined))
1020either replace the old \"Date:\" header (if this variable is nil), or 1020 default)
1021be added below it (otherwise)." 1021 (dolist (type types)
1022 :version "21.1" 1022 (let ((variable (intern (format "gnus-treat-date-%s" type))))
1023 (when (and (boundp variable)
1024 (symbol-value variable))
1025 (push type default))))
1026 (when (and (or (not (boundp (intern "gnus-article-date-lapsed-new-header")))
1027 (not (symbol-value (intern "gnus-article-date-lapsed-new-header"))))
1028 (memq 'lapsed default))
1029 (setq default (delq 'lapsed default)))
1030 (or default
1031 '(combined-lapsed)))
1032 "A list of Date header formats to display.
1033Valid formats are `ut' (universal time), `local' (local time
1034zone), `english' (readable English), `lapsed' (elapsed time),
1035`combined-lapsed' (both the original date and the elapsed time),
1036`original' (the original date header), `iso8601' (ISO8601
1037format), and `user-defined' (a user-defined format defined by the
1038`gnus-article-time-format' variable).
1039
1040You have as many date headers as you want in the article buffer.
1041Some of these headers are updated automatically. See
1042`gnus-article-update-date-headers' for details."
1043 :version "24.1"
1023 :group 'gnus-article-headers 1044 :group 'gnus-article-headers
1024 :type 'boolean) 1045 :type '(repeat
1025 1046 (item :tag "Universal time (UT)" :value 'ut)
1026(defcustom gnus-article-update-lapsed-header 1 1047 (item :tag "Local time zone" :value 'local)
1027 "How often to update the lapsed date header. 1048 (item :tag "Readable English" :value 'english)
1049 (item :tag "Elapsed time" :value 'lapsed)
1050 (item :tag "Original and elapsed time" :value 'combined-lapsed)
1051 (item :tag "Original date header" :value 'original)
1052 (item :tag "ISO8601 format" :value 'iso8601)
1053 (item :tag "User-defined" :value 'user-defined)))
1054
1055(defcustom gnus-article-update-date-headers 1
1056 "How often to update the date header.
1028If nil, don't update it at all." 1057If nil, don't update it at all."
1029 :version "24.1" 1058 :version "24.1"
1030 :group 'gnus-article-headers 1059 :group 'gnus-article-headers
@@ -1135,6 +1164,15 @@ predicate. See Info node `(gnus)Customizing Articles'."
1135 :type gnus-article-treat-head-custom) 1164 :type gnus-article-treat-head-custom)
1136(put 'gnus-treat-buttonize-head 'highlight t) 1165(put 'gnus-treat-buttonize-head 'highlight t)
1137 1166
1167(defcustom gnus-treat-date 'head
1168 "Display dates according to the `gnus-article-date-headers' variable.
1169Valid values are nil, t, `head', `first', `last', an integer or a
1170predicate. See Info node `(gnus)Customizing Articles'."
1171 :version "24.1"
1172 :group 'gnus-article-treat
1173 :link '(custom-manual "(gnus)Customizing Articles")
1174 :type gnus-article-treat-head-custom)
1175
1138(defcustom gnus-treat-emphasize 50000 1176(defcustom gnus-treat-emphasize 50000
1139 "Emphasize text. 1177 "Emphasize text.
1140Valid values are nil, t, `head', `first', `last', an integer or a 1178Valid values are nil, t, `head', `first', `last', an integer or a
@@ -1266,73 +1304,6 @@ predicate. See Info node `(gnus)Customizing Articles'."
1266 :type gnus-article-treat-custom) 1304 :type gnus-article-treat-custom)
1267(put 'gnus-treat-highlight-citation 'highlight t) 1305(put 'gnus-treat-highlight-citation 'highlight t)
1268 1306
1269(defcustom gnus-treat-date-ut nil
1270 "Display the Date in UT (GMT).
1271Valid values are nil, t, `head', `first', `last', an integer or a
1272predicate. See Info node `(gnus)Customizing Articles'."
1273 :group 'gnus-article-treat
1274 :link '(custom-manual "(gnus)Customizing Articles")
1275 :type gnus-article-treat-head-custom)
1276
1277(defcustom gnus-treat-date-local nil
1278 "Display the Date in the local timezone.
1279Valid values are nil, t, `head', `first', `last', an integer or a
1280predicate. See Info node `(gnus)Customizing Articles'."
1281 :group 'gnus-article-treat
1282 :link '(custom-manual "(gnus)Customizing Articles")
1283 :type gnus-article-treat-head-custom)
1284
1285(defcustom gnus-treat-date-english nil
1286 "Display the Date in a format that can be read aloud in English.
1287Valid values are nil, t, `head', `first', `last', an integer or a
1288predicate. See Info node `(gnus)Customizing Articles'."
1289 :version "22.1"
1290 :group 'gnus-article-treat
1291 :link '(custom-manual "(gnus)Customizing Articles")
1292 :type gnus-article-treat-head-custom)
1293
1294(defcustom gnus-treat-date-lapsed nil
1295 "Display the Date header in a way that says how much time has elapsed.
1296Valid values are nil, t, `head', `first', `last', an integer or a
1297predicate. See Info node `(gnus)Customizing Articles'."
1298 :group 'gnus-article-treat
1299 :link '(custom-manual "(gnus)Customizing Articles")
1300 :type gnus-article-treat-head-custom)
1301
1302(defcustom gnus-treat-date-combined-lapsed 'head
1303 "Display the Date header in a way that says how much time has elapsed.
1304Valid values are nil, t, `head', `first', `last', an integer or a
1305predicate. See Info node `(gnus)Customizing Articles'."
1306 :group 'gnus-article-treat
1307 :link '(custom-manual "(gnus)Customizing Articles")
1308 :type gnus-article-treat-head-custom)
1309
1310(defcustom gnus-treat-date-original nil
1311 "Display the date in the original timezone.
1312Valid values are nil, t, `head', `first', `last', an integer or a
1313predicate. See Info node `(gnus)Customizing Articles'."
1314 :group 'gnus-article-treat
1315 :link '(custom-manual "(gnus)Customizing Articles")
1316 :type gnus-article-treat-head-custom)
1317
1318(defcustom gnus-treat-date-iso8601 nil
1319 "Display the date in the ISO8601 format.
1320Valid values are nil, t, `head', `first', `last', an integer or a
1321predicate. See Info node `(gnus)Customizing Articles'."
1322 :version "21.1"
1323 :group 'gnus-article-treat
1324 :link '(custom-manual "(gnus)Customizing Articles")
1325 :type gnus-article-treat-head-custom)
1326
1327(defcustom gnus-treat-date-user-defined nil
1328 "Display the date in a user-defined format.
1329The format is defined by the `gnus-article-time-format' variable.
1330Valid values are nil, t, `head', `first', `last', an integer or a
1331predicate. See Info node `(gnus)Customizing Articles'."
1332 :group 'gnus-article-treat
1333 :link '(custom-manual "(gnus)Customizing Articles")
1334 :type gnus-article-treat-head-custom)
1335
1336(defcustom gnus-treat-strip-headers-in-body t 1307(defcustom gnus-treat-strip-headers-in-body t
1337 "Strip the X-No-Archive header line from the beginning of the body. 1308 "Strip the X-No-Archive header line from the beginning of the body.
1338Valid values are nil, t, `head', `first', `last', an integer or a 1309Valid values are nil, t, `head', `first', `last', an integer or a
@@ -1690,14 +1661,6 @@ regexp."
1690 (gnus-treat-fill-long-lines gnus-article-fill-cited-long-lines) 1661 (gnus-treat-fill-long-lines gnus-article-fill-cited-long-lines)
1691 (gnus-treat-strip-cr gnus-article-remove-cr) 1662 (gnus-treat-strip-cr gnus-article-remove-cr)
1692 (gnus-treat-unsplit-urls gnus-article-unsplit-urls) 1663 (gnus-treat-unsplit-urls gnus-article-unsplit-urls)
1693 (gnus-treat-date-ut gnus-article-date-ut)
1694 (gnus-treat-date-local gnus-article-date-local)
1695 (gnus-treat-date-english gnus-article-date-english)
1696 (gnus-treat-date-original gnus-article-date-original)
1697 (gnus-treat-date-user-defined gnus-article-date-user)
1698 (gnus-treat-date-iso8601 gnus-article-date-iso8601)
1699 (gnus-treat-date-lapsed gnus-article-date-lapsed)
1700 (gnus-treat-date-combined-lapsed gnus-article-date-combined-lapsed)
1701 (gnus-treat-display-x-face gnus-article-display-x-face) 1664 (gnus-treat-display-x-face gnus-article-display-x-face)
1702 (gnus-treat-display-face gnus-article-display-face) 1665 (gnus-treat-display-face gnus-article-display-face)
1703 (gnus-treat-hide-headers gnus-article-maybe-hide-headers) 1666 (gnus-treat-hide-headers gnus-article-maybe-hide-headers)
@@ -1709,6 +1672,7 @@ regexp."
1709 (gnus-treat-mail-picon gnus-treat-mail-picon) 1672 (gnus-treat-mail-picon gnus-treat-mail-picon)
1710 (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon) 1673 (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon)
1711 (gnus-treat-strip-pem gnus-article-hide-pem) 1674 (gnus-treat-strip-pem gnus-article-hide-pem)
1675 (gnus-treat-date gnus-article-treat-date)
1712 (gnus-treat-from-gravatar gnus-treat-from-gravatar) 1676 (gnus-treat-from-gravatar gnus-treat-from-gravatar)
1713 (gnus-treat-mail-gravatar gnus-treat-mail-gravatar) 1677 (gnus-treat-mail-gravatar gnus-treat-mail-gravatar)
1714 (gnus-treat-highlight-headers gnus-article-highlight-headers) 1678 (gnus-treat-highlight-headers gnus-article-highlight-headers)
@@ -3441,25 +3405,18 @@ lines forward."
3441 (forward-line 1) 3405 (forward-line 1)
3442 (setq ended t))))) 3406 (setq ended t)))))
3443 3407
3444(defun article-date-ut (&optional type highlight) 3408(defun article-treat-date ()
3445 "Convert DATE date to universal time in the current article. 3409 (article-date-ut gnus-article-date-headers t))
3446If TYPE is `local', convert to local time; if it is `lapsed', output 3410
3447how much time has lapsed since DATE. For `lapsed', the value of 3411(defun article-date-ut (&optional type highlight date-position)
3448`gnus-article-date-lapsed-new-header' says whether the \"X-Sent:\" header 3412 "Convert DATE date to TYPE in the current article.
3449should replace the \"Date:\" one, or should be added below it." 3413The default type is `ut'. See `gnus-article-date-headers' for
3414possible values."
3450 (interactive (list 'ut t)) 3415 (interactive (list 'ut t))
3451 (let* ((tdate-regexp "^Date:[ \t]\\|^X-Sent:[ \t]") 3416 (let* ((case-fold-search t)
3452 (date-regexp (cond ((not gnus-article-date-lapsed-new-header)
3453 tdate-regexp)
3454 ((eq type 'lapsed)
3455 "^X-Sent:[ \t]")
3456 (article-lapsed-timer
3457 "^Date:[ \t]")
3458 (t
3459 tdate-regexp)))
3460 (case-fold-search t)
3461 (inhibit-read-only t) 3417 (inhibit-read-only t)
3462 (inhibit-point-motion-hooks t) 3418 (inhibit-point-motion-hooks t)
3419 (first t)
3463 pos date bface eface) 3420 pos date bface eface)
3464 (save-excursion 3421 (save-excursion
3465 (save-restriction 3422 (save-restriction
@@ -3481,37 +3438,41 @@ should replace the \"Date:\" one, or should be added below it."
3481 (1+ (point)))) 3438 (1+ (point))))
3482 (point-max))) 3439 (point-max)))
3483 (goto-char (point-min)) 3440 (goto-char (point-min))
3484 (when (re-search-forward tdate-regexp nil t) 3441 (when (re-search-forward "^Date:" nil t)
3485 (setq bface (get-text-property (point-at-bol) 'face) 3442 (setq bface (get-text-property (point-at-bol) 'face)
3486 eface (get-text-property (1- (point-at-eol)) 'face))) 3443 eface (get-text-property (1- (point-at-eol)) 'face)))
3487 (goto-char (point-min)) 3444 (goto-char (point-min))
3488 (setq pos nil)
3489 ;; Delete any old Date headers. 3445 ;; Delete any old Date headers.
3490 (while (re-search-forward date-regexp nil t) 3446 (if date-position
3491 (if pos 3447 (progn
3492 (delete-region (point-at-bol) (progn 3448 (goto-char date-position)
3493 (gnus-article-forward-header) 3449 (delete-region (point)
3494 (point))) 3450 (progn
3451 (gnus-article-forward-header)
3452 (point))))
3453 (while (re-search-forward "^Date:" nil t)
3495 (delete-region (point-at-bol) (progn 3454 (delete-region (point-at-bol) (progn
3496 (gnus-article-forward-header) 3455 (gnus-article-forward-header)
3497 (forward-char -1) 3456 (point)))))
3498 (point))) 3457 (dolist (this-type (cond
3499 (setq pos (point)))) 3458 ((null type)
3500 (when (and (not pos) 3459 (list 'ut))
3501 (re-search-forward tdate-regexp nil t)) 3460 ((atom type)
3502 (forward-line 1)) 3461 (list type))
3503 (gnus-goto-char pos) 3462 (t
3504 (insert (article-make-date-line date (or type 'ut))) 3463 type)))
3505 (unless pos 3464 (insert (article-make-date-line date (or this-type 'ut)) "\n")
3506 (insert "\n") 3465 (forward-line -1)
3507 (forward-line -1)) 3466 (put-text-property (line-beginning-position)
3508 ;; Do highlighting. 3467 (1+ (line-beginning-position))
3509 (beginning-of-line) 3468 'gnus-date-type this-type)
3510 (when (looking-at "\\([^:]+\\): *\\(.*\\)$") 3469 ;; Do highlighting.
3511 (put-text-property (match-beginning 1) (1+ (match-end 1)) 3470 (beginning-of-line)
3512 'face bface) 3471 (when (looking-at "\\([^:]+\\): *\\(.*\\)$")
3513 (put-text-property (match-beginning 2) (match-end 2) 3472 (put-text-property (match-beginning 1) (1+ (match-end 1))
3514 'face eface)) 3473 'face bface)
3474 (put-text-property (match-beginning 2) (match-end 2)
3475 'face eface)))
3515 (put-text-property (point-min) (1- (point-max)) 'original-date date) 3476 (put-text-property (point-min) (1- (point-max)) 'original-date date)
3516 (goto-char (point-max)) 3477 (goto-char (point-max))
3517 (widen)))))) 3478 (widen))))))
@@ -3565,9 +3526,9 @@ should replace the \"Date:\" one, or should be added below it."
3565 (format "%s%02d%02d" 3526 (format "%s%02d%02d"
3566 (if (> tz 0) "+" "-") (/ (abs tz) 3600) 3527 (if (> tz 0) "+" "-") (/ (abs tz) 3600)
3567 (/ (% (abs tz) 3600) 60))))) 3528 (/ (% (abs tz) 3600) 60)))))
3568 ;; Do an X-Sent lapsed format. 3529 ;; Do a lapsed format.
3569 ((eq type 'lapsed) 3530 ((eq type 'lapsed)
3570 (concat "X-Sent: " (article-lapsed-string time))) 3531 (concat "Date: " (article-lapsed-string time)))
3571 ;; A combined date/lapsed format. 3532 ;; A combined date/lapsed format.
3572 ((eq type 'combined-lapsed) 3533 ((eq type 'combined-lapsed)
3573 (let ((date-string (article-make-date-line date 'original)) 3534 (let ((date-string (article-make-date-line date 'original))
@@ -3695,11 +3656,12 @@ function and want to see what the date was before converting."
3695 (let ((old-line (count-lines (point-min) (point))) 3656 (let ((old-line (count-lines (point-min) (point)))
3696 (old-column (current-column))) 3657 (old-column (current-column)))
3697 (goto-char (point-min)) 3658 (goto-char (point-min))
3698 (when (re-search-forward "^X-Sent:\\|^Date:" nil t) 3659 (while (re-search-forward "^Date:" nil t)
3699 (when gnus-treat-date-combined-lapsed 3660 (let ((type (get-text-property (match-beginning 0) 'gnus-date-type)))
3700 (article-date-combined-lapsed t)) 3661 (when (memq type '(lapsed combined-lapsed user-format))
3701 (when gnus-treat-date-lapsed 3662 (save-excursion
3702 (article-date-lapsed t))) 3663 (article-date-ut type t (match-beginning 0)))
3664 (forward-line 1))))
3703 (goto-char (point-min)) 3665 (goto-char (point-min))
3704 (when (> old-column 0) 3666 (when (> old-column 0)
3705 (setq old-line (1- old-line))) 3667 (setq old-line (1- old-line)))
@@ -3711,7 +3673,7 @@ function and want to see what the date was before converting."
3711 nil 'visible)))))) 3673 nil 'visible))))))
3712 3674
3713(defun gnus-start-date-timer (&optional n) 3675(defun gnus-start-date-timer (&optional n)
3714 "Start a timer to update the X-Sent header in the article buffers. 3676 "Start a timer to update the Date headers in the article buffers.
3715The numerical prefix says how frequently (in seconds) the function 3677The numerical prefix says how frequently (in seconds) the function
3716is to run." 3678is to run."
3717 (interactive "p") 3679 (interactive "p")
@@ -3722,7 +3684,7 @@ is to run."
3722 (run-at-time 1 n 'article-update-date-lapsed))) 3684 (run-at-time 1 n 'article-update-date-lapsed)))
3723 3685
3724(defun gnus-stop-date-timer () 3686(defun gnus-stop-date-timer ()
3725 "Stop the X-Sent timer." 3687 "Stop the Date timer."
3726 (interactive) 3688 (interactive)
3727 (when article-lapsed-timer 3689 (when article-lapsed-timer
3728 (nnheader-cancel-timer article-lapsed-timer) 3690 (nnheader-cancel-timer article-lapsed-timer)
@@ -4347,6 +4309,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
4347 article-date-english 4309 article-date-english
4348 article-date-iso8601 4310 article-date-iso8601
4349 article-date-original 4311 article-date-original
4312 article-treat-date
4350 article-date-ut 4313 article-date-ut
4351 article-decode-mime-words 4314 article-decode-mime-words
4352 article-decode-charset 4315 article-decode-charset
@@ -4550,9 +4513,9 @@ commands:
4550 (setq gnus-summary-buffer 4513 (setq gnus-summary-buffer
4551 (gnus-summary-buffer-name gnus-newsgroup-name)) 4514 (gnus-summary-buffer-name gnus-newsgroup-name))
4552 (gnus-summary-set-local-parameters gnus-newsgroup-name) 4515 (gnus-summary-set-local-parameters gnus-newsgroup-name)
4553 (when (and gnus-article-update-lapsed-header 4516 (when (and gnus-article-update-date-headers
4554 (not article-lapsed-timer)) 4517 (not article-lapsed-timer))
4555 (gnus-start-date-timer gnus-article-update-lapsed-header)) 4518 (gnus-start-date-timer gnus-article-update-date-headers))
4556 (current-buffer))))) 4519 (current-buffer)))))
4557 4520
4558;; Set article window start at LINE, where LINE is the number of lines 4521;; Set article window start at LINE, where LINE is the number of lines