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