Sync with flim-1_14_0-pre5.

diff --git a/mail/qmtp.el b/mail/qmtp.el
index 459cd7f..9be821d 100644 (file)
--- a/mail/qmtp.el
+++ b/mail/qmtp.el
@@ -29,12 +29,11 @@
 
 ;; To send mail using QMTP instead of SMTP, do
 
-;; (fset 'smtp-via-smtp 'qmtp-via-qmtp)
+;; (fset 'smtp-send-buffer 'qmtp-send-buffer)
 
 ;;; Code:
 
-(require 'poem)
-(require 'pcustom)
+(require 'custom)
 
 (defgroup qmtp nil
   "QMTP protocol for sending mail."
@@ -125,11 +124,11 @@ called from `qmtp-via-qmtp' with arguments SENDER and RECIPIENTS.")
     (setq qmtp-read-point (point-min))
     (let (process)
       (unwind-protect
-         (progn
-           (as-binary-process
-            (setq process
-                  (funcall qmtp-open-connection-function
-                           "QMTP" (current-buffer) qmtp-server qmtp-service)))
+         (let ((coding-system-for-read  'binary)
+               (coding-system-for-write 'binary))
+           (setq process
+                 (funcall qmtp-open-connection-function
+                          "QMTP" (current-buffer) qmtp-server qmtp-service))
            (qmtp-send-package process sender recipients buffer))
        (when (and process
                   (memq (process-status process) '(open run)))

diff --git a/mail/smtp.el b/mail/smtp.el
index 2a979d4..0d3fef5 100644 (file)
--- a/mail/smtp.el
+++ b/mail/smtp.el
@@ -32,9 +32,10 @@
 ;;; Code:
 
 (require 'pces)
-(require 'pcustom)
+(require 'custom)
 (require 'mail-utils)                  ; mail-strip-quoted-names
 (require 'sasl)
+(require 'luna)
 
 (defgroup smtp nil
   "SMTP protocol for sending mail."
@@ -120,36 +121,32 @@ don't define this value."
 
 (defvar smtp-submit-package-function #'smtp-submit-package)
 
-;;; @ SMTP package structure
+;;; @ SMTP package
 ;;; A package contains a mail message, an envelope sender address,
 ;;; and one or more envelope recipient addresses.  In ESMTP model
 ;;; the current sending package should be guaranteed to be accessible
 ;;; anywhere from the hook methods (or SMTP commands).
 
-(defmacro smtp-package-sender (package)
-  "Return the sender of PACKAGE, a string."
-  `(aref ,package 0))
-
-(defmacro smtp-package-recipients (package)
-  "Return the recipients of PACKAGE, a list of strings."
-  `(aref ,package 1))
+(eval-and-compile
+  (luna-define-class smtp-package ()
+                    (sender
+                     recipients
+                     buffer))
 
-(defmacro smtp-package-buffer (package)
-  "Return the data of PACKAGE, a buffer."
-  `(aref ,package 2))
+  (luna-define-internal-accessors 'smtp-package))
 
-(defmacro smtp-make-package (sender recipients buffer)
+(defun smtp-make-package (sender recipients buffer)
   "Create a new package structure.
 A package is a unit of SMTP message
 SENDER specifies the package sender, a string.
 RECIPIENTS is a list of recipients.
 BUFFER may be a buffer or a buffer name which contains mail message."
-  `(vector ,sender ,recipients ,buffer))
+  (luna-make-entity 'smtp-package :sender sender :recipients recipients :buffer buffer))
 
-(defun smtp-package-buffer-size (package)
+(defun smtp-package-buffer-internal-size (package)
   "Return the size of PACKAGE, an integer."
   (save-excursion
-    (set-buffer (smtp-package-buffer package))
+    (set-buffer (smtp-package-buffer-internal package))
     (let ((size
           (+ (buffer-size)
              ;; Add one byte for each change-of-line
@@ -165,49 +162,42 @@ BUFFER may be a buffer or a buffer name which contains mail message."
        (setq size (1+ size)))
       size)))
 
-;;; @ SMTP connection structure
+;;; @ SMTP connection
 ;;; We should consider the function `open-network-stream' is a emulation
 ;;; for another network stream.  They are likely to be implemented with an
 ;;; external program and the function `process-contact' returns the
 ;;; process id instead of `(HOST SERVICE)' pair.
 
-(defmacro smtp-connection-process (connection)
-  "Return the subprocess-object of CONNECTION."
-  `(aref ,connection 0))
-
-(defmacro smtp-connection-server (connection)
-  "Return the server of CONNECTION, a string."
-  `(aref ,connection 1))
-
-(defmacro smtp-connection-service (connection)
-  "Return the service of CONNECTION, a string or an integer."
-  `(aref ,connection 2))
-
-(defmacro smtp-connection-extensions (connection)
-  "Return the SMTP extensions of CONNECTION, a list of strings."
-  `(aref ,connection 3))
+(eval-and-compile
+  (luna-define-class smtp-connection ()
+                    (process
+                     server
+                     service
+                     extensions
+                     encoder
+                     decoder))
 
-(defmacro smtp-connection-set-extensions (connection extensions)
-  "Set the SMTP extensions of CONNECTION.
-EXTENSIONS is a list of cons cells of the form \(EXTENSION . PARAMETERS).
-Where EXTENSION is a symbol and PARAMETERS is a list of strings."
-  `(aset ,connection 3 ,extensions))
+  (luna-define-internal-accessors 'smtp-connection))
 
-(defmacro smtp-make-connection (process server service)
+(defun smtp-make-connection (process server service)
   "Create a new connection structure.
 PROCESS is an internal subprocess-object.  SERVER is name of the host
 to connect to.  SERVICE is name of the service desired."
-  `(vector ,process ,server ,service nil))
+  (luna-make-entity 'smtp-connection :process process :server server :service service))
 
-(defun smtp-connection-opened (connection)
-  "Say whether the CONNECTION to server has been opened."
-  (let ((process (smtp-connection-process connection)))
+(luna-define-generic smtp-connection-opened (connection)
+  "Say whether the CONNECTION to server has been opened.")
+
+(luna-define-generic smtp-close-connection (connection)
+  "Close the CONNECTION to server.")
+
+(luna-define-method smtp-connection-opened ((connection smtp-connection))
+  (let ((process (smtp-connection-process-internal connection)))
     (if (memq (process-status process) '(open run))
        t)))
 
-(defun smtp-close-connection (connection)
-  "Close the CONNECTION to server."
-  (let ((process (smtp-connection-process connection)))
+(luna-define-method smtp-close-connection ((connection smtp-connection))
+  (let ((process (smtp-connection-process-internal connection)))
     (delete-process process)))
 
 (defun smtp-make-fqdn ()
@@ -244,11 +234,12 @@ to connect to.  SERVICE is name of the service desired."
 Return a newly allocated connection-object.
 BUFFER is the buffer to associate with the connection.  SERVER is name
 of the host to connect to.  SERVICE is name of the service desired."
-  (let ((process
-        (as-binary-process
+  (let* ((coding-system-for-read  'binary)
+        (coding-system-for-write 'binary)
+        (process
          (funcall smtp-open-connection-function
-                  "SMTP" buffer  server service)))
-       connection)
+                  "SMTP" buffer  server service))
+        connection)
     (when process
       (setq connection (smtp-make-connection process server service))
       (set-process-filter process 'smtp-process-filter)
@@ -318,22 +309,19 @@ of the host to connect to.  SERVICE is name of the service desired."
   (let* ((connection
          (smtp-find-connection (current-buffer)))
         (response
-         (smtp-read-response
-          (smtp-connection-process connection))))
+         (smtp-read-response connection)))
     (if (/= (car response) 220)
        (smtp-response-error response))))
 
 (defun smtp-primitive-ehlo (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
-        (process
-         (smtp-connection-process connection))
         response)
-    (smtp-send-command process (format "EHLO %s" (smtp-make-fqdn)))
-    (setq response (smtp-read-response process))
+    (smtp-send-command connection (format "EHLO %s" (smtp-make-fqdn)))
+    (setq response (smtp-read-response connection))
     (if (/= (car response) 250)
        (smtp-response-error response))
-    (smtp-connection-set-extensions
+    (smtp-connection-set-extensions-internal
      connection (mapcar
                 (lambda (extension)
                   (let ((extensions
@@ -347,21 +335,17 @@ of the host to connect to.  SERVICE is name of the service desired."
 (defun smtp-primitive-helo (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
-        (process
-         (smtp-connection-process connection))
         response)
-    (smtp-send-command process (format "HELO %s" (smtp-make-fqdn)))
-    (setq response (smtp-read-response process))
+    (smtp-send-command connection (format "HELO %s" (smtp-make-fqdn)))
+    (setq response (smtp-read-response connection))
     (if (/= (car response) 250)
        (smtp-response-error response))))
 
 (defun smtp-primitive-auth (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
-        (process
-         (smtp-connection-process connection))
         (mechanisms
-         (cdr (assq 'auth (smtp-connection-extensions connection))))
+         (cdr (assq 'auth (smtp-connection-extensions-internal connection))))
         (sasl-mechanisms
          (or smtp-sasl-mechanisms sasl-mechanisms))
         (mechanism
@@ -373,20 +357,20 @@ of the host to connect to.  SERVICE is name of the service desired."
     (unless mechanism
       (error "No authentication mechanism available"))
     (setq client (sasl-make-client mechanism smtp-sasl-user-name "smtp"
-                                  (smtp-connection-server connection)))
+                                  (smtp-connection-server-internal connection)))
     (if smtp-sasl-properties
        (sasl-client-set-properties client smtp-sasl-properties))
     (setq name (sasl-mechanism-name mechanism)
          ;; Retrieve the initial response
          step (sasl-next-step client nil))
     (smtp-send-command
-     process
+     connection
      (if (sasl-step-data step)
         (format "AUTH %s %s" name (base64-encode-string (sasl-step-data step) t))
        (format "AUTH %s" name)))
     (catch 'done
       (while t
-       (setq response (smtp-read-response process))
+       (setq response (smtp-read-response connection))
        (when (= (car response) 235)
          ;; The authentication process is finished.
          (setq step (sasl-next-step client step))
@@ -398,97 +382,93 @@ of the host to connect to.  SERVICE is name of the service desired."
        (sasl-step-set-data step (base64-decode-string (nth 1 response)))
        (setq step (sasl-next-step client step))
        (smtp-send-command
-        process (if (sasl-step-data step)
-                    (base64-encode-string (sasl-step-data step) t)
-                  ""))))))
+        connection
+        (if (sasl-step-data step)
+            (base64-encode-string (sasl-step-data step) t)
+          ""))))
+;;;    (smtp-connection-set-encoder-internal
+;;;     connection (sasl-client-encoder client))
+;;;    (smtp-connection-set-decoder-internal
+;;;     connection (sasl-client-decoder client))
+    ))
 
 (defun smtp-primitive-starttls (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
-        (process
-         (smtp-connection-process connection))
         response)
     ;; STARTTLS --- begin a TLS negotiation (RFC 2595)
-    (smtp-send-command process "STARTTLS")
-    (setq response (smtp-read-response process))
+    (smtp-send-command connection "STARTTLS")
+    (setq response (smtp-read-response connection))
     (if (/= (car response) 220)
        (smtp-response-error response))
-    (starttls-negotiate process)))
+    (starttls-negotiate (smtp-connection-process-internal connection))))
 
 (defun smtp-primitive-mailfrom (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
-        (process
-         (smtp-connection-process connection))
         (extensions
-         (smtp-connection-extensions
+         (smtp-connection-extensions-internal
           connection))
         (sender
-         (smtp-package-sender package))
+         (smtp-package-sender-internal package))
         extension
         response)
     ;; SIZE --- Message Size Declaration (RFC1870)
     (if (and smtp-use-size
             (assq 'size extensions))
-       (setq extension (format "SIZE=%d" (smtp-package-buffer-size package))))
+       (setq extension (format "SIZE=%d" (smtp-package-buffer-internal-size package))))
     ;; 8BITMIME --- 8bit-MIMEtransport (RFC1652)
     (if (and smtp-use-8bitmime
             (assq '8bitmime extensions))
        (setq extension (concat extension " BODY=8BITMIME")))
     (smtp-send-command
-     process
+     connection
      (if extension
         (format "MAIL FROM:<%s> %s" sender extension)
        (format "MAIL FROM:<%s>" sender)))
-    (setq response (smtp-read-response process))
+    (setq response (smtp-read-response connection))
     (if (/= (car response) 250)
        (smtp-response-error response))))
 
 (defun smtp-primitive-rcptto (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
-        (process
-         (smtp-connection-process connection))
         (recipients
-         (smtp-package-recipients package))
+         (smtp-package-recipients-internal package))
         response)
     (while recipients
       (smtp-send-command
-       process (format "RCPT TO:<%s>" (pop recipients)))
-      (setq response (smtp-read-response process))
+       connection (format "RCPT TO:<%s>" (pop recipients)))
+      (setq response (smtp-read-response connection))
       (unless (memq (car response) '(250 251))
        (smtp-response-error response)))))
 
 (defun smtp-primitive-data (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
-        (process
-         (smtp-connection-process connection))
         response)
-    (smtp-send-command process "DATA")
-    (setq response (smtp-read-response process))
+    (smtp-send-command connection "DATA")
+    (setq response (smtp-read-response connection))
     (if (/= (car response) 354)
        (smtp-response-error response))
     (save-excursion
-      (set-buffer (smtp-package-buffer package))
+      (set-buffer (smtp-package-buffer-internal package))
       (goto-char (point-min))
       (while (not (eobp))
        (smtp-send-data
-        process (buffer-substring (point) (progn (end-of-line)(point))))
+        connection (buffer-substring (point) (progn (end-of-line)(point))))
        (beginning-of-line 2)))
-    (smtp-send-command process ".")
-    (setq response (smtp-read-response process))
+    (smtp-send-command connection ".")
+    (setq response (smtp-read-response connection))
     (if (/= (car response) 250)
        (smtp-response-error response))))
 
 (defun smtp-primitive-quit (package)
   (let* ((connection
          (smtp-find-connection (current-buffer)))
-        (process
-         (smtp-connection-process connection))
         response)
-    (smtp-send-command process "QUIT")
-    (setq response (smtp-read-response process))
+    (smtp-send-command connection "QUIT")
+    (setq response (smtp-read-response connection))
     (if (/= (car response) 221)
        (smtp-response-error response))))
 
@@ -509,14 +489,20 @@ of the host to connect to.  SERVICE is name of the service desired."
 (defun smtp-response-error (response)
   (signal 'smtp-response-error response))
 
-(defun smtp-read-response (process)
-  (let ((response-continue t)
+(defun smtp-read-response (connection)
+  (let ((decoder
+        (smtp-connection-decoder-internal connection))
+       (response-continue t)
        response)
     (while response-continue
       (goto-char smtp-read-point)
       (while (not (search-forward "\r\n" nil t))
-       (accept-process-output process)
+       (accept-process-output (smtp-connection-process-internal connection))
        (goto-char smtp-read-point))
+      (if decoder
+         (let ((string (buffer-substring smtp-read-point (- (point) 2))))
+           (delete-region smtp-read-point (point))
+           (insert (funcall decoder string) "\r\n")))
       (setq response
            (nconc response
                   (list (buffer-substring
@@ -530,21 +516,33 @@ of the host to connect to.  SERVICE is name of the service desired."
                response-continue nil)))
     response))
 
-(defun smtp-send-command (process command)
+(defun smtp-send-command (connection command)
   (save-excursion
-    (set-buffer (process-buffer process))
-    (goto-char (point-max))
-    (insert command "\r\n")
-    (setq smtp-read-point (point))
-    (process-send-string process command)
-    (process-send-string process "\r\n")))
-
-(defun smtp-send-data (process data)
-  ;; Escape "." at start of a line.
-  (if (eq (string-to-char data) ?.)
-      (process-send-string process "."))
-  (process-send-string process data)
-  (process-send-string process "\r\n"))
+    (let ((process
+          (smtp-connection-process-internal connection))
+         (encoder
+          (smtp-connection-encoder-internal connection)))
+      (set-buffer (process-buffer process))
+      (goto-char (point-max))
+      (setq command (concat command "\r\n"))
+      (insert command)
+      (setq smtp-read-point (point))
+      (if encoder
+         (setq command (funcall encoder command)))
+      (process-send-string process command))))
+
+(defun smtp-send-data (connection data)
+  (let ((process
+        (smtp-connection-process-internal connection))
+       (encoder
+        (smtp-connection-encoder-internal connection)))
+    ;; Escape "." at start of a line.
+    (if (eq (string-to-char data) ?.)
+       (setq data (concat "." data "\r\n"))
+      (setq data (concat data "\r\n")))
+    (if encoder
+       (setq data (funcall encoder data)))
+    (process-send-string process data)))
 
 (defun smtp-deduce-address-list (smtp-text-buffer header-start header-end)
   "Get address list suitable for smtp RCPT TO:<address>."

diff --git a/mail/smtpmail.el b/mail/smtpmail.el
index 8582394..094dc4f 100644 (file)
--- a/mail/smtpmail.el
+++ b/mail/smtpmail.el
@@ -42,8 +42,7 @@
 
 ;;; Code:
 
-(require 'poe)
-(require 'pcustom)
+(require 'custom)
 (require 'smtp)
 (require 'sendmail)
 (require 'time-stamp)
@@ -245,7 +244,7 @@ This is relative to `smtpmail-queue-dir'.")
                (insert-buffer tembuf)
                (or (file-directory-p smtpmail-queue-dir)
                    (make-directory smtpmail-queue-dir t))
-               (write-region-as-binary (point-min) (point-max) file-data)
+               (binary-write-region (point-min) (point-max) file-data)
                (set-buffer buffer-elisp)
                (erase-buffer)
                (insert (concat

diff --git a/mime/mel-b-ccl.el b/mime/mel-b-ccl.el
index fa12483..7e31dfa 100644 (file)
--- a/mime/mel-b-ccl.el
+++ b/mime/mel-b-ccl.el
@@ -1,8 +1,8 @@
 ;;; mel-b-ccl.el --- Base64 encoder/decoder using CCL.
 
-;; Copyright (C) 1998,1999 Tanaka Akira
+;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc.
 
-;; Author: Tanaka Akira <akr@jaist.ac.jp>
+;; Author: Tanaka Akira <akr@m17n.org>
 ;; Created: 1998/9/17
 ;; Keywords: MIME, Base64
 
@@ -419,7 +419,9 @@ abcdefghijklmnopqrstuvwxyz\
   (defun base64-ccl-insert-encoded-file (filename)
     "Encode contents of file FILENAME to base64, and insert the result."
     (interactive "*fInsert encoded file: ")
-    (insert-file-contents-as-coding-system 'mel-ccl-base64-lf-rev filename))
+    (let ((coding-system-for-read 'mel-ccl-base64-lf-rev)
+         format-alist)
+      (insert-file-contents filename)))
 
   (mel-define-method-function (mime-encode-string string (nil "base64"))
                              'base64-ccl-encode-string)
@@ -447,7 +449,9 @@ abcdefghijklmnopqrstuvwxyz\
 (defun base64-ccl-write-decoded-region (start end filename)
   "Decode the region from START to END and write out to FILENAME."
   (interactive "*r\nFWrite decoded region to file: ")
-  (write-region-as-coding-system 'mel-ccl-b-rev start end filename))
+  (let ((coding-system-for-write 'mel-ccl-b-rev)
+       jka-compr-compression-info-list jam-zcat-filename-list)
+    (write-region start end filename)))
 
 (mel-define-method-function (mime-decode-string string (nil "base64"))
                            'base64-ccl-decode-string)

diff --git a/mime/mel-q-ccl.el b/mime/mel-q-ccl.el
index c71fab6..cb54a56 100644 (file)
--- a/mime/mel-q-ccl.el
+++ b/mime/mel-q-ccl.el
@@ -898,8 +898,9 @@ abcdefghijklmnopqrstuvwxyz\
   (defun quoted-printable-ccl-insert-encoded-file (filename)
     "Encode contents of the file named as FILENAME, and insert it."
     (interactive "*fInsert encoded file: ")
-    (insert-file-contents-as-coding-system
-     'mel-ccl-quoted-printable-lf-lf-rev filename))
+    (let ((coding-system-for-read 'mel-ccl-quoted-printable-lf-lf-rev)
+         format-alist)
+      (insert-file-contents filename)))
 
   (mel-define-method-function
    (mime-encode-string string (nil "quoted-printable"))
@@ -927,8 +928,9 @@ encoding."
 (defun quoted-printable-ccl-write-decoded-region (start end filename)
   "Decode quoted-printable encoded current region and write out to FILENAME."
   (interactive "*r\nFWrite decoded region to file: ")
-  (write-region-as-coding-system 'mel-ccl-quoted-printable-lf-lf-rev
-                                start end filename))
+  (let ((coding-system-for-write 'mel-ccl-quoted-printable-lf-lf-rev)
+       jka-compr-compression-info-list jam-zcat-filename-list)
+    (write-region start end filename)))
 
 (mel-define-method-function
  (mime-decode-string string (nil "quoted-printable"))

diff --git a/mime/mel-u.el b/mime/mel-u.el
index 49d5733..ead3efb 100644 (file)
--- a/mime/mel-u.el
+++ b/mime/mel-u.el
@@ -51,11 +51,12 @@ This function uses external uuencode encoder which is specified by
 variable `uuencode-external-encoder'."
   (interactive "*r")
   (save-excursion
-    (as-binary-process
-     (apply (function call-process-region)
-           start end (car uuencode-external-encoder)
-           t t nil
-           (cdr uuencode-external-encoder)))
+    (let ((coding-system-for-read  'binary)
+         (coding-system-for-write 'binary))
+      (apply (function call-process-region)
+            start end (car uuencode-external-encoder)
+            t t nil
+            (cdr uuencode-external-encoder)))
     ;; for OS/2
     ;;   regularize line break code
     (goto-char (point-min))
@@ -78,19 +79,20 @@ variable `uuencode-external-decoder'."
                                                  (match-end 0)))))))
          (default-directory temporary-file-directory))
       (if filename
-         (as-binary-process
-          (apply (function call-process-region)
-                 start end (car uuencode-external-decoder)
-                 t nil nil
-                 (cdr uuencode-external-decoder))
-          (as-binary-input-file (insert-file-contents filename))
-          ;; The previous line causes the buffer to be made read-only, I
-          ;; do not pretend to understand the control flow leading to this
-          ;; but suspect it has something to do with image-mode. -slb
-          ;;   Use `inhibit-read-only' to avoid to force
-          ;;   buffer-read-only nil. - tomo.
-          (let ((inhibit-read-only t))
-            (delete-file filename)))))))
+         (let ((coding-system-for-read  'binary)
+               (coding-system-for-write 'binary))
+           (apply (function call-process-region)
+                  start end (car uuencode-external-decoder)
+                  t nil nil
+                  (cdr uuencode-external-decoder))
+           (insert-file-contents filename)
+           ;; The previous line causes the buffer to be made read-only, I
+           ;; do not pretend to understand the control flow leading to this
+           ;; but suspect it has something to do with image-mode. -slb
+           ;;  Use `inhibit-read-only' to avoid to force
+           ;;  buffer-read-only nil. - tomo.
+           (let ((inhibit-read-only t))
+             (delete-file filename)))))))
 
 (mel-define-method-function (mime-encode-region start end (nil "x-uue"))
                            'uuencode-external-encode-region)
@@ -142,12 +144,13 @@ START and END are buffer positions."
                                              (match-end 0)))))))
          (default-directory temporary-file-directory))
       (if file
-         (as-binary-process
-          (apply (function call-process-region)
-                 start end (car uuencode-external-decoder)
-                 nil nil nil
-                 (cdr uuencode-external-decoder))
-          (rename-file file filename 'overwrites))))))
+         (let ((coding-system-for-read  'binary)
+               (coding-system-for-write 'binary))
+           (apply (function call-process-region)
+                  start end (car uuencode-external-decoder)
+                  nil nil nil
+                  (cdr uuencode-external-decoder))
+           (rename-file file filename 'overwrites))))))
 
 
 ;;; @ end

diff --git a/mime/mel.el b/mime/mel.el
index 12fff86..7df86fd 100644 (file)
--- a/mime/mel.el
+++ b/mime/mel.el
@@ -26,9 +26,7 @@
 ;;; Code:
 
 (require 'mime-def)
-(require 'poem)
 (require 'alist)
-(require 'path-util)
 
 (defcustom mime-encoding-list
   '("7bit" "8bit" "binary" "base64" "quoted-printable")
@@ -87,10 +85,10 @@ Content-Transfer-Encoding for it."
 (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)
+                           'binary-insert-file-contents)
 (mel-define-method-function (mime-write-decoded-region
                             start end filename (nil "7bit"))
-                           'write-region-as-binary)
+                           'binary-write-region)
 
 (mel-define-backend "8bit" ("7bit"))
 
@@ -119,7 +117,7 @@ mmencode included in metamail or XEmacs package)."
     (insert (base64-encode-string
             (with-temp-buffer
               (set-buffer-multibyte nil)
-              (insert-file-contents-as-binary filename)
+              (binary-insert-file-contents filename)
               (buffer-string))))
     (or (bolp) (insert ?\n)))
     

diff --git a/mime/mime-def.el b/mime/mime-def.el
index acae86f..4fa1c96 100644 (file)
--- a/mime/mime-def.el
+++ b/mime/mime-def.el
@@ -24,9 +24,7 @@
 
 ;;; Code:
 
-(require 'poe)
-(require 'poem)
-(require 'pcustom)
+(require 'custom)
 (require 'mcharset)
 (require 'alist)
 
@@ -59,8 +57,6 @@
 ;;; @ variables
 ;;;
 
-(require 'custom)
-
 (defgroup mime '((default-mime-charset custom-variable))
   "Emacs MIME Interfaces"
   :group 'news
@@ -81,7 +77,24 @@
 (defsubst regexp-or (&rest args)
   (concat "\\(" (mapconcat (function identity) args "\\|") "\\)"))
 
+(eval-when-compile (require 'static))
+
+(static-if (and (featurep 'xemacs)
+               (not (featurep 'utf-2000)))
+    (progn
+      (require 'pces)
+      (defalias 'binary-insert-file-contents 'insert-file-contents-as-binary)
+      (defalias 'binary-write-region 'write-region-as-binary))
+  (defalias 'binary-insert-file-contents 'insert-file-contents-literally)
+  (defun binary-write-region (start end filename
+                                   &optional append visit lockname)
+    "Like `write-region', q.v., but don't encode."
+    (let ((coding-system-for-write 'binary)
+         jka-compr-compression-info-list jam-zcat-filename-list)
+      (write-region start end filename append visit lockname)))
+  )
 
+  
 ;;; @ about STD 11
 ;;;
 

diff --git a/mime/mmbuffer.el b/mime/mmbuffer.el
index 6a7803a..b99d80b 100644 (file)
--- a/mime/mmbuffer.el
+++ b/mime/mmbuffer.el
@@ -96,11 +96,10 @@
 (luna-define-method mime-write-entity ((entity mime-buffer-entity) filename)
   (save-excursion
     (set-buffer (mime-buffer-entity-buffer-internal entity))
-    (write-region-as-raw-text-CRLF
-     (mime-buffer-entity-header-start-internal entity)
-     (mime-buffer-entity-body-end-internal entity)
-     filename)
-    ))
+    (let ((coding-system-for-write 'raw-text-dos))
+      (write-region (mime-buffer-entity-header-start-internal entity)
+                   (mime-buffer-entity-body-end-internal entity)
+                   filename))))
 
 
 ;;; @ entity header
@@ -126,10 +125,9 @@
                                            filename)
   (save-excursion
     (set-buffer (mime-buffer-entity-buffer-internal entity))
-    (write-region-as-binary (mime-buffer-entity-body-start-internal entity)
-                           (mime-buffer-entity-body-end-internal entity)
-                           filename)
-    ))
+    (binary-write-region (mime-buffer-entity-body-start-internal entity)
+                        (mime-buffer-entity-body-end-internal entity)
+                        filename)))
 
 
 ;;; @ entity content

diff --git a/mime/mmexternal.el b/mime/mmexternal.el
index 9da0773..90f838f 100644 (file)
--- a/mime/mmexternal.el
+++ b/mime/mmexternal.el
@@ -79,7 +79,7 @@
                                 (concat " *Body of "
                                         (mime-entity-name entity)
                                         "*"))
-            (insert-file-contents-as-binary
+            (binary-insert-file-contents
              (mime-external-entity-body-file-internal entity))
             (current-buffer))))
       (error (message "Can't get external-body.")))))
@@ -96,7 +96,8 @@
 (luna-define-method mime-write-entity ((entity mime-external-entity) filename)
   (with-temp-buffer
     (mime-insert-entity entity)
-    (write-region-as-raw-text-CRLF (point-min) (point-max) filename)))
+    (let ((coding-system-for-write 'raw-text-dos))
+      (write-region (point-min) (point-max) filename))))
 
 
 ;;; @ entity header
@@ -120,7 +121,7 @@
                                            filename)
   (mmexternal-require-buffer entity)
   (with-current-buffer (mime-external-entity-body-buffer-internal entity)
-    (write-region-as-binary (point-min) (point-max) filename)))
+    (binary-write-region (point-min) (point-max) filename)))
 
 
 ;;; @ entity content

diff --git a/mime/std11.el b/mime/std11.el
index dc7bde5..051d45a 100644 (file)
--- a/mime/std11.el
+++ b/mime/std11.el
@@ -1,8 +1,8 @@
 ;;; std11.el --- STD 11 functions for GNU Emacs
 
-;; Copyright (C) 1995,1996,1997,1998,1999 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>
 ;; Keywords: mail, news, RFC 822, STD 11
 
 ;; This file is part of FLIM (Faithful Library about Internet Message).
@@ -24,9 +24,7 @@
 
 ;;; Code:
 
-(require 'poe)
-(require 'poem)                                ; find-non-ascii-charset-string
-(require 'pcustom)                     ; std11-lexical-analyzer
+(require 'custom)                      ; std11-lexical-analyzer
 
 
 ;;; @ fetch
@@ -435,8 +433,7 @@ be the result."
                (setq token (car lal))
                (or (std11-ignored-token-p token)
                    (if (and (setq token-value (cdr token))
-                            (find-non-ascii-charset-string token-value)
-                            )
+                            (delq 'ascii (find-charset-string token-value)))
                        (setq token nil)
                      )))
       (setq lal (cdr lal))