(compile-flim-package): Use batch-update-directory-autoloads if it is available

[elisp/flim.git] / mel.el

diff --git a/mel.el b/mel.el
index ccfc072..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,14 +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 'poem)
+(require 'alist)

 
 (defcustom mime-encoding-list
   '("7bit" "8bit" "binary" "base64" "quoted-printable")
 
 (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."
 
 (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

@@ -79,25 +77,84 @@ Content-Transfer-Encoding for it."
 ;;; @ setting for modules
 ;;;
 
 ;;; @ 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)
                            'identity)

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

                            '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 "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
 (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)
   (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)."
 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 (base64-encode-string
             (with-temp-buffer
               (set-buffer-multibyte nil)

-              (insert-file-contents-as-binary filename)
+              (binary-insert-encoded-file filename)

               (buffer-string))))
               (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"))
   (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)))
   )
        (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)
   (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)
 
 (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
 
 
 ;;; @ 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
   "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

@@ -184,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)

@@ -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."
 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)
   (* (/ (+ (length string) 2) 3) 4))
 
 (defsubst Q-encoding-printable-char-p (chr mode)
   (and (not (memq chr '(?= ?? ?_)))
 
 (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)
        (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))
 
 

@@ -247,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)

@@ -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
   "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)