X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mel.el;h=44d7a707ea9fa0fef076006aa29dbce2f3d794f5;hb=2e575ffb102248a212cb81b0664ddf2efb65167d;hp=ccfc07279288ae926967cdbd87d39ae7e476d70a;hpb=f7230fcb61e32630f6bcf87e6eb8b35c564dd06c;p=elisp%2Fflim.git

diff --git a/mel.el b/mel.el
index ccfc072..44d7a70 100644
--- a/mel.el
+++ b/mel.el
@@ -1,8 +1,8 @@
-;;; mel.el : a MIME encoding/decoding library
+;;; mel.el --- A MIME encoding/decoding library.
 
-;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+;; Copyright (C) 1995,1996,1997,1998,1999,2000 Free Software Foundation, Inc.
 
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Created: 1995/6/25
 ;; Keywords: MIME, Base64, Quoted-Printable, uuencode, gzip64
 
@@ -19,14 +19,14 @@
 ;; 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.
+;; along with this program; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Code:
 
 (require 'mime-def)
-(require 'poem)
+(require 'alist)
 
 (defcustom mime-encoding-list
   '("7bit" "8bit" "binary" "base64" "quoted-printable")
@@ -59,17 +59,15 @@ Content-Transfer-Encoding for it."
 
 (defun mime-encoding-alist (&optional service)
   "Return table of Content-Transfer-Encoding for completion."
-  (mapcar #'list (mime-encoding-list service))
-  )
+  (mapcar #'list (mime-encoding-list service)))
 
 (defsubst mel-use-module (name encodings)
-  (let (encoding)
-    (while (setq encoding (car encodings))
-      (set-alist 'mel-encoding-module-alist
-		 encoding
-		 (cons name (cdr (assoc encoding mel-encoding-module-alist))))
-      (setq encodings (cdr encodings))
-      )))
+  (while encodings
+    (set-alist 'mel-encoding-module-alist
+	       (car encodings)
+	       (cons name (cdr (assoc (car encodings)
+				      mel-encoding-module-alist))))
+    (setq encodings (cdr encodings))))
 
 (defsubst mel-find-function (service encoding)
   (mel-find-function-from-obarray
@@ -79,25 +77,84 @@ Content-Transfer-Encoding for it."
 ;;; @ setting for modules
 ;;;
 
-(mel-define-backend "7bit")
-(mel-define-method-function (mime-encode-string string (nil "7bit"))
+(defun 8bit-insert-encoded-file (filename)
+  "Insert file FILENAME encoded by \"7bit\" format."
+  (let ((coding-system-for-read 'raw-text)
+	format-alist)
+    ;; Returns list of absolute file name and length of data inserted.
+    (insert-file-contents filename)))
+
+(defun 8bit-write-decoded-region (start end filename)
+  "Decode and write current region encoded by \"8bit\" into FILENAME."
+  (let ((coding-system-for-write 'raw-text)
+	format-alist)
+    (write-region start end filename)))
+
+(mel-define-backend "8bit")
+(mel-define-method-function (mime-encode-string string (nil "8bit"))
 			    'identity)
-(mel-define-method-function (mime-decode-string string (nil "7bit"))
+(mel-define-method-function (mime-decode-string string (nil "8bit"))
 			    'identity)
-(mel-define-method mime-encode-region (start end (nil "7bit")))
-(mel-define-method mime-decode-region (start end (nil "7bit")))
-(mel-define-method-function (mime-insert-encoded-file filename (nil "7bit"))
-			    'insert-file-contents-as-binary)
+(mel-define-method mime-encode-region (start end (nil "8bit")))
+(mel-define-method mime-decode-region (start end (nil "8bit")))
+(mel-define-method-function (mime-insert-encoded-file filename (nil "8bit"))
+			    '8bit-insert-encoded-file)
 (mel-define-method-function (mime-write-decoded-region
-			     start end filename (nil "7bit"))
-			    'write-region-as-binary)
+			     start end filename (nil "8bit"))
+			    '8bit-write-decoded-region)
+
+
+(defalias '7bit-insert-encoded-file '8bit-insert-encoded-file)
+(defalias '7bit-write-decoded-region '8bit-write-decoded-region)
+
+(mel-define-backend "7bit" ("8bit"))
+
+
+(defun binary-write-decoded-region (start end filename)
+  "Decode and write current region encoded by \"binary\" into FILENAME."
+  (let ((coding-system-for-write 'binary)
+	jka-compr-compression-info-list jam-zcat-filename-list)
+    (write-region start end filename)))
+
+(defalias 'binary-insert-encoded-file 'insert-file-contents-literally)
+
+(defun binary-find-file-noselect (filename &optional nowarn rawfile)
+  "Like `find-file-noselect', q.v., but don't code and format conversion."
+  (let ((coding-system-for-read 'binary)
+	format-alist)
+    (find-file-noselect filename nowarn rawfile)))
+
+(defun binary-funcall (name &rest args)
+  "Like `funcall', q.v., but read and write as binary."
+  (let ((coding-system-for-read 'binary)
+	(coding-system-for-write 'binary))
+    (apply name args)))
 
-(mel-define-backend "8bit" ("7bit"))
+(defun binary-to-text-funcall (coding-system name &rest args)
+  "Like `funcall', q.v., but write as binary and read as text.
+Read text is decoded as CODING-SYSTEM."
+  (let ((coding-system-for-read coding-system)
+	(coding-system-for-write 'binary))
+    (apply name args)))
 
-(mel-define-backend "binary" ("8bit"))
+(mel-define-backend "binary")
+(mel-define-method-function (mime-encode-string string (nil "binary"))
+			    'identity)
+(mel-define-method-function (mime-decode-string string (nil "binary"))
+			    'identity)
+(mel-define-method mime-encode-region (start end (nil "binary")))
+(mel-define-method mime-decode-region (start end (nil "binary")))
+(mel-define-method-function (mime-insert-encoded-file filename (nil "binary"))
+			    'binary-insert-encoded-file)
+(mel-define-method-function (mime-write-decoded-region
+			     start end filename (nil "binary"))
+			    'binary-write-decoded-region)
 
-(when (and (fboundp 'base64-encode-string)
-	   (subrp (symbol-function 'base64-encode-string)))
+(defvar mel-b-builtin
+   (and (fboundp 'base64-encode-string)
+        (subrp (symbol-function 'base64-encode-string))))
+
+(when mel-b-builtin
   (mel-define-backend "base64")
   (mel-define-method-function (mime-encode-string string (nil "base64"))
 			      'base64-encode-string)
@@ -112,21 +169,20 @@ Content-Transfer-Encoding for it."
 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: ")))
+    (interactive "*fInsert encoded file: ")
     (insert (base64-encode-string
 	     (with-temp-buffer
 	       (set-buffer-multibyte nil)
-	       (insert-file-contents-as-binary filename)
+	       (binary-insert-encoded-file filename)
 	       (buffer-string))))
-    (or (bolp)
-	(insert "\n"))
-    )
+    (or (bolp) (insert ?\n)))
     
-  (mel-define-method-function (encoded-text-encode-string string (nil "B"))
-			      'base64-encode-string)
+  ;; (mel-define-method-function (encoded-text-encode-string string (nil "B"))
+  ;;                             'base64-encode-string)
   (mel-define-method encoded-text-decode-string (string (nil "B"))
-    (if (and (string-match B-encoded-text-regexp string)
-	     (string= string (match-string 0 string)))
+    (if (string-match (eval-when-compile
+			(concat "\\`" B-encoded-text-regexp "\\'"))
+		      string)
 	(base64-decode-string string)
       (error "Invalid encoded-text %s" string)))
   )
@@ -140,27 +196,22 @@ mmencode included in metamail or XEmacs package)."
   (and (featurep 'mule)
        (progn
 	 (require 'path-util)
-	 (module-installed-p 'mel-b-ccl)
-	 )))
+	 (module-installed-p 'mel-b-ccl))))
 
 (defvar mel-q-ccl-module
   (and (featurep 'mule)
        (progn
 	 (require 'path-util)
-	 (module-installed-p 'mel-q-ccl)
-	 )))
+	 (module-installed-p 'mel-q-ccl))))
 
-(if mel-b-ccl-module
-    (mel-use-module 'mel-b-ccl '("base64" "B"))
-  )
+(when mel-b-ccl-module
+  (mel-use-module 'mel-b-ccl '("base64" "B")))
 
-(if mel-q-ccl-module
-    (mel-use-module 'mel-q-ccl '("quoted-printable" "Q"))
-  )
+(when mel-q-ccl-module
+  (mel-use-module 'mel-q-ccl '("quoted-printable" "Q")))
 
-(if base64-dl-module
-    (mel-use-module 'mel-b-dl '("base64" "B"))
-  )
+(when base64-dl-module
+  (mel-use-module 'mel-b-dl '("base64" "B")))
 
 
 ;;; @ region
@@ -171,12 +222,11 @@ mmencode included in metamail or XEmacs package)."
   "Encode region START to END of current buffer using ENCODING.
 ENCODING must be string."
   (interactive
-   (list (region-beginning) (region-end)
-	 (completing-read "encoding: "
+   (list (region-beginning)(region-end)
+	 (completing-read "Encoding: "
 			  (mime-encoding-alist)
 			  nil t "base64")))
-  (funcall (mel-find-function 'mime-encode-region encoding) start end)
-  )
+  (funcall (mel-find-function 'mime-encode-region encoding) start end))
 
 
 ;;;###autoload
@@ -184,8 +234,8 @@ ENCODING must be string."
   "Decode region START to END of current buffer using ENCODING.
 ENCODING must be string."
   (interactive
-   (list (region-beginning) (region-end)
-	 (completing-read "encoding: "
+   (list (region-beginning)(region-end)
+	 (completing-read "Encoding: "
 			  (mime-encoding-alist 'mime-decode-region)
 			  nil t "base64")))
   (funcall (mel-find-function 'mime-decode-region encoding)
@@ -201,41 +251,49 @@ ENCODING must be string."
 ENCODING must be string.  If ENCODING is found in
 `mime-string-decoding-method-alist' as its key, this function decodes
 the STRING by its value."
-  (funcall (mel-find-function 'mime-decode-string encoding)
-	   string))
+  (let ((f (mel-find-function 'mime-decode-string encoding)))
+    (if f
+	(funcall f string)
+      string)))
 
 
-(mel-define-service encoded-text-encode-string (string encoding)
+(mel-define-service encoded-text-encode-string)
+(defun encoded-text-encode-string (string encoding &optional mode)
   "Encode STRING as encoded-text using ENCODING.
-ENCODING must be string.")
+ENCODING must be string.
+Optional argument MODE allows `text', `comment', `phrase' or nil.
+Default value is `phrase'."
+  (if (string= encoding "B")
+      (base64-encode-string string 'no-line-break)
+    (let ((f (mel-find-function 'encoded-text-encode-string encoding)))
+      (if f
+	  (funcall f string mode)
+	string))))
 
 (mel-define-service encoded-text-decode-string (string encoding)
-  "Decode STRING as encoded-text using ENCODING.
-ENCODING must be string.")
+  "Decode STRING as encoded-text using ENCODING.  ENCODING must be string.")
 
 (defun base64-encoded-length (string)
   (* (/ (+ (length string) 2) 3) 4))
 
 (defsubst Q-encoding-printable-char-p (chr mode)
   (and (not (memq chr '(?= ?? ?_)))
-       (<= ?\   chr)(<= chr ?~)
+       (<= ?\  chr)(<= chr ?~)
        (cond ((eq mode 'text) t)
 	     ((eq mode 'comment)
-	      (not (memq chr '(?\( ?\) ?\\)))
-	      )
+	      (not (memq chr '(?\( ?\) ?\\))))
 	     (t
-	      (string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr))
-	      ))))
+	      (string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr))))))
 
 (defun Q-encoded-text-length (string &optional mode)
   (let ((l 0)(i 0)(len (length string)) chr)
     (while (< i len)
-      (setq chr (elt string i))
-      (if (Q-encoding-printable-char-p chr mode)
+      (setq chr (aref string i))
+      (if (or (Q-encoding-printable-char-p chr mode)
+	      (eq chr ? ))
 	  (setq l (+ l 1))
-	(setq l (+ l 3))
-	)
-      (setq i (+ i 1)) )
+	(setq l (+ l 3)))
+      (setq i (+ i 1)))
     l))
 
 
@@ -247,7 +305,7 @@ ENCODING must be string.")
   "Insert file FILENAME encoded by ENCODING format."
   (interactive
    (list (read-file-name "Insert encoded file: ")
-	 (completing-read "encoding: "
+	 (completing-read "Encoding: "
 			  (mime-encoding-alist)
 			  nil t "base64")))
   (funcall (mel-find-function 'mime-insert-encoded-file encoding)
@@ -259,9 +317,9 @@ ENCODING must be string.")
   "Decode and write current region encoded by ENCODING into FILENAME.
 START and END are buffer positions."
   (interactive
-   (list (region-beginning) (region-end)
+   (list (region-beginning)(region-end)
 	 (read-file-name "Write decoded region to file: ")
-	 (completing-read "encoding: "
+	 (completing-read "Encoding: "
 			  (mime-encoding-alist 'mime-write-decoded-region)
 			  nil t "base64")))
   (funcall (mel-find-function 'mime-write-decoded-region encoding)