From: tmorioka Date: Mon, 24 Feb 1997 02:04:06 +0000 (+0000) Subject: *** empty log message *** X-Git-Tag: emh-0_21~51 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=8025b65daab3f6af6e11b416d8c59f08e0361ad9;p=elisp%2Femh.git *** empty log message *** --- 8025b65daab3f6af6e11b416d8c59f08e0361ad9 diff --git a/emh.el b/emh.el new file mode 100644 index 0000000..eeb7bc2 --- /dev/null +++ b/emh.el @@ -0,0 +1,397 @@ +;;; emh.el --- MIME extender for mh-e + +;; Copyright (C) 1995,1996 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; OKABE Yasuo +;; Maintainer: MORIOKA Tomohiko +;; Created: 1993/11/21 +;; Renamed: 1993/11/27 from mh-e-mime.el +;; Renamed: 1997/02/21 from tm-mh-e.el +;; Version: $Revision: 0.0 $ +;; Keywords: MH, MIME, multimedia, encoded-word, multilingual, mail + +;; This file is part of emh. + +;; 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 'tl-str) +(require 'tl-misc) +(require 'mh-e) +(require 'mime-view) + + +;;; @ version +;;; + +(defconst emh-RCS-ID + "$Id: emh.el,v 0.0 1997-02-24 02:04:06 tmorioka Exp $") + +(defconst emh-version (get-version-string emh-RCS-ID)) + + +;;; @ variable +;;; + +(defvar emh-automatic-mime-preview t + "*If non-nil, show MIME processed message.") + +(defvar emh-decode-encoded-word t + "*If non-nil, decode encoded-word when it is not MIME preview mode.") + + +;;; @ functions +;;; + +(defun mh-display-msg (msg-num folder &optional show-buffer mode) + (or mode + (setq mode emh-automatic-mime-preview) + ) + ;; Display message NUMBER of FOLDER. + ;; Sets the current buffer to the show buffer. + (set-buffer folder) + (or show-buffer + (setq show-buffer mh-show-buffer)) + ;; Bind variables in folder buffer in case they are local + (let ((msg-filename (mh-msg-filename msg-num))) + (if (not (file-exists-p msg-filename)) + (error "Message %d does not exist" msg-num)) + (set-buffer show-buffer) + (cond ((not (equal msg-filename buffer-file-name)) + ;; Buffer does not yet contain message. + (clear-visited-file-modtime) + (unlock-buffer) + (setq buffer-file-name nil) ; no locking during setup + (setq buffer-read-only nil) + (erase-buffer) + (if mode + (let* ((aname (concat "article-" folder)) + (abuf (get-buffer aname)) + ) + (if abuf + (progn + (set-buffer abuf) + (setq buffer-read-only nil) + (erase-buffer) + ) + (setq abuf (get-buffer-create aname)) + (set-buffer abuf) + ) + (as-binary-input-file + (insert-file-contents msg-filename) + ;; (goto-char (point-min)) + (while (re-search-forward "\r$" nil t) + (replace-match "") + ) + ) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (setq buffer-file-name msg-filename) + (mh-show-mode) + (mime-view-mode nil nil nil + aname (concat "show-" folder)) + (goto-char (point-min)) + ) + (let ((clean-message-header mh-clean-message-header) + (invisible-headers mh-invisible-headers) + (visible-headers mh-visible-headers) + ) + ;; 1995/9/21 + ;; modified by ARIURA + ;; to support mhl. + (if mhl-formfile + (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" + (if (stringp mhl-formfile) + (list "-form" mhl-formfile)) + msg-filename) + (insert-file-contents msg-filename)) + ;; end + (goto-char (point-min)) + (cond (clean-message-header + (mh-clean-msg-header (point-min) + invisible-headers + visible-headers) + (goto-char (point-min))) + (t + (mh-start-of-uncleaned-message))) + (if emh-decode-encoded-word + (eword-decode-message-header) + ) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (setq buffer-file-name msg-filename) + (mh-show-mode) + )) + (or (eq buffer-undo-list t) ;don't save undo info for prev msgs + (setq buffer-undo-list nil)) +;;; Added by itokon (02/19/96) + (setq buffer-file-name msg-filename) +;;; + (set-mark nil) + (setq mode-line-buffer-identification + (list (format mh-show-buffer-mode-line-buffer-id + folder msg-num))) + (set-buffer folder) + (setq mh-showing-with-headers nil))))) + +(defun emh-view-message (&optional msg) + "MIME decode and play this message." + (interactive) + (if (or (null emh-automatic-mime-preview) + (null (get-buffer mh-show-buffer)) + (save-excursion + (set-buffer mh-show-buffer) + (not (eq major-mode 'mime-view-mode)) + )) + (let ((emh-automatic-mime-preview t)) + (mh-invalidate-show-buffer) + (mh-show-msg msg) + )) + (pop-to-buffer mh-show-buffer) + ) + +(defun emh-toggle-decoding-mode (arg) + "Toggle MIME processing mode. +With arg, turn MIME processing on if arg is positive." + (interactive "P") + (setq emh-automatic-mime-preview + (if (null arg) + (not emh-automatic-mime-preview) + arg)) + (save-excursion + (set-buffer mh-show-buffer) + (if (null emh-automatic-mime-preview) + (if (and mime::preview/article-buffer + (get-buffer mime::preview/article-buffer)) + (kill-buffer mime::preview/article-buffer) + ))) + (mh-invalidate-show-buffer) + (mh-show (mh-get-msg-num t)) + ) + +(defun emh-show (&optional message) + (interactive) + (mh-invalidate-show-buffer) + (mh-show message) + ) + +(defun emh-header-display () + (interactive) + (mh-invalidate-show-buffer) + (let ((mime-view-ignored-field-regexp "^:$") + emh-decode-encoded-word) + (mh-header-display) + )) + +(defun emh-raw-display () + (interactive) + (mh-invalidate-show-buffer) + (let (emh-automatic-mime-preview + emh-decode-encoded-word) + (mh-header-display) + )) + +(defun emh-burst-multipart/digest () + "Burst apart the current message, which should be a multipart/digest. +The message is replaced by its table of contents and the letters from the +digest are inserted into the folder after that message." + (interactive) + (let ((digest (mh-get-msg-num t))) + (mh-process-or-undo-commands mh-current-folder) + (mh-set-folder-modified-p t) ; lock folder while bursting + (message "Bursting digest...") + (mh-exec-cmd "mhn" "-store" mh-current-folder digest) + (mh-scan-folder mh-current-folder (format "%d-last" mh-first-msg-num)) + (message "Bursting digest...done") + )) + + +;;; @ for mime-view +;;; + +(fset 'emh-decode-charset-buffer + (symbol-function 'mime-charset/decode-buffer)) + +(set-alist 'mime-text-decoder-alist + 'mh-show-mode + (function emh-decode-charset-buffer)) + +(defun emh-content-header-filter () + (goto-char (point-min)) + (mime-preview/cut-header) + (emh-decode-charset-buffer default-mime-charset) + (eword-decode-message-header) + ) + +(set-alist 'mime-view-content-header-filter-alist + 'mh-show-mode + (function emh-content-header-filter)) + +(defun emh-quitting-method () + (let ((win (get-buffer-window + mime/output-buffer-name)) + (buf (current-buffer)) + ) + (if win + (delete-window win) + ) + (pop-to-buffer + (let ((name (buffer-name buf))) + (substring name 5) + )) + (if (not emh-automatic-mime-preview) + (mh-invalidate-show-buffer) + ) + (mh-show (mh-get-msg-num t)) + )) + +(set-alist 'mime-view-quitting-method-alist + 'mh-show-mode + (function emh-quitting-method)) +(set-alist 'mime-view-show-summary-method + 'mh-show-mode + (function emh-quitting-method)) + +(defun emh-following-method (buf) + (save-excursion + (set-buffer buf) + (goto-char (point-max)) + (setq mh-show-buffer buf) + (apply (function mh-send) + (std11-field-bodies '("From" "cc" "Subject") "")) + (setq mh-sent-from-folder buf) + (setq mh-sent-from-msg 1) + (let ((last (point))) + (mh-yank-cur-msg) + (goto-char last) + ))) + +(set-alist 'mime-view-following-method-alist + 'mh-show-mode + (function emh-following-method)) + + +;;; @@ for mime-partial +;;; + +(call-after-loaded + 'mime-partial + (function + (lambda () + (set-atype 'mime/content-decoding-condition + '((type . "message/partial") + (method . mime-article/grab-message/partials) + (major-mode . mh-show-mode) + (summary-buffer-exp + . (and (or (string-match "^article-\\(.+\\)$" article-buffer) + (string-match "^show-\\(.+\\)$" article-buffer)) + (substring article-buffer + (match-beginning 1) (match-end 1)) + )) + )) + (set-alist 'mime-partial/preview-article-method-alist + 'mh-show-mode + (function + (lambda () + (let ((emh-automatic-mime-preview t)) + (emh-show) + )))) + ))) + + +;;; @ set up +;;; + +(define-key mh-folder-mode-map "v" (function emh-view-message)) +(define-key mh-folder-mode-map "\et" (function emh-toggle-decoding-mode)) +(define-key mh-folder-mode-map "." (function emh-show)) +(define-key mh-folder-mode-map "," (function emh-header-display)) +(define-key mh-folder-mode-map "\e," (function emh-raw-display)) +(define-key mh-folder-mode-map "\C-c\C-b" + (function emh-burst-multipart/digest)) + +(defun emh-summary-before-quit () + (let ((buf (get-buffer mh-show-buffer))) + (if buf + (let ((the-buf (current-buffer))) + (switch-to-buffer buf) + (if (and mime::article/preview-buffer + (setq buf (get-buffer mime::article/preview-buffer)) + ) + (progn + (switch-to-buffer the-buf) + (kill-buffer buf) + ) + (switch-to-buffer the-buf) + ) + )))) + +(add-hook 'mh-before-quit-hook (function emh-summary-before-quit)) + + +;;; @@ for emh-comp.el +;;; + +(autoload 'emh-edit-again "emh-comp" + "Clean-up a draft or a message previously sent and make it resendable." t) +(autoload 'emh-extract-rejected-mail "emh-comp" + "Extract a letter returned by the mail system and make it re-editable." t) +(autoload 'emh-forward "emh-comp" + "Forward a message or message sequence by MIME style." t) + +(call-after-loaded + 'mime-setup + (function + (lambda () + (substitute-key-definition + 'mh-edit-again 'emh-edit-again mh-folder-mode-map) + (substitute-key-definition + 'mh-extract-rejected-mail 'emh-extract-rejected-mail + mh-folder-mode-map) + (substitute-key-definition + 'mh-forward 'emh-forward mh-folder-mode-map) + + (call-after-loaded + 'mh-comp + (function + (lambda () + (require 'emh-comp) + )) + 'mh-letter-mode-hook) + ))) + + +;;; @ for BBDB +;;; + +(call-after-loaded + 'bbdb + (function + (lambda () + (require 'tm-bbdb) + ))) + + +;;; @ end +;;; + +(provide 'emh) + +(run-hooks 'emh-load-hook) + +;;; emh.el ends here