emh.el

   1 ;;; emh.el --- MIME extender for mh-e
   2
   3 ;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;;         OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
   7 ;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   8 ;; Created: 1993/11/21
   9 ;;      Renamed: 1993/11/27 from mh-e-mime.el
  10 ;;      Renamed: 1997/02/21 from tm-mh-e.el
  11 ;; Version: $Revision: 0.23 $
  12 ;; Keywords: MH, MIME, multimedia, encoded-word, multilingual, mail
  13
  14 ;; This file is part of emh.
  15
  16 ;; This program is free software; you can redistribute it and/or
  17 ;; modify it under the terms of the GNU General Public License as
  18 ;; published by the Free Software Foundation; either version 2, or (at
  19 ;; your option) any later version.
  20
  21 ;; This program is distributed in the hope that it will be useful, but
  22 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  24 ;; General Public License for more details.
  25
  26 ;; You should have received a copy of the GNU General Public License
  27 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  28 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  29 ;; Boston, MA 02111-1307, USA.
  30
  31 ;;; Code:
  32
  33 (require 'mh-e)
  34 (require 'mime-view)
  35
  36
  37 ;;; @ version
  38 ;;;
  39
  40 (defconst emh-RCS-ID
  41   "$Id: emh.el,v 0.23 1997-11-26 09:40:34 morioka Exp $")
  42
  43 (defconst emh-version (get-version-string emh-RCS-ID))
  44
  45
  46 ;;; @ variable
  47 ;;;
  48
  49 (defgroup emh nil
  50   "MIME Extension for mh-e"
  51   :group 'mime
  52   :group 'mh)
  53
  54 (defcustom emh-automatic-mime-preview t
  55   "*If non-nil, show MIME processed message."
  56   :group 'emh
  57   :type 'boolean)
  58
  59 (defcustom emh-decode-encoded-word t
  60   "*If non-nil, decode encoded-word when it is not MIME preview mode."
  61   :group 'emh
  62   :type 'boolean)
  63
  64
  65 ;;; @ functions
  66 ;;;
  67
  68 (defun mh-display-msg (msg-num folder &optional show-buffer mode)
  69   "Display message number MSG-NUM of FOLDER.
  70 This function uses `mime-view-mode' if MODE is not nil.  If MODE is
  71 nil, `emh-automatic-mime-preview' is used as default value."
  72   (or mode
  73       (setq mode emh-automatic-mime-preview)
  74       )
  75   ;; Display message NUMBER of FOLDER.
  76   ;; Sets the current buffer to the show buffer.
  77   (set-buffer folder)
  78   (or show-buffer
  79       (setq show-buffer mh-show-buffer))
  80   ;; Bind variables in folder buffer in case they are local
  81   (let ((msg-filename (mh-msg-filename msg-num)))
  82     (if (not (file-exists-p msg-filename))
  83         (error "Message %d does not exist" msg-num))
  84     (set-buffer show-buffer)
  85     (cond ((not (equal msg-filename buffer-file-name))
  86            ;; Buffer does not yet contain message.
  87            (clear-visited-file-modtime)
  88            (unlock-buffer)
  89            (setq buffer-file-name nil)  ; no locking during setup
  90            (setq buffer-read-only nil)
  91            (erase-buffer)
  92            (if mode
  93                (let* ((aname (concat "article-" folder))
  94                       (abuf (get-buffer aname))
  95                       )
  96                  (if abuf
  97                      (progn
  98                        (set-buffer abuf)
  99                        (setq buffer-read-only nil)
 100                        (erase-buffer)
 101                        )
 102                    (setq abuf (get-buffer-create aname))
 103                    (set-buffer abuf)
 104                    )
 105                  (let ((coding-system-for-read 'raw-text))
 106                    (insert-file-contents msg-filename)
 107                    )
 108                  (set-buffer-modified-p nil)
 109                  (setq buffer-read-only t)
 110                  (setq buffer-file-name msg-filename)
 111                  (mh-show-mode)
 112                  (mime-view-mode nil nil nil
 113                                  aname (concat "show-" folder))
 114                  (goto-char (point-min))
 115                  )
 116              (let ((clean-message-header mh-clean-message-header)
 117                    (invisible-headers mh-invisible-headers)
 118                    (visible-headers mh-visible-headers)
 119                    )
 120                ;; 1995/9/21
 121                ;;   modified by ARIURA <ariura@cc.tuat.ac.jp>
 122                ;;   to support mhl.
 123                (if mhl-formfile
 124                    (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
 125                                            (if (stringp mhl-formfile)
 126                                                (list "-form" mhl-formfile))
 127                                            msg-filename)
 128                  (insert-file-contents msg-filename))
 129                ;; end
 130                (goto-char (point-min))
 131                (cond (clean-message-header
 132                       (mh-clean-msg-header (point-min)
 133                                            invisible-headers
 134                                            visible-headers)
 135                       (goto-char (point-min)))
 136                      (t
 137                       (mh-start-of-uncleaned-message)))
 138                (if emh-decode-encoded-word
 139                    (eword-decode-header)
 140                  )
 141                (set-buffer-modified-p nil)
 142                (setq buffer-read-only t)
 143                (setq buffer-file-name msg-filename)
 144                (mh-show-mode)
 145                ))
 146            (or (eq buffer-undo-list t)  ;don't save undo info for prev msgs
 147                (setq buffer-undo-list nil))
 148 ;;; Added by itokon (02/19/96)
 149            (setq buffer-file-name msg-filename)
 150 ;;;
 151            (set-mark nil)
 152            (setq mode-line-buffer-identification
 153                  (list (format mh-show-buffer-mode-line-buffer-id
 154                                folder msg-num)))
 155            (set-buffer folder)
 156            (setq mh-showing-with-headers nil)))))
 157
 158 (defun emh-view-message (&optional msg)
 159   "MIME decode and play this message."
 160   (interactive)
 161   (if (or (null emh-automatic-mime-preview)
 162           (null (get-buffer mh-show-buffer))
 163           (save-excursion
 164             (set-buffer mh-show-buffer)
 165             (not (eq major-mode 'mime-view-mode))
 166             ))
 167       (let ((emh-automatic-mime-preview t))
 168         (mh-invalidate-show-buffer)
 169         (mh-show-msg msg)
 170         ))
 171   (pop-to-buffer mh-show-buffer)
 172   )
 173
 174 (defun emh-toggle-decoding-mode (arg)
 175   "Toggle MIME processing mode.
 176 With arg, turn MIME processing on if arg is positive."
 177   (interactive "P")
 178   (setq emh-automatic-mime-preview
 179         (if (null arg)
 180             (not emh-automatic-mime-preview)
 181           arg))
 182   (save-excursion
 183     (set-buffer mh-show-buffer)
 184     (if (null emh-automatic-mime-preview)
 185         (if (and mime-raw-buffer
 186                  (get-buffer mime-raw-buffer))
 187             (kill-buffer mime-raw-buffer)
 188           )))
 189   (mh-invalidate-show-buffer)
 190   (mh-show (mh-get-msg-num t))
 191   )
 192
 193 (defun emh-show (&optional message)
 194   (interactive)
 195   (mh-invalidate-show-buffer)
 196   (mh-show message)
 197   )
 198
 199 (defun emh-header-display ()
 200   (interactive)
 201   (mh-invalidate-show-buffer)
 202   (let ((mime-view-ignored-field-regexp "^:$")
 203         emh-decode-encoded-word)
 204     (mh-header-display)
 205     ))
 206
 207 (defun emh-raw-display ()
 208   (interactive)
 209   (mh-invalidate-show-buffer)
 210   (let (emh-automatic-mime-preview
 211         emh-decode-encoded-word)
 212     (mh-header-display)
 213     ))
 214
 215 (defun emh-burst-multipart/digest ()
 216   "Burst apart the current message, which should be a multipart/digest.
 217 The message is replaced by its table of contents and the letters from the
 218 digest are inserted into the folder after that message."
 219   (interactive)
 220   (let ((digest (mh-get-msg-num t)))
 221     (mh-process-or-undo-commands mh-current-folder)
 222     (mh-set-folder-modified-p t)                ; lock folder while bursting
 223     (message "Bursting digest...")
 224     (mh-exec-cmd "mhn" "-store" mh-current-folder digest)
 225     (mh-scan-folder mh-current-folder (format "%d-last" mh-first-msg-num))
 226     (message "Bursting digest...done")
 227     ))
 228
 229
 230 ;;; @ for mime-view
 231 ;;;
 232
 233 (fset 'emh-text-decode-buffer
 234       (symbol-function 'mime-text-decode-buffer))
 235
 236 (set-alist 'mime-text-decoder-alist
 237            'mh-show-mode
 238            (function emh-text-decode-buffer))
 239
 240 (defvar emh-content-header-filter-hook
 241   (if window-system
 242       '(emh-highlight-header)
 243     )
 244   "Hook for header filtering.")
 245
 246 (autoload 'emh-highlight-header "emh-face")
 247
 248 (defun emh-content-header-filter ()
 249   "Header filter for mime-view.
 250 It is registered to variable `mime-view-content-header-filter-alist'."
 251   (goto-char (point-min))
 252   (mime-view-cut-header)
 253   (emh-text-decode-buffer default-mime-charset)
 254   (eword-decode-header)
 255   (run-hooks 'emh-content-header-filter-hook)
 256   )
 257
 258 (set-alist 'mime-view-content-header-filter-alist
 259            'mh-show-mode
 260            (function emh-content-header-filter))
 261
 262 (defun emh-quitting-method ()
 263   (let ((buf (current-buffer)))
 264     (mime-hide-echo-buffer)
 265     (pop-to-buffer
 266      (let ((name (buffer-name buf)))
 267        (substring name 5)
 268        ))
 269     (if (not emh-automatic-mime-preview)
 270         (mh-invalidate-show-buffer)
 271       )
 272     (mh-show (mh-get-msg-num t))
 273     ))
 274
 275 (set-alist 'mime-view-quitting-method-alist
 276            'mh-show-mode
 277            (function emh-quitting-method))
 278 (set-alist 'mime-view-show-summary-method
 279            'mh-show-mode
 280            (function emh-quitting-method))
 281
 282 (defun emh-following-method (buf)
 283   (save-excursion
 284     (set-buffer buf)
 285     (goto-char (point-max))
 286     (setq mh-show-buffer buf)
 287     (apply (function mh-send)
 288            (std11-field-bodies '("From" "cc" "Subject") ""))
 289     (setq mh-sent-from-folder buf)
 290     (setq mh-sent-from-msg 1)
 291     (let ((last (point)))
 292       (mh-yank-cur-msg)
 293       (goto-char last)
 294       )))
 295
 296 (set-alist 'mime-view-following-method-alist
 297            'mh-show-mode
 298            (function emh-following-method))
 299
 300
 301 ;;; @@ for mime-partial
 302 ;;;
 303
 304 (eval-after-load
 305     "mime-view"
 306   '(progn
 307      (autoload 'mime-combine-message/partials-automatically
 308        "mime-partial"
 309        "Internal method to combine message/partial messages automatically.")
 310      (set-atype 'mime-acting-condition
 311                 '((type . "message/partial")
 312                   (method . mime-combine-message/partials-automatically)
 313                   (major-mode . mh-show-mode)
 314                   (summary-buffer-exp
 315                    . (and (or (string-match "^article-\\(.+\\)$"
 316                                             article-buffer)
 317                               (string-match "^show-\\(.+\\)$" article-buffer))
 318                           (substring article-buffer
 319                                      (match-beginning 1) (match-end 1))
 320                           ))
 321                   ))
 322      (set-alist 'mime-view-partial-message-method-alist
 323                 'mh-show-mode
 324                 (function
 325                  (lambda ()
 326                    (let ((emh-automatic-mime-preview t))
 327                      (emh-show)
 328                      ))))
 329      ))
 330
 331
 332 ;;; @ set up
 333 ;;;
 334
 335 (define-key mh-folder-mode-map "v" (function emh-view-message))
 336 (define-key mh-folder-mode-map "\et" (function emh-toggle-decoding-mode))
 337 (define-key mh-folder-mode-map "." (function emh-show))
 338 (define-key mh-folder-mode-map "," (function emh-header-display))
 339 (define-key mh-folder-mode-map "\e," (function emh-raw-display))
 340 (define-key mh-folder-mode-map "\C-c\C-b"
 341   (function emh-burst-multipart/digest))
 342
 343 (defun emh-summary-before-quit ()
 344   (let ((buf (get-buffer mh-show-buffer)))
 345     (if buf
 346         (let ((the-buf (current-buffer)))
 347           (switch-to-buffer buf)
 348           (if (and mime-view-buffer
 349                    (setq buf (get-buffer mime-view-buffer))
 350                    )
 351               (progn
 352                 (switch-to-buffer the-buf)
 353                 (kill-buffer buf)
 354                 )
 355             (switch-to-buffer the-buf)
 356             )
 357           ))))
 358
 359 (add-hook 'mh-before-quit-hook (function emh-summary-before-quit))
 360
 361
 362 ;;; @ for BBDB
 363 ;;;
 364
 365 (eval-after-load "bbdb" '(require 'mime-bbdb))
 366
 367
 368 ;;; @ end
 369 ;;;
 370
 371 (provide 'emh)
 372
 373 (run-hooks 'emh-load-hook)
 374
 375 ;;; emh.el ends here