From: 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/gitweb/?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 +;; 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 +;; 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")))