comparison lisp/gnus/rfc2047.el @ 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.

50880:c4ef9b4c327f

;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages
;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <[e-mail]>
;;	MORIOKA Tomohiko <[e-mail]>
;; This file is part of GNU Emacs.

(require 'mail-prsvr)
(require 'base64)
(autoload 'mm-body-7-or-8 "mm-bodies")

(defvar rfc2047-header-encoding-alist
  '(("Newsgroups" . nil)
    ("Message-ID" . nil)
    ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\)" .
     address-mime)
    (t . mime))
  "*Header/encoding method alist.

    (let (alist elem method)
      (while (not (eobp))
	(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)))
	    ;; We found something that may perhaps be encoded.
	    (setq method nil
		  alist rfc2047-header-encoding-alist)
	    (while (setq elem (pop alist))
	      (when (or (and (stringp (car elem))

      ;; `address-mime' case -- take care of quoted words, comments.
      (with-syntax-table rfc2047-syntax-table
	(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.
	      last-encoded)
	  (goto-char (point-min))
	  (condition-case nil	      ; in case of unbalanced quotes
	      ;; Look for rfc2822-style: sequences of atoms, quoted
	      ;; strings, specials, whitespace.  (Specials mustn't be
	      ;; encoded.)
	      (while (not (eobp))
		(setq start (point))
		;; Skip whitespace.
		(unless (= 0 (skip-chars-forward " \t"))
		  (setq start (point)))
		(cond
		 ((not (char-after)))	; eob
		 ;; else token start
		 ((eq ?\" (char-syntax (char-after)))

  (save-restriction
    (narrow-to-region b e)
    (goto-char (point-min))
    (let ((break nil)
	  (qword-break nil)
	  (bol (save-restriction
		 (widen)
		 (mm-point-at-bol))))
      (while (not (eobp))
	(when (and (or break qword-break) (> (- (point) bol) 76))
	  (goto-char (or break qword-break))
	  (setq break nil
		qword-break nil)
	  (if (looking-at " \t")
	      (insert ?\n)
	    (insert "\n "))
	  (setq bol (1- (point)))
	  ;; Don't break before the first non-LWSP characters.
	  (skip-chars-forward " \t")

	    (forward-char 1)))
	 ((eq (char-after) ?\r)
	  (forward-char 1))
	 ((memq (char-after) '(?  ?\t))
	  (skip-chars-forward " \t")
	  (setq break (1- (point))))
	 ((not break)
	  (if (not (looking-at "=\\?[^=]"))
	      (if (eq (char-after) ?=)
		  (forward-char 1)
		(skip-chars-forward "^ \t\n\r="))

	  (skip-chars-forward "^ \t\n\r"))))
      (when (and (or break qword-break) (> (- (point) bol) 76))
	(goto-char (or break qword-break))
	(setq break nil
	      qword-break nil)
	  (if (looking-at " \t")
	      (insert ?\n)
	    (insert "\n "))
	(setq bol (1- (point)))
	;; Don't break before the first non-LWSP characters.
	(skip-chars-forward " \t")

		 (mm-point-at-bol)))
	  (eol (mm-point-at-eol))
	  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)))))
	  (setq bol (mm-point-at-bol)))
	(setq eol (mm-point-at-eol))
	(forward-line 1)))))

(defun rfc2047-b-encode-region (b e)

50881:b042c57894f8

;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages
;; Copyright (C) 1998, 1999, 2000, 2002, 2003 Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <[e-mail]>
;;	MORIOKA Tomohiko <[e-mail]>
;; This file is part of GNU Emacs.

(require 'mail-prsvr)
(require 'base64)
(autoload 'mm-body-7-or-8 "mm-bodies")

(defvar rfc2047-header-encoding-alist
  '(("Newsgroups\\|Followup-To" . nil)
    ("Message-ID" . nil)
    ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|Reply-To\\|Sender\\)" .
     address-mime)
    (t . mime))
  "*Header/encoding method alist.

    (let (alist elem method)
      (while (not (eobp))
	(save-restriction
	  (rfc2047-narrow-to-field)
	  (if (not (rfc2047-encodable-p))
	      (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)
	    (while (setq elem (pop alist))
	      (when (or (and (stringp (car elem))

      ;; `address-mime' case -- take care of quoted words, comments.
      (with-syntax-table rfc2047-syntax-table
	(let ((start (point))		; start of current token
	      end			; end of current token
	      ;; Whether there's an encoded word before the current
	      ;; token, either immediately or separated by space.
	      last-encoded)
	  (goto-char (point-min))
	  (condition-case nil	      ; in case of unbalanced quotes
	      ;; Look for rfc2822-style: sequences of atoms, quoted
	      ;; strings, specials, whitespace.  (Specials mustn't be
	      ;; encoded.)
	      (while (not (eobp))
		(setq start (point))
		;; Skip whitespace.
		(unless (= 0 (skip-chars-forward " \t\n"))
		  (setq start (point)))
		(cond
		 ((not (char-after)))	; eob
		 ;; else token start
		 ((eq ?\" (char-syntax (char-after)))

  (save-restriction
    (narrow-to-region b e)
    (goto-char (point-min))
    (let ((break nil)
	  (qword-break nil)
	  (first t)
	  (bol (save-restriction
		 (widen)
		 (mm-point-at-bol))))
      (while (not (eobp))
	(when (and (or break qword-break) (> (- (point) bol) 76))
	  (goto-char (or break qword-break))
	  (setq break nil
		qword-break nil)
	  (if (looking-at "[ \t]")
	      (insert ?\n)
	    (insert "\n "))
	  (setq bol (1- (point)))
	  ;; Don't break before the first non-LWSP characters.
	  (skip-chars-forward " \t")

	    (forward-char 1)))
	 ((eq (char-after) ?\r)
	  (forward-char 1))
	 ((memq (char-after) '(?  ?\t))
	  (skip-chars-forward " \t")
	  (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) ?=)
		  (forward-char 1)
		(skip-chars-forward "^ \t\n\r="))

	  (skip-chars-forward "^ \t\n\r"))))
      (when (and (or break qword-break) (> (- (point) bol) 76))
	(goto-char (or break qword-break))
	(setq break nil
	      qword-break nil)
	  (if (looking-at "[ \t]")
	      (insert ?\n)
	    (insert "\n "))
	(setq bol (1- (point)))
	;; Don't break before the first non-LWSP characters.
	(skip-chars-forward " \t")

		 (mm-point-at-bol)))
	  (eol (mm-point-at-eol))
	  leading)
      (forward-line 1)
      (while (not (eobp))
	(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)))))

(defun rfc2047-b-encode-region (b e)