d7ed30d374943e3605db2858a3e53ba000131755
[gnus] / lisp / qp.el
1 ;;; qp.el --- Quoted-Printable functions
2
3 ;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
4
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6 ;; Keywords: mail, extensions
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
22
23 ;;; Commentary:
24
25 ;; Functions for encoding and decoding quoted-printable text as
26 ;; defined in RFC 2045.
27
28 ;;; Code:
29
30 (require 'mm-util)
31 (defvar mm-use-ultra-safe-encoding)
32
33 ;;;###autoload
34 (defun quoted-printable-decode-region (from to &optional coding-system)
35   "Decode quoted-printable in the region between FROM and TO, per RFC 2045.
36 If CODING-SYSTEM is non-nil, decode bytes into characters with that
37 coding-system.
38
39 Interactively, you can supply the CODING-SYSTEM argument
40 with \\[universal-coding-system-argument].
41
42 The CODING-SYSTEM argument is a historical hangover and is deprecated.
43 QP encodes raw bytes and should be decoded into raw bytes.  Decoding
44 them into characters should be done separately."
45   (interactive
46    ;; Let the user determine the coding system with "C-x RET c".
47    (list (region-beginning) (region-end) coding-system-for-read))
48   (unless (mm-coding-system-p coding-system) ; e.g. `ascii' from Gnus
49     (setq coding-system nil))
50   (save-excursion
51     (save-restriction
52       ;; RFC 2045:  ``An "=" followed by two hexadecimal digits, one
53       ;; or both of which are lowercase letters in "abcdef", is
54       ;; formally illegal. A robust implementation might choose to
55       ;; recognize them as the corresponding uppercase letters.''
56       (let ((case-fold-search t))
57         (narrow-to-region from to)
58         ;; Do this in case we're called from Gnus, say, in a buffer
59         ;; which already contains non-ASCII characters which would
60         ;; then get doubly-decoded below.
61         (if coding-system
62             (mm-encode-coding-region (point-min) (point-max) coding-system))
63         (goto-char (point-min))
64         (while (and (skip-chars-forward "^=")
65                     (not (eobp)))
66           (cond ((eq (char-after (1+ (point))) ?\n)
67                  (delete-char 2))
68                 ((looking-at "\\(=[0-9A-F][0-9A-F]\\)+")
69                  ;; Decode this sequence at once; i.e. by a single
70                  ;; deletion and insertion.
71                  (let* ((n (/ (- (match-end 0) (point)) 3))
72                         (str (make-string n 0)))
73                    (dotimes (i n)
74                      (let ((n1 (char-after (1+ (point))))
75                            (n2 (char-after (+ 2 (point)))))
76                        (aset str i
77                              (+ (* 16 (- n1 (if (<= n1 ?9) ?0
78                                               (if (<= n1 ?F) (- ?A 10)
79                                                 (- ?a 10)))))
80                                 (- n2 (if (<= n2 ?9) ?0
81                                         (if (<= n2 ?F) (- ?A 10)
82                                           (- ?a 10)))))))
83                      (forward-char 3))
84                    (delete-region (match-beginning 0) (match-end 0))
85                    (insert str)))
86                 (t
87                  (message "Malformed quoted-printable text")
88                  (forward-char)))))
89       (if coding-system
90           (mm-decode-coding-region (point-min) (point-max) coding-system)))))
91
92 (defun quoted-printable-decode-string (string &optional coding-system)
93   "Decode the quoted-printable encoded STRING and return the result.
94 If CODING-SYSTEM is non-nil, decode the string with coding-system.
95 Use of CODING-SYSTEM is deprecated; this function should deal with
96 raw bytes, and coding conversion should be done separately."
97   (mm-with-unibyte-buffer
98     (insert string)
99     (quoted-printable-decode-region (point-min) (point-max) coding-system)
100     (buffer-string)))
101
102 (defun quoted-printable-encode-region (from to &optional fold class)
103   "Quoted-printable encode the region between FROM and TO per RFC 2045.
104
105 If FOLD, fold long lines at 76 characters (as required by the RFC).
106 If CLASS is non-nil, translate the characters not matched by that
107 regexp class, which is in the form expected by `skip-chars-forward'.
108 You should probably avoid non-ASCII characters in this arg.
109
110 If `mm-use-ultra-safe-encoding' is set, fold lines unconditionally and
111 encode lines starting with \"From\"."
112   (interactive "r")
113   (unless class
114     ;; Avoid using 8bit characters. = is \075.
115     ;; Equivalent to "^\000-\007\013\015-\037\200-\377="
116     (setq class "\010-\012\014\040-\074\076-\177"))
117   (save-excursion
118     (goto-char from)
119     (if (re-search-forward (mm-string-to-multibyte "[^\x0-\x7f\x80-\xff]")
120                            to t)
121         (error "Multibyte character in QP encoding region"))
122     (save-restriction
123       (narrow-to-region from to)
124       ;; Encode all the non-ascii and control characters.
125       (goto-char (point-min))
126       (while (and (skip-chars-forward class)
127                   (not (eobp)))
128         (insert
129          (prog1
130              ;; To unibyte in case of Emacs 23 (unicode) eight-bit.
131              (format "=%02X" (mm-multibyte-char-to-unibyte (char-after)))
132            (delete-char 1))))
133       ;; Encode white space at the end of lines.
134       (goto-char (point-min))
135       (while (re-search-forward "[ \t]+$" nil t)
136         (goto-char (match-beginning 0))
137         (while (not (eolp))
138           (insert
139            (prog1
140                (format "=%02X" (char-after))
141              (delete-char 1)))))
142       (let ((mm-use-ultra-safe-encoding
143              (and (boundp 'mm-use-ultra-safe-encoding)
144                   mm-use-ultra-safe-encoding)))
145         (when (or fold mm-use-ultra-safe-encoding)
146           (let ((tab-width 1)           ; HTAB is one character.
147                 (case-fold-search nil))
148             (goto-char (point-min))
149             (while (not (eobp))
150               ;; In ultra-safe mode, encode "From " at the beginning
151               ;; of a line.
152               (when mm-use-ultra-safe-encoding
153                 (if (looking-at "From ")
154                     (replace-match "From=20" nil t)
155                   (if (looking-at "-")
156                       (replace-match "=2D" nil t))))
157               (end-of-line)
158               ;; Fold long lines.
159               (while (> (current-column) 76) ; tab-width must be 1.
160                 (beginning-of-line)
161                 (forward-char 75)       ; 75 chars plus an "="
162                 (search-backward "=" (- (point) 2) t)
163                 (insert "=\n")
164                 (end-of-line))
165               (forward-line))))))))
166
167 (defun quoted-printable-encode-string (string)
168   "Encode the STRING as quoted-printable and return the result."
169   (with-temp-buffer
170     (if (mm-multibyte-string-p string)
171         (mm-enable-multibyte)
172       (mm-disable-multibyte))
173     (insert string)
174     (quoted-printable-encode-region (point-min) (point-max))
175     (buffer-string)))
176
177 (provide 'qp)
178
179 ;;; qp.el ends here