Mercurial > emacs

comparison lisp/gnus/mm-partial.el @ 88155:d7ddb3e565de

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
sync with trunk
author Henrik Enberg <henrik.enberg@telia.com>
date Mon, 16 Jan 2006 00:03:54 +0000
parents 0d8b17d428b5
children
comparison
equal deleted inserted replaced
88154:8ce476d3ba36 88155:d7ddb3e565de
1 ;;; mm-partial.el --- showing message/partial 1 ;;; mm-partial.el --- showing message/partial
2 ;; Copyright (C) 2000 Free Software Foundation, Inc. 2
3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
4 ;; 2005 Free Software Foundation, Inc.
3 5
4 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> 6 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
5 ;; Keywords: message partial 7 ;; Keywords: message partial
6 8
7 ;; This file is part of GNU Emacs. 9 ;; This file is part of GNU Emacs.
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 ;; General Public License for more details. 19 ;; General Public License for more details.
18 20
19 ;; You should have received a copy of the GNU General Public License 21 ;; 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 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22 ;; Boston, MA 02111-1307, USA. 24 ;; Boston, MA 02110-1301, USA.
23 25
24 ;;; Commentary: 26 ;;; Commentary:
25 27
26 ;;; Code: 28 ;;; Code:
27 29
28 (eval-when-compile 30 (eval-when-compile (require 'cl))
29 (require 'cl))
30 31
31 (require 'gnus-sum) 32 (require 'gnus-sum)
32 (require 'mm-util) 33 (require 'mm-util)
33 (require 'mm-decode) 34 (require 'mm-decode)
34 35
41 (unless (eq (aref header 0) art) 42 (unless (eq (aref header 0) art)
42 (mm-with-unibyte-buffer 43 (mm-with-unibyte-buffer
43 (gnus-request-article-this-buffer (aref header 0) 44 (gnus-request-article-this-buffer (aref header 0)
44 gnus-newsgroup-name) 45 gnus-newsgroup-name)
45 (when (search-forward id nil t) 46 (when (search-forward id nil t)
46 (let ((nhandles (mm-dissect-buffer)) nid) 47 (let ((nhandles (mm-dissect-buffer
48 nil gnus-article-loose-mime)) nid)
47 (if (consp (car nhandles)) 49 (if (consp (car nhandles))
48 (mm-destroy-parts nhandles) 50 (mm-destroy-parts nhandles)
49 (setq nid (cdr (assq 'id 51 (setq nid (cdr (assq 'id
50 (cdr (mm-handle-type nhandles))))) 52 (cdr (mm-handle-type nhandles)))))
51 (if (not (equal id nid)) 53 (if (not (equal id nid))
81 (bnumber (string-to-number 83 (bnumber (string-to-number
82 (cdr (assq 'number 84 (cdr (assq 'number
83 (cdr (mm-handle-type b))))))) 85 (cdr (mm-handle-type b)))))))
84 (< anumber bnumber))))) 86 (< anumber bnumber)))))
85 (setq gnus-article-mime-handles 87 (setq gnus-article-mime-handles
86 (append (if (listp (car gnus-article-mime-handles)) 88 (mm-merge-handles gnus-article-mime-handles phandles))
87 gnus-article-mime-handles
88 (list gnus-article-mime-handles))
89 phandles))
90 (save-excursion 89 (save-excursion
91 (set-buffer (generate-new-buffer " *mm*")) 90 (set-buffer (generate-new-buffer " *mm*"))
92 (while (setq phandle (pop phandles)) 91 (while (setq phandle (pop phandles))
93 (setq nn (string-to-number 92 (setq nn (string-to-number
94 (cdr (assq 'number 93 (cdr (assq 'number
115 (unless total 114 (unless total
116 (error "Don't known the total number of")) 115 (error "Don't known the total number of"))
117 (if (<= n total) 116 (if (<= n total)
118 (error "Missing part %d" n)) 117 (error "Missing part %d" n))
119 (kill-buffer (mm-handle-buffer handle)) 118 (kill-buffer (mm-handle-buffer handle))
119 (goto-char (point-min))
120 (let ((point (if (search-forward "\n\n" nil t)
121 (1- (point))
122 (point-max))))
123 (goto-char (point-min))
124 (unless (re-search-forward "^mime-version:" point t)
125 (insert "MIME-Version: 1.0\n")))
120 (setcar handle (current-buffer)) 126 (setcar handle (current-buffer))
121 (mm-handle-set-cache handle t))) 127 (mm-handle-set-cache handle t)))
122 (unless no-display 128 (unless no-display
123 (save-excursion 129 (save-excursion
124 (save-restriction 130 (save-restriction
129 (gnus-article-prepare-display) 135 (gnus-article-prepare-display)
130 (setq handles gnus-article-mime-handles)) 136 (setq handles gnus-article-mime-handles))
131 (when handles 137 (when handles
132 ;; It is in article buffer. 138 ;; It is in article buffer.
133 (setq gnus-article-mime-handles 139 (setq gnus-article-mime-handles
134 (nconc (if (listp (car gnus-article-mime-handles)) 140 (mm-merge-handles gnus-article-mime-handles handles)))
135 gnus-article-mime-handles
136 (list gnus-article-mime-handles))
137 (if (listp (car handles))
138 handles (list handles)))))
139 (mm-handle-set-undisplayer 141 (mm-handle-set-undisplayer
140 handle 142 handle
141 `(lambda () 143 `(lambda ()
142 (let (buffer-read-only) 144 (let (buffer-read-only)
143 (condition-case nil 145 (condition-case nil
147 (face-property 'default prop) (current-buffer))) 149 (face-property 'default prop) (current-buffer)))
148 '(background background-pixmap foreground)) 150 '(background background-pixmap foreground))
149 (error nil)) 151 (error nil))
150 (delete-region ,(point-min-marker) ,(point-max-marker)))))))))) 152 (delete-region ,(point-min-marker) ,(point-max-marker))))))))))
151 153
154 (provide 'mm-partial)
155
156 ;;; arch-tag: 460e7424-05f2-4a1d-a0f2-70ec081eff7d
152 ;;; mm-partial.el ends here 157 ;;; mm-partial.el ends here