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.
31 ;; XXX: should provide char-list instead of string-to-char-list.
34 ;;; @ Quoted-Printable encoder
37 (defsubst quoted-printable-quote-char (character)
40 (char-to-string (aref quoted-printable-hex-chars (ash character -4)))
41 (char-to-string (aref quoted-printable-hex-chars (logand character 15)))))
43 (defun quoted-printable-internal-encode-region (start end)
46 (narrow-to-region (goto-char start) end)
51 ((>= col 75) ; soft line break.
54 ((eolp) ; end of line.
58 (setq chr (char-after (point)))
60 ((and (memq chr '(? ?\t)) ; encode WSP char before CRLF.
61 (eq (char-after (1+ (point))) ?\n))
66 ((and (bolp) ; "^From " is not safe.
68 (eq (char-after (1+ (point))) ?r)
69 (eq (char-after (+ 2 (point))) ?o)
70 (eq (char-after (+ 3 (point))) ?m)
71 (eq (char-after (+ 4 (point))) ? ))
72 (delete-region (point)(1+ (point)))
73 (insert "=46") ; moved to ?r.
74 (forward-char 4) ; skip "rom ".
76 ((or (= chr ?\t) ; skip safe char.
77 (and (<= 32 chr)(/= chr ?=)(< chr 127)))
80 ((>= col 73) ; soft line break.
83 (t ; encode unsafe char.
84 (delete-region (point)(1+ (point)))
85 ;; (insert (quoted-printable-quote-char chr))
88 (aref quoted-printable-hex-chars (ash chr -4))
89 (aref quoted-printable-hex-chars (logand chr 15)))
90 (setq col (+ col 3)))))))))))
93 (defvar quoted-printable-external-encoder '("mmencode" "-q")
94 "*list of quoted-printable encoder program name and its arguments.")
96 (defun quoted-printable-external-encode-region (start end)
99 (narrow-to-region start end)
101 (apply (function call-process-region)
102 start end (car quoted-printable-external-encoder)
104 (cdr quoted-printable-external-encoder)))
106 ;; regularize line break code
107 (goto-char (point-min))
108 (while (re-search-forward "\r$" nil t)
109 (replace-match "")))))
112 (defvar quoted-printable-internal-encoding-limit
113 (if (and (featurep 'xemacs)(featurep 'mule))
116 (if (exec-installed-p "mmencode")
118 ;; XXX: Fix this message, or simply remove it.
119 ;; (message "Don't found external encoder for Quoted-Printable!")
121 "*limit size to use internal quoted-printable encoder.
122 If size of input to encode is larger than this limit,
123 external encoder is called.")
125 (defun quoted-printable-encode-region (start end)
126 "Encode current region by quoted-printable.
127 START and END are buffer positions.
128 This function calls internal quoted-printable encoder if size of
129 region is smaller than `quoted-printable-internal-encoding-limit',
130 otherwise it calls external quoted-printable encoder specified by
131 `quoted-printable-external-encoder'. In this case, you must install
132 the program (maybe mmencode included in metamail or XEmacs package)."
134 (if (and quoted-printable-internal-encoding-limit
135 (> (- end start) quoted-printable-internal-encoding-limit))
136 (quoted-printable-external-encode-region start end)
137 (quoted-printable-internal-encode-region start end)))
139 (defun quoted-printable-encode-string (string)
140 "Encode STRING to quoted-printable, and return the result."
143 (quoted-printable-encode-region (point-min)(point-max))
147 (mel-define-method-function
148 (mime-encode-string string (nil "quoted-printable"))
149 'quoted-printable-encode-string)
151 (mel-define-method-function
152 (mime-encode-region start end (nil "quoted-printable"))
153 'quoted-printable-encode-region)
155 (mel-define-method mime-insert-encoded-file (filename (nil "quoted-printable"))
156 "Encode contents of file FILENAME to quoted-printable, and insert the result.
157 It calls external quoted-printable encoder specified by
158 `quoted-printable-external-encoder'. So you must install the program
159 \(maybe mmencode included in metamail or XEmacs package)."
160 (interactive "*fInsert encoded file: ")
161 (apply (function call-process)
162 (car quoted-printable-external-encoder)
164 (cdr quoted-printable-external-encoder)))
167 ;;; @ Quoted-Printable decoder
170 (defsubst quoted-printable-hex-char-to-num (chr)
171 (cond ((<= ?a chr) (+ (- chr ?a) 10))
172 ((<= ?A chr) (+ (- chr ?A) 10))
173 ((<= ?0 chr) (- chr ?0))
176 (defun quoted-printable-internal-decode-region (start end)
179 (narrow-to-region start end)
180 (goto-char (point-min))
181 (while (search-forward "=" nil t)
184 ;; unfold soft line break.
185 (delete-region (1- (point))(1+ (point))))
186 ((and (memq (char-after (point))
188 ;; XXX: should provide char-list instead.
189 (string-to-char-list quoted-printable-hex-chars)))
190 (memq (char-after (1+ (point)))
192 ;; XXX: should provide char-list instead.
193 (string-to-char-list quoted-printable-hex-chars))))
198 (ash (quoted-printable-hex-char-to-num (char-after (point))) 4)
199 (quoted-printable-hex-char-to-num (char-after (1+ (point)))))
200 (delete-region (1- (point))(+ 2 (point))))))
205 (defvar quoted-printable-external-decoder '("mmencode" "-q" "-u")
206 "*list of quoted-printable decoder program name and its arguments.")
208 (defun quoted-printable-external-decode-region (start end)
211 (apply (function call-process-region)
212 start end (car quoted-printable-external-decoder)
214 (cdr quoted-printable-external-decoder)))))
217 (defvar quoted-printable-internal-decoding-limit nil
218 "*limit size to use internal quoted-printable decoder.
219 If size of input to decode is larger than this limit,
220 external decoder is called.")
222 (defun quoted-printable-decode-region (start end)
223 "Decode current region by quoted-printable.
224 START and END are buffer positions.
225 This function calls internal quoted-printable decoder if size of
226 region is smaller than `quoted-printable-internal-decoding-limit',
227 otherwise it calls external quoted-printable decoder specified by
228 `quoted-printable-external-decoder'. In this case, you must install
229 the program (maybe mmencode included in metamail or XEmacs package)."
231 (if (and quoted-printable-internal-decoding-limit
232 (> (- end start) quoted-printable-internal-decoding-limit))
233 (quoted-printable-external-decode-region start end)
234 (quoted-printable-internal-decode-region start end)))
236 (defun quoted-printable-decode-string (string)
237 "Decode STRING which is encoded in quoted-printable, and return the result."
240 (quoted-printable-decode-region (point-min)(point-max))
244 (mel-define-method-function
245 (mime-decode-string string (nil "quoted-printable"))
246 'quoted-printable-decode-string)
248 (mel-define-method-function
249 (mime-decode-region start end (nil "quoted-printable"))
250 'quoted-printable-decode-region)
253 (defvar quoted-printable-external-decoder-option-to-specify-file '("-o")
254 "*list of options of quoted-printable decoder program to specify file.")
256 (mel-define-method mime-write-decoded-region (start end filename
257 (nil "quoted-printable"))
258 "Decode and write current region encoded by quoted-printable into FILENAME.
259 START and END are buffer positions."
260 (interactive "*r\nFWrite decoded region to file: ")
262 (apply (function call-process-region)
263 start end (car quoted-printable-external-decoder)
265 (append (cdr quoted-printable-external-decoder)
266 quoted-printable-external-decoder-option-to-specify-file
270 ;;; @ Q-encoding encode/decode string
273 (defconst q-encoding-special-chars-alist
275 (comment ?= ?? ?_ ?\( ?\) ?\\)
276 (phrase ?= ?? ?_ ?\( ?\) ?\\ ?\" ?# ?$ ?% ?& ?' ?, ?. ?/
277 ?: ?\; ?< ?> ?@ ?\[ ?\] ?^ ?` ?{ ?| ?} ?~)
280 (defun q-encoding-encode-string (string &optional mode)
281 "Encode STRING to Q-encoding of encoded-word, and return the result.
282 MODE allows `text', `comment', `phrase' or nil. Default value is
284 (let ((specials (cdr (or (assq mode q-encoding-special-chars-alist)
285 (assq 'phrase q-encoding-special-chars-alist)))))
288 (cond ((eq chr ? ) "_")
289 ((or (< chr 32) (< 126 chr)
291 (quoted-printable-quote-char chr))
293 (char-to-string chr)))))
296 (defun q-encoding-decode-string (string)
297 "Decode STRING which is encoded in Q-encoding and return the result."
301 (cond ((eq chr ?_) " ")
305 (q (setq h (quoted-printable-hex-char-to-num chr))
308 (h (setq l (quoted-printable-hex-char-to-num chr))
310 (char-to-string (logior (ash h 4) l))
312 (t (char-to-string chr)))))
315 (mel-define-method-function (encoded-text-encode-string string (nil "Q"))
316 'q-encoding-encode-string)
318 (mel-define-method encoded-text-decode-string (string (nil "Q"))
319 (if (string-match (eval-when-compile
320 (concat "\\`" Q-encoded-text-regexp "\\'"))
322 (q-encoding-decode-string string)
323 (error "Invalid encoded-text %s" string)))
331 ;;; mel-q.el ends here.