X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmm-uu.el;h=9f00f0c99906cc9f50c2ab71b214c29048fcfdd5;hb=27688c4fe73986a46e3f2cb9051170f41ef82f4c;hp=1bdebded09b3c45a685eee862fe0c2f34e453fa0;hpb=66c26c155163db358a8641e5165b0439f95e7133;p=elisp%2Fgnus.git- diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el index 1bdebde..9f00f0c 100644 --- a/lisp/mm-uu.el +++ b/lisp/mm-uu.el @@ -19,8 +19,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -81,6 +81,7 @@ This can be either \"inline\" or \"attachment\".") (defcustom mm-uu-diff-groups-regexp "gnus\\.commits" "*Regexp matching diff groups." + :version "22.1" :type 'regexp :group 'gnus-article-mime) @@ -111,8 +112,8 @@ This can be either \"inline\" or \"attachment\".") "^exit 0$" mm-uu-shar-extract) (forward -;;; Thanks to Edward J. Sabol and -;;; Peter von der Ah\'e + ;; Thanks to Edward J. Sabol and + ;; Peter von der Ah\'e "^-+ \\(Start of \\)?Forwarded message" "^-+ End \\(of \\)?forwarded message" mm-uu-forward-extract @@ -163,6 +164,10 @@ To disable dissecting shar codes, for instance, add mm-uu-type-alist) :group 'gnus-article-mime) +(defvar mm-uu-text-plain-type '("text/plain" (charset . gnus-decoded)) + "MIME type and parameters for text/plain parts. +`gnus-decoded' is a fake charset, which means no further decoding.") + ;; functions (defsubst mm-uu-type (entry) @@ -186,13 +191,12 @@ To disable dissecting shar codes, for instance, add (defun mm-uu-copy-to-buffer (&optional from to) "Copy the contents of the current buffer to a fresh buffer. Return that buffer." - (save-excursion - (let ((obuf (current-buffer)) - (coding-system - ;; Might not exist in non-MULE XEmacs - (when (boundp 'buffer-file-coding-system) - buffer-file-coding-system))) - (set-buffer (generate-new-buffer " *mm-uu*")) + (let ((obuf (current-buffer)) + (coding-system + ;; Might not exist in non-MULE XEmacs + (when (boundp 'buffer-file-coding-system) + buffer-file-coding-system))) + (with-current-buffer (generate-new-buffer " *mm-uu*") (setq buffer-file-coding-system coding-system) (insert-buffer-substring obuf from to) (current-buffer)))) @@ -363,7 +367,7 @@ Return that buffer." (while (re-search-forward "^- " nil t) (replace-match "" t t) (forward-line 1))) - (list (mm-make-handle buf '("text/plain" (charset . gnus-decoded)))))) + (list (mm-make-handle buf mm-uu-text-plain-type)))) (defun mm-uu-pgp-signed-extract () (let ((mm-security-handle (list (format "multipart/signed")))) @@ -395,9 +399,7 @@ Return that buffer." (with-current-buffer buf (mml2015-clean-buffer) (funcall (mml2015-clear-decrypt-function)))) - (list - (mm-make-handle buf - '("text/plain" (charset . gnus-decoded)))))) + (list (mm-make-handle buf mm-uu-text-plain-type)))) (defun mm-uu-pgp-encrypted-extract () (let ((mm-security-handle (list (format "multipart/encrypted")))) @@ -431,12 +433,14 @@ Return that buffer." '("application/pgp-keys")))) ;;;###autoload -(defun mm-uu-dissect (&optional noheader) +(defun mm-uu-dissect (&optional noheader mime-type) "Dissect the current buffer and return a list of uu handles. -The optional NOHEADER means there's no header in the buffer." +The optional NOHEADER means there's no header in the buffer. +MIME-TYPE specifies a MIME type and parameters, which defaults to the +value of `mm-uu-text-plain-type'." (let ((case-fold-search t) - text-start start-point end-point file-name result - text-plain-type entry func) + (mm-uu-text-plain-type (or mime-type mm-uu-text-plain-type)) + text-start start-point end-point file-name result entry func) (save-excursion (goto-char (point-min)) (cond @@ -446,10 +450,7 @@ The optional NOHEADER means there's no header in the buffer." ((search-forward "\n\n" nil t) t) (t (goto-char (point-max)))) - ;;; gnus-decoded is a fake charset, which means no further - ;;; decoding. - (setq text-start (point) - text-plain-type '("text/plain" (charset . gnus-decoded))) + (setq text-start (point)) (while (re-search-forward mm-uu-beginning-regexp nil t) (setq start-point (match-beginning 0)) (let ((alist mm-uu-type-alist) @@ -478,7 +479,7 @@ The optional NOHEADER means there's no header in the buffer." (re-search-forward "." start-point t))) (push (mm-make-handle (mm-uu-copy-to-buffer text-start start-point) - text-plain-type) + mm-uu-text-plain-type) result)) (push (funcall (mm-uu-function-extract entry)) @@ -491,7 +492,7 @@ The optional NOHEADER means there's no header in the buffer." (re-search-forward "." nil t))) (push (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max)) - text-plain-type) + mm-uu-text-plain-type) result)) (setq result (cons "multipart/mixed" (nreverse result)))) result))) @@ -499,13 +500,16 @@ The optional NOHEADER means there's no header in the buffer." (defun mm-uu-dissect-text-parts (handle) "Dissect text parts and put uu handles into HANDLE." (let ((buffer (mm-handle-buffer handle)) - children) + type children) (cond ((stringp buffer) (mapc 'mm-uu-dissect-text-parts (cdr handle))) ((bufferp buffer) - (when (and (equal "text/plain" (mm-handle-media-type handle)) + (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)))) + (setq children + (mm-uu-dissect t (mm-handle-type handle))))) (kill-buffer buffer) (setcar handle (car children)) (setcdr handle (cdr children))))