--- /dev/null
+;;;
+;;; $Id: mel-b.el,v 1.6 1995/08/05 00:30:53 morioka Exp $
+;;;
+
+;;; @ variables
+;;;
+
+(defvar base64-external-encoder '("mmencode")
+ "*list of base64 encoder program name and its arguments.")
+
+(defvar base64-external-decoder '("mmencode" "-u")
+ "*list of base64 decoder program name and its arguments.")
+
+(defvar base64-internal-encoding-limit 1000
+ "*limit size to use internal base64 encoder.
+If size of input to encode is larger than this limit,
+external encoder is called.")
+
+(defvar base64-internal-decoding-limit 1000
+ "*limit size to use internal base64 decoder.
+If size of input to decode is larger than this limit,
+external decoder is called.")
+
+
+;;; @ internal base64 decoder/encoder
+;;; based on base64 decoder by Enami Tsugutomo
+
+;;; @@ convert from/to base64 char
+;;;
+
+(defun base64-num-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 base64-char-to-num (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))))
+
+
+;;; @@ 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-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) "==")
+ ))
+ ))
+
+(defun base64-decode-string (string)
+ (mapconcat (function
+ (lambda (pack)
+ (mapconcat (function char-to-string)
+ (apply (function base64-decode-chars) pack)
+ "")
+ ))
+ (pack-sequence string 4)
+ ""))
+
+
+;;; @ encode/decode base64 region
+;;;
+
+(defun base64-internal-decode-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 (point-min)(point-max))))
+ (delete-region (point-min)(point-max))
+ (insert (base64-decode-string str))
+ ))))
+
+(defun base64-internal-encode-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))
+ )))
+
+(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))
+ ))
+
+(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)
+ (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)
+ ))
+
+(defun base64-decode-region (beg end)
+ (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)
+ ))
+
+
+;;; @ etc
+;;;
+
+(defun base64-encoded-length (string)
+ (let ((len (length string)))
+ (* (+ (/ len 3)
+ (if (= (mod len 3) 0) 0 1)
+ ) 4)
+ ))
+
+(defun pack-sequence (seq size)
+ "Split sequence SEQ into SIZE elements packs,
+and return list of packs. [mel-b; tl-seq function]"
+ (let ((len (length seq)) (p 0) obj
+ unit (i 0)
+ dest)
+ (while (< p len)
+ (setq obj (elt seq p))
+ (setq unit (cons obj unit))
+ (setq i (1+ i))
+ (if (= i size)
+ (progn
+ (setq dest (cons (reverse unit) dest))
+ (setq unit nil)
+ (setq i 0)
+ ))
+ (setq p (1+ p))
+ )
+ (if unit
+ (setq dest (cons (reverse unit) dest))
+ )
+ (reverse dest)
+ ))
+
+(provide 'mel-b)
--- /dev/null
+;;;
+;;; $Id: mel-q.el,v 1.5 1995/06/26 05:56:39 morioka Exp $
+;;;
+
+;;; @ constants
+;;;
+
+(defconst quoted-printable-hex-chars "0123456789ABCDEF")
+(defconst quoted-printable-octet-regexp
+ (concat "=[" quoted-printable-hex-chars
+ "][" quoted-printable-hex-chars "]"))
+
+
+;;; @ variables
+;;;
+
+(defvar quoted-printable-external-encoder '("mmencode" "-q")
+ "*list of quoted-printable encoder program name and its arguments.")
+
+(defvar quoted-printable-external-decoder '("mmencode" "-q" "-u")
+ "*list of quoted-printable decoder program name and its arguments.")
+
+(defvar quoted-printable-internal-encoding-limit 10000
+ "*limit size to use internal quoted-printable encoder.
+If size of input to encode is larger than this limit,
+external encoder is called.")
+
+(defvar quoted-printable-internal-decoding-limit nil
+ "*limit size to use internal quoted-printable decoder.
+If size of input to decode is larger than this limit,
+external decoder is called.")
+
+
+;;; @ Quoted-Printable (Q-encode) encoder/decoder
+;;;
+
+(defun quoted-printable-quote-char (chr)
+ (concat "="
+ (char-to-string (elt quoted-printable-hex-chars (ash chr -4)))
+ (char-to-string (elt quoted-printable-hex-chars (logand chr 15)))
+ ))
+
+
+;;; @@ Quoted-Printable encode/decode string
+;;;
+
+(defun quoted-printable-encode-string (str)
+ (let ((i 0))
+ (mapconcat (function
+ (lambda (chr)
+ (cond ((or (< chr 32) (< 126 chr) (eq chr ?=))
+ (if (>= i 73)
+ (progn
+ (setq i 0)
+ (concat "=\n" (quoted-printable-quote-char chr))
+ )
+ (progn
+ (setq i (+ i 3))
+ (quoted-printable-quote-char chr)
+ )))
+ (t (if (>= i 75)
+ (progn
+ (setq i 0)
+ (concat "=\n" (char-to-string chr))
+ )
+ (progn
+ (setq i (1+ i))
+ (char-to-string chr)
+ )))
+ )))
+ str "")))
+
+(defun quoted-printable-decode-string (str)
+ (let (q h l)
+ (mapconcat (function
+ (lambda (chr)
+ (cond ((eq chr ?=)
+ (setq q t)
+ "")
+ (q (setq h
+ (cond ((<= ?a chr) (+ (- chr ?a) 10))
+ ((<= ?A chr) (+ (- chr ?A) 10))
+ ((<= ?0 chr) (- chr ?0))
+ ))
+ (setq q nil)
+ "")
+ (h (setq l (cond ((<= ?a chr) (+ (- chr ?a) 10))
+ ((<= ?A chr) (+ (- chr ?A) 10))
+ ((<= ?0 chr) (- chr ?0))
+ ))
+ (prog1
+ (char-to-string (logior (ash h 4) l))
+ (setq h nil)
+ )
+ )
+ (t (char-to-string chr))
+ )))
+ str "")))
+
+
+;;; @@ Quoted-Printable encode/decode region
+;;;
+
+(defun quoted-printable-internal-encode-region (beg end)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (while (re-search-forward "^.*$" nil t)
+ (replace-match
+ (quoted-printable-encode-string
+ (buffer-substring (match-beginning 0)(match-end 0))
+ ))
+ ))))
+
+(defun quoted-printable-internal-decode-region (beg end)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (while (re-search-forward "=\n" nil t)
+ (replace-match "")
+ )
+ (goto-char (point-min))
+ (let (b e str)
+ (while (re-search-forward quoted-printable-octet-regexp nil t)
+ (setq b (match-beginning 0))
+ (setq e (match-end 0))
+ (setq str (buffer-substring b e))
+ (replace-match (quoted-printable-decode-string str))
+ ))
+ )))
+
+(cond ((boundp 'MULE)
+ (define-program-coding-system
+ nil (car quoted-printable-external-encoder) *noconv*)
+ (define-program-coding-system
+ nil (car quoted-printable-external-decoder) *noconv*)
+ )
+ ((boundp 'NEMACS)
+ (define-program-kanji-code
+ nil (car quoted-printable-external-encoder) 0)
+ (define-program-kanji-code
+ nil (car quoted-printable-external-decoder) 0)
+ ))
+
+(defun quoted-printable-external-encode-region (beg end)
+ (save-excursion
+ (apply (function call-process-region)
+ beg end (car quoted-printable-external-encoder)
+ t t nil (cdr quoted-printable-external-encoder))
+ ))
+
+(defun quoted-printable-external-decode-region (beg end)
+ (save-excursion
+ (apply (function call-process-region)
+ beg end (car quoted-printable-external-decoder)
+ t t nil (cdr quoted-printable-external-decoder))
+ ))
+
+(defun quoted-printable-encode-region (beg end)
+ (interactive "r")
+ (if (and quoted-printable-internal-encoding-limit
+ (> (- end beg) quoted-printable-internal-encoding-limit))
+ (quoted-printable-external-encode-region beg end)
+ (quoted-printable-internal-encode-region beg end)
+ ))
+
+(defun quoted-printable-decode-region (beg end)
+ (interactive "r")
+ (if (and quoted-printable-internal-decoding-limit
+ (> (- end beg) quoted-printable-internal-decoding-limit))
+ (quoted-printable-external-decode-region beg end)
+ (quoted-printable-internal-decode-region beg end)
+ ))
+
+
+;;; @ Q-encoding encode/decode string
+;;;
+
+(defun q-encoding-encode-string-for-text (str)
+ (mapconcat (function
+ (lambda (chr)
+ (cond ((eq chr 32) "_")
+ ((or (< chr 32) (< 126 chr) (eq chr ?=))
+ (quoted-printable-quote-char chr)
+ )
+ (t (char-to-string chr))
+ )))
+ str ""))
+
+(defun q-encoding-encode-string-for-comment (str)
+ (mapconcat (function
+ (lambda (chr)
+ (cond ((eq chr 32) "_")
+ ((or (< chr 32) (< 126 chr)
+ (memq chr '(?= ?\( ?\) ?\\))
+ )
+ (quoted-printable-quote-char chr)
+ )
+ (t (char-to-string chr))
+ )))
+ str ""))
+
+(defun q-encoding-encode-string-for-phrase (str)
+ (mapconcat (function
+ (lambda (chr)
+ (cond ((or (and (<= ?A chr)(<= chr ?Z))
+ (and (<= ?a chr)(<= chr ?z))
+ (and (<= ?0 chr)(<= chr ?9))
+ (memq chr '(?! ?* ?+ ?- ?/))
+ )
+ (char-to-string chr)
+ )
+ (t (quoted-printable-quote-char chr))
+ )))
+ str ""))
+
+(defun q-encoding-encode-string (str &optional mode)
+ (cond ((eq mode 'text)
+ (q-encoding-encode-string-for-text str)
+ )
+ ((eq mode 'comment)
+ (q-encoding-encode-string-for-comment str)
+ )
+ ((eq mode 'phrase)
+ (q-encoding-encode-string-for-phrase str)
+ )
+ (t (quoted-printable-encode-string str))
+ ))
+
+(defun q-encoding-decode-string (str)
+ (let (q h l)
+ (mapconcat (function
+ (lambda (chr)
+ (cond ((eq chr ?_) " ")
+ ((eq chr ?=)
+ (setq q t)
+ "")
+ (q (setq h (cond ((<= ?a chr) (+ (- chr ?a) 10))
+ ((<= ?A chr) (+ (- chr ?A) 10))
+ ((<= ?0 chr) (- chr ?0))
+ ))
+ (setq q nil)
+ "")
+ (h (setq l (cond ((<= ?a chr) (+ (- chr ?a) 10))
+ ((<= ?A chr) (+ (- chr ?A) 10))
+ ((<= ?0 chr) (- chr ?0))
+ ))
+ (prog1
+ (char-to-string (logior (ash h 4) l))
+ (setq h nil)
+ )
+ )
+ (t (char-to-string chr))
+ )))
+ str "")))
+
+
+;;; @@ etc
+;;;
+
+(defun q-encoding-encoded-length (string &optional mode)
+ (let ((l 0)(i 0)(len (length string)) chr)
+ (while (< i len)
+ (setq chr (elt string i))
+ (if (string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr))
+ (setq l (+ l 1))
+ (setq l (+ l 3))
+ )
+ (setq i (+ i 1)) )
+ l))
+
+
+;;; @ end
+;;;
+
+(provide 'qprint)
--- /dev/null
+;;;
+;;; mel : a MIME encoding library
+;;;
+;;; by MORIOKA Tomohiko <morioka@jaist.ac.jp>, 1995/6/25
+;;;
+;;; $Id: mel.el,v 1.4 1995/06/26 05:57:39 morioka Exp $
+;;;
+
+(autoload 'base64-encode-region "mel-b" nil t)
+(autoload 'base64-decode-region "mel-b" nil t)
+(autoload 'base64-encode-string "mel-b")
+(autoload 'base64-decode-string "mel-b")
+(autoload 'base64-encoded-length "mel-b")
+
+(autoload 'quoted-printable-encode-region "mel-q" nil t)
+(autoload 'quoted-printable-decode-region "mel-q" nil t)
+
+(autoload 'q-encoding-encode-string-for-text "mel-q")
+(autoload 'q-encoding-encode-string-for-comment "mel-q")
+(autoload 'q-encoding-encode-string-for-phrase "mel-q")
+(autoload 'q-encoding-encode-string "mel-q")
+(autoload 'q-encoding-decode-string "mel-q")
+(autoload 'q-encoding-encoded-length "mel-q")
+
+(provide 'mel)
projects / elisp / flim.git / commitdiff