diff options
author | Dave Love <fx@gnu.org> | 2003-05-07 17:27:31 +0000 |
---|---|---|
committer | Dave Love <fx@gnu.org> | 2003-05-07 17:27:31 +0000 |
commit | c6e26ce2e466e93739d2ba3917d15ce7cadf26ea (patch) | |
tree | 0a5ff94b6fe5b99064d95740b656e7b69b0a27c1 /lisp/gnus/rfc2047.el | |
parent | be4d6a6fb6deae8b4abdf6f921a9835c7305c51f (diff) | |
download | emacs-c6e26ce2e466e93739d2ba3917d15ce7cadf26ea.tar.gz emacs-c6e26ce2e466e93739d2ba3917d15ce7cadf26ea.tar.bz2 emacs-c6e26ce2e466e93739d2ba3917d15ce7cadf26ea.zip |
(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.
Diffstat (limited to 'lisp/gnus/rfc2047.el')
-rw-r--r-- | lisp/gnus/rfc2047.el | 60 |
1 files changed, 36 insertions, 24 deletions
diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el index d695f70e15c..fbe10012182 100644 --- a/lisp/gnus/rfc2047.el +++ b/lisp/gnus/rfc2047.el @@ -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 @@ Should be called narrowed to the head of the message." (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 @@ Dynamically bind `rfc2047-encoding-type' to change that." (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 @@ Dynamically bind `rfc2047-encoding-type' to change that." (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 @@ By default, the region is treated as containing addresses (see (goto-char (point-min)) (let ((break nil) (qword-break nil) + (first t) (bol (save-restriction (widen) (mm-point-at-bol)))) @@ -372,7 +383,7 @@ By default, the region is treated as containing addresses (see (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 @@ By default, the region is treated as containing addresses (see (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 @@ By default, the region is treated as containing addresses (see (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 @@ By default, the region is treated as containing addresses (see 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))))) |