Sync up with SEMI 1.7.1.
[elisp/semi.git] / mime-partial.el
1 ;;; mime-partial.el --- Grabbing all MIME "message/partial"s.
2
3 ;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
4
5 ;; Author: OKABE Yasuo @ Kyoto University
6 ;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
7 ;; Keywords: message/partial, MIME, multimedia, mail, news
8
9 ;; This file is part of SEMI (Suite of Emacs MIME Interfaces).
10
11 ;; This program is free software; you can redistribute it and/or
12 ;; modify it under the terms of the GNU General Public License as
13 ;; published by the Free Software Foundation; either version 2, or (at
14 ;; your option) any later version.
15
16 ;; This program is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19 ;; General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
25
26 ;;; Code:
27
28 (require 'mime-view)
29 (require 'mime-play)
30
31 (defvar mime-view-partial-message-method-alist nil
32   "Alist major-mode vs. function to view partial message for mime-partial.")
33
34 ;; display Article at the cursor in Subject buffer.
35 (defsubst mime-view-partial-message (target)
36   (save-window-excursion
37     (let ((f (assq target mime-view-partial-message-method-alist)))
38       (if f
39           (funcall (cdr f))
40         (error "Fatal. Unsupported mode")
41         ))))
42
43 (defun mime-combine-message/partial-pieces-automatically (entity cal)
44   "Internal method for mime-view to combine message/partial messages
45 automatically.  This function refers variable
46 `mime-view-partial-message-method-alist' to select function to display
47 partial messages using mime-view."
48   (interactive)
49   (let* ((id (cdr (assoc "id" cal)))
50          (target (cdr (assq 'major-mode cal)))
51          (article-buffer (buffer-name (current-buffer)))
52          (subject-buf (eval (cdr (assq 'summary-buffer-exp cal))))
53          subject-id
54          (root-dir (expand-file-name
55                     (concat "m-prts-" (user-login-name)) mime-temp-directory))
56          full-file)
57     (setq root-dir (concat root-dir "/" (replace-as-filename id)))
58     (setq full-file (concat root-dir "/FULL"))
59     
60     (if (null target)
61         (error "%s is not supported. Sorry." target)
62       )
63     
64     ;; if you can't parse the subject line, try simple decoding method
65     (if (or (file-exists-p full-file)
66             (not (y-or-n-p "Merge partials?"))
67             )
68         (mime-store-message/partial-piece entity cal)
69       (setq subject-id (mime-entity-read-field entity 'Subject))
70       (if (string-match "[0-9\n]+" subject-id)
71           (setq subject-id (substring subject-id 0 (match-beginning 0)))
72         )
73       (save-excursion
74         (set-buffer subject-buf)
75         (while (search-backward subject-id nil t))
76         (catch 'tag
77           (while t
78             (mime-view-partial-message target)
79             (set-buffer article-buffer)
80             (let* ((situation
81                     (mime-entity-situation mime-message-structure))
82                    (the-id (cdr (assoc "id" situation))))
83               (when (string= the-id id)
84                 (mime-store-message/partial-piece mime-message-structure
85                                                   situation)
86                 (if (file-exists-p full-file)
87                     (throw 'tag nil)
88                   ))
89               (if (not (progn
90                          (set-buffer subject-buf)
91                          (end-of-line)
92                          (search-forward subject-id nil t)
93                          ))
94                   (error "not found")
95                 )
96               ))
97           )))))
98
99
100 ;;; @ end
101 ;;;
102
103 (provide 'mime-partial)
104
105 (run-hooks 'mime-partial-load-hook)
106
107 ;;; mime-partial.el ends here