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.8 $
  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 (require 'alist)
  36
  37
  38 ;;; @ version
  39 ;;;
  40
  41 (defconst emh-RCS-ID
  42   "$Id: emh.el,v 0.8 1997-03-16 00:05:32 morioka Exp $")
  43
  44 (defconst emh-version (get-version-string emh-RCS-ID))
  45
  46
  47 ;;; @ variable
  48 ;;;
  49
  50 (defvar emh-automatic-mime-preview t
  51   "*If non-nil, show MIME processed message.")
  52
  53 (defvar emh-decode-encoded-word t
  54   "*If non-nil, decode encoded-word when it is not MIME preview mode.")
  55
  56
  57 ;;; @ functions
  58 ;;;
  59
  60 (defun mh-display-msg (msg-num folder &optional show-buffer mode)
  61   (or mode
  62       (setq mode emh-automatic-mime-preview)
  63       )
  64   ;; Display message NUMBER of FOLDER.
  65   ;; Sets the current buffer to the show buffer.
  66   (set-buffer folder)
  67   (or show-buffer
  68       (setq show-buffer mh-show-buffer))
  69   ;; Bind variables in folder buffer in case they are local
  70   (let ((msg-filename (mh-msg-filename msg-num)))
  71     (if (not (file-exists-p msg-filename))
  72         (error "Message %d does not exist" msg-num))
  73     (set-buffer show-buffer)
  74     (cond ((not (equal msg-filename buffer-file-name))
  75            ;; Buffer does not yet contain message.
  76            (clear-visited-file-modtime)
  77            (unlock-buffer)
  78            (setq buffer-file-name nil)  ; no locking during setup
  79            (setq buffer-read-only nil)
  80            (erase-buffer)
  81            (if mode
  82                (let* ((aname (concat "article-" folder))
  83                       (abuf (get-buffer aname))
  84                       )
  85                  (if abuf
  86                      (progn
  87                        (set-buffer abuf)
  88                        (setq buffer-read-only nil)
  89                        (erase-buffer)
  90                        )
  91                    (setq abuf (get-buffer-create aname))
  92                    (set-buffer abuf)
  93                    )
  94                  (as-binary-input-file
  95                   (insert-file-contents msg-filename)
  96                   ;; (goto-char (point-min))
  97                   (while (re-search-forward "\r$" nil t)
  98                     (replace-match "")
  99                     )
 100                   )
 101                  (set-buffer-modified-p nil)
 102                  (setq buffer-read-only t)
 103                  (setq buffer-file-name msg-filename)
 104                  (mh-show-mode)
 105                  (mime-view-mode nil nil nil
 106                                  aname (concat "show-" folder))
 107                  (goto-char (point-min))
 108                  )
 109              (let ((clean-message-header mh-clean-message-header)
 110                    (invisible-headers mh-invisible-headers)
 111                    (visible-headers mh-visible-headers)
 112                    )
 113                ;; 1995/9/21
 114                ;;   modified by ARIURA <ariura@cc.tuat.ac.jp>
 115                ;;   to support mhl.
 116                (if mhl-formfile
 117                    (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
 118                                            (if (stringp mhl-formfile)
 119                                                (list "-form" mhl-formfile))
 120                                            msg-filename)
 121                  (insert-file-contents msg-filename))
 122                ;; end
 123                (goto-char (point-min))
 124                (cond (clean-message-header
 125                       (mh-clean-msg-header (point-min)
 126                                            invisible-headers
 127                                            visible-headers)
 128                       (goto-char (point-min)))
 129                      (t
 130                       (mh-start-of-uncleaned-message)))
 131                (if emh-decode-encoded-word
 132                    (eword-decode-header)
 133                  )
 134                (set-buffer-modified-p nil)
 135                (setq buffer-read-only t)
 136                (setq buffer-file-name msg-filename)
 137                (mh-show-mode)
 138                ))
 139            (or (eq buffer-undo-list t)  ;don't save undo info for prev msgs
 140                (setq buffer-undo-list nil))
 141 ;;; Added by itokon (02/19/96)
 142            (setq buffer-file-name msg-filename)
 143 ;;;
 144            (set-mark nil)
 145            (setq mode-line-buffer-identification
 146                  (list (format mh-show-buffer-mode-line-buffer-id
 147                                folder msg-num)))
 148            (set-buffer folder)
 149            (setq mh-showing-with-headers nil)))))
 150
 151 (defun emh-view-message (&optional msg)
 152   "MIME decode and play this message."
 153   (interactive)
 154   (if (or (null emh-automatic-mime-preview)
 155           (null (get-buffer mh-show-buffer))
 156           (save-excursion
 157             (set-buffer mh-show-buffer)
 158             (not (eq major-mode 'mime-view-mode))
 159             ))
 160       (let ((emh-automatic-mime-preview t))
 161         (mh-invalidate-show-buffer)
 162         (mh-show-msg msg)
 163         ))
 164   (pop-to-buffer mh-show-buffer)
 165   )
 166
 167 (defun emh-toggle-decoding-mode (arg)
 168   "Toggle MIME processing mode.
 169 With arg, turn MIME processing on if arg is positive."
 170   (interactive "P")
 171   (setq emh-automatic-mime-preview
 172         (if (null arg)
 173             (not emh-automatic-mime-preview)
 174           arg))
 175   (save-excursion
 176     (set-buffer mh-show-buffer)
 177     (if (null emh-automatic-mime-preview)
 178         (if (and mime::preview/article-buffer
 179                  (get-buffer mime::preview/article-buffer))
 180             (kill-buffer mime::preview/article-buffer)
 181           )))
 182   (mh-invalidate-show-buffer)
 183   (mh-show (mh-get-msg-num t))
 184   )
 185
 186 (defun emh-show (&optional message)
 187   (interactive)
 188   (mh-invalidate-show-buffer)
 189   (mh-show message)
 190   )
 191
 192 (defun emh-header-display ()
 193   (interactive)
 194   (mh-invalidate-show-buffer)
 195   (let ((mime-view-ignored-field-regexp "^:$")
 196         emh-decode-encoded-word)
 197     (mh-header-display)
 198     ))
 199
 200 (defun emh-raw-display ()
 201   (interactive)
 202   (mh-invalidate-show-buffer)
 203   (let (emh-automatic-mime-preview
 204         emh-decode-encoded-word)
 205     (mh-header-display)
 206     ))
 207
 208 (defun emh-burst-multipart/digest ()
 209   "Burst apart the current message, which should be a multipart/digest.
 210 The message is replaced by its table of contents and the letters from the
 211 digest are inserted into the folder after that message."
 212   (interactive)
 213   (let ((digest (mh-get-msg-num t)))
 214     (mh-process-or-undo-commands mh-current-folder)
 215     (mh-set-folder-modified-p t)                ; lock folder while bursting
 216     (message "Bursting digest...")
 217     (mh-exec-cmd "mhn" "-store" mh-current-folder digest)
 218     (mh-scan-folder mh-current-folder (format "%d-last" mh-first-msg-num))
 219     (message "Bursting digest...done")
 220     ))
 221
 222
 223 ;;; @ for mime-view
 224 ;;;
 225
 226 (fset 'emh-decode-charset-buffer
 227       (symbol-function 'mime-text-decode-buffer))
 228
 229 (set-alist 'mime-text-decoder-alist
 230            'mh-show-mode
 231            (function emh-decode-charset-buffer))
 232
 233 (defvar emh-content-header-filter-hook
 234   (if window-system
 235       '(emh-highlight-header)
 236     )
 237   "Hook for header filtering.")
 238
 239 (autoload 'emh-highlight-header "emh-face")
 240
 241 (defun emh-content-header-filter ()
 242   (goto-char (point-min))
 243   (mime-preview/cut-header)
 244   (emh-decode-charset-buffer default-mime-charset)
 245   (eword-decode-header)
 246   (run-hooks 'emh-content-header-filter-hook)
 247   )
 248
 249 (set-alist 'mime-view-content-header-filter-alist
 250            'mh-show-mode
 251            (function emh-content-header-filter))
 252
 253 (defun emh-quitting-method ()
 254   (let ((win (get-buffer-window
 255               mime/output-buffer-name))
 256         (buf (current-buffer))
 257         )
 258     (if win
 259         (delete-window win)
 260       )
 261     (pop-to-buffer
 262      (let ((name (buffer-name buf)))
 263        (substring name 5)
 264        ))
 265     (if (not emh-automatic-mime-preview)
 266         (mh-invalidate-show-buffer)
 267       )
 268     (mh-show (mh-get-msg-num t))
 269     ))
 270
 271 (set-alist 'mime-view-quitting-method-alist
 272            'mh-show-mode
 273            (function 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 (call-after-loaded
 301  'mime-partial
 302  (function
 303   (lambda ()
 304     (set-atype 'mime/content-decoding-condition
 305                '((type . "message/partial")
 306                  (method . mime-article/grab-message/partials)
 307                  (major-mode . mh-show-mode)
 308                  (summary-buffer-exp
 309                   . (and (or (string-match "^article-\\(.+\\)$" article-buffer)
 310                              (string-match "^show-\\(.+\\)$" article-buffer))
 311                          (substring article-buffer
 312                                     (match-beginning 1) (match-end 1))
 313                          ))
 314                  ))
 315     (set-alist 'mime-partial/preview-article-method-alist
 316                'mh-show-mode
 317                (function
 318                 (lambda ()
 319                   (let ((emh-automatic-mime-preview t))
 320                     (emh-show)
 321                     ))))
 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::article/preview-buffer
 342                    (setq buf (get-buffer mime::article/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 emh-comp.el
 356 ;;;
 357
 358 (autoload 'emh-edit-again "emh-comp"
 359   "Clean-up a draft or a message previously sent and make it resendable." t)
 360 (autoload 'emh-extract-rejected-mail "emh-comp"
 361   "Extract a letter returned by the mail system and make it re-editable." t)
 362 (autoload 'emh-forward "emh-comp"
 363   "Forward a message or message sequence by MIME style." t)
 364
 365 (call-after-loaded
 366  'mime-setup
 367  (function
 368   (lambda ()
 369     (substitute-key-definition
 370      'mh-edit-again 'emh-edit-again mh-folder-mode-map)
 371     (substitute-key-definition
 372      'mh-extract-rejected-mail 'emh-extract-rejected-mail
 373      mh-folder-mode-map)
 374     (substitute-key-definition
 375      'mh-forward 'emh-forward mh-folder-mode-map)
 376
 377     (call-after-loaded
 378      'mh-comp
 379      (function
 380       (lambda ()
 381         (require 'emh-comp)
 382         ))
 383      'mh-letter-mode-hook)
 384     )))
 385
 386
 387 ;;; @ for BBDB
 388 ;;;
 389
 390 (call-after-loaded
 391  'bbdb
 392  (function
 393   (lambda ()
 394     (require 'mime-bbdb)
 395     )))
 396
 397
 398 ;;; @ end
 399 ;;;
 400
 401 (provide 'emh)
 402
 403 (run-hooks 'emh-load-hook)
 404
 405 ;;; emh.el ends here