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