f4a50758107506e69a469f25c63241d46aae60dd
[elisp/emh.git] / 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.20 $
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.20 1997-05-12 12:32: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-raw-buffer
181                  (get-buffer mime-raw-buffer))
182             (kill-buffer mime-raw-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 ((buf (current-buffer)))
259     (mime-hide-echo-buffer)
260     (pop-to-buffer
261      (let ((name (buffer-name buf)))
262        (substring name 5)
263        ))
264     (if (not emh-automatic-mime-preview)
265         (mh-invalidate-show-buffer)
266       )
267     (mh-show (mh-get-msg-num t))
268     ))
269
270 (set-alist 'mime-view-quitting-method-alist
271            'mh-show-mode
272            (function emh-quitting-method))
273 (set-alist 'mime-view-show-summary-method
274            'mh-show-mode
275            (function emh-quitting-method))
276
277 (defun emh-following-method (buf)
278   (save-excursion
279     (set-buffer buf)
280     (goto-char (point-max))
281     (setq mh-show-buffer buf)
282     (apply (function mh-send)
283            (std11-field-bodies '("From" "cc" "Subject") ""))
284     (setq mh-sent-from-folder buf)
285     (setq mh-sent-from-msg 1)
286     (let ((last (point)))
287       (mh-yank-cur-msg)
288       (goto-char last)
289       )))
290
291 (set-alist 'mime-view-following-method-alist
292            'mh-show-mode
293            (function emh-following-method))
294
295
296 ;;; @@ for mime-partial
297 ;;;
298
299 (call-after-loaded
300  'mime-view
301  (function
302   (lambda ()
303     (autoload 'mime-combine-message/partials-automatically
304       "mime-partial"
305       "Internal method to combine message/partial messages automatically.")
306     (set-atype 'mime-acting-condition
307                '((type . "message/partial")
308                  (method . mime-combine-message/partials-automatically)
309                  (major-mode . mh-show-mode)
310                  (summary-buffer-exp
311                   . (and (or (string-match "^article-\\(.+\\)$" article-buffer)
312                              (string-match "^show-\\(.+\\)$" article-buffer))
313                          (substring article-buffer
314                                     (match-beginning 1) (match-end 1))
315                          ))
316                  ))
317     (set-alist 'mime-view-partial-message-method-alist
318                'mh-show-mode
319                (function
320                 (lambda ()
321                   (let ((emh-automatic-mime-preview t))
322                     (emh-show)
323                     ))))
324     )))
325
326
327 ;;; @ set up
328 ;;;
329
330 (define-key mh-folder-mode-map "v" (function emh-view-message))
331 (define-key mh-folder-mode-map "\et" (function emh-toggle-decoding-mode))
332 (define-key mh-folder-mode-map "." (function emh-show))
333 (define-key mh-folder-mode-map "," (function emh-header-display))
334 (define-key mh-folder-mode-map "\e," (function emh-raw-display))
335 (define-key mh-folder-mode-map "\C-c\C-b"
336   (function emh-burst-multipart/digest))
337
338 (defun emh-summary-before-quit ()
339   (let ((buf (get-buffer mh-show-buffer)))
340     (if buf
341         (let ((the-buf (current-buffer)))
342           (switch-to-buffer buf)
343           (if (and mime-view-buffer
344                    (setq buf (get-buffer mime-view-buffer))
345                    )
346               (progn
347                 (switch-to-buffer the-buf)
348                 (kill-buffer buf)
349                 )
350             (switch-to-buffer the-buf)
351             )
352           ))))
353
354 (add-hook 'mh-before-quit-hook (function emh-summary-before-quit))
355
356
357 ;;; @@ for emh-comp.el
358 ;;;
359
360 (autoload 'emh-edit-again "emh-comp"
361   "Clean-up a draft or a message previously sent and make it resendable." t)
362 (autoload 'emh-extract-rejected-mail "emh-comp"
363   "Extract a letter returned by the mail system and make it re-editable." t)
364 (autoload 'emh-forward "emh-comp"
365   "Forward a message or message sequence by MIME style." t)
366
367 (call-after-loaded
368  'mime-setup
369  (function
370   (lambda ()
371     (substitute-key-definition
372      'mh-edit-again 'emh-edit-again mh-folder-mode-map)
373     (substitute-key-definition
374      'mh-extract-rejected-mail 'emh-extract-rejected-mail
375      mh-folder-mode-map)
376     (substitute-key-definition
377      'mh-forward 'emh-forward mh-folder-mode-map)
378
379     (call-after-loaded
380      'mh-comp
381      (function
382       (lambda ()
383         (require 'emh-comp)
384         ))
385      'mh-letter-mode-hook)
386     )))
387
388
389 ;;; @ for BBDB
390 ;;;
391
392 (call-after-loaded
393  'bbdb
394  (function
395   (lambda ()
396     (require 'mime-bbdb)
397     )))
398
399
400 ;;; @ end
401 ;;;
402
403 (provide 'emh)
404
405 (run-hooks 'emh-load-hook)
406
407 ;;; emh.el ends here