1 ;;; mel-q.el --- Quoted-Printable encoder/decoder.
3 ;; Copyright (C) 1995,1996,1997,1998,1999 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., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
32 ;;; @ Quoted-Printable encoder
35 (defsubst quoted-printable-quote-char (character)
38 (char-to-string (aref quoted-printable-hex-chars (ash character -4)))
39 (char-to-string (aref quoted-printable-hex-chars (logand character 15)))))
41 (defun quoted-printable-internal-encode-region (start end)
44 (narrow-to-region (goto-char start) end)
49 ((>= col 75) ; soft line break.
52 ((eolp) ; end of line.
56 (setq chr (char-after (point)))
58 ((and (memq chr '(? ?\t)) ; encode WSP char before CRLF.
59 (eq (char-after (1+ (point))) ?\n))
64 ((and (bolp) ; "^From " is not safe.
66 (eq (char-after (1+ (point))) ?r)
67 (eq (char-after (+ 2 (point))) ?o)
68 (eq (char-after (+ 3 (point))) ?m)
69 (eq (char-after (+ 4 (point))) ? ))
70 (delete-region (point)(1+ (point)))
71 (insert "=46") ; moved to ?r.
72 (forward-char 4) ; skip "rom ".
74 ((or (= chr ?\t) ; skip safe char.
75 (and (<= 32 chr)(/= chr ?=)(< chr 127)))
78 ((>= col 73) ; soft line break.
81 (t ; encode unsafe char.
82 (delete-region (point)(1+ (point)))
83 ;; (insert (quoted-printable-quote-char chr))
86 (aref quoted-printable-hex-chars (ash chr -4))
87 (aref quoted-printable-hex-chars (logand chr 15)))
88 (setq col (+ col 3)))))))))))
91 (defvar quoted-printable-external-encoder '("mmencode" "-q")
92 "*list of quoted-printable encoder program name and its arguments.")
94 (defun quoted-printable-external-encode-region (start end)
97 (narrow-to-region start end)
99 (apply (function call-process-region)
100 start end (car quoted-printable-external-encoder)
102 (cdr quoted-printable-external-encoder)))
104 ;; regularize line break code
105 (goto-char (point-min))
106 (while (re-search-forward "\r$" nil t)
107 (replace-match "")))))
110 (defvar quoted-printable-internal-encoding-limit
111 (if (and (featurep 'xemacs)(featurep 'mule))
114 (if (exec-installed-p "mmencode")
116 ;; XXX: Fix this message, or simply remove it.
117 ;; (message "Don't found external encoder for Quoted-Printable!")
119 "*limit size to use internal quoted-printable encoder.
120 If size of input to encode is larger than this limit,
121 external encoder is called.")
123 (defun quoted-printable-encode-region (start end)
124 "Encode current region by quoted-printable.
125 START and END are buffer positions.
126 This function calls internal quoted-printable encoder if size of
127 region is smaller than `quoted-printable-internal-encoding-limit',
128 otherwise it calls external quoted-printable encoder specified by
129 `quoted-printable-external-encoder'. In this case, you must install
130 the program (maybe mmencode included in metamail or XEmacs package)."
132 (if (and quoted-printable-internal-encoding-limit
133 (> (- end start) quoted-printable-internal-encoding-limit))
134 (quoted-printable-external-encode-region start end)
135 (quoted-printable-internal-encode-region start end)))
137 (defun quoted-printable-encode-string (string)
138 "Encode STRING to quoted-printable, and return the result."
141 (quoted-printable-encode-region (point-min)(point-max))
145 (mel-define-method-function
146 (mime-encode-string string (nil "quoted-printable"))
147 'quoted-printable-encode-string)
149 (mel-define-method-function
150 (mime-encode-region start end (nil "quoted-printable"))
151 'quoted-printable-encode-region)
153 (mel-define-method mime-insert-encoded-file (filename (nil "quoted-printable"))
154 "Encode contents of file FILENAME to quoted-printable, and insert the result.
155 It calls external quoted-printable encoder specified by
156 `quoted-printable-external-encoder'. So you must install the program
157 \(maybe mmencode included in metamail or XEmacs package)."
158 (interactive "*fInsert encoded file: ")
159 (apply (function call-process)
160 (car quoted-printable-external-encoder)
162 (cdr quoted-printable-external-encoder)))
165 ;;; @ Quoted-Printable decoder
168 (defsubst quoted-printable-hex-char-to-num (chr)
169 (cond ((<= ?a chr) (+ (- chr ?a) 10))
170 ((<= ?A chr) (+ (- chr ?A) 10))
171 ((<= ?0 chr) (- chr ?0))
174 (defun quoted-printable-internal-decode-region (start end)
177 (narrow-to-region start end)
178 (goto-char (point-min))
179 (while (search-forward "=" nil t)
182 ;; unfold soft line break.
183 (delete-region (1- (point))(1+ (point))))
184 ((and (memq (char-after (point))
186 ;; XXX: should provide char-list instead.
187 (string-to-char-list quoted-printable-hex-chars)))
188 (memq (char-after (1+ (point)))
190 ;; XXX: should provide char-list instead.
191 (string-to-char-list quoted-printable-hex-chars))))
196 (ash (quoted-printable-hex-char-to-num (char-after (point))) 4)
197 (quoted-printable-hex-char-to-num (char-after (1+ (point)))))
198 (delete-region (1- (point))(+ 2 (point))))))
203 (defvar quoted-printable-external-decoder '("mmencode" "-q" "-u")
204 "*list of quoted-printable decoder program name and its arguments.")
206 (defun quoted-printable-external-decode-region (start end)
209 (apply (function call-process-region)
210 start end (car quoted-printable-external-decoder)
212 (cdr quoted-printable-external-decoder)))))
215 (defvar quoted-printable-internal-decoding-limit nil
216 "*limit size to use internal quoted-printable decoder.
217 If size of input to decode is larger than this limit,
218 external decoder is called.")
220 (defun quoted-printable-decode-region (start end)
221 "Decode current region by quoted-printable.
222 START and END are buffer positions.
223 This function calls internal quoted-printable decoder if size of
224 region is smaller than `quoted-printable-internal-decoding-limit',
225 otherwise it calls external quoted-printable decoder specified by
226 `quoted-printable-external-decoder'. In this case, you must install
227 the program (maybe mmencode included in metamail or XEmacs package)."
229 (if (and quoted-printable-internal-decoding-limit
230 (> (- end start) quoted-printable-internal-decoding-limit))
231 (quoted-printable-external-decode-region start end)
232 (quoted-printable-internal-decode-region start end)))
234 (defun quoted-printable-decode-string (string)
235 "Decode STRING which is encoded in quoted-printable, and return the result."
238 (quoted-printable-decode-region (point-min)(point-max))
242 (mel-define-method-function
243 (mime-decode-string string (nil "quoted-printable"))
244 'quoted-printable-decode-string)
246 (mel-define-method-function
247 (mime-decode-region start end (nil "quoted-printable"))
248 'quoted-printable-decode-region)
251 (defvar quoted-printable-external-decoder-option-to-specify-file '("-o")
252 "*list of options of quoted-printable decoder program to specify file.")
254 (mel-define-method mime-write-decoded-region (start end filename
255 (nil "quoted-printable"))
256 "Decode and write current region encoded by quoted-printable into FILENAME.
257 START and END are buffer positions."
258 (interactive "*r\nFWrite decoded region to file: ")
260 (apply (function call-process-region)
261 start end (car quoted-printable-external-decoder)
263 (append (cdr quoted-printable-external-decoder)
264 quoted-printable-external-decoder-option-to-specify-file
268 ;;; @ Q-encoding encode/decode string
271 (defconst q-encoding-special-chars-alist
273 (comment ?= ?? ?_ ?\( ?\) ?\\)
274 (phrase ?= ?? ?_ ?\( ?\) ?\\ ?\" ?# ?$ ?% ?& ?' ?, ?. ?/
275 ?: ?\; ?< ?> ?@ ?\[ ?\] ?^ ?` ?{ ?| ?} ?~)
278 (defun q-encoding-encode-string (string &optional mode)
279 "Encode STRING to Q-encoding of encoded-word, and return the result.
280 MODE allows `text', `comment', `phrase' or nil. Default value is
282 (let ((specials (cdr (or (assq mode q-encoding-special-chars-alist)
283 (assq 'phrase q-encoding-special-chars-alist)))))
286 (cond ((eq chr ? ) "_")
287 ((or (< chr 32) (< 126 chr)
289 (quoted-printable-quote-char chr))
291 (char-to-string chr)))))
294 (defun q-encoding-decode-string (string)
295 "Decode STRING which is encoded in Q-encoding and return the result."
299 (cond ((eq chr ?_) " ")
303 (q (setq h (quoted-printable-hex-char-to-num chr))
306 (h (setq l (quoted-printable-hex-char-to-num chr))
308 (char-to-string (logior (ash h 4) l))
310 (t (char-to-string chr)))))
313 (mel-define-method-function (encoded-text-encode-string string (nil "Q"))
314 'q-encoding-encode-string)
316 (mel-define-method encoded-text-decode-string (string (nil "Q"))
317 (if (string-match (eval-when-compile
318 (concat "\\`" Q-encoded-text-regexp "\\'"))
320 (q-encoding-decode-string string)
321 (error "Invalid encoded-text %s" string)))
329 ;;; mel-q.el ends here.