Function: rfc2047-encode-message-header

rfc2047-encode-message-header is an interactive and byte-compiled function defined in rfc2047.el.gz.

Signature

(rfc2047-encode-message-header)

Documentation

Encode the message header according to rfc2047-header-encoding-alist.

Should be called narrowed to the head of the message.

Key Bindings

Aliases

mail-encode-encoded-word-buffer

Source Code

;; Defined in /usr/src/emacs/lisp/mail/rfc2047.el.gz
(defun rfc2047-encode-message-header ()
  "Encode the message header according to `rfc2047-header-encoding-alist'.
Should be called narrowed to the head of the message."
  (interactive "*")
  (save-excursion
    (goto-char (point-min))
    (let (alist elem method charsets)
      (while (not (eobp))
	(save-restriction
	  (rfc2047-narrow-to-field)
	  (setq method nil
		alist rfc2047-header-encoding-alist
		charsets (mm-find-mime-charset-region (point-min) (point-max)))
	  ;; M$ Outlook boycotts decoding of a header if it consists
	  ;; of two or more encoded words and those charsets differ;
	  ;; it seems to decode all words in a header from a charset
	  ;; found first in the header.  So, we unify the charsets into
	  ;; a single one used for encoding the whole text in a header.
	  (let ((mm-coding-system-priorities
		 (if (= (length charsets) 1)
		     (cons (mm-charset-to-coding-system (car charsets))
			   mm-coding-system-priorities)
		   mm-coding-system-priorities))
                (case-fold-search t))
	    (while (setq elem (pop alist))
	      (when (or (and (stringp (car elem))
			     (looking-at (car elem)))
			(eq (car elem) t))
		(setq alist nil
		      method (cdr elem))))
	    (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.
		    (encode-coding-region
		     (point-min) (point-max)
		     (mm-charset-to-coding-system
		      (car message-posting-charset))))
	      ;; We found something that may perhaps be encoded.
	      (re-search-forward "^[^:]+: *" nil t)
	      (cond
	       ((eq method 'address-mime)
		(rfc2047-encode-region (point) (point-max)))
	       ((eq method 'mime)
		(let ((rfc2047-encoding-type 'mime))
		  (rfc2047-encode-region (point) (point-max))))
	       ((eq method 'default)
		(if mail-parse-charset
		    (encode-coding-region (point) (point-max)
					  mail-parse-charset)))
	       ;; We get this when Cc'ing messages to newsgroups with
	       ;; 8-bit names.  The group name mail copy just got
	       ;; unconditionally encoded.  Previously, it would ask
	       ;; whether to encode, which was quite confusing for the
	       ;; user.  If the new behavior is wrong, tell me.  I have
	       ;; left the old code commented out below.
	       ;; -- Per Abrahamsen <abraham@dina.kvl.dk> Date: 2001-10-07.
	       ;; Modified by Dave Love, with the commented-out code changed
	       ;; in accordance with changes elsewhere.
	       ((null method)
		(rfc2047-encode-region (point) (point-max)))
	       ;; ((null method)
	       ;;  (if (or (message-options-get
	       ;;        'rfc2047-encode-message-header-encode-any)
	       ;;       (message-options-set
	       ;;        'rfc2047-encode-message-header-encode-any
	       ;;        (y-or-n-p
	       ;;         "Some texts are not encoded. Encode anyway?")))
	       ;;      (rfc2047-encode-region (point-min) (point-max))
	       ;;    (error "Cannot send unencoded text")))
	       ((mm-coding-system-p method)
		(encode-coding-region (point) (point-max) method))
	       ;; Hm.
	       (t)))
	    (goto-char (point-max))))))))