Mercurial > hg > xemacs-beta
comparison lisp/tm/tm-partial.el @ 4:b82b59fe008d r19-15b3
Import from CVS: tag r19-15b3
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:46:56 +0200 |
parents | |
children | 4b173ad71786 |
comparison
equal
deleted
inserted
replaced
3:30df88044ec6 | 4:b82b59fe008d |
---|---|
1 ;;; tm-partial.el --- Grabbing all MIME "message/partial"s. | |
2 | |
3 ;; Copyright (C) 1995,1996 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: OKABE Yasuo @ Kyoto University | |
6 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> | |
7 ;; Version: | |
8 ;; $Id: tm-partial.el,v 1.1.1.1 1996/12/18 03:55:32 steve Exp $ | |
9 ;; Keywords: mail, news, MIME, multimedia, message/partial | |
10 | |
11 ;; This file is a part of tm (Tools for MIME). | |
12 | |
13 ;; This program is free software; you can redistribute it and/or | |
14 ;; modify it under the terms of the GNU General Public License as | |
15 ;; published by the Free Software Foundation; either version 2, or (at | |
16 ;; your option) any later version. | |
17 | |
18 ;; This program is distributed in the hope that it will be useful, but | |
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
21 ;; General Public License for more details. | |
22 | |
23 ;; You should have received a copy of the GNU General Public License | |
24 ;; along with this program; see the file COPYING. If not, write to | |
25 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
26 ;; Boston, MA 02111-1307, USA. | |
27 | |
28 ;;; Code: | |
29 | |
30 (require 'tm-view) | |
31 (require 'tm-play) | |
32 | |
33 (defvar tm-partial/preview-article-method-alist nil) | |
34 | |
35 ;; display Article at the cursor in Subject buffer. | |
36 (defun tm-partial/preview-article (target) | |
37 (let ((f (assq target tm-partial/preview-article-method-alist))) | |
38 (if f | |
39 (funcall (cdr f)) | |
40 (error "Fatal. Unsupported mode") | |
41 ))) | |
42 | |
43 (defun mime-article/grab-message/partials (beg end cal) | |
44 (interactive) | |
45 (let* ((id (cdr (assoc "id" cal))) | |
46 (buffer (generate-new-buffer id)) | |
47 (mother mime::article/preview-buffer) | |
48 (target (cdr (assq 'major-mode cal))) | |
49 (article-buffer (buffer-name (current-buffer))) | |
50 (subject-buf (eval (cdr (assq 'summary-buffer-exp cal)))) | |
51 subject-id | |
52 (root-dir (expand-file-name | |
53 (concat "m-prts-" (user-login-name)) mime/tmp-dir)) | |
54 full-file) | |
55 (setq root-dir (concat root-dir "/" (replace-as-filename id))) | |
56 (setq full-file (concat root-dir "/FULL")) | |
57 | |
58 (if (null target) | |
59 (error "%s is not supported. Sorry." target) | |
60 ) | |
61 | |
62 ;; if you can't parse the subject line, try simple decoding method | |
63 (if (or (file-exists-p full-file) | |
64 (not (y-or-n-p "Merge partials?")) | |
65 ) | |
66 (progn | |
67 (kill-buffer buffer) | |
68 (mime-article/decode-message/partial beg end cal) | |
69 ) | |
70 (let (cinfo the-id parameters) | |
71 (setq subject-id (std11-field-body "Subject")) | |
72 (if (string-match "[0-9\n]+" subject-id) | |
73 (setq subject-id (substring subject-id 0 (match-beginning 0))) | |
74 ) | |
75 (pop-to-buffer subject-buf) | |
76 (while (search-backward subject-id nil t) | |
77 ) | |
78 (catch 'tag | |
79 (while t | |
80 (tm-partial/preview-article target) | |
81 (pop-to-buffer article-buffer) | |
82 (switch-to-buffer mime::article/preview-buffer) | |
83 (setq cinfo | |
84 (mime::preview-content-info/content-info | |
85 (car mime::preview/content-list))) | |
86 (setq parameters (mime::content-info/parameters cinfo)) | |
87 (setq the-id (assoc-value "id" parameters)) | |
88 (if (equal the-id id) | |
89 (progn | |
90 (switch-to-buffer article-buffer) | |
91 (mime-article/decode-message/partial | |
92 (point-min)(point-max) parameters) | |
93 (if (file-exists-p full-file) | |
94 (throw 'tag nil) | |
95 ) | |
96 )) | |
97 (if (not (progn | |
98 (pop-to-buffer subject-buf) | |
99 (end-of-line) | |
100 (search-forward subject-id nil t) | |
101 )) | |
102 (error "not found") | |
103 ) | |
104 )))))) | |
105 | |
106 | |
107 ;;; @ end | |
108 ;;; | |
109 | |
110 (provide 'tm-partial) | |
111 | |
112 (run-hooks 'tm-partial-load-hook) | |
113 | |
114 ;;; tm-partial.el ends here |