Mercurial > emacs
annotate lisp/gnus/qp.el @ 33067:adc6c04ffe30
*** empty log message ***
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Mon, 30 Oct 2000 15:21:36 +0000 |
parents | 651afe016895 |
children | 07dcbc7e702f |
rev | line source |
---|---|
31717 | 1 ;;; qp.el --- Quoted-Printable functions |
32103 | 2 |
31717 | 3 ;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. |
4 | |
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | |
32103 | 6 ;; Keywords: mail, extensions |
7 | |
31717 | 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 2, or (at your option) | |
13 ;; 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; see the file COPYING. If not, write to the | |
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 ;; Boston, MA 02111-1307, USA. | |
24 | |
25 ;;; Commentary: | |
26 | |
32103 | 27 ;; Functions for encoding and decoding quoted-printable text as |
28 ;; defined in RFC 2045. | |
29 | |
31717 | 30 ;;; Code: |
31 | |
32504 | 32 (require 'mm-util) |
33 (eval-when-compile (defvar mm-use-ultra-safe-encoding)) | |
32211
5b42e5f7e809
(mm-decode-coding-region, mm-encode-coding-region):
Dave Love <fx@gnu.org>
parents:
32107
diff
changeset
|
34 |
5b42e5f7e809
(mm-decode-coding-region, mm-encode-coding-region):
Dave Love <fx@gnu.org>
parents:
32107
diff
changeset
|
35 (defun quoted-printable-decode-region (from to &optional coding-system) |
32103 | 36 "Decode quoted-printable in the region between FROM and TO, per RFC 2045. |
32211
5b42e5f7e809
(mm-decode-coding-region, mm-encode-coding-region):
Dave Love <fx@gnu.org>
parents:
32107
diff
changeset
|
37 If CODING-SYSTEM is non-nil, decode bytes into characters with that |
5b42e5f7e809
(mm-decode-coding-region, mm-encode-coding-region):
Dave Love <fx@gnu.org>
parents:
32107
diff
changeset
|
38 coding-system." |
31717 | 39 (interactive "r") |
32462
7a39fdec7aac
(quoted-printable-decode-region): Avoid invalid
Dave Love <fx@gnu.org>
parents:
32211
diff
changeset
|
40 (unless (mm-coding-system-p coding-system) ; e.g. `ascii' from Gnus |
7a39fdec7aac
(quoted-printable-decode-region): Avoid invalid
Dave Love <fx@gnu.org>
parents:
32211
diff
changeset
|
41 (setq coding-system nil)) |
31717 | 42 (save-excursion |
43 (save-restriction | |
32462
7a39fdec7aac
(quoted-printable-decode-region): Avoid invalid
Dave Love <fx@gnu.org>
parents:
32211
diff
changeset
|
44 ;; RFC 2045: ``An "=" followed by two hexadecimal digits, one |
7a39fdec7aac
(quoted-printable-decode-region): Avoid invalid
Dave Love <fx@gnu.org>
parents:
32211
diff
changeset
|
45 ;; or both of which are lowercase letters in "abcdef", is |
7a39fdec7aac
(quoted-printable-decode-region): Avoid invalid
Dave Love <fx@gnu.org>
parents:
32211
diff
changeset
|
46 ;; formally illegal. A robust implementation might choose to |
7a39fdec7aac
(quoted-printable-decode-region): Avoid invalid
Dave Love <fx@gnu.org>
parents:
32211
diff
changeset
|
47 ;; recognize them as the corresponding uppercase letters.'' |
32211
5b42e5f7e809
(mm-decode-coding-region, mm-encode-coding-region):
Dave Love <fx@gnu.org>
parents:
32107
diff
changeset
|
48 (let ((case-fold-search t)) |
31717 | 49 (narrow-to-region from to) |
32211
5b42e5f7e809
(mm-decode-coding-region, mm-encode-coding-region):
Dave Love <fx@gnu.org>
parents:
32107
diff
changeset
|
50 ;; Do this in case we're called from Gnus, say, in a buffer |
5b42e5f7e809
(mm-decode-coding-region, mm-encode-coding-region):
Dave Love <fx@gnu.org>
parents:
32107
diff
changeset
|
51 ;; which already contains non-ASCII characters which would |
5b42e5f7e809
(mm-decode-coding-region, mm-encode-coding-region):
Dave Love <fx@gnu.org>
parents:
32107
diff
changeset
|
52 ;; then get doubly-decoded below. |
5b42e5f7e809
(mm-decode-coding-region, mm-encode-coding-region):
Dave Love <fx@gnu.org>
parents:
32107
diff
changeset
|
53 (if coding-system |
5b42e5f7e809
(mm-decode-coding-region, mm-encode-coding-region):
Dave Love <fx@gnu.org>
parents:
32107
diff
changeset
|
54 (mm-encode-coding-region (point-min) (point-max) coding-system)) |
5b42e5f7e809
(mm-decode-coding-region, mm-encode-coding-region):
Dave Love <fx@gnu.org>
parents:
32107
diff
changeset
|
55 (goto-char (point-min)) |
32103 | 56 (while (and (skip-chars-forward "^=" to) |
57 (not (eobp))) | |
58 (cond ((eq (char-after (1+ (point))) ?\n) | |
59 (delete-char 2)) | |
60 ((looking-at "=[0-9A-F][0-9A-F]") | |
61 (let ((byte (string-to-int (buffer-substring (1+ (point)) | |
62 (+ 3 (point))) | |
63 16))) | |
32211
5b42e5f7e809
(mm-decode-coding-region, mm-encode-coding-region):
Dave Love <fx@gnu.org>
parents:
32107
diff
changeset
|
64 (insert byte) |
5b42e5f7e809
(mm-decode-coding-region, mm-encode-coding-region):
Dave Love <fx@gnu.org>
parents:
32107
diff
changeset
|
65 (delete-char 3) |
32103 | 66 (unless (eq byte ?=) |
67 (backward-char)))) | |
68 (t | |
69 (message "Malformed MIME quoted-printable message") | |
32211
5b42e5f7e809
(mm-decode-coding-region, mm-encode-coding-region):
Dave Love <fx@gnu.org>
parents:
32107
diff
changeset
|
70 (forward-char))))) |
5b42e5f7e809
(mm-decode-coding-region, mm-encode-coding-region):
Dave Love <fx@gnu.org>
parents:
32107
diff
changeset
|
71 (if coding-system |
5b42e5f7e809
(mm-decode-coding-region, mm-encode-coding-region):
Dave Love <fx@gnu.org>
parents:
32107
diff
changeset
|
72 (mm-decode-coding-region (point-min) (point-max) coding-system))))) |
31717 | 73 |
32211
5b42e5f7e809
(mm-decode-coding-region, mm-encode-coding-region):
Dave Love <fx@gnu.org>
parents:
32107
diff
changeset
|
74 (defun quoted-printable-decode-string (string &optional coding-system) |
32103 | 75 "Decode the quoted-printable encoded STRING and return the result. |
32211
5b42e5f7e809
(mm-decode-coding-region, mm-encode-coding-region):
Dave Love <fx@gnu.org>
parents:
32107
diff
changeset
|
76 If CODING-SYSTEM is non-nil, decode the region with coding-system." |
31717 | 77 (with-temp-buffer |
78 (insert string) | |
32211
5b42e5f7e809
(mm-decode-coding-region, mm-encode-coding-region):
Dave Love <fx@gnu.org>
parents:
32107
diff
changeset
|
79 (quoted-printable-decode-region (point-min) (point-max) coding-system) |
31717 | 80 (buffer-string))) |
81 | |
82 (defun quoted-printable-encode-region (from to &optional fold class) | |
32103 | 83 "Quoted-printable encode the region between FROM and TO per RFC 2045. |
31717 | 84 |
32103 | 85 If FOLD, fold long lines at 76 characters (as required by the RFC). |
86 If CLASS is non-nil, translate the characters matched by that class in | |
87 the form expected by `skip-chars-forward'. | |
31717 | 88 |
32103 | 89 If `mm-use-ultra-safe-encoding' is set, fold lines unconditionally and |
31717 | 90 encode lines starting with \"From\"." |
91 (interactive "r") | |
32107
31d231ad0b91
(quoted-printable-encode-region): Don't use mm-find-charset-region.
Dave Love <fx@gnu.org>
parents:
32103
diff
changeset
|
92 ;; Fixme: what should this do in XEmacs/Mule? |
31d231ad0b91
(quoted-printable-encode-region): Don't use mm-find-charset-region.
Dave Love <fx@gnu.org>
parents:
32103
diff
changeset
|
93 (if (fboundp 'find-charset-region) ; else XEmacs, non-Mule |
31d231ad0b91
(quoted-printable-encode-region): Don't use mm-find-charset-region.
Dave Love <fx@gnu.org>
parents:
32103
diff
changeset
|
94 (if (delq 'unknown ; Emacs 20 unibyte |
31d231ad0b91
(quoted-printable-encode-region): Don't use mm-find-charset-region.
Dave Love <fx@gnu.org>
parents:
32103
diff
changeset
|
95 (delq 'eight-bit-graphic ; Emacs 21 |
31d231ad0b91
(quoted-printable-encode-region): Don't use mm-find-charset-region.
Dave Love <fx@gnu.org>
parents:
32103
diff
changeset
|
96 (delq 'eight-bit-control |
31d231ad0b91
(quoted-printable-encode-region): Don't use mm-find-charset-region.
Dave Love <fx@gnu.org>
parents:
32103
diff
changeset
|
97 (delq 'ascii (find-charset-region from to))))) |
31d231ad0b91
(quoted-printable-encode-region): Don't use mm-find-charset-region.
Dave Love <fx@gnu.org>
parents:
32103
diff
changeset
|
98 (error "Multibyte character in QP encoding region"))) |
32103 | 99 (unless class |
100 (setq class "^\000-\007\013\015-\037\200-\377=")) | |
101 (if (fboundp 'string-as-multibyte) | |
102 (setq class (string-as-multibyte class))) | |
31717 | 103 (save-excursion |
104 (save-restriction | |
105 (narrow-to-region from to) | |
106 ;; Encode all the non-ascii and control characters. | |
107 (goto-char (point-min)) | |
32103 | 108 (while (and (skip-chars-forward class) |
31717 | 109 (not (eobp))) |
110 (insert | |
111 (prog1 | |
32103 | 112 (format "=%02x" (upcase (char-after))) |
31717 | 113 (delete-char 1)))) |
114 ;; Encode white space at the end of lines. | |
115 (goto-char (point-min)) | |
116 (while (re-search-forward "[ \t]+$" nil t) | |
117 (goto-char (match-beginning 0)) | |
118 (while (not (eolp)) | |
119 (insert | |
120 (prog1 | |
32103 | 121 (format "=%02x" (upcase (char-after))) |
31717 | 122 (delete-char 1))))) |
32103 | 123 (let ((mm-use-ultra-safe-encoding |
124 (and (boundp 'mm-use-ultra-safe-encoding) | |
125 mm-use-ultra-safe-encoding))) | |
126 (when (or fold mm-use-ultra-safe-encoding) | |
127 ;; Fold long lines. | |
128 (let ((tab-width 1)) ; HTAB is one character. | |
129 (goto-char (point-min)) | |
130 (while (not (eobp)) | |
131 ;; In ultra-safe mode, encode "From " at the beginning | |
132 ;; of a line. | |
133 (when mm-use-ultra-safe-encoding | |
134 (beginning-of-line) | |
135 (when (looking-at "From ") | |
136 (replace-match "From=20" nil t))) | |
137 (end-of-line) | |
138 (while (> (current-column) 76) ; tab-width must be 1. | |
139 (beginning-of-line) | |
140 (forward-char 75) ; 75 chars plus an "=" | |
141 (search-backward "=" (- (point) 2) t) | |
142 (insert "=\n") | |
143 (end-of-line)) | |
144 (unless (eobp) | |
145 (forward-line))))))))) | |
31717 | 146 |
147 (defun quoted-printable-encode-string (string) | |
32103 | 148 "Encode the STRING as quoted-printable and return the result." |
149 (with-temp-buffer | |
31717 | 150 (insert string) |
151 (quoted-printable-encode-region (point-min) (point-max)) | |
152 (buffer-string))) | |
153 | |
154 (provide 'qp) | |
155 | |
32103 | 156 ;;; qp.el ends here |