1 ;;; mm-partial.el --- showing message/partial
2 ;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
4 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
5 ;; Keywords: message partial
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published
11 ;; by the Free Software Foundation; either version 2, or (at your
12 ;; option) any later version.
14 ;; GNU Emacs is distributed in the hope that it will be useful, but
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 ;; General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
28 (eval-when-compile (require 'cl
))
34 (defun mm-partial-find-parts (id &optional art
)
35 (let ((headers (save-excursion
36 (set-buffer gnus-summary-buffer
)
37 gnus-newsgroup-headers
))
39 (while (setq header
(pop headers
))
40 (unless (eq (aref header
0) art
)
41 (mm-with-unibyte-buffer
42 (gnus-request-article-this-buffer (aref header
0)
44 (when (search-forward id nil t
)
45 (let ((nhandles (mm-dissect-buffer
46 nil gnus-article-loose-mime
)) nid
)
47 (if (consp (car nhandles
))
48 (mm-destroy-parts nhandles
)
49 (setq nid
(cdr (assq 'id
50 (cdr (mm-handle-type nhandles
)))))
51 (if (not (equal id nid
))
52 (mm-destroy-parts nhandles
)
53 (push nhandles phandles
))))))))
57 (defun mm-inline-partial (handle &optional no-display
)
58 "Show the partial part of HANDLE.
59 This function replaces the buffer of HANDLE with a buffer contains
61 If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing."
62 (let ((id (cdr (assq 'id
(cdr (mm-handle-type handle
)))))
64 (b (point)) (n 1) total
66 gnus-displaying-mime handles buffer
)
67 (unless (mm-handle-cache handle
)
69 (error "Can not find message/partial id"))
72 (mm-partial-find-parts
75 (set-buffer gnus-summary-buffer
)
76 (gnus-summary-article-number))))
78 (let ((anumber (string-to-number
80 (cdr (mm-handle-type a
))))))
81 (bnumber (string-to-number
83 (cdr (mm-handle-type b
)))))))
84 (< anumber bnumber
)))))
85 (setq gnus-article-mime-handles
86 (mm-merge-handles gnus-article-mime-handles phandles
))
88 (set-buffer (generate-new-buffer " *mm*"))
89 (while (setq phandle
(pop phandles
))
90 (setq nn
(string-to-number
92 (cdr (mm-handle-type phandle
))))))
93 (setq ntotal
(string-to-number
95 (cdr (mm-handle-type phandle
))))))
98 (unless (eq total ntotal
)
99 (error "The numbers of total are different"))
100 (setq total ntotal
)))
103 (error "Missing part %d" n
))
104 (mm-insert-part phandle
)
105 (goto-char (point-max))
106 (when (not (eq 0 (skip-chars-backward "\r\n")))
107 ;; remove tail blank spaces except one
108 (if (looking-at "\r?\n")
109 (goto-char (match-end 0)))
110 (delete-region (point) (point-max)))
113 (error "Don't known the total number of"))
115 (error "Missing part %d" n
))
116 (kill-buffer (mm-handle-buffer handle
))
117 (goto-char (point-min))
118 (let ((point (if (search-forward "\n\n" nil t
)
121 (goto-char (point-min))
122 (unless (re-search-forward "^mime-version:" point t
)
123 (insert "MIME-Version: 1.0\n")))
124 (setcar handle
(current-buffer))
125 (mm-handle-set-cache handle t
)))
129 (narrow-to-region b b
)
130 (mm-insert-part handle
)
131 (let (gnus-article-mime-handles)
132 (run-hooks 'gnus-article-decode-hook
)
133 (gnus-article-prepare-display)
134 (setq handles gnus-article-mime-handles
))
136 ;; It is in article buffer.
137 (setq gnus-article-mime-handles
138 (mm-merge-handles gnus-article-mime-handles handles
)))
139 (mm-handle-set-undisplayer
142 (let (buffer-read-only)
144 ;; This is only valid on XEmacs.
145 (mapcar (lambda (prop)
147 (face-property 'default prop
) (current-buffer)))
148 '(background background-pixmap foreground
))
150 (delete-region ,(point-min-marker) ,(point-max-marker))))))))))
152 (provide 'mm-partial
)
154 ;;; arch-tag: 460e7424-05f2-4a1d-a0f2-70ec081eff7d
155 ;;; mm-partial.el ends here