Mercurial > hg > xemacs-beta

comparison lisp/tm/tm-partial.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents d95e72db5c07
children c0c698873ce1
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; tm-partial.el --- Grabbing all MIME "message/partial"s. 1 ;;; tm-partial.el --- Grabbing all MIME "message/partial"s.
2 2
3 ;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
4 4
5 ;; Author: OKABE Yasuo @ Kyoto University 5 ;; Author: OKABE Yasuo @ Kyoto University
6 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp> 6 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
7 ;; Version: 7 ;; Version:
8 ;; $Id: tm-partial.el,v 1.4 1997/02/04 02:36:07 steve Exp $ 8 ;; $Id: tm-partial.el,v 1.1.1.1 1996/12/18 22:43:37 steve Exp $
9 ;; Keywords: mail, news, MIME, multimedia, message/partial 9 ;; Keywords: mail, news, MIME, multimedia, message/partial
10 10
11 ;; This file is a part of tm (Tools for MIME). 11 ;; This file is a part of tm (Tools for MIME).
12 12
13 ;; This program is free software; you can redistribute it and/or 13 ;; This program is free software; you can redistribute it and/or
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 ;; General Public License for more details. 21 ;; General Public License for more details.
22 22
23 ;; You should have received a copy of the GNU General Public License 23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the 24 ;; along with this program; see the file COPYING. If not, write to
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 25 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA. 26 ;; Boston, MA 02111-1307, USA.
27 27
28 ;;; Code: 28 ;;; Code:
29 29
30 (require 'tm-view) 30 (require 'tm-view)
32 32
33 (defvar tm-partial/preview-article-method-alist nil) 33 (defvar tm-partial/preview-article-method-alist nil)
34 34
35 ;; display Article at the cursor in Subject buffer. 35 ;; display Article at the cursor in Subject buffer.
36 (defun tm-partial/preview-article (target) 36 (defun tm-partial/preview-article (target)
37 (save-window-excursion 37 (let ((f (assq target tm-partial/preview-article-method-alist)))
38 (let ((f (assq target tm-partial/preview-article-method-alist))) 38 (if f
39 (if f 39 (funcall (cdr f))
40 (funcall (cdr f)) 40 (error "Fatal. Unsupported mode")
41 (error "Fatal. Unsupported mode") 41 )))
42 ))))
43 42
44 (defun mime-article/grab-message/partials (beg end cal) 43 (defun mime-article/grab-message/partials (beg end cal)
45 (interactive) 44 (interactive)
46 (let* ((id (cdr (assoc "id" cal))) 45 (let* ((id (cdr (assoc "id" cal)))
46 (buffer (generate-new-buffer id))
47 (mother mime::article/preview-buffer) 47 (mother mime::article/preview-buffer)
48 (target (cdr (assq 'major-mode cal))) 48 (target (cdr (assq 'major-mode cal)))
49 (article-buffer (buffer-name (current-buffer))) 49 (article-buffer (buffer-name (current-buffer)))
50 (subject-buf (eval (cdr (assq 'summary-buffer-exp cal)))) 50 (subject-buf (eval (cdr (assq 'summary-buffer-exp cal))))
51 subject-id 51 subject-id
61 61
62 ;; if you can't parse the subject line, try simple decoding method 62 ;; if you can't parse the subject line, try simple decoding method
63 (if (or (file-exists-p full-file) 63 (if (or (file-exists-p full-file)
64 (not (y-or-n-p "Merge partials?")) 64 (not (y-or-n-p "Merge partials?"))
65 ) 65 )
66 (mime-article/decode-message/partial beg end cal) 66 (progn
67 (kill-buffer buffer)
68 (mime-article/decode-message/partial beg end cal)
69 )
67 (let (cinfo the-id parameters) 70 (let (cinfo the-id parameters)
68 (setq subject-id (std11-field-body "Subject")) 71 (setq subject-id (std11-field-body "Subject"))
69 (if (string-match "[0-9\n]+" subject-id) 72 (if (string-match "[0-9\n]+" subject-id)
70 (setq subject-id (substring subject-id 0 (match-beginning 0))) 73 (setq subject-id (substring subject-id 0 (match-beginning 0)))
71 ) 74 )
72 (save-excursion 75 (pop-to-buffer subject-buf)
73 (set-buffer subject-buf) 76 (while (search-backward subject-id nil t)
74 (while (search-backward subject-id nil t)) 77 )
75 (catch 'tag 78 (catch 'tag
76 (while t 79 (while t
77 (tm-partial/preview-article target) 80 (tm-partial/preview-article target)
78 (set-buffer article-buffer) 81 (pop-to-buffer article-buffer)
79 (set-buffer mime::article/preview-buffer) 82 (switch-to-buffer mime::article/preview-buffer)
80 (setq cinfo 83 (setq cinfo
81 (mime::preview-content-info/content-info 84 (mime::preview-content-info/content-info
82 (car mime::preview/content-list))) 85 (car mime::preview/content-list)))
83 (setq parameters (mime::content-info/parameters cinfo)) 86 (setq parameters (mime::content-info/parameters cinfo))
84 (setq the-id (assoc-value "id" parameters)) 87 (setq the-id (assoc-value "id" parameters))
85 (if (equal the-id id) 88 (if (equal the-id id)
86 (progn 89 (progn
87 (set-buffer article-buffer) 90 (switch-to-buffer article-buffer)
88 (mime-article/decode-message/partial 91 (mime-article/decode-message/partial
89 (point-min)(point-max) parameters) 92 (point-min)(point-max) parameters)
90 (if (file-exists-p full-file) 93 (if (file-exists-p full-file)
91 (throw 'tag nil) 94 (throw 'tag nil)
92 ) 95 )
93 )) 96 ))
94 (if (not (progn 97 (if (not (progn
95 (set-buffer subject-buf) 98 (pop-to-buffer subject-buf)
96 (end-of-line) 99 (end-of-line)
97 (search-forward subject-id nil t) 100 (search-forward subject-id nil t)
98 )) 101 ))
99 (error "not found") 102 (error "not found")
100 )
101 ) 103 )
102 )))))) 104 ))))))
103 105
104 106
105 ;;; @ end 107 ;;; @ end