Mercurial > emacs
comparison lisp/mail/rmail.el @ 64972:d10e1f63c588
(rmail-nonignored-headers): New variable.
(rmail-clear-headers): Use it.
(rmail-reply): Better handling of mail-followup-to header.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 15 Aug 2005 02:04:29 +0000 |
parents | 1fa57fbe3d5f |
children | 65cc9b3bbebd 2d92f5c9d6ae |
comparison
equal
deleted
inserted
replaced
64971:7fb2b79e33d0 | 64972:d10e1f63c588 |
---|---|
252 "\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:" | 252 "\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:" |
253 "\\|^nntp-posting-host:\\|^path:\\|^x-char.*:\\|^x-face:\\|^face:" | 253 "\\|^nntp-posting-host:\\|^path:\\|^x-char.*:\\|^x-face:\\|^face:" |
254 "\\|^x-mailer:\\|^delivered-to:\\|^lines:" | 254 "\\|^x-mailer:\\|^delivered-to:\\|^lines:" |
255 "\\|^content-transfer-encoding:\\|^x-coding-system:" | 255 "\\|^content-transfer-encoding:\\|^x-coding-system:" |
256 "\\|^return-path:\\|^errors-to:\\|^return-receipt-to:" | 256 "\\|^return-path:\\|^errors-to:\\|^return-receipt-to:" |
257 "\\|^x-sign:\\|^x-beenthere:\\|^x-mailman-version:\\|^x-mailman-copy:" | |
258 "\\|^precedence:\\|^list-help:\\|^list-post:\\|^list-subscribe:" | 257 "\\|^precedence:\\|^list-help:\\|^list-post:\\|^list-subscribe:" |
259 "\\|^list-id:\\|^list-unsubscribe:\\|^list-archive:" | 258 "\\|^list-id:\\|^list-unsubscribe:\\|^list-archive:" |
260 "\\|^content-length:" | 259 "\\|^content-length:\\|^nntp-posting-date:\\|^user-agent" |
261 "\\|^x-attribution:\\|^x-disclaimer:\\|^x-trace:" | 260 "\\|^importance:\\|^envelope-to:\\|^delivery-date\\|^openpgp:" |
262 "\\|^x-complaints-to:\\|^nntp-posting-date:\\|^user-agent" | 261 "\\|^mbox-line:\\|^cancel-lock:" |
263 "\\|^importance:\\|^envelope-to:\\|^delivery-date" | 262 "\\|^resent-face:\\|^resent-x.*:\\|^resent-organization:\\|^resent-openpgp:" |
264 "\\|^x.*-priority:\\|^x-mimeole:\\|^x-archive:" | 263 |
265 "\\|^resent-face:\\|^resent-x.*:\\|^resent-organization\\|^resent-openpgp" | 264 "\\|^x-.*:") |
266 "\\|^openpgp:\\|^x-request-pgp:\\|^x-original.*:" | |
267 "\\|^x-virus-scanned:\\|^x-spam-[^s].*:") | |
268 "*Regexp to match header fields that Rmail should normally hide. | 265 "*Regexp to match header fields that Rmail should normally hide. |
266 \(See also `rmail-nonignored-headers', which overrides this regexp.) | |
267 This variable is used for reformatting the message header, | |
268 which normally happens once for each message, | |
269 when you view the message for the first time in Rmail. | |
270 To make a change in this variable take effect | |
271 for a message that you have already viewed, | |
272 go to that message and type \\[rmail-toggle-header] twice." | |
273 :type 'regexp | |
274 :group 'rmail-headers) | |
275 | |
276 (defcustom rmail-nonignored-headers "^x-spam-status:" | |
277 "*Regexp to match X header fields that Rmail should show. | |
278 This regexp overrides `rmail-ignored-headers'; if both this regexp | |
279 and that one match a certain header field, Rmail shows the field. | |
280 | |
269 This variable is used for reformatting the message header, | 281 This variable is used for reformatting the message header, |
270 which normally happens once for each message, | 282 which normally happens once for each message, |
271 when you view the message for the first time in Rmail. | 283 when you view the message for the first time in Rmail. |
272 To make a change in this variable take effect | 284 To make a change in this variable take effect |
273 for a message that you have already viewed, | 285 for a message that you have already viewed, |
2181 "Delete all header fields that Rmail should not show. | 2193 "Delete all header fields that Rmail should not show. |
2182 If the optional argument IGNORED-HEADERS is non-nil, | 2194 If the optional argument IGNORED-HEADERS is non-nil, |
2183 delete all header fields whose names match that regexp. | 2195 delete all header fields whose names match that regexp. |
2184 Otherwise, if `rmail-displayed-headers' is non-nil, | 2196 Otherwise, if `rmail-displayed-headers' is non-nil, |
2185 delete all header fields *except* those whose names match that regexp. | 2197 delete all header fields *except* those whose names match that regexp. |
2186 Otherwise, delete all header fields whose names match `rmail-ignored-headers'." | 2198 Otherwise, delete all header fields whose names match `rmail-ignored-headers' |
2199 unless they also match `rmail-nonignored-headers'." | |
2187 (when (search-forward "\n\n" nil t) | 2200 (when (search-forward "\n\n" nil t) |
2188 (forward-char -1) | 2201 (forward-char -1) |
2189 (let ((case-fold-search t) | 2202 (let ((case-fold-search t) |
2190 (buffer-read-only nil)) | 2203 (buffer-read-only nil)) |
2191 (if (and rmail-displayed-headers (null ignored-headers)) | 2204 (if (and rmail-displayed-headers (null ignored-headers)) |
2205 (delete-region (point) next)))) | 2218 (delete-region (point) next)))) |
2206 (goto-char (point-min))) | 2219 (goto-char (point-min))) |
2207 (or ignored-headers (setq ignored-headers rmail-ignored-headers)) | 2220 (or ignored-headers (setq ignored-headers rmail-ignored-headers)) |
2208 (save-restriction | 2221 (save-restriction |
2209 (narrow-to-region (point-min) (point)) | 2222 (narrow-to-region (point-min) (point)) |
2223 (goto-char (point-min)) | |
2210 (while (and ignored-headers | 2224 (while (and ignored-headers |
2211 (progn | 2225 (re-search-forward ignored-headers nil t)) |
2212 (goto-char (point-min)) | |
2213 (re-search-forward ignored-headers nil t))) | |
2214 (beginning-of-line) | 2226 (beginning-of-line) |
2215 (delete-region (point) | 2227 (if (looking-at rmail-nonignored-headers) |
2216 (if (re-search-forward "\n[^ \t]" nil t) | 2228 (forward-line 1) |
2217 (1- (point)) | 2229 (delete-region (point) |
2218 (point-max))))))))) | 2230 (save-excursion |
2231 (if (re-search-forward "\n[^ \t]" nil t) | |
2232 (1- (point)) | |
2233 (point-max))))))))))) | |
2219 | 2234 |
2220 (defun rmail-msg-is-pruned () | 2235 (defun rmail-msg-is-pruned () |
2221 (rmail-maybe-set-message-counters) | 2236 (rmail-maybe-set-message-counters) |
2222 (save-restriction | 2237 (save-restriction |
2223 (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) | 2238 (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) |
3410 (point))) | 3425 (point))) |
3411 (narrow-to-region (point) | 3426 (narrow-to-region (point) |
3412 (progn (search-forward "\n*** EOOH ***\n") | 3427 (progn (search-forward "\n*** EOOH ***\n") |
3413 (beginning-of-line) (point))))) | 3428 (beginning-of-line) (point))))) |
3414 (setq from (mail-fetch-field "from") | 3429 (setq from (mail-fetch-field "from") |
3415 reply-to (or (if just-sender | 3430 reply-to (or (mail-fetch-field "mail-reply-to" nil t) |
3416 (mail-fetch-field "mail-reply-to" nil t) | |
3417 (mail-fetch-field "mail-followup-to" nil t)) | |
3418 (mail-fetch-field "reply-to" nil t) | 3431 (mail-fetch-field "reply-to" nil t) |
3419 from) | 3432 from) |
3420 cc (and (not just-sender) | |
3421 ;; mail-followup-to, if given, overrides cc. | |
3422 (not (mail-fetch-field "mail-followup-to" nil t)) | |
3423 (mail-fetch-field "cc" nil t)) | |
3424 subject (mail-fetch-field "subject") | 3433 subject (mail-fetch-field "subject") |
3425 date (mail-fetch-field "date") | 3434 date (mail-fetch-field "date") |
3426 to (or (mail-fetch-field "to" nil t) "") | |
3427 message-id (mail-fetch-field "message-id") | 3435 message-id (mail-fetch-field "message-id") |
3428 references (mail-fetch-field "references" nil nil t) | 3436 references (mail-fetch-field "references" nil nil t) |
3429 resent-reply-to (mail-fetch-field "resent-reply-to" nil t) | 3437 resent-reply-to (mail-fetch-field "resent-reply-to" nil t) |
3430 resent-cc (and (not just-sender) | 3438 resent-cc (and (not just-sender) |
3431 (mail-fetch-field "resent-cc" nil t)) | 3439 (mail-fetch-field "resent-cc" nil t)) |
3432 resent-to (or (mail-fetch-field "resent-to" nil t) "") | 3440 resent-to (or (mail-fetch-field "resent-to" nil t) "") |
3433 ;;; resent-subject (mail-fetch-field "resent-subject") | 3441 ;;; resent-subject (mail-fetch-field "resent-subject") |
3434 ;;; resent-date (mail-fetch-field "resent-date") | 3442 ;;; resent-date (mail-fetch-field "resent-date") |
3435 ;;; resent-message-id (mail-fetch-field "resent-message-id") | 3443 ;;; resent-message-id (mail-fetch-field "resent-message-id") |
3436 ))) | 3444 ) |
3445 (unless just-sender | |
3446 (if (mail-fetch-field "mail-followup-to" nil t) | |
3447 ;; If this header field is present, use it instead of the To and CC fields. | |
3448 (setq to (mail-fetch-field "mail-followup-to" nil t)) | |
3449 (setq cc (or (mail-fetch-field "cc" nil t) "") | |
3450 to (or (mail-fetch-field "to" nil t) "")))) | |
3451 | |
3452 )) | |
3453 | |
3437 ;; Merge the resent-to and resent-cc into the to and cc. | 3454 ;; Merge the resent-to and resent-cc into the to and cc. |
3438 (if (and resent-to (not (equal resent-to ""))) | 3455 (if (and resent-to (not (equal resent-to ""))) |
3439 (if (not (equal to "")) | 3456 (if (not (equal to "")) |
3440 (setq to (concat to ", " resent-to)) | 3457 (setq to (concat to ", " resent-to)) |
3441 (setq to resent-to))) | 3458 (setq to resent-to))) |