qp.el 5.87 KB
Newer Older
Gerd Moellmann's avatar
Gerd Moellmann committed
1
;;; qp.el --- Quoted-Printable functions
Dave Love's avatar
Dave Love committed
2

3
;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
Gerd Moellmann's avatar
Gerd Moellmann committed
4 5

;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
Dave Love's avatar
Dave Love committed
6 7
;; Keywords: mail, extensions

Gerd Moellmann's avatar
Gerd Moellmann committed
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

Dave Love's avatar
Dave Love committed
27 28
;; Functions for encoding and decoding quoted-printable text as
;; defined in RFC 2045.
Gerd Moellmann's avatar
Gerd Moellmann committed
29

Dave Love's avatar
Dave Love committed
30
;;; Code:
Gerd Moellmann's avatar
Gerd Moellmann committed
31

Dave Love's avatar
Dave Love committed
32 33
(require 'mm-util)
(eval-when-compile (defvar mm-use-ultra-safe-encoding))
34 35

(defun quoted-printable-decode-region (from to &optional coding-system)
Dave Love's avatar
Dave Love committed
36
  "Decode quoted-printable in the region between FROM and TO, per RFC 2045.
37 38
If CODING-SYSTEM is non-nil, decode bytes into characters with that
coding-system."
Gerd Moellmann's avatar
Gerd Moellmann committed
39
  (interactive "r")
40 41
  (unless (mm-coding-system-p coding-system) ; e.g. `ascii' from Gnus
    (setq coding-system nil))
Gerd Moellmann's avatar
Gerd Moellmann committed
42 43
  (save-excursion
    (save-restriction
44 45 46 47
      ;; RFC 2045:  ``An "=" followed by two hexadecimal digits, one
      ;; or both of which are lowercase letters in "abcdef", is
      ;; formally illegal. A robust implementation might choose to
      ;; recognize them as the corresponding uppercase letters.''
48
      (let ((case-fold-search t))
Gerd Moellmann's avatar
Gerd Moellmann committed
49
	(narrow-to-region from to)
50 51 52 53 54 55
	;; Do this in case we're called from Gnus, say, in a buffer
	;; which already contains non-ASCII characters which would
	;; then get doubly-decoded below.
	(if coding-system
	    (mm-encode-coding-region (point-min) (point-max) coding-system))
	(goto-char (point-min))
56
	(while (and (skip-chars-forward "^=")
Dave Love's avatar
Dave Love committed
57 58 59 60 61 62 63
		    (not (eobp)))
	  (cond ((eq (char-after (1+ (point))) ?\n)
		 (delete-char 2))
		((looking-at "=[0-9A-F][0-9A-F]")
		 (let ((byte (string-to-int (buffer-substring (1+ (point))
							      (+ 3 (point)))
					    16)))
64 65
		   (insert byte)
		   (delete-char 3)
Dave Love's avatar
Dave Love committed
66 67 68
		   (unless (eq byte ?=)
		     (backward-char))))
		(t
69
		 (error "Malformed quoted-printable text")
70 71 72
		 (forward-char)))))
      (if coding-system
	  (mm-decode-coding-region (point-min) (point-max) coding-system)))))
Gerd Moellmann's avatar
Gerd Moellmann committed
73

74
(defun quoted-printable-decode-string (string &optional coding-system)
Dave Love's avatar
Dave Love committed
75
  "Decode the quoted-printable encoded STRING and return the result.
76
If CODING-SYSTEM is non-nil, decode the region with coding-system."
Gerd Moellmann's avatar
Gerd Moellmann committed
77 78
  (with-temp-buffer
    (insert string)
79
    (quoted-printable-decode-region (point-min) (point-max) coding-system)
Gerd Moellmann's avatar
Gerd Moellmann committed
80 81 82
    (buffer-string)))

(defun quoted-printable-encode-region (from to &optional fold class)
Dave Love's avatar
Dave Love committed
83
  "Quoted-printable encode the region between FROM and TO per RFC 2045.
Gerd Moellmann's avatar
Gerd Moellmann committed
84

Dave Love's avatar
Dave Love committed
85
If FOLD, fold long lines at 76 characters (as required by the RFC).
86 87 88
If CLASS is non-nil, translate the characters not matched by that
regexp class, which is in the form expected by `skip-chars-forward'.
You should probably avoid non-ASCII characters in this arg.
Gerd Moellmann's avatar
Gerd Moellmann committed
89

Dave Love's avatar
Dave Love committed
90
If `mm-use-ultra-safe-encoding' is set, fold lines unconditionally and
Gerd Moellmann's avatar
Gerd Moellmann committed
91 92
encode lines starting with \"From\"."
  (interactive "r")
93 94 95 96 97 98 99
  ;; Fixme: what should this do in XEmacs/Mule?
  (if (fboundp 'find-charset-region)	; else XEmacs, non-Mule
      (if (delq 'unknown		; Emacs 20 unibyte
		(delq 'eight-bit-graphic ; Emacs 21
		      (delq 'eight-bit-control
			    (delq 'ascii (find-charset-region from to)))))
	  (error "Multibyte character in QP encoding region")))
Dave Love's avatar
Dave Love committed
100
  (unless class
101 102 103
    ;; Avoid using 8bit characters. = is \075.
    ;; Equivalent to "^\000-\007\013\015-\037\200-\377="
    (setq class "\010-\012\014\040-\074\076-\177"))
Gerd Moellmann's avatar
Gerd Moellmann committed
104 105 106
  (save-excursion
    (save-restriction
      (narrow-to-region from to)
107 108 109 110 111 112 113 114 115 116 117 118 119
      ;; Encode all the non-ascii and control characters.
      (goto-char (point-min))
      (while (and (skip-chars-forward class)
		  (not (eobp)))
	(insert
	 (prog1
	     (format "=%02X" (char-after))
	   (delete-char 1))))
      ;; Encode white space at the end of lines.
      (goto-char (point-min))
      (while (re-search-forward "[ \t]+$" nil t)
	(goto-char (match-beginning 0))
	(while (not (eolp))
Gerd Moellmann's avatar
Gerd Moellmann committed
120 121
	  (insert
	   (prog1
122 123 124 125 126 127 128 129 130 131 132 133 134 135 136
	       (format "=%02X" (char-after))
	     (delete-char 1))))
	;; Encode white space at the end of lines.
	(goto-char (point-min))
	(while (re-search-forward "[ \t]+$" nil t)
	  (goto-char (match-beginning 0))
	  (while (not (eolp))
	    (insert
	     (prog1
		 (format "=%02X" (char-after))
	       (delete-char 1)))))
	(let ((mm-use-ultra-safe-encoding
	       (and (boundp 'mm-use-ultra-safe-encoding)
		    mm-use-ultra-safe-encoding)))
	  (when (or fold mm-use-ultra-safe-encoding)
137
	    (let ((tab-width 1))	; HTAB is one character.
138 139 140 141 142 143 144 145 146 147
	      (goto-char (point-min))
	      (while (not (eobp))
		;; In ultra-safe mode, encode "From " at the beginning
		;; of a line.
		(when mm-use-ultra-safe-encoding
		  (if (looking-at "From ")
		      (replace-match "From=20" nil t)
		    (if (looking-at "-")
			(replace-match "=2D" nil t))))
		(end-of-line)
148 149 150 151 152 153 154 155
		;; Fold long lines.
		(while (> (current-column) 76) ; tab-width must be 1.
		  (beginning-of-line)
		  (forward-char 75)	; 75 chars plus an "="
		  (search-backward "=" (- (point) 2) t)
		  (insert "=\n")
		  (end-of-line))
		(forward-line)))))))))
Gerd Moellmann's avatar
Gerd Moellmann committed
156 157

(defun quoted-printable-encode-string (string)
Dave Love's avatar
Dave Love committed
158
  "Encode the STRING as quoted-printable and return the result."
159 160 161 162 163
  (let ((default-enable-multibyte-characters (mm-multibyte-string-p string)))
    (with-temp-buffer
      (insert string)
      (quoted-printable-encode-region (point-min) (point-max))
      (buffer-string))))
Gerd Moellmann's avatar
Gerd Moellmann committed
164 165 166

(provide 'qp)

Dave Love's avatar
Dave Love committed
167
;;; qp.el ends here