;;; base64.el,v --- Base64 encoding functions
;; Author: wmperry
;; Created: 1996/04/22 15:08:08
;; Version: 1.7
;; Keywords: extensions

;;; LCD Archive Entry:
;;; base64.el|William M. Perry|wmperry@cs.indiana.edu|
;;; Package for encoding/decoding base64 data (MIME)|
;;; 1996/04/22 15:08:08|1.7|Location Undetermined
;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1996 Free Software Foundation, Inc.
;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu)
;;;
;;; This file is not part of GNU Emacs, but the same permissions apply.
;;;
;;; GNU Emacs 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.
;;;
;;; GNU Emacs 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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Base 64 encoding functions
;;; This code was converted to lisp code by me from the C code in
;;; ftp://cs.utk.edu/pub/MIME/b64encode.c
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar base64-code-string
  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  "Character set used for base64 decoding")

(defvar base64-decode-vector
  (let ((vec (make-vector 256 nil))
	(i 0)
	(case-fold-search nil))
    (while (< i 256)
      (aset vec i (string-match (regexp-quote (char-to-string i))
				base64-code-string))
      (setq i (1+ i)))
    vec))

(defvar base64-max-line-length 64)

;(defun b0 (x) (aref base64-code-string (logand (lsh x -18) 63)))
;(defun b1 (x) (aref base64-code-string (logand (lsh x -12) 63)))
;(defun b2 (x) (aref base64-code-string (logand (lsh x -6) 63)))
;(defun b3 (x) (aref base64-code-string (logand x 63)))

(defmacro b0 (x) (` (aref base64-code-string (logand (lsh (, x) -18) 63))))
(defmacro b1 (x) (` (aref base64-code-string (logand (lsh (, x) -12) 63))))
(defmacro b2 (x) (` (aref base64-code-string (logand (lsh (, x) -6) 63))))
(defmacro b3 (x) (` (aref base64-code-string (logand (, x) 63))))

(defun base64-encode (str)
  "Do base64 encoding on string STR and return the encoded string.
This code was converted to lisp code by me from the C code in
ftp://cs.utk.edu/pub/MIME/b64encode.c.  Returns a string that is
broken into `base64-max-line-length' byte lines."
  (or str (setq str (buffer-string)))
  (let ((x (base64-encode-internal str))
	(y ""))
    (while (> (length x) base64-max-line-length)
      (setq y (concat y (substring x 0 base64-max-line-length) "\n")
	    x (substring x base64-max-line-length nil)))
    (setq y (concat y x))
    y))

(defun base64-encode-internal (str)
  "Do base64 encoding on string STR and return the encoded string.
This code was converted to lisp code by me from the C code in
ftp://cs.utk.edu/pub/MIME/b64encode.c.  Returns the entire string,
not broken up into `base64-max-line-length' byte lines."
  (let (
	(word 0)			; The word to translate
	w1 w2 w3
	)
    (cond
     ((> (length str) 3)
      (concat
       (base64-encode-internal (substring str 0 3))
       (base64-encode-internal (substring str 3 nil))))
     ((= (length str) 3)
      (setq w1 (aref str 0)
	    w2 (aref str 1)
	    w3 (aref str 2)
	    word (logior
		  (lsh (logand w1 255) 16)
		  (lsh (logand w2 255) 8)
		  (logand w3 255)))
      (format "%c%c%c%c" (b0 word) (b1 word) (b2 word) (b3 word)))
     ((= (length str) 2)
      (setq w1 (aref str 0)
	    w2 (aref str 1)
	    word (logior
		  (lsh (logand w1 255) 16)
		  (lsh (logand w2 255) 8)
		  0))
      (format "%c%c%c=" (b0 word) (b1 word) (b2 word)))
     ((= (length str) 1)
      (setq w1 (aref str 0)
	    word (logior
		  (lsh (logand w1 255) 16)
		  0))
      (format "%c%c==" (b0 word) (b1 word)))
     (t ""))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Base64 decoding functions
;;; Most of the decoding code is courtesy Francesco Potorti`
;;; <F.Potorti@cnuce.cnr.it>
;;; this is much faster than my original code - thanks!
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun base64-decode-region (beg end)
  (interactive "r")
  (barf-if-buffer-read-only)
  (let
      ((exchange (= (point) beg))
       (endchars 0)
       (list) (code))
    (goto-char beg)
    (while (< (point) end)
      (setq list (mapcar
		  (function
		   (lambda (c)
		     (cond
		      ((aref base64-decode-vector c))
		      ((char-equal c ?=)
		       (setq endchars (1+ endchars))
		       0)
		      (nil
		       (error
			"Character %c does not match Mime base64 coding" c)))))
		  (buffer-substring (point) (+ (point) 4))))
      (setq code (+ (nth 3 list) (lsh (nth 2 list) 6)
		    (lsh (nth 1 list) 12) (lsh (car list) 18)))
      (delete-char 4)
      (cond
       ((zerop endchars)
	(insert (% (lsh code -16) 256) (% (lsh code -8) 256) (% code 256)))
       ((= endchars 1)
	(insert (% (lsh code -16) 256) (% (lsh code -8) 256))
	(setq end (point)))
       ((= endchars 2)
	(insert (% (lsh code -16) 256))
	(setq end (point))))
      (if (char-equal (following-char) ?\n)
	  (progn (delete-char 1)
		 (setq end (- end 2)))
	(setq end (1- end))))
    ))
;    (if exchange
;	(exchange-point-and-mark))))

(defun base64-decode (st &optional nd)
  "Do base64 decoding on string STR and return the original string.
If given buffer positions, destructively decodes that area of the
current buffer."
  (let ((replace-p nil)
	(retval nil))
    (if (stringp st)
	nil
      (setq st (prog1
		   (buffer-substring st (or nd (point-max)))
		 (delete-region st (or nd (point-max))))
	    replace-p t))
    (setq retval
	  (save-excursion
	    (set-buffer (get-buffer-create " *b64decode*"))
	    (erase-buffer)
	    (insert st)
	    (goto-char (point-min))
	    (while (re-search-forward "\r*\n" nil t)
	      (replace-match ""))
	    (goto-char (point-min))
	    (base64-decode-region (point-min) (point-max))
	    (buffer-string)))
    (if replace-p (insert retval))
    retval))

(provide 'base64)