-;;; @ Base64 (B-encode) decoder/encoder
-;;; by Enami Tsugutomo
-;;; modified by mol.
-
-(defun mime/base64-decode-string (string)
- (mime/base64-mapconcat (function mime/base64-decode-chars) 4 string))
-
-;; (mime/base64-encode-string (mime/base64-decode-string "GyRAOjRGI0stGyhK"))
-(defun mime/base64-encode-string (string &optional mode)
- (let ((es (mime/base64-mapconcat (function mime/base64-encode-chars) 3 string))
- m)
- (setq m (mod (length es) 4))
- (concat es
- (cond ((= m 3) "=")
- ((= m 2) "==")
- ))
- ))
-
-;; (char-to-string (mime/base64-bit-to-char 26))
-(defun mime/base64-bit-to-char (n)
- (cond ((eq n nil) ?=)
- ((< n 26) (+ ?A n))
- ((< n 52) (+ ?a (- n 26)))
- ((< n 62) (+ ?0 (- n 52)))
- ((= n 62) ?+)
- ((= n 63) ?/)
- (t (error "not a base64 integer %d" n))))
-
-(defun mime/base64-char-to-bit (c)
- (cond ((and (<= ?A c) (<= c ?Z)) (- c ?A))
- ((and (<= ?a c) (<= c ?z)) (+ (- c ?a) 26))
- ((and (<= ?0 c) (<= c ?9)) (+ (- c ?0) 52))
- ((= c ?+) 62)
- ((= c ?/) 63)
- ((= c ?=) nil)
- (t (error "not a base64 character %c" c))))
-
-(defun mime/mask (i n) (logand i (1- (ash 1 n))))
-
-(defun mime/base64-encode-1 (a &optional b &optional c)
- (cons (ash a -2)
- (cons (logior (ash (mime/mask a 2) (- 6 2))
- (if b (ash b -4) 0))
- (if b
- (cons (logior (ash (mime/mask b 4) (- 6 4))
- (if c (ash c -6) 0))
- (if c
- (cons (mime/mask c (- 6 0))
- nil)))))))
-
-(defun mime/base64-decode-1 (a b &optional c &optional d)
- (cons (logior (ash a 2) (ash b (- 2 6)))
- (if c (cons (logior (ash (mime/mask b 4) 4)
- (mime/mask (ash c (- 4 6)) 4))
- (if d (cons (logior (ash (mime/mask c 2) 6) d)
- nil))))))
-
-;; (mime/base64-decode-chars ?G ?y ?R ?A)
-(defun mime/base64-decode-chars (a b c d)
- (apply (function mime/base64-decode-1)
- (mapcar (function mime/base64-char-to-bit)
- (list a b c d))))
-
-;; (mapcar (function char-to-string) (mime/base64-encode-chars 27 36 64))
-(defun mime/base64-encode-chars (a b c)
- (mapcar (function mime/base64-bit-to-char) (mime/base64-encode-1 a b c)))
-
-(defun mime/base64-fecth-from (func from pos len)
- (let (ret)
- (while (< 0 len)
- (setq len (1- len)
- ret (cons (funcall func from (+ pos len)) ret)))
- ret))
-
-(defun mime/base64-fecth-from-buffer (from pos len)
- (mime/base64-fecth-from (function (lambda (f p) (char-after p)))
- from pos len))
-
-(defun mime/base64-fecth-from-string (from pos len)
- (mime/base64-fecth-from (function (lambda (f p)
- (if (< p (length f)) (aref f p))))
- from pos len))
-
-(defun mime/base64-fecth (source pos len)
- (cond ((stringp source) (mime/base64-fecth-from-string source pos len))
- (t (mime/base64-fecth-from-buffer source pos len))))
-
-(defun mime/base64-mapconcat (func unit string)
- (let ((i 0) ret)
- (while (< i (length string))
- (setq ret
- (apply (function concat)
- ret
- (mapcar (function char-to-string)
- (apply func (mime/base64-fecth string i unit)))))
- (setq i (+ i unit)))
- ret))
-
-;;; @ Quoted-Printable (Q-encode) encoder/decoder
-;;;
-
-(defun mime/Quoted-Printable-decode-string (str)
- (let ((dest "")
- (len (length str))
- (i 0) chr num h l)
- (while (< i len)
- (setq chr (elt str i))
- (cond ((eq chr ?=)
- (if (< (+ i 2) len)
- (progn
- (setq h (hex-char-to-number (elt str (+ i 1))))
- (setq l (hex-char-to-number (elt str (+ i 2))))
- (setq num (+ (* h 16) l))
- (setq dest (concat dest (char-to-string num)))
- (setq i (+ i 3))
- )
- (progn
- (setq dest (concat dest (char-to-string chr)))
- (setq i (+ i 1))
- )))
- ((eq chr ?_)
- (setq dest (concat dest (char-to-string 32)))
- (setq i (+ i 1))
- )
- (t
- (setq dest (concat dest (char-to-string chr)))
- (setq i (+ i 1))
- ))
- )
- dest))
-
-(defun mime/Quoted-Printable-encode-string (str &optional mode)
- (if (null mode)
- (setq mode 'phrase))
- (let ((dest "")
- (len (length str))
- (i 0) chr)
- (while (< i len)
- (setq chr (elt str i))
- (cond ((eq chr 32)
- (setq dest (concat dest "_"))
- )
- ((or (eq chr ?=)
- (eq chr ??)
- (eq chr ?_)
- (and (eq mode 'comment)
- (or (eq chr ?\()
- (eq chr ?\))
- (eq chr ?\\)
- ))
- (and (eq mode 'phrase)
- (not (string-match "[A-Za-z0-9!*+/=_---]"
- (char-to-string chr)))
- )
- (< chr 32)
- (> chr 126))
- (setq dest (concat dest
- "="
- (char-to-string (number-to-hex-char (/ chr 16)))
- (char-to-string (number-to-hex-char (% chr 16)))
- ))
- )
- (t (setq dest (concat dest (char-to-string chr)))
- ))
- (setq i (+ i 1))
- )
- dest))