1 ;;; mel-b.el: Base64 encoder/decoder for GNU Emacs
3 ;; Copyright (C) 1992,1995,1996,1997,1998 Free Software Foundation, Inc.
5 ;; Author: ENAMI Tsugutomo <enami@sys.ptg.sony.co.jp>
6 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
8 ;; Keywords: MIME, Base64
10 ;; This file is part of MEL (MIME Encoding Library).
12 ;; This program is free software; you can redistribute it and/or
13 ;; modify it under the terms of the GNU General Public License as
14 ;; published by the Free Software Foundation; either version 2, or (at
15 ;; your option) any later version.
17 ;; This program is distributed in the hope that it will be useful, but
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
35 (defvar base64-external-encoder '("mmencode")
36 "*list of base64 encoder program name and its arguments.")
38 (defvar base64-external-decoder '("mmencode" "-u")
39 "*list of base64 decoder program name and its arguments.")
41 (defvar base64-external-decoder-option-to-specify-file '("-o")
42 "*list of options of base64 decoder program to specify file.")
45 ;;; @ internal base64 decoder/encoder
46 ;;; based on base64 decoder by Enami Tsugutomo
48 ;;; @@ convert from/to base64 char
51 (defun base64-num-to-char (n)
54 ((< n 52) (+ ?a (- n 26)))
55 ((< n 62) (+ ?0 (- n 52)))
58 (t (error "not a base64 integer %d" n))))
60 (defun base64-char-to-num (c)
61 (cond ((and (<= ?A c) (<= c ?Z)) (- c ?A))
62 ((and (<= ?a c) (<= c ?z)) (+ (- c ?a) 26))
63 ((and (<= ?0 c) (<= c ?9)) (+ (- c ?0) 52))
67 (t (error "not a base64 character %c" c))))
70 ;;; @@ encode/decode one base64 unit
73 (defun base64-encode-1 (pack)
78 (char-to-string (base64-num-to-char (ash a -2)))
82 (base64-num-to-char (logior (ash (logand a 3) 4) (ash b -4))))
86 (base64-num-to-char (logior (ash (logand b 15) 2) (ash c -6))))
87 (char-to-string (base64-num-to-char (logand c 63)))
89 (concat (char-to-string
90 (base64-num-to-char (ash (logand b 15) 2))) "=")
92 (concat (char-to-string
93 (base64-num-to-char (ash (logand a 3) 4))) "==")
96 (defun base64-decode-unit (a b &optional c d)
99 (char-to-string (logior (ash (base64-char-to-num a) 2)
100 (ash (setq b (base64-char-to-num b)) -4)))
101 (if (and c (setq c (base64-char-to-num c)))
102 (concat (char-to-string
103 (logior (ash (logand b 15) 4) (ash c -2)))
104 (if (and d (setq d (base64-char-to-num d)))
105 (char-to-string (logior (ash (logand c 3) 6) d))
107 (error (message (nth 1 err))
111 ;;; @@ base64 encoder/decoder for string
114 (defun base64-internal-encode-string (string)
115 "Encode STRING to base64, and return the result."
116 (let ((len (length string))
123 (function base64-encode-1)
124 (pack-sequence (substring string b e) 3)
131 (let* ((es (mapconcat
132 (function base64-encode-1)
133 (pack-sequence (substring string b) 3)
135 (m (mod (length es) 4))
137 (concat dest es (cond ((= m 3) "=")
142 (defun base64-internal-decode-string (string)
143 (let ((len (length string))
147 (let ((a (aref string i)))
150 (let ((b (aref string i)))
157 (setq dest (concat dest (base64-decode-unit a b) ))
160 (let ((c (aref string i)))
164 (setq dest (concat dest (base64-decode-unit a b)))
167 (setq dest (concat dest (base64-decode-unit a b c)))
170 (let ((d (aref string i)))
175 (base64-decode-unit a b c)
176 (base64-decode-unit a b c d))))
181 ;;; @ base64 encoder/decoder for region
184 (defun base64-internal-encode-region (beg end)
187 (narrow-to-region beg end)
188 (let ((str (buffer-substring beg end)))
189 (delete-region beg end)
190 (insert (base64-internal-encode-string str))
197 (defun base64-internal-decode-region (beg end)
199 (let ((str (buffer-substring beg end)))
200 (delete-region beg end)
202 (insert (base64-internal-decode-string str)))))
204 (defun base64-external-encode-region (beg end)
207 (narrow-to-region beg end)
209 (apply (function call-process-region)
210 beg end (car base64-external-encoder)
211 t t nil (cdr base64-external-encoder)))
213 ;; regularize line break code
214 (goto-char (point-min))
215 (while (re-search-forward "\r$" nil t)
219 (defun base64-external-decode-region (beg end)
222 (apply (function call-process-region)
223 beg end (car base64-external-decoder)
224 t t nil (cdr base64-external-decoder)))
227 (defun base64-external-decode-string (string)
231 (apply (function call-process-region)
232 (point-min) (point-max)
233 (car base64-external-decoder)
234 t t nil (cdr base64-external-decoder)))
237 ;;; @ base64 encoder/decoder for file
240 (defun base64-external-insert-encoded-file (filename)
241 "Encode contents of file FILENAME to base64, and insert the result.
242 It calls external base64 encoder specified by
243 `base64-external-encoder'. So you must install the program (maybe
244 mmencode included in metamail or XEmacs package)."
245 (interactive (list (read-file-name "Insert encoded file: ")))
246 (apply (function call-process) (car base64-external-encoder)
247 filename t nil (cdr base64-external-encoder))
250 (defun base64-internal-insert-encoded-file (filename)
251 "Encode contents of file FILENAME to base64, and insert the result."
252 (interactive (list (read-file-name "Insert encoded file: ")))
254 (base64-internal-encode-string
256 (insert-file-contents-as-binary filename)
262 (defun base64-external-write-decoded-region (start end filename)
263 "Decode and write current region encoded by base64 into FILENAME.
264 START and END are buffer positions."
266 (list (region-beginning) (region-end)
267 (read-file-name "Write decoded region to file: ")))
269 (apply (function call-process-region)
270 start end (car base64-external-decoder)
272 (append (cdr base64-external-decoder)
273 base64-external-decoder-option-to-specify-file
276 (defun base64-internal-write-decoded-region (start end filename)
277 "Decode and write current region encoded by base64 into FILENAME.
278 START and END are buffer positions."
280 (list (region-beginning) (region-end)
281 (read-file-name "Write decoded region to file: ")))
282 (let ((str (buffer-substring start end)))
284 (insert (base64-internal-decode-string str))
285 (write-region-as-binary (point-min) (point-max) filename))))
290 (defun base64-internal-encoded-length (string)
291 (let ((len (length string)))
293 (if (= (mod len 3) 0) 0 1)
297 (defun pack-sequence (seq size)
298 "Split sequence SEQ into SIZE elements packs,
299 and return list of packs. [mel-b; tl-seq function]"
300 (let ((len (length seq)) (p 0) obj
304 (setq obj (elt seq p))
305 (setq unit (cons obj unit))
309 (setq dest (cons (reverse unit) dest))
316 (setq dest (cons (reverse unit) dest))
327 ;;; mel-b.el ends here.