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