1 ;;; mel-q.el --- Quoted-Printable encoder/decoder.
3 ;; Copyright (C) 1995,96,97,98,99,2000,2001 Free Software Foundation, Inc.
5 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
7 ;; Keywords: MIME, Quoted-Printable, Q-encoding
9 ;; This file is part of FLIM (Faithful Library about Internet Message).
11 ;; This program is free software; you can redistribute it and/or
12 ;; modify it under the terms of the GNU General Public License as
13 ;; published by the Free Software Foundation; either version 2, or (at
14 ;; your option) any later version.
16 ;; This program is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with this program; 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.
31 ;; XXX: should provide char-list instead of string-to-char-list.
32 ;; XXx: and also the macro `as-binary-process' should be provided
33 ;; XXx: by the module "pces" which will be loaded by way of "poem".
37 ;;; @ Quoted-Printable encoder
40 (defsubst quoted-printable-quote-char (character)
43 (char-to-string (aref quoted-printable-hex-chars
44 (ash (logand character 255) -4)))
45 (char-to-string (aref quoted-printable-hex-chars (logand character 15)))))
47 (defun quoted-printable-internal-encode-region (start end)
50 (narrow-to-region (goto-char start) end)
55 ((>= col 75) ; soft line break.
58 ((eolp) ; end of line.
62 (setq chr (logand (char-after (point)) 255))
64 ((and (memq chr '(? ?\t)) ; encode WSP char before CRLF.
65 (eq (char-after (1+ (point))) ?\n))
70 ((and (bolp) ; "^From " is not safe.
72 (eq (char-after (1+ (point))) ?r)
73 (eq (char-after (+ 2 (point))) ?o)
74 (eq (char-after (+ 3 (point))) ?m)
75 (eq (char-after (+ 4 (point))) ? ))
76 (delete-region (point)(1+ (point)))
77 (insert "=46") ; moved to ?r.
78 (forward-char 4) ; skip "rom ".
80 ((or (= chr ?\t) ; skip safe char.
81 (and (<= 32 chr)(/= chr ?=)(< chr 127)))
84 ((>= col 73) ; soft line break.
87 (t ; encode unsafe char.
88 (delete-region (point)(1+ (point)))
89 ;; (insert (quoted-printable-quote-char chr))
92 (aref quoted-printable-hex-chars (ash chr -4))
93 (aref quoted-printable-hex-chars (logand chr 15)))
94 (setq col (+ col 3)))))))))))
97 (defvar quoted-printable-external-encoder '("mmencode" "-q")
98 "*list of quoted-printable encoder program name and its arguments.")
100 (defun quoted-printable-external-encode-region (start end)
103 (narrow-to-region start end)
105 (apply (function call-process-region)
106 start end (car quoted-printable-external-encoder)
108 (cdr quoted-printable-external-encoder)))
110 ;; regularize line break code
111 (goto-char (point-min))
112 (while (re-search-forward "\r$" nil t)
113 (replace-match "")))))
116 (defvar quoted-printable-internal-encoding-limit
117 (if (and (featurep 'xemacs)(featurep 'mule))
120 (if (exec-installed-p "mmencode")
122 ;; XXX: Fix this message, or simply remove it.
123 ;; (message "Don't found external encoder for Quoted-Printable!")
125 "*limit size to use internal quoted-printable encoder.
126 If size of input to encode is larger than this limit,
127 external encoder is called.")
129 (defun quoted-printable-encode-region (start end)
130 "Encode current region by quoted-printable.
131 START and END are buffer positions.
132 This function calls internal quoted-printable encoder if size of
133 region is smaller than `quoted-printable-internal-encoding-limit',
134 otherwise it calls external quoted-printable encoder specified by
135 `quoted-printable-external-encoder'. In this case, you must install
136 the program (maybe mmencode included in metamail or XEmacs package)."
138 (if (and quoted-printable-internal-encoding-limit
139 (> (- end start) quoted-printable-internal-encoding-limit))
140 (quoted-printable-external-encode-region start end)
141 (quoted-printable-internal-encode-region start end)))
143 (defun quoted-printable-encode-string (string)
144 "Encode STRING to quoted-printable, and return the result."
147 (quoted-printable-encode-region (point-min)(point-max))
151 (mel-define-method-function
152 (mime-encode-string string (nil "quoted-printable"))
153 'quoted-printable-encode-string)
155 (mel-define-method-function
156 (mime-encode-region start end (nil "quoted-printable"))
157 'quoted-printable-encode-region)
159 (mel-define-method mime-insert-encoded-file (filename (nil "quoted-printable"))
160 "Encode contents of file FILENAME to quoted-printable, and insert the result.
161 It calls external quoted-printable encoder specified by
162 `quoted-printable-external-encoder'. So you must install the program
163 \(maybe mmencode included in metamail or XEmacs package)."
164 (interactive "*fInsert encoded file: ")
165 (apply (function call-process)
166 (car quoted-printable-external-encoder)
168 (cdr quoted-printable-external-encoder)))
171 ;;; @ Quoted-Printable decoder
174 (defsubst quoted-printable-hex-char-to-num (chr)
175 (cond ((<= ?a chr) (+ (- chr ?a) 10))
176 ((<= ?A chr) (+ (- chr ?A) 10))
177 ((<= ?0 chr) (- chr ?0))
180 (defun quoted-printable-internal-decode-region (start end)
183 (narrow-to-region start end)
184 (goto-char (point-min))
185 (while (search-forward "=" nil t)
188 ;; unfold soft line break.
189 (delete-region (1- (point))(1+ (point))))
190 ((and (memq (char-after (point))
192 ;; XXX: should provide char-list instead.
193 (string-to-char-list quoted-printable-hex-chars)))
194 (memq (char-after (1+ (point)))
196 ;; XXX: should provide char-list instead.
197 (string-to-char-list quoted-printable-hex-chars))))
202 (ash (quoted-printable-hex-char-to-num (char-after (point))) 4)
203 (quoted-printable-hex-char-to-num (char-after (1+ (point)))))
204 (delete-region (1- (point))(+ 2 (point))))))
209 (defvar quoted-printable-external-decoder '("mmencode" "-q" "-u")
210 "*list of quoted-printable decoder program name and its arguments.")
212 (defun quoted-printable-external-decode-region (start end)
215 (apply (function call-process-region)
216 start end (car quoted-printable-external-decoder)
218 (cdr quoted-printable-external-decoder)))))
221 (defvar quoted-printable-internal-decoding-limit nil
222 "*limit size to use internal quoted-printable decoder.
223 If size of input to decode is larger than this limit,
224 external decoder is called.")
226 (defun quoted-printable-decode-region (start end)
227 "Decode current region by quoted-printable.
228 START and END are buffer positions.
229 This function calls internal quoted-printable decoder if size of
230 region is smaller than `quoted-printable-internal-decoding-limit',
231 otherwise it calls external quoted-printable decoder specified by
232 `quoted-printable-external-decoder'. In this case, you must install
233 the program (maybe mmencode included in metamail or XEmacs package)."
235 (if (and quoted-printable-internal-decoding-limit
236 (> (- end start) quoted-printable-internal-decoding-limit))
237 (quoted-printable-external-decode-region start end)
238 (quoted-printable-internal-decode-region start end)))
240 (defun quoted-printable-decode-string (string)
241 "Decode STRING which is encoded in quoted-printable, and return the result."
244 (quoted-printable-decode-region (point-min)(point-max))
248 (mel-define-method-function
249 (mime-decode-string string (nil "quoted-printable"))
250 'quoted-printable-decode-string)
252 (mel-define-method-function
253 (mime-decode-region start end (nil "quoted-printable"))
254 'quoted-printable-decode-region)
257 (defvar quoted-printable-external-decoder-option-to-specify-file '("-o")
258 "*list of options of quoted-printable decoder program to specify file.
259 If the quoted-printable decoder does not have such option, set this as nil.")
261 (mel-define-method mime-write-decoded-region (start end filename
262 (nil "quoted-printable"))
263 "Decode and write current region encoded by quoted-printable into FILENAME.
264 START and END are buffer positions."
265 (interactive "*r\nFWrite decoded region to file: ")
267 (apply (function call-process-region)
268 start end (car quoted-printable-external-decoder)
269 (null quoted-printable-external-decoder-option-to-specify-file)
270 (unless quoted-printable-external-decoder-option-to-specify-file
271 (list (current-buffer) nil))
275 (cdr quoted-printable-external-decoder)
276 quoted-printable-external-decoder-option-to-specify-file
277 (when quoted-printable-external-decoder-option-to-specify-file
279 (unless quoted-printable-external-decoder-option-to-specify-file
280 (write-region-as-binary (point-min) (point-max) filename)))
283 ;;; @ Q-encoding encode/decode string
286 (defconst q-encoding-special-chars-alist
288 (comment ?= ?? ?_ ?\( ?\) ?\\)
289 (phrase ?= ?? ?_ ?\( ?\) ?\\ ?\" ?# ?$ ?% ?& ?' ?, ?. ?/
290 ?: ?\; ?< ?> ?@ ?\[ ?\] ?^ ?` ?{ ?| ?} ?~)
293 (defun q-encoding-encode-string (string &optional mode)
294 "Encode STRING to Q-encoding of encoded-word, and return the result.
295 MODE allows `text', `comment', `phrase' or nil. Default value is
297 (let ((specials (cdr (or (assq mode q-encoding-special-chars-alist)
298 (assq 'phrase q-encoding-special-chars-alist)))))
301 (cond ((eq chr ? ) "_")
302 ((or (< chr 32) (< 126 chr)
304 (quoted-printable-quote-char chr))
306 (char-to-string chr)))))
309 (defun q-encoding-decode-string (string)
310 "Decode STRING which is encoded in Q-encoding and return the result."
314 (cond ((eq chr ?_) " ")
318 (q (setq h (quoted-printable-hex-char-to-num chr))
321 (h (setq l (quoted-printable-hex-char-to-num chr))
323 (char-to-string (logior (ash h 4) l))
325 (t (char-to-string chr)))))
328 (mel-define-method-function (encoded-text-encode-string string (nil "Q"))
329 'q-encoding-encode-string)
331 (mel-define-method encoded-text-decode-string (string (nil "Q"))
332 (if (string-match (eval-when-compile
333 (concat "\\`" Q-encoded-text-regexp "\\'"))
335 (q-encoding-decode-string string)
336 (error "Invalid encoded-text %s" string)))
344 ;;; mel-q.el ends here.