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