Mercurial > emacs
changeset 50881:b042c57894f8
(rfc2047-header-encoding-alist): Add Followup-To.
(rfc2047-encode-message-header): Fold when encoding not necessary.
(rfc2047-encode-region): Skip \n as whitespace.
(rfc2047-fold-region): Fix whitespace regexps. Don't break just
after the header name.
(rfc2047-unfold-region): Fix regexp and whitespace-skipping.
author | Dave Love <fx@gnu.org> |
---|---|
date | Wed, 07 May 2003 17:26:31 +0000 |
parents | c4ef9b4c327f |
children | f48074afcf3c |
files | lisp/gnus/rfc2047.el |
diffstat | 1 files changed, 36 insertions(+), 24 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/gnus/rfc2047.el Wed May 07 17:22:28 2003 +0000 +++ b/lisp/gnus/rfc2047.el Wed May 07 17:26:31 2003 +0000 @@ -1,5 +1,5 @@ ;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages -;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2002, 2003 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> @@ -39,7 +39,7 @@ (autoload 'mm-body-7-or-8 "mm-bodies") (defvar rfc2047-header-encoding-alist - '(("Newsgroups" . nil) + '(("Newsgroups\\|Followup-To" . nil) ("Message-ID" . nil) ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\)" . address-mime) @@ -135,15 +135,25 @@ (save-restriction (rfc2047-narrow-to-field) (if (not (rfc2047-encodable-p)) - (if (and (eq (mm-body-7-or-8) '8bit) - (mm-multibyte-p) - (mm-coding-system-p - (car message-posting-charset))) - ;; 8 bit must be decoded. - ;; Is message-posting-charset a coding system? - (mm-encode-coding-region - (point-min) (point-max) - (car message-posting-charset))) + (prog1 + (if (and (eq (mm-body-7-or-8) '8bit) + (mm-multibyte-p) + (mm-coding-system-p + (car message-posting-charset))) + ;; 8 bit must be decoded. + (mm-encode-coding-region + (point-min) (point-max) + (mm-charset-to-coding-system + (car message-posting-charset)))) + ;; No encoding necessary, but folding is nice + (rfc2047-fold-region + (save-excursion + (goto-char (point-min)) + (skip-chars-forward "^:") + (when (looking-at ": ") + (forward-char 2)) + (point)) + (point-max))) ;; We found something that may perhaps be encoded. (setq method nil alist rfc2047-header-encoding-alist) @@ -230,7 +240,7 @@ (let ((start (point)) ; start of current token end ; end of current token ;; Whether there's an encoded word before the current - ;; tpken, either immediately or separated by space. + ;; token, either immediately or separated by space. last-encoded) (goto-char (point-min)) (condition-case nil ; in case of unbalanced quotes @@ -240,7 +250,7 @@ (while (not (eobp)) (setq start (point)) ;; Skip whitespace. - (unless (= 0 (skip-chars-forward " \t")) + (unless (= 0 (skip-chars-forward " \t\n")) (setq start (point))) (cond ((not (char-after))) ; eob @@ -364,6 +374,7 @@ (goto-char (point-min)) (let ((break nil) (qword-break nil) + (first t) (bol (save-restriction (widen) (mm-point-at-bol)))) @@ -372,7 +383,7 @@ (goto-char (or break qword-break)) (setq break nil qword-break nil) - (if (looking-at " \t") + (if (looking-at "[ \t]") (insert ?\n) (insert "\n ")) (setq bol (1- (point))) @@ -392,7 +403,10 @@ (forward-char 1)) ((memq (char-after) '(? ?\t)) (skip-chars-forward " \t") - (setq break (1- (point)))) + (if first + ;; Don't break just after the header name. + (setq first nil) + (setq break (1- (point))))) ((not break) (if (not (looking-at "=\\?[^=]")) (if (eq (char-after) ?=) @@ -406,7 +420,7 @@ (goto-char (or break qword-break)) (setq break nil qword-break nil) - (if (looking-at " \t") + (if (looking-at "[ \t]") (insert ?\n) (insert "\n ")) (setq bol (1- (point))) @@ -426,14 +440,12 @@ leading) (forward-line 1) (while (not (eobp)) - (looking-at "[ \t]*") - (setq leading (- (match-end 0) (match-beginning 0))) - (if (< (- (mm-point-at-eol) bol leading) 76) - (progn - (goto-char eol) - (delete-region eol (progn - (skip-chars-forward "[ \t\n\r]+") - (1- (point))))) + (if (and (looking-at "[ \t]") + (< (- (mm-point-at-eol) bol) 76)) + (delete-region eol (progn + (goto-char eol) + (skip-chars-forward "\r\n") + (point))) (setq bol (mm-point-at-bol))) (setq eol (mm-point-at-eol)) (forward-line 1)))))