From 6663242d375f57f0cb76eb3e4962a715c0e4dadb Mon Sep 17 00:00:00 2001 From: yoichi Date: Mon, 24 Nov 2008 09:16:59 +0000 Subject: [PATCH] sync with flim-1_14_9 --- ChangeLog | 96 ++++++++++++++----- FLIM-CFG | 13 +-- FLIM-MK | 12 ++- Makefile | 2 +- README.en | 2 +- README.ja | 6 +- VERSION | 1 + eword-decode.el | 273 ++++++++++++++++++++++++++----------------------------- mel-b-ccl.el | 10 +- mel-q-ccl.el | 10 +- mime-def.el | 4 +- smtp.el | 149 +++++++----------------------- 12 files changed, 271 insertions(+), 307 deletions(-) diff --git a/ChangeLog b/ChangeLog index 9a354a5..f05c0be 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,35 +1,87 @@ -2007-09-05 Katsumi Yamaoka +2007-11-28 MORIOKA Tomohiko - * eword-encode.el (make-ew-rword, ew-rword-text, ew-rword-charset) - (ew-rword-encoding, ew-rword-type) - * hmac-def.el (define-hmac-function) - * md4.el (md4-make-step) - * sha1-el.el (sha1-F0, sha1-F1, sha1-F2, sha1-F3, sha1-S1) - (sha1-S5, sha1-S30, sha1-OP, sha1-add-to-H) - * hex-util.el (hex-char-to-num, num-to-hex-char): Revert last changes. + * FLIM: Version 1.14.9 (Goj-Dò) released.-A -2007-09-04 Katsumi Yamaoka +2006-12-20 MORIOKA Tomohiko - * eword-encode.el (make-ew-rword, ew-rword-text, ew-rword-charset) - (ew-rword-encoding, ew-rword-type): Use new-style backquotes. + * mime-def.el (mime-library-product): Update to 1.14.9. - * hmac-def.el (define-hmac-function): Use new-style backquotes. +2007-06-18 Wencheng Fang - * md4.el (md4-make-step): Use new-style backquotes. + * mel.el (mime-write-decoded-region): Define method function that + uses built-in base64-decode-region. [cf. ] -2007-08-23 Stefan Monnier +2006-12-20 MORIOKA Tomohiko - * sha1-el.el: Fix up comment style. - (sha1-F0, sha1-F1, sha1-F2, sha1-F3, sha1-S1, sha1-S5, sha1-S30) - (sha1-OP, sha1-add-to-H): Use new-style backquotes. + * README.ja, README.en (Installation): Update required version of + APEL to 10.7 or later. - * hex-util.el: Fix up comment style. - (hex-char-to-num, num-to-hex-char): Use new-style backquotes. + * FLIM-CFG (PACKAGEDIR): Use + `install-get-default-package-directory'. -2007-06-18 Wencheng Fang +2006-12-13 Katsumi Yamaoka - * mel.el (mime-write-decoded-region): Define method function that - uses built-in base64-decode-region. [cf. ] + * FLIM-CFG (PACKAGEDIR): Avoid an error with Emacs. + +2006-12-12 Katsumi Yamaoka + + * FLIM-MK (compile-flim-package): Use + batch-update-directory-autoloads if it is available instead of + batch-update-directory. + +2006-12-11 Katsumi Yamaoka + + * FLIM-CFG (PACKAGEDIR): Check for + (early|late|last)-package-hierarchies and configure-package-path + as well as (early|late|last)-packages. + +2006-09-24 Daiki Ueno + + * smtp.el (smtp-progress-message-format): Abolished; reverted the + change 2004-08-11 Katsumi Yamaoka . + +2006-09-24 Daiki Ueno + + * smtp.el (smtp-end-of-line): Abolished; reverted the change + 2002-07-24 Katsumi Yamaoka . + +2006-06-15 Yoichi NAKAYAMA + + * smtp.el (smtp-submit-package): Ignore error in + `smtp-primitive-quit' where SMTP mail transaction is completed. + +2006-06-12 Hiroya Murata + + * mel-b-ccl.el (base64-ccl-insert-encoded-file): Use + `insert-file-contents-as-binary' instead of `insert-file-contents'. + + * mel-q-ccl.el (quoted-printable-ccl-insert-encoded-file): + Likewise. + +2006-02-18 Hiroya Murata + + * smtp.el (smtp-debug): New user option. + (smtp-read-response): Treat a line break code loosely. If + smtp-debug is non-nil, show an invalid response. + +2005-12-25 Katsumi Yamaoka + + * eword-decode.el: Change the way to decode successive + encoded-words: decode B- or Q-encoding in each encoded-word, + concatenate them, and decode it as charset. See the following + threads for more information: + http://news.gmane.org/group/gmane.emacs.pretest.bugs/thread=9541 + http://news.gmane.org/group/gmane.emacs.gnus.general/thread=61176 + (eword-decode-allow-incomplete-encoded-text): New variable. + (eword-decode-encoded-words): New function. + (eword-decode-string): Use it. + (eword-decode-region): Use it. + (eword-analyze-encoded-word): Use it. + (eword-decode-encoded-word): Abolish. + (eword-decode-encoded-text): Abolish. + (eword-decode-encoded-word-error-handler): Abolish. + (eword-warning-face): Abolish. + (eword-decode-encoded-word-default-error-handler): Abolish. 2005-12-25 MORIOKA Tomohiko diff --git a/FLIM-CFG b/FLIM-CFG index 8a314fd..3878aca 100644 --- a/FLIM-CFG +++ b/FLIM-CFG @@ -61,17 +61,6 @@ (expand-file-name FLIM_PREFIX VERSION_SPECIFIC_LISPDIR)) (defvar PACKAGEDIR - (if (boundp 'early-packages) - (let ((dirs (append (if early-package-load-path - early-packages) - (if late-package-load-path - late-packages) - (if last-package-load-path - last-packages))) - dir) - (while (not (file-exists-p - (setq dir (car dirs)))) - (setq dirs (cdr dirs))) - dir))) + (install-get-default-package-directory)) ;;; FLIM-CFG ends here diff --git a/FLIM-MK b/FLIM-MK index 8415fd1..6af7c49 100644 --- a/FLIM-MK +++ b/FLIM-MK @@ -69,9 +69,15 @@ LISPDIR=%s\n" PREFIX LISPDIR)))) (defun compile-flim-package () (config-flim-package) - (setq autoload-package-name "flim") - (add-to-list 'command-line-args-left ".") - (batch-update-directory) + (if (fboundp 'batch-update-directory-autoloads) + ;; XEmacs 21.5.19 and newer. + (progn + (add-to-list 'command-line-args-left ".") + (add-to-list 'command-line-args-left "flim") + (batch-update-directory-autoloads)) + (setq autoload-package-name "flim") + (add-to-list 'command-line-args-left ".") + (batch-update-directory)) (add-to-list 'command-line-args-left ".") (Custom-make-dependencies) diff --git a/Makefile b/Makefile index 046a61a..e3b4096 100644 --- a/Makefile +++ b/Makefile @@ -4,7 +4,7 @@ PACKAGE = flim API = 1.14 -RELEASE = 8 +RELEASE = 9 TAR = tar RM = /bin/rm -f diff --git a/README.en b/README.en index da9875d..c3c0d3f 100644 --- a/README.en +++ b/README.en @@ -44,7 +44,7 @@ What's FLIM Installation ============ -(0) before installing it, please install APEL (9.22 or later) package. +(0) before installing it, please install APEL (10.7 or later) package. APEL package is available at: ftp://ftp.m17n.org/pub/mule/apel/ diff --git a/README.ja b/README.ja index b9592ba..619a3e0 100644 --- a/README.ja +++ b/README.ja @@ -39,10 +39,10 @@ FLIM $B$H$O!)(B XEmacs 21.1 $B0J9_(B -$BF3F~(B (install) -============== +$BF3F~(B (Installation) +=================== -(0) $BF3F~(B (install) $B$9$kA0$K!"(BAPEL (9.22 $B0J9_(B) $B$rF3F~$7$F$/$@$5$$!#(BAPEL +(0) $BF3F~(B (install) $B$9$kA0$K!"(BAPEL (10.7 $B0J9_(B) $B$rF3F~$7$F$/$@$5$$!#(BAPEL $B$O0J2<$N$H$3$m$Gr(B)-A 1.14.8 Shij-Dò $(B;M>r(B-A +1.14.9 Goj-Dò $(B8^>r(B-A [Chao Version names] diff --git a/eword-decode.el b/eword-decode.el index fe46018..ff38088 100644 --- a/eword-decode.el +++ b/eword-decode.el @@ -1,6 +1,7 @@ ;;; eword-decode.el --- RFC 2047 based encoded-word decoder for GNU Emacs -;; Copyright (C) 1995,96,97,98,99,2000,01,03,04 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, +;; 2005 Free Software Foundation, Inc. ;; Author: ENAMI Tsugutomo ;; MORIOKA Tomohiko @@ -88,30 +89,28 @@ If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even if there are in decoded encoded-words (generated by bad manner MUA such as a version of Net$cape)." (setq string (std11-unfold-string string)) - (let ((dest "")(ew nil) - beg end) - (while (and (string-match eword-encoded-word-regexp string) - (setq beg (match-beginning 0) - end (match-end 0)) - ) - (if (> beg 0) - (if (not - (and (eq ew t) - (string-match "^[ \t]+$" (substring string 0 beg)) - )) - (setq dest (concat dest (substring string 0 beg))) - ) - ) - (setq dest - (concat dest - (eword-decode-encoded-word - (substring string beg end) must-unfold) - )) - (setq string (substring string end)) - (setq ew t) - ) - (concat dest string) - )) + (let ((regexp (concat "[\n\t ]*\\(" eword-encoded-word-regexp "\\)")) + (next 0) + match start words) + (while (setq match (string-match regexp string next)) + (setq start (match-beginning 1) + words nil) + (while match + (setq next (match-end 0)) + (push (list (match-string 2 string) ;; charset + (match-string 3 string) ;; language + (match-string 4 string) ;; encoding + (match-string 5 string) ;; encoded-text + (match-string 1 string)) ;; encoded-word + words) + (setq match (and (string-match regexp string next) + (= next (match-beginning 0))))) + (setq words (eword-decode-encoded-words (nreverse words) must-unfold) + string (concat (substring string 0 start) + words + (substring string next)) + next (+ start (length words))))) + string) (defun eword-decode-structured-field-body (string &optional start-column max-column @@ -223,24 +222,25 @@ such as a version of Net$cape)." (save-restriction (narrow-to-region start end) (if unfolding - (eword-decode-unfold) - ) + (eword-decode-unfold)) (goto-char (point-min)) - (while (re-search-forward (concat "\\(" eword-encoded-word-regexp "\\)" - "\\(\n?[ \t]\\)+" - "\\(" eword-encoded-word-regexp "\\)") - nil t) - (replace-match "\\1\\7") - (goto-char (point-min)) - ) - (while (re-search-forward eword-encoded-word-regexp nil t) - (insert (eword-decode-encoded-word - (prog1 - (buffer-substring (match-beginning 0) (match-end 0)) - (delete-region (match-beginning 0) (match-end 0)) - ) must-unfold)) - ) - ))) + (let ((regexp (concat "[\n\t ]*\\(" eword-encoded-word-regexp "\\)")) + match words) + (while (setq match (re-search-forward regexp nil t)) + (setq start (match-beginning 1) + words nil) + (while match + (goto-char (setq end (match-end 0))) + (push (list (match-string 2) ;; charset + (match-string 3) ;; language + (match-string 4) ;; encoding + (match-string 5) ;; encoded-text + (match-string 1)) ;; encoded-word + words) + (setq match (looking-at regexp))) + (delete-region start end) + (insert + (eword-decode-encoded-words (nreverse words) must-unfold))))))) (defun eword-decode-unfold () (goto-char (point-min)) @@ -511,86 +511,82 @@ If SEPARATOR is not nil, it is used as header separator." (make-obsolete 'eword-decode-header 'mime-decode-header-in-buffer) -;;; @ encoded-word decoder -;;; - -(defvar eword-decode-encoded-word-error-handler - 'eword-decode-encoded-word-default-error-handler) - -(defvar eword-warning-face nil - "Face used for invalid encoded-word.") - -(defun eword-decode-encoded-word-default-error-handler (word signal) - (and (add-text-properties 0 (length word) - (and eword-warning-face - (list 'face eword-warning-face)) - word) - word)) - -(defun eword-decode-encoded-word (word &optional must-unfold) - "Decode WORD as an encoded-word. - -If charset is unknown or unsupported, return WORD. -If encoding is unknown, or some error occurs while decoding, -`eword-decode-encoded-word-error-handler' is called with WORD and an -error condition. - -If MUST-UNFOLD is non-nil, unfold decoded WORD." - (or (and (string-match eword-encoded-word-regexp word) - (condition-case err - (eword-decode-encoded-text - ;; charset - (substring word (match-beginning 1)(match-end 1)) - ;; language - (when (match-beginning 2) - (intern - (downcase - (substring word (1+ (match-beginning 2))(match-end 2))))) - ;; encoding - (upcase - (substring word (match-beginning 3)(match-end 3))) - ;; encoded-text - (substring word (match-beginning 4)(match-end 4)) - must-unfold) - (error - (funcall eword-decode-encoded-word-error-handler word err)))) - word)) - - -;;; @ encoded-text decoder +;;; @ encoded-words decoder ;;; -(defun eword-decode-encoded-text (charset language encoding string - &optional must-unfold) - "Decode STRING as an encoded-text. - -If your emacs implementation can not decode CHARSET, it returns nil. +(defvar eword-decode-allow-incomplete-encoded-text t + "*Non-nil means allow incomplete encoded-text in successive encoded-words. +Dividing of encoded-text in the place other than character boundaries +violates RFC2047 section 5, while we have a capability to decode it. +If it is non-nil, the decoder will decode B- or Q-encoding in each +encoded-word, concatenate them, and decode it by charset. Otherwise, +the decoder will fully decode each encoded-word before concatenating +them.") -If LANGUAGE is non-nil, it is put to `mime-language' text-property. -If ENCODING is not \"B\" or \"Q\", it occurs error. -So you should write error-handling code if you don't want break by errors. +(defun eword-decode-encoded-words (words must-unfold) + "Decode successive encoded-words in WORDS and return a decoded string. +Each element of WORDS looks like (CHARSET LANGUAGE ENCODING ENCODED-TEXT +ENCODED-WORD). If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even -if there are in decoded encoded-text (generated by bad manner MUA such -as a version of Net$cape)." - (when (mime-charset-to-coding-system charset) - (let ((dest (encoded-text-decode-string string encoding))) - (when dest - (setq dest (decode-mime-charset-string dest charset)) - (when must-unfold - (setq dest - (mapconcat - (function - (lambda (chr) - (cond ((eq chr ?\n) "") - ((eq chr ?\r) "") - ((eq chr ?\t) " ") - (t (char-to-string chr))))) - (std11-unfold-string dest) ""))) - (when language - (put-text-property 0 (length dest) 'mime-language language dest)) - dest)))) - +if there are in decoded encoded-words (generated by bad manner MUA +such as a version of Net$cape)." + (let (word language charset encoding text rest) + (while words + (setq word (pop words) + language (nth 1 word)) + (if (and (or (mime-charset-to-coding-system (setq charset (car word))) + (progn + (message "Unknown charset: %s" charset) + nil)) + (cond ((member (setq encoding (nth 2 word)) '("B" "Q")) + t) + ((member encoding '("b" "q")) + (setq encoding (upcase encoding))) + (t + (message "Invalid encoding: %s" encoding) + nil)) + (condition-case err + (setq text + (encoded-text-decode-string (nth 3 word) encoding)) + (error + (message "%s" (error-message-string err)) + nil))) + (if (and eword-decode-allow-incomplete-encoded-text + rest + (caaar rest) + (string-equal (downcase charset) (downcase (caaar rest))) + (equal language (cdaar rest))) + ;; Concatenate text of which the charset is the same. + (setcdr (car rest) (concat (cdar rest) text)) + (push (cons (cons charset language) text) rest)) + ;; Don't decode encoded-word. + (push (cons (cons nil language) (nth 4 word)) rest))) + (while rest + (setq word (or (and (setq charset (caaar rest)) + (condition-case err + (decode-mime-charset-string (cdar rest) charset) + (error + (message "%s" (error-message-string err)) + nil))) + (concat (when (cdr rest) " ") + (cdar rest) + (when (and words + (not (eq (string-to-char words) ? ))) + " ")))) + (when must-unfold + (setq word (mapconcat (lambda (chr) + (cond ((eq chr ?\n) "") + ((eq chr ?\r) "") + ((eq chr ?\t) " ") + (t (char-to-string chr)))) + (std11-unfold-string word) + ""))) + (when (setq language (cdaar rest)) + (put-text-property 0 (length word) 'mime-language language word)) + (setq words (concat word words) + rest (cdr rest))) + words)) ;;; @ lexical analyze ;;; @@ -710,31 +706,24 @@ be the result.") (std11-analyze-special string start)) (defun eword-analyze-encoded-word (string start &optional must-unfold) - (if (and (string-match eword-encoded-word-regexp string start) - (= (match-beginning 0) start)) - (let ((end (match-end 0)) - (dest (eword-decode-encoded-word (match-string 0 string) - must-unfold)) - ) - ;;(setq string (substring string end)) - (setq start end) - (while (and (string-match (eval-when-compile - (concat "[ \t\n]*\\(" - eword-encoded-word-regexp - "\\)")) - string start) - (= (match-beginning 0) start)) - (setq end (match-end 0)) - (setq dest - (concat dest - (eword-decode-encoded-word (match-string 1 string) - must-unfold)) - ;;string (substring string end)) - start end) - ) - (cons (cons 'atom dest) ;;string) - end) - ))) + (let* ((regexp (concat "[\n\t ]*\\(" eword-encoded-word-regexp "\\)")) + (match (and (string-match regexp string start) + (= start (match-beginning 0)))) + next words) + (while match + (setq next (match-end 0)) + (push (list (match-string 2 string) ;; charset + (match-string 3 string) ;; language + (match-string 4 string) ;; encoding + (match-string 5 string) ;; encoded-text + (match-string 1 string)) ;; encoded-word + words) + (setq match (and (string-match regexp string next) + (= next (match-beginning 0))))) + (when words + (cons (cons 'atom (eword-decode-encoded-words (nreverse words) + must-unfold)) + next)))) (defun eword-analyze-atom (string start &optional must-unfold) (if (and (string-match std11-atom-regexp string start) diff --git a/mel-b-ccl.el b/mel-b-ccl.el index 4a82772..69e178b 100644 --- a/mel-b-ccl.el +++ b/mel-b-ccl.el @@ -419,9 +419,13 @@ abcdefghijklmnopqrstuvwxyz\ (defun base64-ccl-insert-encoded-file (filename) "Encode contents of file FILENAME to base64, and insert the result." (interactive "*fInsert encoded file: ") - (let ((coding-system-for-read 'mel-ccl-base64-lf-rev) - format-alist) - (insert-file-contents filename))) + (insert + (decode-coding-string + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-as-binary filename) + (buffer-string)) + 'mel-ccl-base64-lf-rev))) (mel-define-method-function (mime-encode-string string (nil "base64")) 'base64-ccl-encode-string) diff --git a/mel-q-ccl.el b/mel-q-ccl.el index 3769fb9..cccacd8 100644 --- a/mel-q-ccl.el +++ b/mel-q-ccl.el @@ -898,9 +898,13 @@ abcdefghijklmnopqrstuvwxyz\ (defun quoted-printable-ccl-insert-encoded-file (filename) "Encode contents of the file named as FILENAME, and insert it." (interactive "*fInsert encoded file: ") - (let ((coding-system-for-read 'mel-ccl-quoted-printable-lf-lf-rev) - format-alist) - (insert-file-contents filename))) + (insert + (decode-coding-string + (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-as-binary filename) + (buffer-string)) + 'mel-ccl-quoted-printable-lf-lf-rev))) (mel-define-method-function (mime-encode-string string (nil "quoted-printable")) diff --git a/mime-def.el b/mime-def.el index 7f00c70..f899b65 100644 --- a/mime-def.el +++ b/mime-def.el @@ -1,6 +1,6 @@ ;;; mime-def.el --- definition module about MIME -*- coding: iso-8859-4; -*- -;; Copyright (C) 1995,96,97,98,99,2000,2001,2002,2003,2004 +;; Copyright (C) 1995,96,97,98,99,2000,2001,2002,2003,2004,2005,2006 ;; Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko @@ -33,7 +33,7 @@ (eval-when-compile (require 'luna)) ; luna-arglist-to-arguments (eval-and-compile - (defconst mime-library-product ["FLIM" (1 14 8) "Shijò"] + (defconst mime-library-product ["FLIM" (1 14 9) "Gojò"] "Product name, version number and code name of MIME-library package.")) (defmacro mime-product-name (product) diff --git a/smtp.el b/smtp.el index 0fcf274..994bb47 100644 --- a/smtp.el +++ b/smtp.el @@ -131,21 +131,9 @@ don't define this value." :type '(repeat string) :group 'smtp-extensions) -(defcustom smtp-progress-message-format nil - "Format string used to show progress message while sending mails. -It allows the following special format specifiers: - -%b means show the number of bytes which has been sent - and the total bytes of a mail. -%k means show the number of kilobytes which has been sent - and the total kilobytes of a mail. -%l means show the number of lines which has been sent - and the total lines of a mail. - -For instance, the value \"Sending (%k)...\" shows like -\"Sending (45k/123k)...\" in the echo area." - :type '(radio (string :format "%v\n" :size 0 :value "Sending (%k)...") - (const :tag "Don't show progress message" nil)) +(defcustom smtp-debug nil + "*If non-nil, smtp debug info printout into messages." + :type 'boolean :group 'smtp) (defvar sasl-mechanisms) @@ -166,8 +154,7 @@ Here is an example: It connects to a SMTP server using \"ssh\" before actually connecting to the SMTP port. Where the command \"nc\" is the netcat executable; see http://www.atstake.com/research/tools/index.html#network_utilities -for details. In addition, you will have to modify the value for -`smtp-end-of-line' to \"\\n\" if you use \"telnet\" instead of \"nc\".") +for details.") (defvar smtp-read-point nil) @@ -175,11 +162,6 @@ for details. In addition, you will have to modify the value for (defvar smtp-submit-package-function #'smtp-submit-package) -(defvar smtp-end-of-line "\r\n" - "*String to use as end-of-line marker when talking to a SMTP server. -This is \"\\r\\n\" by default, but it may have to be \"\\n\" when using a non -native connection function. See also `smtp-open-connection-function'.") - ;;; @ SMTP package ;;; A package contains a mail message, an envelope sender address, ;;; and one or more envelope recipient addresses. In ESMTP model @@ -418,7 +400,9 @@ BUFFER may be a buffer or a buffer name which contains mail message." (smtp-primitive-data package)) (let ((connection (smtp-find-connection (current-buffer)))) (when (smtp-connection-opened connection) - (smtp-primitive-quit package) + (condition-case nil + (smtp-primitive-quit package) + (smtp-error)) (smtp-close-connection connection))))) (defun smtp-send-buffer-by-myself (sender recipients buffer) @@ -455,7 +439,7 @@ BUFFER may be a buffer or a buffer name which contains mail message." (let ((smtp-use-sasl nil) (smtp-use-starttls-ignore-error t)) (funcall smtp-submit-package-function package))) - (setq servers (cdr servers))))) + (setq servers (cdr servers))))) ;;; @ hook methods for `smtp-submit-package' ;;; @@ -601,20 +585,18 @@ BUFFER may be a buffer or a buffer name which contains mail message." (defun smtp-primitive-data (package) (let* ((connection (smtp-find-connection (current-buffer))) - response def prev) + response) (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-internal package)) - (setq def (smtp-parse-progress-message-format)) (goto-char (point-min)) (while (not (eobp)) (smtp-send-data connection (buffer-substring (point) (progn (end-of-line)(point)))) - (beginning-of-line 2) - (setq prev (smtp-show-progress-message def prev)))) + (beginning-of-line 2))) (smtp-send-command connection ".") (setq response (smtp-read-response connection)) (if (/= (car response) 250) @@ -653,26 +635,31 @@ BUFFER may be a buffer or a buffer name which contains mail message." response) (while response-continue (goto-char smtp-read-point) - (while (not (search-forward smtp-end-of-line nil t)) + (while (not (re-search-forward "\r?\n" nil t)) (unless (smtp-connection-opened connection) (signal 'smtp-error "Connection closed")) (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) smtp-end-of-line))) - (setq response - (nconc response - (list (buffer-substring - (+ 4 smtp-read-point) - (- (point) 2))))) - (goto-char - (prog1 smtp-read-point - (setq smtp-read-point (point)))) - (if (looking-at "[1-5][0-9][0-9] ") - (setq response (cons (read (point-marker)) response) - response-continue nil))) + (let ((bol smtp-read-point) + (eol (match-beginning 0))) + (when decoder + (let ((string (buffer-substring bol eol))) + (delete-region bol (point)) + (insert (funcall decoder string)) + (setq eol (point)) + (insert "\r\n"))) + (setq smtp-read-point (point)) + (goto-char bol) + (cond + ((looking-at "[1-5][0-9][0-9]\\([ -]\\)") + (setq response + (nconc response + (list (buffer-substring (match-end 0) eol)))) + (when (string= (match-string 1) " ") + (setq response (cons (read (point-marker)) response) + response-continue nil))) + (smtp-debug + (message "Invalid response: %s" (buffer-substring bol eol)))))) response)) (defun smtp-send-command (connection command) @@ -683,7 +670,7 @@ BUFFER may be a buffer or a buffer name which contains mail message." (smtp-connection-encoder-internal connection))) (set-buffer (process-buffer process)) (goto-char (point-max)) - (setq command (concat command smtp-end-of-line)) + (setq command (concat command "\r\n")) (insert command) (setq smtp-read-point (point)) (if encoder @@ -697,8 +684,8 @@ BUFFER may be a buffer or a buffer name which contains mail message." (smtp-connection-encoder-internal connection))) ;; Escape "." at start of a line. (if (eq (string-to-char data) ?.) - (setq data (concat "." data smtp-end-of-line)) - (setq data (concat data smtp-end-of-line))) + (setq data (concat "." data "\r\n")) + (setq data (concat data "\r\n"))) (if encoder (setq data (funcall encoder data))) (process-send-string process data))) @@ -762,74 +749,6 @@ BUFFER may be a buffer or a buffer name which contains mail message." recipient-address-list)) (kill-buffer smtp-address-buffer)))) -;;; @ functions used to show progress message -;;; -(defun smtp-parse-progress-message-format () - "Parse the `smtp-progress-message-format' variable. -Return nil, or a cons of an ordinary format string and a type including -nil, the symbols `b', `k' and `l'." - (when smtp-progress-message-format - (let ((format smtp-progress-message-format) - (index 0) - type) - (while (string-match "%\\([bkl]\\)\\|%\\([^%bkl]\\|\\'\\)" format index) - (if (and (not type) - (match-beginning 1)) - (setq index (match-end 0) - type (intern (match-string 1 format)) - format (replace-match - (cond ((eq type 'b) - (concat "%d/" - (number-to-string (buffer-size)))) - ((eq type 'k) - (if (>= (buffer-size) 512) - (concat "%dk/" - (number-to-string - (/ (+ (buffer-size) 512) 1024)) - "k") - (setq type 'b) - (concat "%d/" - (number-to-string (buffer-size))))) - (t - (concat "%d/" - (number-to-string - (count-lines (point-min) - (point-max)))))) - nil nil format)) - (setq index (1+ (match-end 0)) - format (replace-match "%\\&" nil nil format)))) - (cons format type)))) - -(defun smtp-show-progress-message (def prev) - "Show progress message while sending mails. -DEF is a cons cell which is pre-computed by the -`smtp-parse-progress-message-format' function or nil. -PREV is a number shown last time or nil. -Return a number computed this time." - (when (car def) - (let* ((fmt (car def)) - (type (cdr def)) - (value (cond ((eq type 'b) - (- (point) (point-min))) - ((eq type 'k) - (/ (- (point) (point-min) -512) 1024)) - ((eq type 'l) - (count-lines (point-min) (point))))) - message-log-max) - (unless (and prev - value - (eq type 'k) - (<= value prev)) - (cond ((featurep 'xemacs) - (display-message 'no-log (if value - (format fmt value) - fmt))) - (value - (message fmt value)) - (t - (message "%s" fmt)))) - value))) - (provide 'smtp) ;;; smtp.el ends here -- 1.7.10.4