summaryrefslogtreecommitdiff
path: root/lisp/gnus/rfc2047.el
diff options
context:
space:
mode:
authorDave Love <fx@gnu.org>2003-05-07 17:27:31 +0000
committerDave Love <fx@gnu.org>2003-05-07 17:27:31 +0000
commitc6e26ce2e466e93739d2ba3917d15ce7cadf26ea (patch)
tree0a5ff94b6fe5b99064d95740b656e7b69b0a27c1 /lisp/gnus/rfc2047.el
parentbe4d6a6fb6deae8b4abdf6f921a9835c7305c51f (diff)
downloademacs-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.el60
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)))))