From c6e26ce2e466e93739d2ba3917d15ce7cadf26ea Mon Sep 17 00:00:00 2001 From: Dave Love Date: Wed, 7 May 2003 17:27:31 +0000 Subject: [PATCH] (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. --- lisp/gnus/ChangeLog | 11 ++++++++ lisp/gnus/rfc2047.el | 60 ++++++++++++++++++++++++++------------------ 2 files changed, 47 insertions(+), 24 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 37a0479e317..7f1033786e4 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,14 @@ +2003-05-07 Dave Love + + [Partial sync with Gnus.] + + * rfc2047.el (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. + 2003-05-06 Jesper Harder * gnus-cus.el (gnus-group-customize, gnus-score-parameters): Don't 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 ;; MORIOKA Tomohiko @@ -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))))) -- 2.39.2