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