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.22 $
  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.22 1997-11-15 15:37: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                  (as-binary-input-file
 106                   (insert-file-contents msg-filename)
 107                   ;; (goto-char (point-min))
 108                   (while (re-search-forward "\r$" nil t)
 109                     (replace-match "")
 110                     )
 111                   )
 112                  (set-buffer-modified-p nil)
 113                  (setq buffer-read-only t)
 114                  (setq buffer-file-name msg-filename)
 115                  (mh-show-mode)
 116                  (mime-view-mode nil nil nil
 117                                  aname (concat "show-" folder))
 118                  (goto-char (point-min))
 119                  )
 120              (let ((clean-message-header mh-clean-message-header)
 121                    (invisible-headers mh-invisible-headers)
 122                    (visible-headers mh-visible-headers)
 123                    )
 124                ;; 1995/9/21
 125                ;;   modified by ARIURA <ariura@cc.tuat.ac.jp>
 126                ;;   to support mhl.
 127                (if mhl-formfile
 128                    (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
 129                                            (if (stringp mhl-formfile)
 130                                                (list "-form" mhl-formfile))
 131                                            msg-filename)
 132                  (insert-file-contents msg-filename))
 133                ;; end
 134                (goto-char (point-min))
 135                (cond (clean-message-header
 136                       (mh-clean-msg-header (point-min)
 137                                            invisible-headers
 138                                            visible-headers)
 139                       (goto-char (point-min)))
 140                      (t
 141                       (mh-start-of-uncleaned-message)))
 142                (if emh-decode-encoded-word
 143                    (eword-decode-header)
 144                  )
 145                (set-buffer-modified-p nil)
 146                (setq buffer-read-only t)
 147                (setq buffer-file-name msg-filename)
 148                (mh-show-mode)
 149                ))
 150            (or (eq buffer-undo-list t)  ;don't save undo info for prev msgs
 151                (setq buffer-undo-list nil))
 152 ;;; Added by itokon (02/19/96)
 153            (setq buffer-file-name msg-filename)
 154 ;;;
 155            (set-mark nil)
 156            (setq mode-line-buffer-identification
 157                  (list (format mh-show-buffer-mode-line-buffer-id
 158                                folder msg-num)))
 159            (set-buffer folder)
 160            (setq mh-showing-with-headers nil)))))
 161
 162 (defun emh-view-message (&optional msg)
 163   "MIME decode and play this message."
 164   (interactive)
 165   (if (or (null emh-automatic-mime-preview)
 166           (null (get-buffer mh-show-buffer))
 167           (save-excursion
 168             (set-buffer mh-show-buffer)
 169             (not (eq major-mode 'mime-view-mode))
 170             ))
 171       (let ((emh-automatic-mime-preview t))
 172         (mh-invalidate-show-buffer)
 173         (mh-show-msg msg)
 174         ))
 175   (pop-to-buffer mh-show-buffer)
 176   )
 177
 178 (defun emh-toggle-decoding-mode (arg)
 179   "Toggle MIME processing mode.
 180 With arg, turn MIME processing on if arg is positive."
 181   (interactive "P")
 182   (setq emh-automatic-mime-preview
 183         (if (null arg)
 184             (not emh-automatic-mime-preview)
 185           arg))
 186   (save-excursion
 187     (set-buffer mh-show-buffer)
 188     (if (null emh-automatic-mime-preview)
 189         (if (and mime-raw-buffer
 190                  (get-buffer mime-raw-buffer))
 191             (kill-buffer mime-raw-buffer)
 192           )))
 193   (mh-invalidate-show-buffer)
 194   (mh-show (mh-get-msg-num t))
 195   )
 196
 197 (defun emh-show (&optional message)
 198   (interactive)
 199   (mh-invalidate-show-buffer)
 200   (mh-show message)
 201   )
 202
 203 (defun emh-header-display ()
 204   (interactive)
 205   (mh-invalidate-show-buffer)
 206   (let ((mime-view-ignored-field-regexp "^:$")
 207         emh-decode-encoded-word)
 208     (mh-header-display)
 209     ))
 210
 211 (defun emh-raw-display ()
 212   (interactive)
 213   (mh-invalidate-show-buffer)
 214   (let (emh-automatic-mime-preview
 215         emh-decode-encoded-word)
 216     (mh-header-display)
 217     ))
 218
 219 (defun emh-burst-multipart/digest ()
 220   "Burst apart the current message, which should be a multipart/digest.
 221 The message is replaced by its table of contents and the letters from the
 222 digest are inserted into the folder after that message."
 223   (interactive)
 224   (let ((digest (mh-get-msg-num t)))
 225     (mh-process-or-undo-commands mh-current-folder)
 226     (mh-set-folder-modified-p t)                ; lock folder while bursting
 227     (message "Bursting digest...")
 228     (mh-exec-cmd "mhn" "-store" mh-current-folder digest)
 229     (mh-scan-folder mh-current-folder (format "%d-last" mh-first-msg-num))
 230     (message "Bursting digest...done")
 231     ))
 232
 233
 234 ;;; @ for mime-view
 235 ;;;
 236
 237 (fset 'emh-text-decode-buffer
 238       (symbol-function 'mime-text-decode-buffer))
 239
 240 (set-alist 'mime-text-decoder-alist
 241            'mh-show-mode
 242            (function emh-text-decode-buffer))
 243
 244 (defvar emh-content-header-filter-hook
 245   (if window-system
 246       '(emh-highlight-header)
 247     )
 248   "Hook for header filtering.")
 249
 250 (autoload 'emh-highlight-header "emh-face")
 251
 252 (defun emh-content-header-filter ()
 253   "Header filter for mime-view.
 254 It is registered to variable `mime-view-content-header-filter-alist'."
 255   (goto-char (point-min))
 256   (mime-view-cut-header)
 257   (emh-text-decode-buffer default-mime-charset)
 258   (eword-decode-header)
 259   (run-hooks 'emh-content-header-filter-hook)
 260   )
 261
 262 (set-alist 'mime-view-content-header-filter-alist
 263            'mh-show-mode
 264            (function emh-content-header-filter))
 265
 266 (defun emh-quitting-method ()
 267   (let ((buf (current-buffer)))
 268     (mime-hide-echo-buffer)
 269     (pop-to-buffer
 270      (let ((name (buffer-name buf)))
 271        (substring name 5)
 272        ))
 273     (if (not emh-automatic-mime-preview)
 274         (mh-invalidate-show-buffer)
 275       )
 276     (mh-show (mh-get-msg-num t))
 277     ))
 278
 279 (set-alist 'mime-view-quitting-method-alist
 280            'mh-show-mode
 281            (function emh-quitting-method))
 282 (set-alist 'mime-view-show-summary-method
 283            'mh-show-mode
 284            (function emh-quitting-method))
 285
 286 (defun emh-following-method (buf)
 287   (save-excursion
 288     (set-buffer buf)
 289     (goto-char (point-max))
 290     (setq mh-show-buffer buf)
 291     (apply (function mh-send)
 292            (std11-field-bodies '("From" "cc" "Subject") ""))
 293     (setq mh-sent-from-folder buf)
 294     (setq mh-sent-from-msg 1)
 295     (let ((last (point)))
 296       (mh-yank-cur-msg)
 297       (goto-char last)
 298       )))
 299
 300 (set-alist 'mime-view-following-method-alist
 301            'mh-show-mode
 302            (function emh-following-method))
 303
 304
 305 ;;; @@ for mime-partial
 306 ;;;
 307
 308 (eval-after-load
 309     "mime-view"
 310   '(progn
 311      (autoload 'mime-combine-message/partials-automatically
 312        "mime-partial"
 313        "Internal method to combine message/partial messages automatically.")
 314      (set-atype 'mime-acting-condition
 315                 '((type . "message/partial")
 316                   (method . mime-combine-message/partials-automatically)
 317                   (major-mode . mh-show-mode)
 318                   (summary-buffer-exp
 319                    . (and (or (string-match "^article-\\(.+\\)$"
 320                                             article-buffer)
 321                               (string-match "^show-\\(.+\\)$" article-buffer))
 322                           (substring article-buffer
 323                                      (match-beginning 1) (match-end 1))
 324                           ))
 325                   ))
 326      (set-alist 'mime-view-partial-message-method-alist
 327                 'mh-show-mode
 328                 (function
 329                  (lambda ()
 330                    (let ((emh-automatic-mime-preview t))
 331                      (emh-show)
 332                      ))))
 333      ))
 334
 335
 336 ;;; @ set up
 337 ;;;
 338
 339 (define-key mh-folder-mode-map "v" (function emh-view-message))
 340 (define-key mh-folder-mode-map "\et" (function emh-toggle-decoding-mode))
 341 (define-key mh-folder-mode-map "." (function emh-show))
 342 (define-key mh-folder-mode-map "," (function emh-header-display))
 343 (define-key mh-folder-mode-map "\e," (function emh-raw-display))
 344 (define-key mh-folder-mode-map "\C-c\C-b"
 345   (function emh-burst-multipart/digest))
 346
 347 (defun emh-summary-before-quit ()
 348   (let ((buf (get-buffer mh-show-buffer)))
 349     (if buf
 350         (let ((the-buf (current-buffer)))
 351           (switch-to-buffer buf)
 352           (if (and mime-view-buffer
 353                    (setq buf (get-buffer mime-view-buffer))
 354                    )
 355               (progn
 356                 (switch-to-buffer the-buf)
 357                 (kill-buffer buf)
 358                 )
 359             (switch-to-buffer the-buf)
 360             )
 361           ))))
 362
 363 (add-hook 'mh-before-quit-hook (function emh-summary-before-quit))
 364
 365
 366 ;;; @ for BBDB
 367 ;;;
 368
 369 (eval-after-load "bbdb" '(require 'mime-bbdb))
 370
 371
 372 ;;; @ end
 373 ;;;
 374
 375 (provide 'emh)
 376
 377 (run-hooks 'emh-load-hook)
 378
 379 ;;; emh.el ends here