;;; mm-uu.el --- Return uu stuff as mm handles
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005 Free Software Foundation, Inc.
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp
(lambda () (mm-uu-verbatim-marks-extract 0 0 1 -1))
nil)
(LaTeX
- "^\\(\\\\[^\n]+\n\\)*\\\\documentclass"
+ "^\\([\\\\%][^\n]+\n\\)*\\\\documentclass.*[[{%]"
"^\\\\end{document}"
mm-uu-latex-extract
nil
(defun mm-uu-emacs-sources-extract ()
(mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
- '("application/emacs-lisp")
+ '("application/emacs-lisp" (charset . gnus-decoded))
nil nil
(list mm-dissect-disposition
(cons 'filename file-name))))
(defun mm-uu-diff-extract ()
(mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
- '("text/x-patch")))
+ '("text/x-patch" (charset . gnus-decoded))))
(defun mm-uu-diff-test ()
(and gnus-newsgroup-name
(t (goto-char (point-max))))
(setq text-start (point))
(while (re-search-forward mm-uu-beginning-regexp nil t)
- (setq start-point (match-beginning 0))
+ (setq start-point (match-beginning 0)
+ entry nil)
(let ((alist mm-uu-type-alist)
(beginning-regexp (match-string 0)))
(while (not entry)
(setq result (cons "multipart/mixed" (nreverse result))))
result)))
-(defun mm-uu-dissect-text-parts (handle)
- "Dissect text parts and put uu handles into HANDLE."
- (let ((buffer (mm-handle-buffer handle))
- type children)
+;;;###autoload
+(defun mm-uu-dissect-text-parts (handle &optional decoded)
+ "Dissect text parts and put uu handles into HANDLE.
+Assume text has been decoded if DECODED is non-nil."
+ (let ((buffer (mm-handle-buffer handle)))
(cond ((stringp buffer)
- (mapc 'mm-uu-dissect-text-parts (cdr handle)))
+ (dolist (elem (cdr handle))
+ (mm-uu-dissect-text-parts elem decoded)))
((bufferp buffer)
- (when (and (setq type (mm-handle-media-type handle))
- (stringp type)
- (string-match "\\`text/" type)
- (with-current-buffer buffer
- (setq children
- (mm-uu-dissect t (mm-handle-type handle)))))
- (kill-buffer buffer)
- (setcar handle (car children))
- (setcdr handle (cdr children))))
+ (let ((type (mm-handle-media-type handle))
+ (case-fold-search t) ;; string-match
+ children charset encoding)
+ (when (and
+ (stringp type)
+ ;; Mutt still uses application/pgp even though
+ ;; it has already been withdrawn.
+ (string-match "\\`text/\\|\\`application/pgp\\'" type)
+ (setq
+ children
+ (with-current-buffer buffer
+ (cond
+ ((or decoded
+ (eq (setq charset (mail-content-type-get
+ (mm-handle-type handle)
+ 'charset))
+ 'gnus-decoded))
+ (setq decoded t)
+ (mm-uu-dissect
+ t (cons type '((charset . gnus-decoded)))))
+ (charset
+ (setq decoded t)
+ (mm-with-multibyte-buffer
+ (insert (mm-decode-string (mm-get-part handle)
+ charset))
+ (mm-uu-dissect
+ t (cons type '((charset . gnus-decoded))))))
+ ((setq encoding (mm-handle-encoding handle))
+ (setq decoded nil)
+ ;; Inherit the multibyteness of the `buffer'.
+ (with-temp-buffer
+ (insert-buffer-substring buffer)
+ (mm-decode-content-transfer-encoding
+ encoding type)
+ (mm-uu-dissect t (list type))))
+ (t
+ (setq decoded nil)
+ (mm-uu-dissect t (list type)))))))
+ ;; Ignore it if a given part is dissected into a single
+ ;; part of which the type is the same as the given one.
+ (if (and (<= (length children) 2)
+ (string-equal (mm-handle-media-type (cadr children))
+ type))
+ (kill-buffer (mm-handle-buffer (cadr children)))
+ (kill-buffer buffer)
+ (setcdr handle (cdr children))
+ (setcar handle (car children)) ;; "multipart/mixed"
+ (dolist (elem (cdr children))
+ (mm-uu-dissect-text-parts elem decoded))))))
(t
- (mapc 'mm-uu-dissect-text-parts handle)))))
+ (dolist (elem handle)
+ (mm-uu-dissect-text-parts elem decoded))))))
(provide 'mm-uu)