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 (defcustom emh-icon-directory (if (fboundp 'locate-data-directory)
  62                                   (locate-data-directory "emh")
  63                                 (let ((icons (expand-file-name
  64                                               "emh/icons/"
  65                                               data-directory)))
  66                                   (if (file-directory-p icons)
  67                                       icons)))
  68   "*Directory to load the icon files from, or nil if none."
  69   :group 'emh
  70   :type '(choice (const :tag "none" nil)
  71                  string))
  72
  73 ;;; @ functions
  74 ;;;
  75
  76 (defsubst emh-raw-buffer (folder-buffer)
  77   (concat "article-" (if (bufferp folder-buffer)
  78                          (buffer-name folder-buffer)
  79                        folder-buffer)))
  80
  81 (defun mh-display-msg (msg-num folder &optional show-buffer mode)
  82   "Display message number MSG-NUM of FOLDER.
  83 This function uses `mime-view-mode' if MODE is not nil.  If MODE is
  84 nil, `emh-automatic-mime-preview' is used as default value."
  85   (or mode
  86       (setq mode emh-automatic-mime-preview)
  87       )
  88   ;; Display message NUMBER of FOLDER.
  89   ;; Sets the current buffer to the show buffer.
  90   (set-buffer folder)
  91   (or show-buffer
  92       (setq show-buffer mh-show-buffer))
  93   ;; Bind variables in folder buffer in case they are local
  94   (let ((msg-filename (mh-msg-filename msg-num)))
  95     (if (not (file-exists-p msg-filename))
  96         (error "Message %d does not exist" msg-num))
  97     (set-buffer show-buffer)
  98     (cond ((not (equal msg-filename buffer-file-name))
  99            ;; Buffer does not yet contain message.
 100            (clear-visited-file-modtime)
 101            (unlock-buffer)
 102            (setq buffer-file-name nil)  ; no locking during setup
 103            (setq buffer-read-only nil)
 104            (erase-buffer)
 105            (if mode
 106                (let* ((aname (emh-raw-buffer folder))
 107                       (abuf (get-buffer aname)))
 108                  (if abuf
 109                      (progn
 110                        (set-buffer abuf)
 111                        (setq buffer-read-only nil)
 112                        (erase-buffer))
 113                    (setq abuf (get-buffer-create aname))
 114                    (set-buffer abuf)
 115                    (set-buffer-multibyte nil))
 116                  (8bit-insert-encoded-file msg-filename)
 117                  (set-buffer-modified-p nil)
 118                  (setq buffer-read-only t)
 119                  (setq buffer-file-name msg-filename)
 120                  (mh-show-mode)
 121                  (mime-display-message (mime-open-entity 'buffer aname)
 122                                        (concat "show-" folder))
 123                  (goto-char (point-min)))
 124              (let ((clean-message-header mh-clean-message-header)
 125                    (invisible-headers mh-invisible-headers)
 126                    (visible-headers mh-visible-headers))
 127                ;; 1995/9/21
 128                ;;   modified by ARIURA <ariura@cc.tuat.ac.jp>
 129                ;;   to support mhl.
 130                (if mhl-formfile
 131                    (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
 132                                            (if (stringp mhl-formfile)
 133                                                (list "-form" mhl-formfile))
 134                                            msg-filename)
 135                  (insert-file-contents msg-filename))
 136                ;; end
 137                (goto-char (point-min))
 138                (cond (clean-message-header
 139                       (mh-clean-msg-header (point-min)
 140                                            invisible-headers
 141                                            visible-headers)
 142                       (goto-char (point-min)))
 143                      (t
 144                       (mh-start-of-uncleaned-message)))
 145                (if emh-decode-encoded-word
 146                    (mime-decode-header-in-buffer))
 147                (set-buffer-modified-p nil)
 148                (setq buffer-read-only t)
 149                (setq buffer-file-name msg-filename)
 150                (mh-show-mode)
 151                ))
 152            (or (eq buffer-undo-list t)  ;don't save undo info for prev msgs
 153                (setq buffer-undo-list nil))
 154 ;;; Added by itokon (02/19/96)
 155            (setq buffer-file-name msg-filename)
 156 ;;;
 157            (set-mark nil)
 158            (setq mode-line-buffer-identification
 159                  (list (format mh-show-buffer-mode-line-buffer-id
 160                                folder msg-num)))
 161            (set-buffer folder)
 162            (setq mh-showing-with-headers nil)))))
 163
 164 (defun emh-view-message (&optional msg)
 165   "MIME decode and play this message."
 166   (interactive)
 167   (if (or (null emh-automatic-mime-preview)
 168           (null (get-buffer mh-show-buffer))
 169           (save-excursion
 170             (set-buffer mh-show-buffer)
 171             (not (eq major-mode 'mime-view-mode))
 172             ))
 173       (let ((emh-automatic-mime-preview t))
 174         (mh-invalidate-show-buffer)
 175         (mh-show-msg msg)
 176         ))
 177   (pop-to-buffer mh-show-buffer)
 178   )
 179
 180 (defun emh-toggle-decoding-mode (arg)
 181   "Toggle MIME processing mode.
 182 With arg, turn MIME processing on if arg is positive."
 183   (interactive "P")
 184   (setq emh-automatic-mime-preview
 185         (if (null arg)
 186             (not emh-automatic-mime-preview)
 187           arg))
 188   (let ((raw-buffer (emh-raw-buffer (current-buffer))))
 189     (if (get-buffer raw-buffer)
 190         (kill-buffer raw-buffer)
 191       ))
 192   (mh-invalidate-show-buffer)
 193   (mh-show (mh-get-msg-num t))
 194   )
 195
 196 (defun emh-show (&optional message)
 197   (interactive)
 198   (mh-invalidate-show-buffer)
 199   (mh-show message)
 200   )
 201
 202 (defun emh-header-display ()
 203   (interactive)
 204   (mh-invalidate-show-buffer)
 205   (let (mime-view-ignored-field-list
 206         mime-view-visible-field-list
 207         emh-decode-encoded-word)
 208     (mh-header-display)
 209     ))
 210
 211 (defun emh-raw-display ()
 212   (interactive)
 213   (mh-invalidate-show-buffer)
 214   (let (emh-automatic-mime-preview
 215         emh-decode-encoded-word)
 216     (mh-header-display)
 217     ))
 218
 219 (defun emh-burst-multipart/digest ()
 220   "Burst apart the current message, which should be a multipart/digest.
 221 The message is replaced by its table of contents and the letters from the
 222 digest are inserted into the folder after that message."
 223   (interactive)
 224   (let ((digest (mh-get-msg-num t)))
 225     (mh-process-or-undo-commands mh-current-folder)
 226     (mh-set-folder-modified-p t)                ; lock folder while bursting
 227     (message "Bursting digest...")
 228     (mh-exec-cmd "mhn" "-store" mh-current-folder digest)
 229     (mh-scan-folder mh-current-folder (format "%d-last" mh-first-msg-num))
 230     (message "Bursting digest...done")
 231     ))
 232
 233
 234 ;;; @ for mime-view
 235 ;;;
 236
 237 (defvar emh-display-header-hook (if window-system '(emh-highlight-header))
 238   "Hook for header filtering.")
 239
 240 (autoload 'emh-highlight-header "emh-face")
 241
 242 (defun emh-header-presentation-method (entity situation)
 243   (mime-insert-header entity
 244                       mime-view-ignored-field-list
 245                       mime-view-visible-field-list)
 246   (run-hooks 'emh-display-header-hook)
 247   )
 248
 249 (set-alist 'mime-header-presentation-method-alist
 250            'mh-show-mode #'emh-header-presentation-method)
 251
 252
 253 (defun emh-quitting-method ()
 254   (let ((buf (current-buffer)))
 255     (mime-maybe-hide-echo-buffer)
 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-preview-quitting-method-alist
 267            'mh-show-mode #'emh-quitting-method)
 268
 269
 270 (defun emh-following-method (buf)
 271   (save-excursion
 272     (set-buffer buf)
 273     (goto-char (point-max))
 274     (setq mh-show-buffer buf)
 275     (apply (function mh-send)
 276            (std11-field-bodies '("From" "cc" "Subject") ""))
 277     (setq mh-sent-from-folder buf)
 278     (setq mh-sent-from-msg 1)
 279     (let ((last (point)))
 280       (mh-yank-cur-msg)
 281       (goto-char last)
 282       )))
 283
 284 (set-alist 'mime-preview-following-method-alist
 285            'mh-show-mode #'emh-following-method)
 286
 287
 288 ;;; @@ for mime-partial
 289 ;;;
 290
 291 (defun emh-request-partial-message ()
 292   (let ((msg-filename (mh-msg-filename (mh-get-msg-num t)))
 293         (show-buffer mh-show-buffer)
 294         (coding-system-for-read 'raw-text))
 295     (set-buffer (get-buffer-create " *Partial Article*"))
 296     (erase-buffer)
 297     (setq mime-preview-buffer show-buffer)
 298     (insert-file-contents msg-filename)
 299     (mime-parse-buffer)
 300     ))
 301
 302 (defun emh-get-folder-buffer ()
 303   (let ((buffer-name (buffer-name (current-buffer))))
 304     (and (or (string-match "^article-\\(.+\\)$" buffer-name)
 305              (string-match "^show-\\(.+\\)$" buffer-name))
 306          (substring buffer-name
 307                     (match-beginning 1) (match-end 1))
 308          )))
 309
 310 (autoload 'mime-combine-message/partial-pieces-automatically
 311   "mime-partial"
 312   "Internal method to combine message/partial messages automatically.")
 313
 314 (mime-add-condition
 315  'action
 316  '((type . message)(subtype . partial)
 317    (major-mode . mh-show-mode)
 318    (method . mime-combine-message/partial-pieces-automatically)
 319    (summary-buffer-exp . (emh-get-folder-buffer))
 320    (request-partial-message-method . emh-request-partial-message)
 321    ))
 322
 323
 324 ;;; @ set up
 325 ;;;
 326
 327 (define-key mh-folder-mode-map "v" (function emh-view-message))
 328 (define-key mh-folder-mode-map "\et" (function emh-toggle-decoding-mode))
 329 (define-key mh-folder-mode-map "." (function emh-show))
 330 (define-key mh-folder-mode-map "," (function emh-header-display))
 331 (define-key mh-folder-mode-map "\e," (function emh-raw-display))
 332 (define-key mh-folder-mode-map "\C-c\C-b"
 333   (function emh-burst-multipart/digest))
 334
 335 (defun emh-summary-before-quit ()
 336   (let ((buf (get-buffer mh-show-buffer)))
 337     (if buf
 338         (let ((the-buf (current-buffer)))
 339           (switch-to-buffer buf)
 340           (if (and mime-preview-buffer
 341                    (setq buf (get-buffer mime-preview-buffer))
 342                    )
 343               (progn
 344                 (switch-to-buffer the-buf)
 345                 (kill-buffer buf)
 346                 )
 347             (switch-to-buffer the-buf)
 348             )
 349           ))))
 350
 351 (add-hook 'mh-before-quit-hook (function emh-summary-before-quit))
 352
 353
 354 ;;; @ for BBDB
 355 ;;;
 356
 357 (eval-after-load "bbdb" '(require 'mime-bbdb))
 358
 359 ;;; @ Toolbar
 360
 361 (if (and (not (featurep 'xemacs))
 362          (boundp 'emacs-major-version)
 363          (>= emacs-major-version 21))
 364     (require 'emh-e21))
 365
 366 ;;; @ end
 367 ;;;
 368
 369 (provide 'emh)
 370
 371 (run-hooks 'emh-load-hook)
 372
 373 ;;; emh.el ends here