mime/emh.el

   1 ;;; emh.el --- MIME extender for mh-e
   2
   3 ;; Copyright (C) 1995,1996,1997,1998,2000 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
   6 ;;         OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
   7 ;; Maintainer: MORIOKA Tomohiko <tomo@m17n.org>
   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.14.1")
  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 (defsubst emh-raw-buffer (folder-buffer)
  66   (concat "article-" (if (bufferp folder-buffer)
  67                          (buffer-name folder-buffer)
  68                        folder-buffer)))
  69
  70 (defun mh-display-msg (msg-num folder &optional show-buffer mode)
  71   "Display message number MSG-NUM of FOLDER.
  72 This function uses `mime-view-mode' if MODE is not nil.  If MODE is
  73 nil, `emh-automatic-mime-preview' is used as default value."
  74   (or mode
  75       (setq mode emh-automatic-mime-preview)
  76       )
  77   ;; Display message NUMBER of FOLDER.
  78   ;; Sets the current buffer to the show buffer.
  79   (set-buffer folder)
  80   (or show-buffer
  81       (setq show-buffer mh-show-buffer))
  82   ;; Bind variables in folder buffer in case they are local
  83   (let ((msg-filename (mh-msg-filename msg-num)))
  84     (if (not (file-exists-p msg-filename))
  85         (error "Message %d does not exist" msg-num))
  86     (set-buffer show-buffer)
  87     (cond ((not (equal msg-filename buffer-file-name))
  88            ;; Buffer does not yet contain message.
  89            (clear-visited-file-modtime)
  90            (unlock-buffer)
  91            (setq buffer-file-name nil)  ; no locking during setup
  92            (setq buffer-read-only nil)
  93            (erase-buffer)
  94            (if mode
  95                (let* ((aname (emh-raw-buffer folder))
  96                       (abuf (get-buffer aname)))
  97                  (if abuf
  98                      (progn
  99                        (set-buffer abuf)
 100                        (setq buffer-read-only nil)
 101                        (erase-buffer))
 102                    (setq abuf (get-buffer-create aname))
 103                    (set-buffer abuf)
 104                    (set-buffer-multibyte nil))
 105                  (8bit-insert-encoded-file msg-filename)
 106                  (set-buffer-modified-p nil)
 107                  (setq buffer-read-only t)
 108                  (setq buffer-file-name msg-filename)
 109                  (mh-show-mode)
 110                  (mime-display-message (mime-open-entity 'buffer aname)
 111                                        (concat "show-" folder))
 112                  (goto-char (point-min)))
 113              (let ((clean-message-header mh-clean-message-header)
 114                    (invisible-headers mh-invisible-headers)
 115                    (visible-headers mh-visible-headers))
 116                ;; 1995/9/21
 117                ;;   modified by ARIURA <ariura@cc.tuat.ac.jp>
 118                ;;   to support mhl.
 119                (if mhl-formfile
 120                    (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
 121                                            (if (stringp mhl-formfile)
 122                                                (list "-form" mhl-formfile))
 123                                            msg-filename)
 124                  (insert-file-contents msg-filename))
 125                ;; end
 126                (goto-char (point-min))
 127                (cond (clean-message-header
 128                       (mh-clean-msg-header (point-min)
 129                                            invisible-headers
 130                                            visible-headers)
 131                       (goto-char (point-min)))
 132                      (t
 133                       (mh-start-of-uncleaned-message)))
 134                (if emh-decode-encoded-word
 135                    (mime-decode-header-in-buffer))
 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   (let ((raw-buffer (emh-raw-buffer (current-buffer))))
 178     (if (get-buffer raw-buffer)
 179         (kill-buffer raw-buffer)
 180       ))
 181   (mh-invalidate-show-buffer)
 182   (mh-show (mh-get-msg-num t))
 183   )
 184
 185 (defun emh-show (&optional message)
 186   (interactive)
 187   (mh-invalidate-show-buffer)
 188   (mh-show message)
 189   )
 190
 191 (defun emh-header-display ()
 192   (interactive)
 193   (mh-invalidate-show-buffer)
 194   (let (mime-view-ignored-field-list
 195         mime-view-visible-field-list
 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 (defvar emh-display-header-hook (if window-system '(emh-highlight-header))
 227   "Hook for header filtering.")
 228
 229 (autoload 'emh-highlight-header "emh-face")
 230
 231 (defun emh-header-presentation-method (entity situation)
 232   (mime-insert-header entity
 233                       mime-view-ignored-field-list
 234                       mime-view-visible-field-list)
 235   (run-hooks 'emh-display-header-hook)
 236   )
 237
 238 (set-alist 'mime-header-presentation-method-alist
 239            'mh-show-mode #'emh-header-presentation-method)
 240
 241
 242 (defun emh-quitting-method ()
 243   (let ((buf (current-buffer)))
 244     (mime-maybe-hide-echo-buffer)
 245     (pop-to-buffer
 246      (let ((name (buffer-name buf)))
 247        (substring name 5)
 248        ))
 249     (if (not emh-automatic-mime-preview)
 250         (mh-invalidate-show-buffer)
 251       )
 252     (mh-show (mh-get-msg-num t))
 253     ))
 254
 255 (set-alist 'mime-preview-quitting-method-alist
 256            'mh-show-mode #'emh-quitting-method)
 257
 258
 259 (defun emh-following-method (buf)
 260   (save-excursion
 261     (set-buffer buf)
 262     (goto-char (point-max))
 263     (setq mh-show-buffer buf)
 264     (apply (function mh-send)
 265            (std11-field-bodies '("From" "cc" "Subject") ""))
 266     (setq mh-sent-from-folder buf)
 267     (setq mh-sent-from-msg 1)
 268     (let ((last (point)))
 269       (mh-yank-cur-msg)
 270       (goto-char last)
 271       )))
 272
 273 (set-alist 'mime-preview-following-method-alist
 274            'mh-show-mode #'emh-following-method)
 275
 276
 277 ;;; @@ for mime-partial
 278 ;;;
 279
 280 (defun emh-request-partial-message ()
 281   (let ((msg-filename (mh-msg-filename (mh-get-msg-num t)))
 282         (show-buffer mh-show-buffer))
 283     (set-buffer (get-buffer-create " *Partial Article*"))
 284     (erase-buffer)
 285     (setq mime-preview-buffer show-buffer)
 286     (raw-text-insert-file-contents msg-filename)
 287     (mime-parse-buffer)
 288     ))
 289
 290 (defun emh-get-folder-buffer ()
 291   (let ((buffer-name (buffer-name (current-buffer))))
 292     (and (or (string-match "^article-\\(.+\\)$" buffer-name)
 293              (string-match "^show-\\(.+\\)$" buffer-name))
 294          (substring buffer-name
 295                     (match-beginning 1) (match-end 1))
 296          )))
 297
 298 (autoload 'mime-combine-message/partial-pieces-automatically
 299   "mime-partial"
 300   "Internal method to combine message/partial messages automatically.")
 301
 302 (mime-add-condition
 303  'action
 304  '((type . message)(subtype . partial)
 305    (major-mode . mh-show-mode)
 306    (method . mime-combine-message/partial-pieces-automatically)
 307    (summary-buffer-exp . (emh-get-folder-buffer))
 308    (request-partial-message-method . emh-request-partial-message)
 309    ))
 310
 311
 312 ;;; @ set up
 313 ;;;
 314
 315 (define-key mh-folder-mode-map "v" (function emh-view-message))
 316 (define-key mh-folder-mode-map "\et" (function emh-toggle-decoding-mode))
 317 (define-key mh-folder-mode-map "." (function emh-show))
 318 (define-key mh-folder-mode-map "," (function emh-header-display))
 319 (define-key mh-folder-mode-map "\e," (function emh-raw-display))
 320 (define-key mh-folder-mode-map "\C-c\C-b"
 321   (function emh-burst-multipart/digest))
 322
 323 (defun emh-summary-before-quit ()
 324   (let ((buf (get-buffer mh-show-buffer)))
 325     (if buf
 326         (let ((the-buf (current-buffer)))
 327           (switch-to-buffer buf)
 328           (if (and mime-preview-buffer
 329                    (setq buf (get-buffer mime-preview-buffer))
 330                    )
 331               (progn
 332                 (switch-to-buffer the-buf)
 333                 (kill-buffer buf)
 334                 )
 335             (switch-to-buffer the-buf)
 336             )
 337           ))))
 338
 339 (add-hook 'mh-before-quit-hook (function emh-summary-before-quit))
 340
 341
 342 ;;; @ for BBDB
 343 ;;;
 344
 345 (eval-after-load "bbdb" '(require 'mime-bbdb))
 346
 347
 348 ;;; @ end
 349 ;;;
 350
 351 (provide 'emh)
 352
 353 (run-hooks 'emh-load-hook)
 354
 355 ;;; emh.el ends here