From 57a3177465e8d977a8b2423f4343eefd3adf3d00 Mon Sep 17 00:00:00 2001 From: tomo Date: Tue, 19 Dec 2000 05:10:31 +0000 Subject: [PATCH] Sync with semi21-1_14_0-pre4-1. --- qmtp.el | 6 ++-- raw-io.el | 104 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ smtp.el | 16 ++++----- smtpmail.el | 3 +- 4 files changed, 116 insertions(+), 13 deletions(-) create mode 100644 raw-io.el diff --git a/qmtp.el b/qmtp.el index 9be821d..cf5c294 100644 --- a/qmtp.el +++ b/qmtp.el @@ -60,7 +60,8 @@ called from `qmtp-via-qmtp' with arguments SENDER and RECIPIENTS.") :type 'integer :group 'qmtp) -(defvar qmtp-open-connection-function (function open-network-stream)) +(autoload 'binary-open-network-stream "raw-io") +(defvar qmtp-open-connection-function (function binary-open-network-stream)) (defvar qmtp-error-response-alist '((?Z "Temporary failure") @@ -124,8 +125,7 @@ called from `qmtp-via-qmtp' with arguments SENDER and RECIPIENTS.") (setq qmtp-read-point (point-min)) (let (process) (unwind-protect - (let ((coding-system-for-read 'binary) - (coding-system-for-write 'binary)) + (progn (setq process (funcall qmtp-open-connection-function "QMTP" (current-buffer) qmtp-server qmtp-service)) diff --git a/raw-io.el b/raw-io.el new file mode 100644 index 0000000..8718b9a --- /dev/null +++ b/raw-io.el @@ -0,0 +1,104 @@ +;;; raw-io.el --- input/output without code-conversion + +;; Copyright (C) 1997,1998,1999,2000 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Keywords: definition, MIME, multimedia, mail, news + +;; This file is part of APEL (A Portable Emacs Library). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; 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. + +;;; Code: + +(eval-when-compile (require 'static)) + +(static-if (and (featurep 'xemacs) + (not (featurep 'utf-2000))) + (defun binary-insert-file-contents (filename + &optional visit beg end replace) + "Like `insert-file-contents', but only reads in the file literally. +A buffer may be modified in several ways after reading into the buffer, +to Emacs features such as format decoding, character code +conversion, find-file-hooks, automatic uncompression, etc. + +This function ensures that none of these modifications will take place." + (let ((format-alist nil) + (after-insert-file-functions nil) + (coding-system-for-read 'binary) + (coding-system-for-write 'binary) + (jka-compr-compression-info-list nil) + (jam-zcat-filename-list nil) + (find-buffer-file-type-function + (if (fboundp 'find-buffer-file-type) + (symbol-function 'find-buffer-file-type) + nil))) + (unwind-protect + (progn + (fset 'find-buffer-file-type (lambda (filename) t)) + (insert-file-contents filename visit beg end replace)) + (if find-buffer-file-type-function + (fset 'find-buffer-file-type find-buffer-file-type-function) + (fmakunbound 'find-buffer-file-type))))) + (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))) + +(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-open-network-stream (name buffer host service &rest options) + "Like `open-network-stream', q.v., but don't code and format conversion." + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary)) + (apply #'open-network-stream name buffer host service options))) + + +(defun raw-text-insert-file-contents (filename + &optional visit beg end replace) + "Like `insert-file-contents', q.v., but don't code and format conversion. +Like `insert-file-contents-literary', but it allows find-file-hooks, +automatic uncompression, etc. +Like `binary-insert-file-contents', but it converts line-break +code." + (let ((coding-system-for-read 'raw-text) + format-alist) + ;; Returns list of absolute file name and length of data inserted. + (insert-file-contents filename visit beg end replace))) + + +(defun raw-message-write-region (start end filename + &optional append visit lockname) + "Like `write-region', q.v., but write as network representation." + (let ((coding-system-for-write 'raw-text-dos) + format-alist) + (write-region start end filename append visit lockname))) + + +;;; @ end +;;; + +(provide 'raw-io) + +;;; raw-io.el ends here diff --git a/smtp.el b/smtp.el index 0d3fef5..25b5f72 100644 --- a/smtp.el +++ b/smtp.el @@ -31,7 +31,6 @@ ;;; Code: -(require 'pces) (require 'custom) (require 'mail-utils) ; mail-strip-quoted-names (require 'sasl) @@ -112,8 +111,9 @@ don't define this value." :group 'smtp-extensions) (defvar sasl-mechanisms) - -(defvar smtp-open-connection-function #'open-network-stream) + +(autoload 'binary-open-network-stream "raw-io") +(defvar smtp-open-connection-function #'binary-open-network-stream) (defvar smtp-read-point nil) @@ -234,12 +234,10 @@ 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* ((coding-system-for-read 'binary) - (coding-system-for-write 'binary) - (process - (funcall smtp-open-connection-function - "SMTP" buffer server service)) - connection) + (let ((process + (funcall smtp-open-connection-function + "SMTP" buffer server service)) + connection) (when process (setq connection (smtp-make-connection process server service)) (set-process-filter process 'smtp-process-filter) diff --git a/smtpmail.el b/smtpmail.el index 094dc4f..6475e44 100644 --- a/smtpmail.el +++ b/smtpmail.el @@ -46,6 +46,7 @@ (require 'smtp) (require 'sendmail) (require 'time-stamp) +(require 'raw-io) (eval-when-compile (require 'static)) @@ -280,7 +281,7 @@ This is relative to `smtpmail-queue-dir'.") (end-of-line) (point)))) (load file-msg) - (setq tembuf (find-file-noselect-as-binary file-msg)) + (setq tembuf (binary-find-file-noselect file-msg)) (if smtpmail-recipient-address-list (smtp-send-buffer user-mail-address smtpmail-recipient-address-list tembuf) -- 1.7.10.4