X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tm-rmail.el;h=24f4971e1cb3f57d42ffce8a6b1117f393f51be1;hb=6c79137304c0b1d6e94fe8cb3a38f3aad50e0195;hp=dc001cd41274e6ad775feb55c7a9b5d8b664654d;hpb=95847857479f2e557aff29531db213b89b5117bb;p=elisp%2Ftm.git diff --git a/tm-rmail.el b/tm-rmail.el index dc001cd..24f4971 100644 --- a/tm-rmail.el +++ b/tm-rmail.el @@ -1,14 +1,31 @@ ;;; ;;; Copyright (C) 1995 Free Software Foundation, Inc. -;;; Copyright (C) 1994,1995 MORIOKA Tomohiko +;;; Copyright (C) 1994 .. 1996 MORIOKA Tomohiko ;;; -;;; Author: MORIOKA Tomohiko +;;; Author: MORIOKA Tomohiko +;;; modified by KOBAYASHI Shuhei +;;; Created: 1994/8/30 ;;; Version: -;;; $Id: tm-rmail.el,v 7.12 1995/11/02 12:20:51 morioka Exp $ +;;; $Revision: 7.25 $ ;;; Keywords: mail, MIME, multimedia, multilingual, encoded-word ;;; ;;; This file is part of tm (Tools for MIME). ;;; +;;; 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. If not, write to the Free Software +;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;;; +;;; Code: (require 'tl-list) (require 'tl-misc) @@ -22,6 +39,10 @@ ;;; @ variables ;;; +(defconst tm-rmail/RCS-ID + "$Id: tm-rmail.el,v 7.25 1996/06/12 05:38:23 morioka Exp $") +(defconst tm-rmail/version (get-version-string tm-rmail/RCS-ID)) + (defvar tm-rmail/decode-all nil) @@ -53,18 +74,44 @@ (defun tm-rmail/preview-message () (interactive) (setq tm-rmail/decode-all t) - (let ((ret (rmail-widen-to-current-msgbeg - (function - (lambda () - (cons (mime/Content-Type) - (rfc822/get-field-body "Content-Transfer-Encoding") - ) - ))))) - (mime/viewer-mode nil (car ret)(cdr ret) nil - (format "*Preview-%s [%d/%d]*" - (buffer-name) - rmail-current-message rmail-total-messages)) - )) + (let ((ret (tm-rmail/get-Content-Type-and-Content-Transfer-Encoding))) + (narrow-to-region (point-min) + (save-excursion + (goto-char (point-max)) + (if (and (re-search-backward "^\n") + (eq (match-end 0)(point-max))) + (match-beginning 0) + (point-max) + ))) + (let ((abuf (current-buffer)) + (buf-name (format "*Preview-%s [%d/%d]*" + (buffer-name) + rmail-current-message rmail-total-messages)) + buf win) + (if (and mime::article/preview-buffer + (setq buf (get-buffer mime::article/preview-buffer)) + ) + (progn + (save-excursion + (set-buffer buf) + (rename-buffer buf-name) + ) + (if (setq win (get-buffer-window buf)) + (progn + (delete-window (get-buffer-window abuf)) + (set-window-buffer win abuf) + (set-buffer abuf) + )) + )) + (setq win (get-buffer-window abuf)) + (save-window-excursion + (mime/viewer-mode nil (car ret)(cdr ret) nil buf-name) + (or buf + (setq buf (current-buffer)) + ) + ) + (set-window-buffer win buf) + ))) (defun tm-rmail/preview-message-if-you-need () (if tm-rmail/decode-all @@ -73,13 +120,55 @@ (add-hook 'rmail-show-message-hook 'tm-rmail/preview-message-if-you-need) +(cond ((fboundp 'rmail-summary-rmail-update) + ;; for Emacs 19 or later + (or (fboundp 'tm:rmail-summary-rmail-update) + (fset 'tm:rmail-summary-rmail-update + (symbol-function 'rmail-summary-rmail-update)) + ) + + (defun rmail-summary-rmail-update () + (tm:rmail-summary-rmail-update) + (if tm-rmail/decode-all + (let ((win (get-buffer-window rmail-buffer))) + (if win + (delete-window win) + ))) + ) + + (defun tm-rmail/get-Content-Type-and-Content-Transfer-Encoding () + (rmail-widen-to-current-msgbeg + (function + (lambda () + (cons (mime/Content-Type) + (mime/Content-Transfer-Encoding "7bit") + ))))) + ) + (t + ;; for Emacs 18 + (defun tm-rmail/get-Content-Type-and-Content-Transfer-Encoding () + (save-restriction + (rmail-widen-to-current-msgbeg + (function + (lambda () + (goto-char (point-min)) + (narrow-to-region (or (and (re-search-forward "^.+:" nil t) + (match-beginning 0)) + (point-min)) + (point-max)) + ))) + (cons (mime/Content-Type) + (mime/Content-Transfer-Encoding "7bit") + ))) + )) + (define-key rmail-mode-map "v" (function tm-rmail/preview-message)) (defun tm-rmail/setup () (local-set-key "v" (function (lambda () (interactive) - (pop-to-buffer rmail-buffer) + (set-buffer rmail-buffer) (tm-rmail/preview-message) ))) ) @@ -122,6 +211,12 @@ ) ) +(defun tm-rmail/show-summary-method () + (save-excursion + (set-buffer mime::preview/article-buffer) + (rmail-summary) + )) + (call-after-loaded 'tm-view (function @@ -137,6 +232,10 @@ (set-alist 'mime-viewer/over-to-next-method-alist 'rmail-mode (function tm-rmail/over-to-next-method)) + + (set-alist 'mime-viewer/show-summary-method + 'rmail-mode + (function tm-rmail/show-summary-method)) ))) @@ -171,21 +270,16 @@ ;;; @ for tm-edit ;;; -(call-after-loaded - 'tm-edit - (function - (lambda () - (defun tm-rmail/forward () - "\ -Forward current message in message/rfc822 content-type message + "Forward current message in message/rfc822 content-type message from rmail. The message will be appended if being composed." (interactive) ;;>> this gets set even if we abort. Can't do anything about it, though. (rmail-set-attribute "forwarded" t) (let ((initialized nil) (beginning nil) - (forwarding-buffer (current-buffer)) + (msgnum rmail-current-message) + (rmail-buffer (current-buffer)) (subject (concat "[" (mail-strip-quoted-names (mail-fetch-field "From")) @@ -199,22 +293,26 @@ from rmail. The message will be appended if being composed." (mail nil nil subject) (mail-other-window nil nil subject))) (save-excursion + ;; following two variables are used in 19.29 or later. + (make-local-variable 'rmail-send-actions-rmail-buffer) + (make-local-variable 'rmail-send-actions-rmail-msg-number) + (make-local-variable 'mail-reply-buffer) + (setq rmail-send-actions-rmail-buffer rmail-buffer) + (setq rmail-send-actions-rmail-msg-number msgnum) + (setq mail-reply-buffer rmail-buffer) (goto-char (point-max)) (forward-line 1) (setq beginning (point)) (mime-editor/insert-tag "message" "rfc822") - (insert-buffer forwarding-buffer)) +;; (insert-buffer rmail-buffer)) +;; (mime-editor/inserted-message-filter)) + (tm-mail/insert-message)) (if (not initialized) (goto-char beginning)) )) -(substitute-key-definition 'rmail-forward - 'tm-rmail/forward - rmail-mode-map) - (defun gnus-mail-forward-using-mail-mime () - "\ -Forward current article in message/rfc822 content-type message from + "Forward current article in message/rfc822 content-type message from GNUS. The message will be appended if being composed." (let ((initialized nil) (beginning nil) @@ -243,9 +341,41 @@ GNUS. The message will be appended if being composed." (goto-char beginning)) )) -;; (setq gnus-mail-forward-method 'mime-forward-from-gnus-using-mail) +(call-after-loaded + 'mime-setup + (function + (lambda () + (substitute-key-definition + 'rmail-forward 'tm-rmail/forward rmail-mode-map) + + ;; (setq gnus-mail-forward-method 'gnus-mail-forward-using-mail-mime) + + (call-after-loaded + 'tm-edit + (function + (lambda () + (require 'tm-mail) + (set-alist 'mime-editor/message-inserter-alist + 'mail-mode (function tm-mail/insert-message)) + (set-alist 'mime-editor/split-message-sender-alist + 'mail-mode (function + (lambda () + (interactive) + (sendmail-send-it) + ))) + ))) + ))) -))) + +;;; @ for BBDB +;;; + +(call-after-loaded + 'bbdb + (function + (lambda () + (require 'tm-bbdb) + ))) ;;; @ end @@ -254,3 +384,5 @@ GNUS. The message will be appended if being composed." (provide 'tm-rmail) (run-hooks 'tm-rmail-load-hook) + +;;; tm-rmail.el ends here.