X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tm-rmail.el;h=24f4971e1cb3f57d42ffce8a6b1117f393f51be1;hb=0a13bbcec55dfa171236508297136905c782ad56;hp=222c898e80ac0f0279ec0be511d875d6af5be174;hpb=2ea28a6a167b312d383a06f09f6e09ffc96d110d;p=elisp%2Ftm.git diff --git a/tm-rmail.el b/tm-rmail.el index 222c898..24f4971 100644 --- a/tm-rmail.el +++ b/tm-rmail.el @@ -1,22 +1,53 @@ ;;; -;;; $Id: tm-rmail.el,v 6.7 1995/09/28 06:05:20 morioka Exp $ -;;; ;;; Copyright (C) 1995 Free Software Foundation, Inc. -;;; Copyright (C) 1994,1995 MORIOKA Tomohiko +;;; Copyright (C) 1994 .. 1996 MORIOKA Tomohiko ;;; -;;; Author: MORIOKA Tomohiko -;;; Keywords: mail, news, MIME, multimedia +;;; Author: MORIOKA Tomohiko +;;; modified by KOBAYASHI Shuhei +;;; Created: 1994/8/30 +;;; Version: +;;; $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-header) (require 'tl-list) (require 'tl-misc) +(require 'rmail) (autoload 'mime/viewer-mode "tm-view" "View MIME message." t) (autoload 'mime/Content-Type "tm-view" "parse Content-Type field.") -(autoload 'mime/decode-message-header "tiny-mime" "Decode MIME header." t) +(autoload 'mime/decode-message-header "tm-ew-d" "Decode MIME encoded-word." t) + + +;;; @ 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) + + +;;; @ message filter +;;; (setq rmail-message-filter (function @@ -27,6 +58,10 @@ (set-buffer-modified-p mf) )))) + +;;; @ MIME preview +;;; + (defun tm-rmail/show-all-header-p () (save-restriction (narrow-to-region (point-min) @@ -36,17 +71,114 @@ (re-search-forward rmail-ignored-headers nil t) )) -(defun tm-rmail/view-message () +(defun tm-rmail/preview-message () (interactive) - (let ((ret (rmail-widen-to-current-msgbeg - (function - (lambda () - (cons (mime/Content-Type) - (mail-fetch-field "Content-Transfer-Encoding")) - ))))) - (mime/viewer-mode nil (car ret)(cdr ret)) + (setq tm-rmail/decode-all t) + (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 + (tm-rmail/preview-message) )) +(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) + (set-buffer rmail-buffer) + (tm-rmail/preview-message) + ))) + ) + +(add-hook 'rmail-summary-mode-hook 'tm-rmail/setup) + + +;;; @ over-to-* and quitting methods +;;; + (defun tm-rmail/quitting-method-to-summary () (mime-viewer/kill-buffer) (rmail-summary) @@ -54,37 +186,203 @@ ) (defun tm-rmail/quitting-method-to-article () + (setq tm-rmail/decode-all nil) (mime-viewer/kill-buffer) ) (defalias 'tm-rmail/quitting-method 'tm-rmail/quitting-method-to-article) -(add-hook 'rmail-mode-hook - (function - (lambda () - (local-set-key "v" (function tm-rmail/view-message)) - ))) -(add-hook 'rmail-summary-mode-hook - (function - (lambda () - (local-set-key "v" - (function - (lambda () - (interactive) - (pop-to-buffer rmail-buffer) - (tm-rmail/view-message) - ))) - ))) - -(call-after-loaded 'tm-view - (function - (lambda () - (set-alist 'mime-viewer/quitting-method - 'rmail-mode - (function tm-rmail/quitting-method)) - ))) +(defun tm-rmail/over-to-previous-method () + (let (tm-rmail/decode-all) + (mime-viewer/quit) + ) + (if (not (eq (rmail-next-undeleted-message -1) t)) + (tm-rmail/preview-message) + ) + ) + +(defun tm-rmail/over-to-next-method () + (let (tm-rmail/decode-all) + (mime-viewer/quit) + ) + (if (not (eq (rmail-next-undeleted-message 1) t)) + (tm-rmail/preview-message) + ) + ) + +(defun tm-rmail/show-summary-method () + (save-excursion + (set-buffer mime::preview/article-buffer) + (rmail-summary) + )) + +(call-after-loaded + 'tm-view + (function + (lambda () + (set-alist 'mime-viewer/quitting-method-alist + 'rmail-mode + (function tm-rmail/quitting-method)) + + (set-alist 'mime-viewer/over-to-previous-method-alist + 'rmail-mode + (function tm-rmail/over-to-previous-method)) + + (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)) + ))) + + +;;; @ for tm-partial +;;; + +(call-after-loaded + 'tm-partial + (function + (lambda () + (set-atype 'mime/content-decoding-condition + '((type . "message/partial") + (method . mime-article/grab-message/partials) + (major-mode . rmail-mode) + (summary-buffer-exp + . (progn + (rmail-summary) + (pop-to-buffer rmail-buffer) + rmail-summary-buffer)) + )) + (set-alist 'tm-partial/preview-article-method-alist + 'rmail-mode + (function + (lambda () + (rmail-summary-goto-msg (count-lines 1 (point))) + (pop-to-buffer rmail-buffer) + (tm-rmail/preview-message) + ))) + ))) + + +;;; @ for tm-edit +;;; + +(defun tm-rmail/forward () + "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) + (msgnum rmail-current-message) + (rmail-buffer (current-buffer)) + (subject (concat "[" + (mail-strip-quoted-names + (mail-fetch-field "From")) + ": " (or (mail-fetch-field "Subject") "") "]"))) + ;; If only one window, use it for the mail buffer. + ;; Otherwise, use another window for the mail buffer + ;; so that the Rmail buffer remains visible + ;; and sending the mail will get back to it. + (setq initialized + (if (one-window-p t) + (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 rmail-buffer)) +;; (mime-editor/inserted-message-filter)) + (tm-mail/insert-message)) + (if (not initialized) + (goto-char beginning)) + )) + +(defun gnus-mail-forward-using-mail-mime () + "Forward current article in message/rfc822 content-type message from +GNUS. The message will be appended if being composed." + (let ((initialized nil) + (beginning nil) + (forwarding-buffer (current-buffer)) + (subject + (concat "[" gnus-newsgroup-name "] " + ;;(mail-strip-quoted-names (gnus-fetch-field "From")) ": " + (or (gnus-fetch-field "Subject") "")))) + ;; If only one window, use it for the mail buffer. + ;; Otherwise, use another window for the mail buffer + ;; so that the Rmail buffer remains visible + ;; and sending the mail will get back to it. + (setq initialized + (if (one-window-p t) + (mail nil nil subject) + (mail-other-window nil nil subject))) + (save-excursion + (goto-char (point-max)) + (setq beginning (point)) + (mime-editor/insert-tag "message" "rfc822") + (insert-buffer forwarding-buffer) + ;; You have a chance to arrange the message. + (run-hooks 'gnus-mail-forward-hook) + ) + (if (not initialized) + (goto-char beginning)) + )) + +(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 +;;; (provide 'tm-rmail) (run-hooks 'tm-rmail-load-hook) + +;;; tm-rmail.el ends here.