From 36f1b9e4be394498fcba18ae41802fb8655c8a87 Mon Sep 17 00:00:00 2001 From: tomo Date: Fri, 15 Dec 2000 04:56:46 +0000 Subject: [PATCH] Sync with flim-1_14_0-pre5. --- mail/qmtp.el | 15 ++-- mail/smtp.el | 228 ++++++++++++++++++++++++++-------------------------- mail/smtpmail.el | 5 +- mime/mel-b-ccl.el | 12 ++- mime/mel-q-ccl.el | 10 ++- mime/mel-u.el | 51 ++++++------ mime/mel.el | 8 +- mime/mime-def.el | 23 ++++-- mime/mmbuffer.el | 16 ++-- mime/mmexternal.el | 7 +- mime/std11.el | 11 +-- 11 files changed, 199 insertions(+), 187 deletions(-) diff --git a/mail/qmtp.el b/mail/qmtp.el index 459cd7f..9be821d 100644 --- 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 --- 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:
." diff --git a/mail/smtpmail.el b/mail/smtpmail.el index 8582394..094dc4f 100644 --- 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 --- 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 +;; Author: Tanaka Akira ;; 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 +;; Author: MORIOKA Tomohiko ;; 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)) -- 1.7.10.4