-;;;
-;;; $Id: mel-b.el,v 1.6 1995/08/05 00:30:53 morioka Exp $
-;;;
+;;; mel-b.el: Base64 encoder/decoder for GNU Emacs
+
+;; Copyright (C) 1992,1995,1996,1997,1998 Free Software Foundation, Inc.
+
+;; Author: ENAMI Tsugutomo <enami@sys.ptg.sony.co.jp>
+;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Created: 1995/6/24
+;; Keywords: MIME, Base64
+
+;; This file is part of MEL (MIME Encoding Library).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'emu)
+
;;; @ variables
;;;
(defvar base64-external-decoder '("mmencode" "-u")
"*list of base64 decoder program name and its arguments.")
+(defvar base64-external-decoder-option-to-specify-file '("-o")
+ "*list of options of base64 decoder program to specify file.")
+
(defvar base64-internal-encoding-limit 1000
"*limit size to use internal base64 encoder.
If size of input to encode is larger than this limit,
;;; @@ encode/decode one base64 unit
;;;
-(defun base64-mask (i n) (logand i (1- (ash 1 n))))
-
-(defun base64-encode-1 (a &optional b &optional c)
- (cons (ash a -2)
- (cons (logior (ash (base64-mask a 2) (- 6 2))
- (if b (ash b -4) 0))
- (if b
- (cons (logior (ash (base64-mask b 4) (- 6 4))
- (if c (ash c -6) 0))
- (if c
- (cons (base64-mask c (- 6 0))
- nil)))))))
-
-(defun base64-decode-1 (a b &optional c &optional d)
- (cons (logior (ash a 2) (ash b (- 2 6)))
- (if c (cons (logior (ash (base64-mask b 4) 4)
- (base64-mask (ash c (- 4 6)) 4))
- (if d (cons (logior (ash (base64-mask c 2) 6) d)
- nil))))))
-
-(defun base64-encode-chars (a &optional b &optional c)
- (mapcar (function base64-num-to-char) (base64-encode-1 a b c)))
-
-(defun base64-decode-chars (&rest args)
- (apply (function base64-decode-1)
- (mapcar (function base64-char-to-num) args)
- ))
-
-
-;;; @@ encode/decode base64 string
+(defun base64-encode-1 (pack)
+ (let ((a (car pack))
+ (b (nth 1 pack))
+ (c (nth 2 pack)))
+ (concat
+ (char-to-string (base64-num-to-char (ash a -2)))
+ (if b
+ (concat
+ (char-to-string
+ (base64-num-to-char (logior (ash (logand a 3) 4) (ash b -4))))
+ (if c
+ (concat
+ (char-to-string
+ (base64-num-to-char (logior (ash (logand b 15) 2) (ash c -6))))
+ (char-to-string (base64-num-to-char (logand c 63)))
+ )
+ (concat (char-to-string
+ (base64-num-to-char (ash (logand b 15) 2))) "=")
+ ))
+ (concat (char-to-string
+ (base64-num-to-char (ash (logand a 3) 4))) "==")
+ ))))
+
+(defun base64-decode-1 (pack)
+ (let ((a (base64-char-to-num (car pack)))
+ (b (base64-char-to-num (nth 1 pack)))
+ (c (nth 2 pack))
+ (d (nth 3 pack)))
+ (concat (char-to-string (logior (ash a 2) (ash b -4)))
+ (if (and c (setq c (base64-char-to-num c)))
+ (concat (char-to-string
+ (logior (ash (logand b 15) 4) (ash c -2)))
+ (if (and d (setq d (base64-char-to-num d)))
+ (char-to-string (logior (ash (logand c 3) 6) d))
+ ))))))
+
+
+;;; @@ base64 encoder/decoder for string
;;;
(defun base64-encode-string (string)
- (let* ((es (mapconcat
- (function
- (lambda (pack)
- (mapconcat (function char-to-string)
- (apply (function base64-encode-chars) pack)
- "")
- ))
- (pack-sequence string 3)
- ""))
- (m (mod (length es) 4))
- )
- (concat es (cond ((= m 3) "=")
- ((= m 2) "==")
- ))
- ))
+ "Encode STRING to base64, and return the result."
+ (let ((len (length string))
+ (b 0)(e 57)
+ dest)
+ (while (< e len)
+ (setq dest
+ (concat dest
+ (mapconcat
+ (function base64-encode-1)
+ (pack-sequence (substring string b e) 3)
+ "")
+ "\n"))
+ (setq b e
+ e (+ e 57)
+ )
+ )
+ (let* ((es (mapconcat
+ (function base64-encode-1)
+ (pack-sequence (substring string b) 3)
+ ""))
+ (m (mod (length es) 4))
+ )
+ (concat dest es (cond ((= m 3) "=")
+ ((= m 2) "==")
+ ))
+ )))
(defun base64-decode-string (string)
- (mapconcat (function
- (lambda (pack)
- (mapconcat (function char-to-string)
- (apply (function base64-decode-chars) pack)
- "")
- ))
+ "Decode STRING which is encoded in base64, and return the result."
+ (mapconcat (function base64-decode-1)
(pack-sequence string 4)
""))
-;;; @ encode/decode base64 region
+;;; @ base64 encoder/decoder for region
;;;
-(defun base64-internal-decode-region (beg end)
+(defun base64-internal-encode-region (beg end)
(save-excursion
(save-restriction
(narrow-to-region beg end)
- (goto-char (point-min))
- (while (search-forward "\n" nil t)
- (replace-match "")
+ (let ((str (buffer-substring beg end)))
+ (delete-region beg end)
+ (insert (base64-encode-string str))
)
- (let ((str (buffer-substring (point-min)(point-max))))
- (delete-region (point-min)(point-max))
- (insert (base64-decode-string str))
- ))))
+ (or (bolp)
+ (insert "\n")
+ )
+ )))
-(defun base64-internal-encode-region (beg end)
+(defun base64-internal-decode-region (beg end)
(save-excursion
- (let* ((str (base64-encode-string (buffer-substring beg end)))
- (len (length str))
- (i 0)
- (j (if (>= len 76)
- 76
- len))
- )
- (delete-region beg end)
- (goto-char beg)
- (while (< j len)
- (insert (substring str i j))
- (insert "\n")
- (setq i j)
- (setq j (+ i 76))
- )
- (insert (substring str i))
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (while (looking-at ".*\n")
+ (condition-case err
+ (replace-match
+ (base64-decode-string
+ (buffer-substring (match-beginning 0) (1- (match-end 0))))
+ t t)
+ (error
+ (prog1
+ (message (nth 1 err))
+ (replace-match "")))))
+ (if (looking-at ".*$")
+ (condition-case err
+ (replace-match
+ (base64-decode-string
+ (buffer-substring (match-beginning 0) (match-end 0)))
+ t t)
+ (error
+ (prog1
+ (message (nth 1 err))
+ (replace-match "")))
+ ))
)))
-(cond ((boundp 'MULE)
- (define-program-coding-system
- nil (car base64-external-encoder) *noconv*)
- (define-program-coding-system
- nil (car base64-external-decoder) *noconv*)
- )
- ((boundp 'NEMACS)
- (define-program-kanji-code
- nil (car base64-external-encoder) 0)
- (define-program-kanji-code
- nil (car base64-external-decoder) 0)
- ))
-
(defun base64-external-encode-region (beg end)
(save-excursion
- (apply (function call-process-region)
- beg end (car base64-external-encoder)
- t t nil (cdr base64-external-encoder))
- ))
+ (save-restriction
+ (narrow-to-region beg end)
+ (as-binary-process (apply (function call-process-region)
+ beg end (car base64-external-encoder)
+ t t nil (cdr base64-external-encoder))
+ )
+ ;; for OS/2
+ ;; regularize line break code
+ (goto-char (point-min))
+ (while (re-search-forward "\r$" nil t)
+ (replace-match "")
+ )
+ )))
(defun base64-external-decode-region (beg end)
(save-excursion
- (apply (function call-process-region)
- beg end (car base64-external-decoder)
- t t nil (cdr base64-external-decoder))
- ))
-
-(defun base64-encode-region (beg end)
+ (as-binary-process (apply (function call-process-region)
+ beg end (car base64-external-decoder)
+ t t nil (cdr base64-external-decoder))
+ )))
+
+(defun base64-encode-region (start end)
+ "Encode current region by base64.
+START and END are buffer positions.
+This function calls internal base64 encoder if size of region is
+smaller than `base64-internal-encoding-limit', otherwise it calls
+external base64 encoder specified by `base64-external-encoder'. In
+this case, you must install the program (maybe mmencode included in
+metamail or XEmacs package)."
(interactive "r")
(if (and base64-internal-encoding-limit
- (> (- end beg) base64-internal-encoding-limit))
- (base64-external-encode-region beg end)
- (base64-internal-encode-region beg end)
+ (> (- end start) base64-internal-encoding-limit))
+ (base64-external-encode-region start end)
+ (base64-internal-encode-region start end)
))
-(defun base64-decode-region (beg end)
+(defun base64-decode-region (start end)
+ "Decode current region by base64.
+START and END are buffer positions.
+This function calls internal base64 decoder if size of region is
+smaller than `base64-internal-decoding-limit', otherwise it calls
+external base64 decoder specified by `base64-external-decoder'. In
+this case, you must install the program (maybe mmencode included in
+metamail or XEmacs package)."
(interactive "r")
(if (and base64-internal-decoding-limit
- (> (- end beg) base64-internal-decoding-limit))
- (base64-external-decode-region beg end)
- (base64-internal-decode-region beg end)
+ (> (- end start) base64-internal-decoding-limit))
+ (base64-external-decode-region start end)
+ (base64-internal-decode-region start end)
))
+;;; @ base64 encoder/decoder for file
+;;;
+
+(defun base64-insert-encoded-file (filename)
+ "Encode contents of file FILENAME to base64, and insert the result.
+It calls external base64 encoder specified by
+`base64-external-encoder'. So you must install the program (maybe
+mmencode included in metamail or XEmacs package)."
+ (interactive (list (read-file-name "Insert encoded file: ")))
+ (apply (function call-process) (car base64-external-encoder)
+ filename t nil (cdr base64-external-encoder))
+ )
+
+(defun base64-write-decoded-region (start end filename)
+ "Decode and write current region encoded by base64 into FILENAME.
+START and END are buffer positions."
+ (interactive
+ (list (region-beginning) (region-end)
+ (read-file-name "Write decoded region to file: ")))
+ (as-binary-process
+ (apply (function call-process-region)
+ start end (car base64-external-decoder)
+ nil nil nil
+ (append (cdr base64-external-decoder)
+ base64-external-decoder-option-to-specify-file
+ (list filename))
+ )))
+
+
;;; @ etc
;;;
(reverse dest)
))
+
+;;; @ end
+;;;
+
(provide 'mel-b)
+
+;;; mel-b.el ends here.
projects / elisp / flim.git / blobdiff