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