Function: rfc2047-decode-region

rfc2047-decode-region is an interactive and byte-compiled function defined in rfc2047.el.gz.

Signature

(rfc2047-decode-region START END &optional ADDRESS-MIME)

Documentation

Decode MIME-encoded words in region between START and END.

If ADDRESS-MIME is non-nil, strip backslashes which precede characters other than " and \ in quoted strings.

Key Bindings

Aliases

mail-decode-encoded-word-region

Source Code

;; Defined in /usr/src/emacs/lisp/mail/rfc2047.el.gz
;; Fixme: This should decode in place, not cons intermediate strings.
;; Also check whether it needs to worry about delimiting fields like
;; encoding.

;; In fact it's reported that (invalid) encoding of mailboxes in
;; addr-specs is in use, so delimiting fields might help.  Probably
;; not decoding a word which isn't properly delimited is good enough
;; and worthwhile (is it more correct or not?), e.g. something like
;; `=?iso-8859-1?q?foo?=@'.

(defun rfc2047-decode-region (start end &optional address-mime)
  "Decode MIME-encoded words in region between START and END.
If ADDRESS-MIME is non-nil, strip backslashes which precede characters
other than `\"' and `\\' in quoted strings."
  (interactive "r")
  (let ((case-fold-search t)
	(eword-regexp
	 (if rfc2047-allow-irregular-q-encoded-words
	     (eval-when-compile
	       (concat "[\n\t ]*\\(" rfc2047-encoded-word-regexp-loose "\\)"))
	   (eval-when-compile
	     (concat "[\n\t ]*\\(" rfc2047-encoded-word-regexp "\\)"))))
	b e match words)
    (save-excursion
      (save-restriction
	(narrow-to-region start end)
	(when address-mime
	  (rfc2047-strip-backslashes-in-quoted-strings))
	(goto-char (setq b start))
	;; Look for the encoded-words.
	(while (setq match (re-search-forward eword-regexp nil t))
	  (setq e (match-beginning 1)
		end (match-end 0)
		words nil)
	  (while match
	    (push (list (match-string 2) ;; charset
			(char-after (match-beginning 3)) ;; encoding
			(substring (match-string 3) 2) ;; encoded-text
			(match-string 1)) ;; encoded-word
		  words)
	    ;; Look for the subsequent encoded-words.
	    (when (setq match (looking-at eword-regexp))
	      (goto-char (setq end (match-end 0)))))
	  ;; Replace the encoded-words with the decoded one.
	  (delete-region e end)
	  (insert (rfc2047-decode-encoded-words (nreverse words)))
	  (save-restriction
	    (narrow-to-region e (point))
	    (goto-char e)
	    ;; Remove newlines between decoded words, though such
	    ;; things essentially must not be there.
	    (while (re-search-forward "[\n\r]+" nil t)
	      (replace-match " "))
	    (setq end (point-max))
	    ;; Quote decoded words if there are special characters
	    ;; which might violate RFC 822 (or later).
	    (when (and rfc2047-quote-decoded-words-containing-tspecials
		       (let ((regexp (car (rassq
					   'address-mime
					   rfc2047-header-encoding-alist))))
			 (when regexp
			   (save-restriction
			     (widen)
			     (and
			      ;; Don't quote words if already quoted.
			      (not (and (eq (char-before e) ?\")
					(eq (char-after end) ?\")))
			      (progn
				(beginning-of-line)
				(while (and (memq (char-after) '(?  ?\t))
					    (zerop (forward-line -1))))
				(looking-at regexp)))))))
	      (let (quoted)
		(goto-char e)
		(skip-chars-forward " \t")
		(setq start (point))
		(setq quoted (eq (char-after) ?\"))
		(goto-char (point-max))
		(skip-chars-backward " \t" start)
		(if (setq quoted (and quoted
				      (> (point) (1+ start))
				      (eq (char-before) ?\")))
		    (progn
		      (backward-char)
		      (setq start (1+ start)
			    end (point-marker)))
		  (setq end (point-marker)))
		(goto-char start)
		(while (search-forward "\"" end t)
		  (when (prog2
			    (backward-char)
			    (zerop (% (skip-chars-backward "\\\\") 2))
			  (goto-char (match-beginning 0)))
		    (insert "\\"))
		  (forward-char))
		(when (and (not quoted)
			   (progn
			     (goto-char start)
			     (re-search-forward
			      (concat "[" ietf-drums-tspecials "]")
			      end t)))
		  (goto-char start)
		  (insert "\"")
		  (goto-char end)
		  (insert "\""))
		(set-marker end nil)))
	    (goto-char (point-max)))
	  (when (and (mm-multibyte-p)
		     mail-parse-charset
		     (not (eq mail-parse-charset 'us-ascii))
		     (not (eq mail-parse-charset 'gnus-decoded)))
	    (decode-coding-region b e mail-parse-charset))
	  (setq b (point)))
	(when (and (mm-multibyte-p)
		   mail-parse-charset
		   (not (eq mail-parse-charset 'us-ascii))
		   (not (eq mail-parse-charset 'gnus-decoded)))
	  (decode-coding-region b (point-max) mail-parse-charset))))))