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 'alist)
  34 (require 'mime-view)
  35
  36
  37 ;;; @ version
  38 ;;;
  39
  40 (defconst emh-version "1.10.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                  (if abuf
  93                      (progn
  94                        (set-buffer abuf)
  95                        (setq buffer-read-only nil)
  96                        (erase-buffer)
  97                        )
  98                    (setq abuf (get-buffer-create aname))
  99                    (set-buffer abuf)
 100                    (set-buffer-multibyte nil)
 101                    )
 102                  (insert-file-contents-as-raw-text msg-filename)
 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-display-message (mime-open-entity 'buffer aname)
 108                                        (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                ;; 1995/9/21
 115                ;;   modified by ARIURA <ariura@cc.tuat.ac.jp>
 116                ;;   to support mhl.
 117                (if mhl-formfile
 118                    (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
 119                                            (if (stringp mhl-formfile)
 120                                                (list "-form" mhl-formfile))
 121                                            msg-filename)
 122                  (insert-file-contents msg-filename))
 123                ;; end
 124                (goto-char (point-min))
 125                (cond (clean-message-header
 126                       (mh-clean-msg-header (point-min)
 127                                            invisible-headers
 128                                            visible-headers)
 129                       (goto-char (point-min)))
 130                      (t
 131                       (mh-start-of-uncleaned-message)))
 132                (if emh-decode-encoded-word
 133                    (eword-decode-header)
 134                  )
 135                (set-buffer-modified-p nil)
 136                (setq buffer-read-only t)
 137                (setq buffer-file-name msg-filename)
 138                (mh-show-mode)
 139                ))
 140            (or (eq buffer-undo-list t)  ;don't save undo info for prev msgs
 141                (setq buffer-undo-list nil))
 142 ;;; Added by itokon (02/19/96)
 143            (setq buffer-file-name msg-filename)
 144 ;;;
 145            (set-mark nil)
 146            (setq mode-line-buffer-identification
 147                  (list (format mh-show-buffer-mode-line-buffer-id
 148                                folder msg-num)))
 149            (set-buffer folder)
 150            (setq mh-showing-with-headers nil)))))
 151
 152 (defun emh-view-message (&optional msg)
 153   "MIME decode and play this message."
 154   (interactive)
 155   (if (or (null emh-automatic-mime-preview)
 156           (null (get-buffer mh-show-buffer))
 157           (save-excursion
 158             (set-buffer mh-show-buffer)
 159             (not (eq major-mode 'mime-view-mode))
 160             ))
 161       (let ((emh-automatic-mime-preview t))
 162         (mh-invalidate-show-buffer)
 163         (mh-show-msg msg)
 164         ))
 165   (pop-to-buffer mh-show-buffer)
 166   )
 167
 168 (defun emh-toggle-decoding-mode (arg)
 169   "Toggle MIME processing mode.
 170 With arg, turn MIME processing on if arg is positive."
 171   (interactive "P")
 172   (setq emh-automatic-mime-preview
 173         (if (null arg)
 174             (not emh-automatic-mime-preview)
 175           arg))
 176   (save-excursion
 177     (set-buffer mh-show-buffer)
 178     (if (null emh-automatic-mime-preview)
 179         (if (and mime-raw-buffer
 180                  (get-buffer mime-raw-buffer))
 181             (kill-buffer mime-raw-buffer)
 182           )))
 183   (mh-invalidate-show-buffer)
 184   (mh-show (mh-get-msg-num t))
 185   )
 186
 187 (defun emh-show (&optional message)
 188   (interactive)
 189   (mh-invalidate-show-buffer)
 190   (mh-show message)
 191   )
 192
 193 (defun emh-header-display ()
 194   (interactive)
 195   (mh-invalidate-show-buffer)
 196   (let (mime-view-ignored-field-list
 197         mime-view-visible-field-list
 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 (defvar emh-display-header-hook (if window-system '(emh-highlight-header))
 229   "Hook for header filtering.")
 230
 231 (autoload 'emh-highlight-header "emh-face")
 232
 233 (defun emh-header-presentation-method (entity situation)
 234   (mime-insert-header entity
 235                       mime-view-ignored-field-list
 236                       mime-view-visible-field-list)
 237   (run-hooks 'emh-display-header-hook)
 238   )
 239
 240 (set-alist 'mime-header-presentation-method-alist
 241            'mh-show-mode #'emh-header-presentation-method)
 242
 243
 244 (defun emh-quitting-method ()
 245   (let ((buf (current-buffer)))
 246     (mime-maybe-hide-echo-buffer)
 247     (pop-to-buffer
 248      (let ((name (buffer-name buf)))
 249        (substring name 5)
 250        ))
 251     (if (not emh-automatic-mime-preview)
 252         (mh-invalidate-show-buffer)
 253       )
 254     (mh-show (mh-get-msg-num t))
 255     ))
 256
 257 (set-alist 'mime-preview-quitting-method-alist
 258            'mh-show-mode #'emh-quitting-method)
 259
 260
 261 (defun emh-following-method (buf)
 262   (save-excursion
 263     (set-buffer buf)
 264     (goto-char (point-max))
 265     (setq mh-show-buffer buf)
 266     (apply (function mh-send)
 267            (std11-field-bodies '("From" "cc" "Subject") ""))
 268     (setq mh-sent-from-folder buf)
 269     (setq mh-sent-from-msg 1)
 270     (let ((last (point)))
 271       (mh-yank-cur-msg)
 272       (goto-char last)
 273       )))
 274
 275 (set-alist 'mime-preview-following-method-alist
 276            'mh-show-mode #'emh-following-method)
 277
 278
 279 ;;; @@ for mime-partial
 280 ;;;
 281
 282 (defun emh-request-partial-message ()
 283   (let ((msg-filename (mh-msg-filename (mh-get-msg-num t)))
 284         (show-buffer mh-show-buffer))
 285     (set-buffer (get-buffer-create " *Partial Article*"))
 286     (erase-buffer)
 287     (setq mime-preview-buffer show-buffer)
 288     (insert-file-contents-as-raw-text msg-filename)
 289     (mime-parse-buffer)
 290     ))
 291
 292 (defun emh-get-folder-buffer ()
 293   (let ((buffer-name (buffer-name (current-buffer))))
 294     (and (or (string-match "^article-\\(.+\\)$" buffer-name)
 295              (string-match "^show-\\(.+\\)$" buffer-name))
 296          (substring buffer-name
 297                     (match-beginning 1) (match-end 1))
 298          )))
 299
 300 (autoload 'mime-combine-message/partial-pieces-automatically
 301   "mime-partial"
 302   "Internal method to combine message/partial messages automatically.")
 303
 304 (mime-add-condition
 305  'action
 306  '((type . message)(subtype . partial)
 307    (major-mode . mh-show-mode)
 308    (method . mime-combine-message/partial-pieces-automatically)
 309    (summary-buffer-exp . (emh-get-folder-buffer))
 310    (request-partial-message-method . emh-request-partial-message)
 311    ))
 312
 313
 314 ;;; @ set up
 315 ;;;
 316
 317 (define-key mh-folder-mode-map "v" (function emh-view-message))
 318 (define-key mh-folder-mode-map "\et" (function emh-toggle-decoding-mode))
 319 (define-key mh-folder-mode-map "." (function emh-show))
 320 (define-key mh-folder-mode-map "," (function emh-header-display))
 321 (define-key mh-folder-mode-map "\e," (function emh-raw-display))
 322 (define-key mh-folder-mode-map "\C-c\C-b"
 323   (function emh-burst-multipart/digest))
 324
 325 (defun emh-summary-before-quit ()
 326   (let ((buf (get-buffer mh-show-buffer)))
 327     (if buf
 328         (let ((the-buf (current-buffer)))
 329           (switch-to-buffer buf)
 330           (if (and mime-preview-buffer
 331                    (setq buf (get-buffer mime-preview-buffer))
 332                    )
 333               (progn
 334                 (switch-to-buffer the-buf)
 335                 (kill-buffer buf)
 336                 )
 337             (switch-to-buffer the-buf)
 338             )
 339           ))))
 340
 341 (add-hook 'mh-before-quit-hook (function emh-summary-before-quit))
 342
 343
 344 ;;; @ for BBDB
 345 ;;;
 346
 347 (eval-after-load "bbdb" '(require 'mime-bbdb))
 348
 349
 350 ;;; @ end
 351 ;;;
 352
 353 (provide 'emh)
 354
 355 (run-hooks 'emh-load-hook)
 356
 357 ;;; emh.el ends here