Fixed.

[elisp/flim.git] / mel.el

diff --git a/mel.el b/mel.el
index bd4ea11..44d7a70 100644 (file)
--- 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
 
 ;; Created: 1995/6/25
 ;; Keywords: MIME, Base64, Quoted-Printable, uuencode, gzip64
 

@@ -19,13 +19,14 @@
 ;; General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; 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)
 
 ;;; Code:
 
 (require 'mime-def)

+(require 'alist)

 
 (defcustom mime-encoding-list
   '("7bit" "8bit" "binary" "base64" "quoted-printable")
 
 (defcustom mime-encoding-list
   '("7bit" "8bit" "binary" "base64" "quoted-printable")

@@ -58,17 +59,15 @@ Content-Transfer-Encoding for it."
 
 (defun mime-encoding-alist (&optional service)
   "Return table of Content-Transfer-Encoding for completion."
 
 (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)
 
 (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
 
 (defsubst mel-find-function (service encoding)
   (mel-find-function-from-obarray

@@ -78,42 +77,141 @@ Content-Transfer-Encoding for it."
 ;;; @ setting for modules
 ;;;
 
 ;;; @ setting for modules
 ;;;
 

-(defvar mel-ccl-module
-  (and (featurep 'mule)
-       (progn
-        (require 'path-util)
-        (module-installed-p 'mel-ccl)
-        )))
+(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 "8bit"))
+                           'identity)
+(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 "8bit"))
+                           '8bit-write-decoded-region)

 
 

-(mel-use-module 'mel-b '("base64" "B"))
-(mel-use-module 'mel-q '("quoted-printable" "Q"))
-(mel-use-module 'mel-g '("x-gzip64"))
-(mel-use-module 'mel-u '("x-uue" "x-uuencode"))

 
 

-(if mel-ccl-module
-    (mel-use-module 'mel-ccl '("base64" "quoted-printable" "B" "Q"))
-  )
+(defalias '7bit-insert-encoded-file '8bit-insert-encoded-file)
+(defalias '7bit-write-decoded-region '8bit-write-decoded-region)

 
 

-(if base64-dl-module
-    (mel-use-module 'mel-b-dl '("base64" "B"))
-  )
+(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 "7bit")
-(mel-define-method-function (mime-encode-string string (nil "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")
+(mel-define-method-function (mime-encode-string string (nil "binary"))

                            'identity)
                            'identity)

-(mel-define-method-function (mime-decode-string string (nil "7bit"))
+(mel-define-method-function (mime-decode-string string (nil "binary"))

                            'identity)
                            '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 "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
 (mel-define-method-function (mime-write-decoded-region

-                            start end filename (nil "7bit"))
-                           'write-region-as-binary)
+                            start end filename (nil "binary"))
+                           'binary-write-decoded-region)
+
+(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)
+  (mel-define-method-function (mime-decode-string string (nil "base64"))
+                             'base64-decode-string)
+  (mel-define-method-function (mime-encode-region start end (nil "base64"))
+                             'base64-encode-region)
+  (mel-define-method-function (mime-decode-region start end (nil "base64"))
+                             'base64-decode-region)  
+  (mel-define-method mime-insert-encoded-file (filename (nil "base64"))
+    "Encode contents of file FILENAME to base64, and insert the result.
+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 "*fInsert encoded file: ")
+    (insert (base64-encode-string
+            (with-temp-buffer
+              (set-buffer-multibyte nil)
+              (binary-insert-encoded-file filename)
+              (buffer-string))))
+    (or (bolp) (insert ?\n)))
+    
+  ;; (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 (string-match (eval-when-compile
+                       (concat "\\`" B-encoded-text-regexp "\\'"))
+                     string)
+       (base64-decode-string string)
+      (error "Invalid encoded-text %s" string)))
+  )
+
+(mel-use-module 'mel-b-el '("base64" "B"))
+(mel-use-module 'mel-q '("quoted-printable" "Q"))
+(mel-use-module 'mel-g '("x-gzip64"))
+(mel-use-module 'mel-u '("x-uue" "x-uuencode"))
+
+(defvar mel-b-ccl-module
+  (and (featurep 'mule)
+       (progn
+        (require 'path-util)
+        (module-installed-p 'mel-b-ccl))))
+
+(defvar mel-q-ccl-module
+  (and (featurep 'mule)
+       (progn
+        (require 'path-util)
+        (module-installed-p 'mel-q-ccl))))

 
 

-(mel-define-backend "8bit" ("7bit"))
+(when mel-b-ccl-module
+  (mel-use-module 'mel-b-ccl '("base64" "B")))

 
 

-(mel-define-backend "binary" ("8bit"))
+(when mel-q-ccl-module
+  (mel-use-module 'mel-q-ccl '("quoted-printable" "Q")))
+
+(when base64-dl-module
+  (mel-use-module 'mel-b-dl '("base64" "B")))

 
 
 ;;; @ region
 
 
 ;;; @ region

@@ -124,12 +222,11 @@ Content-Transfer-Encoding for it."
   "Encode region START to END of current buffer using ENCODING.
 ENCODING must be string."
   (interactive
   "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")))
                          (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
 
 
 ;;;###autoload

@@ -137,8 +234,8 @@ ENCODING must be string."
   "Decode region START to END of current buffer using ENCODING.
 ENCODING must be string."
   (interactive
   "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)
                          (mime-encoding-alist 'mime-decode-region)
                          nil t "base64")))
   (funcall (mel-find-function 'mime-decode-region encoding)

@@ -154,45 +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."
 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.
   "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)
 
 (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)
 
 (defun base64-encoded-length (string)

-  (let ((len (length string)))
-    (* (+ (/ len 3)
-         (if (= (mod len 3) 0) 0 1)
-         ) 4)
-    ))
+  (* (/ (+ (length string) 2) 3) 4))

 
 (defsubst Q-encoding-printable-char-p (chr mode)
   (and (not (memq chr '(?= ?? ?_)))
 
 (defsubst Q-encoding-printable-char-p (chr mode)
   (and (not (memq chr '(?= ?? ?_)))

-       (<= ?\   chr)(<= chr ?~)
+       (<= ?\  chr)(<= chr ?~)

        (cond ((eq mode 'text) t)
             ((eq mode 'comment)
        (cond ((eq mode 'text) t)
             ((eq mode 'comment)

-             (not (memq chr '(?\( ?\) ?\\)))
-             )
+             (not (memq chr '(?\( ?\) ?\\))))

             (t
             (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)
 
 (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 1))

-       (setq l (+ l 3))
-       )
-      (setq i (+ i 1)) )
+       (setq l (+ l 3)))
+      (setq i (+ i 1)))

     l))
 
 
     l))
 
 

@@ -204,7 +305,7 @@ ENCODING must be string.")
   "Insert file FILENAME encoded by ENCODING format."
   (interactive
    (list (read-file-name "Insert encoded file: ")
   "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)
                          (mime-encoding-alist)
                          nil t "base64")))
   (funcall (mel-find-function 'mime-insert-encoded-file encoding)

@@ -216,9 +317,9 @@ ENCODING must be string.")
   "Decode and write current region encoded by ENCODING into FILENAME.
 START and END are buffer positions."
   (interactive
   "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: ")
         (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)
                          (mime-encoding-alist 'mime-write-decoded-region)
                          nil t "base64")))
   (funcall (mel-find-function 'mime-write-decoded-region encoding)