From: tomo <tomo>
Date: Thu, 29 Mar 2001 06:24:24 +0000 (+0000)
Subject: Merge handa-2001-2-14.
X-Git-Tag: main-handa-2001-2-14
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=bf8ddd0fcaf0abdb9652d08b22309d1067b02a7e;p=elisp%2Flemi.git

Merge handa-2001-2-14.
---

diff --git a/mail/feedmail.el b/mail/feedmail.el
index f864de3..dcff42b 100644
--- a/mail/feedmail.el
+++ b/mail/feedmail.el
@@ -1356,15 +1356,23 @@ complicated cases."
   ;; I'm not sure smtpmail.el is careful about the following
   ;; return value, but it also uses it internally, so I will fear
   ;; no evil.
-  (require 'smtp)
-  (if (not (smtp-via-smtp user-mail-address addr-listoid prepped))
+
+  ;; There exists a better SMTP handling program which provides
+  ;; `smtp'.  If we have it, use it.
+  (or (require 'smtp nil t) (require 'smtpmail))
+  (if (not (if (featurep 'smtp) 
+	       (smtp-via-smtp user-mail-address addr-listoid prepped)
+	     (smtpmail-via-smtp addr-listoid prepped)))
       (progn
 	(set-buffer errors-to)
 	(insert "Send via smtpmail failed.  Probable SMTP protocol error.\n")
 	(insert "Look for details below or in the *Messages* buffer.\n\n")
 	(let ((case-fold-search t)
 	      ;; don't be overconfident about the name of the trace buffer
-	      (tracer (concat "trace.*smtp.*" (regexp-quote smtp-server))))
+	      (tracer (concat "trace.*smtp.*" (regexp-quote
+					       (if (featurep 'smtp)
+						   smtp-server
+					       smtpmail-smtp-server)))))
 	  (mapcar
 	   '(lambda (buffy)
 	      (if (string-match tracer (buffer-name buffy))
diff --git a/mail/rmail-mime.el b/mail/rmail-mime.el
new file mode 100644
index 0000000..53e8d33
--- /dev/null
+++ b/mail/rmail-mime.el
@@ -0,0 +1,198 @@
+;;; rmail-mime.el --- Add MIME handling facility to RMAIL
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
+;; Keywords: mail, news, MIME, multimedia, multilingual, encoded-word
+
+;; This file is part of SEMI (Setting for Emacs MIME Interfaces).
+
+;; 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:
+
+(require 'mime-view)
+
+(defun rmail-decode-header (decoded-buffer original-buffer start end)
+  (set-buffer (get-buffer-create decoded-buffer))
+  (erase-buffer)
+  (insert-buffer-substring original-buffer start end)
+  (mime-decode-header-in-buffer rmail-enable-mime))
+
+(defun rmail-decode-mime-message (decoded-buffer original-buffer start end)
+  (save-excursion
+    (set-buffer original-buffer)
+    (save-restriction
+      (narrow-to-region start end)
+      (mime-view-buffer nil decoded-buffer)))
+  (set-buffer decoded-buffer))
+
+(defun rmail-view-kill-rmail-buffer ()
+  (if rmail-buffer (kill-buffer rmail-buffer)))
+
+(defvar rmail-view-mode-map nil)
+
+(defun rmail-show-mime-message ()
+  (let ((abuf (current-buffer))
+	(buf-name (concat (buffer-name) "-view"))
+	buf win)
+    (setq mime-message-structure
+	  (mime-open-entity 'babyl abuf))
+    (set-buffer (mime-display-message mime-message-structure
+				      buf-name nil
+				      nil nil rmail-view-mode-map))
+    (setq buf (current-buffer))
+    (make-local-variable 'font-lock-defaults)
+    (setq font-lock-defaults
+	  '(rmail-font-lock-keywords
+	    t nil nil nil
+	    (font-lock-maximum-size . nil)
+	    (font-lock-fontify-buffer-function
+	     . rmail-fontify-buffer-function)
+	    (font-lock-unfontify-buffer-function
+	     . rmail-unfontify-buffer-function)
+	    (font-lock-inhibit-thing-lock
+	     . (lazy-lock-mode fast-lock-mode))))
+    (make-local-variable 'rmail-buffer)
+    (setq rmail-buffer abuf)
+    (make-local-variable 'rmail-view-buffer)
+    (setq rmail-view-buffer (current-buffer))
+    (make-local-variable 'rmail-summary-buffer)
+    (setq rmail-summary-buffer
+	  (with-current-buffer rmail-buffer
+	    rmail-summary-buffer))
+    (make-local-variable 'rmail-current-message)
+    (setq rmail-current-message
+	  (with-current-buffer rmail-buffer
+	    rmail-current-message))
+    (make-local-variable 'kill-buffer-hook)
+    (add-hook 'kill-buffer-hook 'rmail-view-kill-rmail-buffer)
+    (let ((mode-line
+	   (with-current-buffer abuf
+	     (setq rmail-view-buffer buf)
+	     mode-line-process)))
+      (setq mode-line-process mode-line))
+    (if (and (setq win (get-buffer-window abuf))
+	     buf)
+	(set-window-buffer win buf))
+    (bury-buffer rmail-buffer)
+    (run-hooks 'rmail-show-mime-message-hook)))
+
+(defun rmail-insert-mime-forwarded-message (forward-buffer)
+  (insert (mime-make-tag "message" "rfc822"))
+  (insert "\n")
+  (mime-insert-entity (with-current-buffer forward-buffer
+			mime-message-structure)))
+
+(defun rmail-enable-mime ()
+  (interactive)
+  (setq rmail-enable-mime t)
+  (rmail-show-message))
+
+(defun rmail-disable-mime ()
+  (interactive)
+  (let ((buf rmail-buffer))
+    (when rmail-enable-mime
+      (remove-hook 'kill-buffer-hook 'rmail-view-kill-rmail-buffer)
+      (set-window-buffer (selected-window) buf)
+      (kill-buffer rmail-view-buffer))
+    (set-buffer buf))
+  (setq rmail-enable-mime nil
+	rmail-view-buffer (current-buffer))
+  (rmail-show-message))
+
+(defun rmail-search-mime-message (msg regexp)
+  "Search the message of number MSG for REGEXP.
+If the search succeeds, return non-nil.  Otherwise, return nil."
+  (save-excursion
+    (rmail-decode-mime-message " *RMAIL-temp-VIEW*"
+			       (current-buffer)
+			       (if (search-forward "\n*** EOOH ***\n"
+						   (rmail-msgend msg) t)
+				   (match-end 0)
+				 (point))
+			       (rmail-msgend msg))
+    (goto-char (point-min))
+    (prog1 (re-search-forward regexp nil t)
+      (kill-buffer " *RMAIL-temp-VIEW*"))))
+
+(defun rmail-search-mime-header (msg beg end regexp)
+  "Search the message header of number MSG for REGEXP.
+If the search succeeds, return non-nil.  Otherwise, return nil."
+  (save-excursion
+    (rmail-decode-header " *RMAIL-temp-VIEW*"
+			 (current-buffer)
+			 beg end)
+    (goto-char (point-min))
+    (prog1 (re-search-forward regexp nil t)
+      (kill-buffer " *RMAIL-temp-VIEW*"))))
+
+(set-alist 'mime-raw-representation-type-alist 'rmail-mode
+	   (if rmail-enable-mime
+	       'binary
+	     'cooked))
+
+(set-alist 'mime-preview-over-to-previous-method-alist
+	   'rmail-mode
+	   (function
+	    (lambda ()
+	      (message "Beginning of buffer")
+	      ;; (rmail-previous-undeleted-message 1)
+	      )))
+
+(set-alist 'mime-preview-over-to-next-method-alist
+	   'rmail-mode
+	   (function
+	    (lambda ()
+	      (message "End of buffer")
+	      ;; (rmail-next-undeleted-message 1)
+	      )))
+
+(set-alist 'mime-preview-quitting-method-alist 'rmail-mode #'rmail-quit)
+
+;; Override values defined in rmail.
+(eval-after-load "rmail"
+  '(progn
+     (define-key rmail-mode-map "v" 'rmail-enable-mime)
+     (setq rmail-show-mime-function (function rmail-show-mime-message))
+     (unless rmail-view-mode-map
+       (setq rmail-view-mode-map (mime-view-define-keymap rmail-mode-map))
+       (define-key rmail-view-mode-map
+	 "p" (function rmail-previous-undeleted-message))
+       (define-key rmail-view-mode-map
+	 "n" (function rmail-next-undeleted-message))
+       (define-key rmail-view-mode-map
+	 "u" (function rmail-undelete-previous-message))
+       (define-key rmail-view-mode-map
+	 "a" (function rmail-add-label))
+       (define-key rmail-view-mode-map
+	 "\C-c\C-c" (function rmail-disable-mime)))))
+
+;; Override values defined in rmailsum.
+(eval-after-load "rmailsum"
+  '(setq rmail-summary-line-decoder
+	 (function
+	  (lambda (string)
+	    (eword-decode-string
+	     (decode-coding-string string 'undecided))))))
+
+;; Override values defined in sendmail.
+(eval-after-load "sendmail"
+  '(progn
+     (add-hook 'mail-setup-hook 'turn-on-mime-edit)
+     (add-hook 'mail-send-hook 'mime-edit-maybe-translate)))
+
+(provide 'rmail-mime)
diff --git a/mime/mel-b.el b/mime/mel-b.el
new file mode 100644
index 0000000..d534039
--- /dev/null
+++ b/mime/mel-b.el
@@ -0,0 +1,82 @@
+;;; mel-b.el --- Base64 encoder/decoder using builtin base64 handlers
+
+;; Copyright (C) 1998,1999,2000,2001 Free Software Foundation, Inc.
+
+;; Author: Tanaka Akira <akr@m17n.org>
+;; Created by modifying mel-b-ccl.el: 2001/2/6
+;; Keywords: MIME, Base64
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; 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 this program; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'mime-def)
+
+(defun base64-insert-encoded-file (filename)
+  "Encode contents of file FILENAME to base64, and insert the result."
+  (interactive "*fInsert encoded file: ")
+  (save-excursion
+    (save-restriction
+      (narrow-to-region (point) (point))
+      (let ((coding-system-for-read 'binary))
+	(insert-file-contents filename))
+      (base64-encode-region (point-min) (point-max)))))
+
+(mel-define-method-function (mime-encode-string string (nil "base64"))
+			    'base64-encode-string)
+(mel-define-method-function (mime-encode-region start end (nil "base64"))
+			    'base64-encode-region)
+(mel-define-method-function (mime-insert-encoded-file filename (nil "base64"))
+			    'base64-insert-encoded-file)
+(mel-define-method-function (encoded-text-encode-string string (nil "B"))
+			    'base64-encode-string)
+
+(defun base64-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: ")
+  (let ((current (current-buffer))
+	(multibyte enable-multibyte-characters))
+    (with-temp-buffer
+      (set-buffer-multibyte multibyte)
+      (insert-buffer-substring current start end)
+      (base64-decode-region (point-min) (point-max))
+      (let ((coding-system-for-write 'binary))
+	(write-region (point-min) (point-max) filename)))))
+
+(mel-define-method-function (mime-decode-string string (nil "base64"))
+			    'base64-ccl-decode-string)
+(mel-define-method-function (mime-decode-region start end (nil "base64"))
+			    'base64-ccl-decode-region)
+(mel-define-method-function
+ (mime-write-decoded-region start end filename (nil "base64"))
+ 'base64-write-decoded-region)
+
+(mel-define-method encoded-text-decode-string (string (nil "B"))
+  (if (string-match (eval-when-compile
+		      (concat "\\`" B-encoded-text-regexp "\\'"))
+		    string)
+      (base64-decode-string string)
+    (error "Invalid encoded-text %s" string)))
+
+
+;;; @ end
+;;;
+
+(provide 'mel-b)
+
+;;; mel-b.el ends here.
diff --git a/mime/mel.el b/mime/mel.el
index 6d7de59..1a1c7d2 100644
--- a/mime/mel.el
+++ b/mime/mel.el
@@ -198,6 +198,12 @@ mmencode included in metamail or XEmacs package)."
 	 (require 'path-util)
 	 (module-installed-p 'mel-b-ccl))))
 
+(defvar mel-b-module
+  (and (featurep 'mule)
+       (progn
+	 (require 'path-util)
+	 (module-installed-p 'mel-b))))
+
 (defvar mel-q-ccl-module
   (and (featurep 'mule)
        (progn
@@ -207,6 +213,9 @@ mmencode included in metamail or XEmacs package)."
 (when mel-b-ccl-module
   (mel-use-module 'mel-b-ccl '("base64" "B")))
 
+(when mel-b-module
+  (mel-use-module 'mel-b '("base64" "B")))
+
 (when mel-q-ccl-module
   (mel-use-module 'mel-q-ccl '("quoted-printable" "Q")))