emh.el

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