From: morioka <morioka>
Date: Sun, 11 Jan 1998 16:48:22 +0000 (+0000)
Subject: MEL 1.6.
X-Git-Tag: mel-1_6
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=b0992046db3ec7fb35057615ceb7c371d29198c1;p=elisp%2Fflim.git

MEL 1.6.
---

b0992046db3ec7fb35057615ceb7c371d29198c1
diff --git a/mel-b.el b/mel-b.el
new file mode 100644
index 0000000..5a0eda2
--- /dev/null
+++ b/mel-b.el
@@ -0,0 +1,227 @@
+;;;
+;;; $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)
diff --git a/mel-q.el b/mel-q.el
new file mode 100644
index 0000000..ca11faf
--- /dev/null
+++ b/mel-q.el
@@ -0,0 +1,278 @@
+;;;
+;;; $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)
diff --git a/mel.el b/mel.el
new file mode 100644
index 0000000..8bc5da2
--- /dev/null
+++ b/mel.el
@@ -0,0 +1,25 @@
+;;;
+;;; 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)