emh.el

   1 ;;; emh.el --- MIME extender for mh-e
   2
   3 ;; Copyright (C) 1995,1996 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.3 $
  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 (eval-when-compile
  38   (require 'mime-play)
  39   )
  40
  41
  42 ;;; @ version
  43 ;;;
  44
  45 (defconst emh-RCS-ID
  46   "$Id: emh.el,v 0.3 1997-02-28 02:39:57 tmorioka Exp $")
  47
  48 (defconst emh-version (get-version-string emh-RCS-ID))
  49
  50
  51 ;;; @ variable
  52 ;;;
  53
  54 (defvar emh-automatic-mime-preview t
  55   "*If non-nil, show MIME processed message.")
  56
  57 (defvar emh-decode-encoded-word t
  58   "*If non-nil, decode encoded-word when it is not MIME preview mode.")
  59
  60
  61 ;;; @ functions
  62 ;;;
  63
  64 (defun mh-display-msg (msg-num folder &optional show-buffer mode)
  65   (or mode
  66       (setq mode emh-automatic-mime-preview)
  67       )
  68   ;; Display message NUMBER of FOLDER.
  69   ;; Sets the current buffer to the show buffer.
  70   (set-buffer folder)
  71   (or show-buffer
  72       (setq show-buffer mh-show-buffer))
  73   ;; Bind variables in folder buffer in case they are local
  74   (let ((msg-filename (mh-msg-filename msg-num)))
  75     (if (not (file-exists-p msg-filename))
  76         (error "Message %d does not exist" msg-num))
  77     (set-buffer show-buffer)
  78     (cond ((not (equal msg-filename buffer-file-name))
  79            ;; Buffer does not yet contain message.
  80            (clear-visited-file-modtime)
  81            (unlock-buffer)
  82            (setq buffer-file-name nil)  ; no locking during setup
  83            (setq buffer-read-only nil)
  84            (erase-buffer)
  85            (if mode
  86                (let* ((aname (concat "article-" folder))
  87                       (abuf (get-buffer aname))
  88                       )
  89                  (if abuf
  90                      (progn
  91                        (set-buffer abuf)
  92                        (setq buffer-read-only nil)
  93                        (erase-buffer)
  94                        )
  95                    (setq abuf (get-buffer-create aname))
  96                    (set-buffer abuf)
  97                    )
  98                  (as-binary-input-file
  99                   (insert-file-contents msg-filename)
 100                   ;; (goto-char (point-min))
 101                   (while (re-search-forward "\r$" nil t)
 102                     (replace-match "")
 103                     )
 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::preview/article-buffer
 183                  (get-buffer mime::preview/article-buffer))
 184             (kill-buffer mime::preview/article-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 (fset 'emh-decode-charset-buffer
 231       (symbol-function 'mime-charset/decode-buffer))
 232
 233 (set-alist 'mime-text-decoder-alist
 234            'mh-show-mode
 235            (function emh-decode-charset-buffer))
 236
 237 (defun emh-content-header-filter ()
 238   (goto-char (point-min))
 239   (mime-preview/cut-header)
 240   (emh-decode-charset-buffer default-mime-charset)
 241   (eword-decode-header)
 242   )
 243
 244 (set-alist 'mime-view-content-header-filter-alist
 245            'mh-show-mode
 246            (function emh-content-header-filter))
 247
 248 (defun emh-quitting-method ()
 249   (let ((win (get-buffer-window
 250               mime/output-buffer-name))
 251         (buf (current-buffer))
 252         )
 253     (if win
 254         (delete-window win)
 255       )
 256     (pop-to-buffer
 257      (let ((name (buffer-name buf)))
 258        (substring name 5)
 259        ))
 260     (if (not emh-automatic-mime-preview)
 261         (mh-invalidate-show-buffer)
 262       )
 263     (mh-show (mh-get-msg-num t))
 264     ))
 265
 266 (set-alist 'mime-view-quitting-method-alist
 267            'mh-show-mode
 268            (function emh-quitting-method))
 269 (set-alist 'mime-view-show-summary-method
 270            'mh-show-mode
 271            (function emh-quitting-method))
 272
 273 (defun emh-following-method (buf)
 274   (save-excursion
 275     (set-buffer buf)
 276     (goto-char (point-max))
 277     (setq mh-show-buffer buf)
 278     (apply (function mh-send)
 279            (std11-field-bodies '("From" "cc" "Subject") ""))
 280     (setq mh-sent-from-folder buf)
 281     (setq mh-sent-from-msg 1)
 282     (let ((last (point)))
 283       (mh-yank-cur-msg)
 284       (goto-char last)
 285       )))
 286
 287 (set-alist 'mime-view-following-method-alist
 288            'mh-show-mode
 289            (function emh-following-method))
 290
 291
 292 ;;; @@ for mime-partial
 293 ;;;
 294
 295 (call-after-loaded
 296  'mime-partial
 297  (function
 298   (lambda ()
 299     (set-atype 'mime/content-decoding-condition
 300                '((type . "message/partial")
 301                  (method . mime-article/grab-message/partials)
 302                  (major-mode . mh-show-mode)
 303                  (summary-buffer-exp
 304                   . (and (or (string-match "^article-\\(.+\\)$" article-buffer)
 305                              (string-match "^show-\\(.+\\)$" article-buffer))
 306                          (substring article-buffer
 307                                     (match-beginning 1) (match-end 1))
 308                          ))
 309                  ))
 310     (set-alist 'mime-partial/preview-article-method-alist
 311                'mh-show-mode
 312                (function
 313                 (lambda ()
 314                   (let ((emh-automatic-mime-preview t))
 315                     (emh-show)
 316                     ))))
 317     )))
 318
 319
 320 ;;; @ set up
 321 ;;;
 322
 323 (define-key mh-folder-mode-map "v" (function emh-view-message))
 324 (define-key mh-folder-mode-map "\et" (function emh-toggle-decoding-mode))
 325 (define-key mh-folder-mode-map "." (function emh-show))
 326 (define-key mh-folder-mode-map "," (function emh-header-display))
 327 (define-key mh-folder-mode-map "\e," (function emh-raw-display))
 328 (define-key mh-folder-mode-map "\C-c\C-b"
 329   (function emh-burst-multipart/digest))
 330
 331 (defun emh-summary-before-quit ()
 332   (let ((buf (get-buffer mh-show-buffer)))
 333     (if buf
 334         (let ((the-buf (current-buffer)))
 335           (switch-to-buffer buf)
 336           (if (and mime::article/preview-buffer
 337                    (setq buf (get-buffer mime::article/preview-buffer))
 338                    )
 339               (progn
 340                 (switch-to-buffer the-buf)
 341                 (kill-buffer buf)
 342                 )
 343             (switch-to-buffer the-buf)
 344             )
 345           ))))
 346
 347 (add-hook 'mh-before-quit-hook (function emh-summary-before-quit))
 348
 349
 350 ;;; @@ for emh-comp.el
 351 ;;;
 352
 353 (autoload 'emh-edit-again "emh-comp"
 354   "Clean-up a draft or a message previously sent and make it resendable." t)
 355 (autoload 'emh-extract-rejected-mail "emh-comp"
 356   "Extract a letter returned by the mail system and make it re-editable." t)
 357 (autoload 'emh-forward "emh-comp"
 358   "Forward a message or message sequence by MIME style." t)
 359
 360 (call-after-loaded
 361  'mime-setup
 362  (function
 363   (lambda ()
 364     (substitute-key-definition
 365      'mh-edit-again 'emh-edit-again mh-folder-mode-map)
 366     (substitute-key-definition
 367      'mh-extract-rejected-mail 'emh-extract-rejected-mail
 368      mh-folder-mode-map)
 369     (substitute-key-definition
 370      'mh-forward 'emh-forward mh-folder-mode-map)
 371
 372     (call-after-loaded
 373      'mh-comp
 374      (function
 375       (lambda ()
 376         (require 'emh-comp)
 377         ))
 378      'mh-letter-mode-hook)
 379     )))
 380
 381
 382 ;;; @ for BBDB
 383 ;;;
 384
 385 (call-after-loaded
 386  'bbdb
 387  (function
 388   (lambda ()
 389     (require 'tm-bbdb)
 390     )))
 391
 392
 393 ;;; @ end
 394 ;;;
 395
 396 (provide 'emh)
 397
 398 (run-hooks 'emh-load-hook)
 399
 400 ;;; emh.el ends here