X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmm-decode.el;h=f773c2fea68b3eb6179db225a9821536872f9ab3;hb=380310006a5f5e5ac9510ec4927aed69bc7c506d;hp=ead419e25ec4e7d212ac6eb34e64e19cf4ccddd1;hpb=e2c9efb05a1ae9e65fd40bab80466da331f3981b;p=gnus diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index ead419e25..f773c2fea 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -1,7 +1,7 @@ ;;; mm-decode.el --- Functions for decoding MIME things ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -29,12 +29,14 @@ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (require 'mail-parse) -(require 'mailcap) (require 'mm-bodies) -(require 'gnus-util) (eval-when-compile (require 'cl) (require 'term)) +(autoload 'gnus-map-function "gnus-util") +(autoload 'gnus-replace-in-string "gnus-util") +(autoload 'gnus-read-shell-command "gnus-util") + (autoload 'mm-inline-partial "mm-partial") (autoload 'mm-inline-external-body "mm-extern") (autoload 'mm-extern-cache-contents "mm-extern") @@ -103,10 +105,7 @@ ,disposition ,description ,cache ,id)) (defcustom mm-text-html-renderer - (cond ((executable-find "w3m") - (if (locate-library "w3m") - 'w3m - 'w3m-standalone)) + (cond ((executable-find "w3m") 'gnus-article-html) ((executable-find "links") 'links) ((executable-find "lynx") 'lynx) ((locate-library "w3") 'w3) @@ -115,6 +114,7 @@ "Render of HTML contents. It is one of defined renderer types, or a rendering function. The defined renderer types are: +`gnus-article-html' : use Gnus renderer based on w3m; `w3m' : use emacs-w3m; `w3m-standalone': use w3m; `links': use links; @@ -122,9 +122,10 @@ The defined renderer types are: `w3' : use Emacs/W3; `html2text' : use html2text; nil : use external viewer (default web browser)." - :version "23.0" ;; No Gnus - :type '(choice (const w3) - (const w3m :tag "emacs-w3m") + :version "24.1" + :type '(choice (const gnus-article-html) + (const w3) + (const w3m :tag "emacs-w3m") (const w3m-standalone :tag "standalone w3m" ) (const links) (const lynx) @@ -550,6 +551,8 @@ Postpone undisplaying of viewers for types in (message "Destroying external MIME viewers") (mm-destroy-parts mm-postponed-undisplay-list))) +(autoload 'message-fetch-field "message") + (defun mm-dissect-buffer (&optional no-strict-mime loose-mime from) "Dissect the current buffer and return a list of MIME handles." (save-excursion @@ -563,7 +566,9 @@ Postpone undisplaying of viewers for types in ctl (and ct (mail-header-parse-content-type ct)) cte (mail-fetch-field "content-transfer-encoding") cd (mail-fetch-field "content-disposition") - description (mail-fetch-field "content-description") + ;; Newlines in description should be stripped so as + ;; not to break the MIME tag into two or more lines. + description (message-fetch-field "content-description") id (mail-fetch-field "content-id")) (unless from (setq from (mail-fetch-field "from"))) @@ -686,6 +691,9 @@ Postpone undisplaying of viewers for types in (goto-char (point-max))) (mapcar 'mm-display-parts handle)))) +(autoload 'mailcap-parse-mailcaps "mailcap") +(autoload 'mailcap-mime-info "mailcap") + (defun mm-display-part (handle &optional no-default) "Display the MIME part represented by HANDLE. Returns nil if the part is removed; inline if displayed inline; @@ -745,6 +753,7 @@ external if displayed external." handle 'mailcap-save-binary-file))))))))) (declare-function gnus-configure-windows "gnus-win" (setting &optional force)) +(defvar mailcap-mime-extensions) ; mailcap-mime-info autoloads (defun mm-display-external (handle method) "Display HANDLE using METHOD." @@ -1138,13 +1147,15 @@ in HANDLE." ;; time to adjust it, since we know at this point that it should ;; be unibyte. `(let* ((handle ,handle)) - (with-temp-buffer - (mm-disable-multibyte) - (insert-buffer-substring (mm-handle-buffer handle)) - (mm-decode-content-transfer-encoding - (mm-handle-encoding handle) - (mm-handle-media-type handle)) - ,@forms))) + (when (and (mm-handle-buffer handle) + (buffer-name (mm-handle-buffer handle))) + (with-temp-buffer + (mm-disable-multibyte) + (insert-buffer-substring (mm-handle-buffer handle)) + (mm-decode-content-transfer-encoding + (mm-handle-encoding handle) + (mm-handle-media-type handle)) + ,@forms)))) (put 'mm-with-part 'lisp-indent-function 1) (put 'mm-with-part 'edebug-form-spec '(body)) @@ -1237,9 +1248,13 @@ PROMPT overrides the default one used to ask user for a file name." (setq filename (gnus-map-function mm-file-name-rewrite-functions (file-name-nondirectory filename)))) (setq file - (read-file-name (or prompt "Save MIME part to: ") + (read-file-name (or prompt + (format "Save MIME part to (default %s): " + (or filename ""))) (or mm-default-directory default-directory) - nil nil (or filename ""))) + (or filename ""))) + (when (file-directory-p file) + (setq file (expand-file-name filename file))) (setq mm-default-directory (file-name-directory file)) (and (or (not (file-exists-p file)) (yes-or-no-p (format "File %s already exists; overwrite? " @@ -1248,11 +1263,11 @@ PROMPT overrides the default one used to ask user for a file name." (mm-save-part-to-file handle file) file)))) -(defun mm-add-meta-html-tag (handle &optional charset) +(defun mm-add-meta-html-tag (handle &optional charset force-charset) "Add meta html tag to specify CHARSET of HANDLE in the current buffer. CHARSET defaults to the one HANDLE specifies. Existing meta tag that -specifies charset will not be modified. Return t if meta tag is added -or replaced." +specifies charset will not be modified unless FORCE-CHARSET is non-nil. +Return t if meta tag is added or replaced." (when (equal (mm-handle-media-type handle) "text/html") (when (or charset (setq charset (mail-content-type-get (mm-handle-type handle) @@ -1263,8 +1278,9 @@ or replaced." (goto-char (point-min)) (if (re-search-forward "\ ]*>" nil t) - (if (and (match-beginning 2) +text/\\(\\sw+\\)\\(?:\;\\s-*charset=\\(.+\\)\\)?[\"'][^>]*>" nil t) + (if (and (not force-charset) + (match-beginning 2) (string-match "\\`html\\'" (match-string 1))) ;; Don't modify existing meta tag. nil @@ -1290,12 +1306,13 @@ text/\\(\\sw+\\)\\(?:\;\\s-*charset=\\(.+?\\)\\)?[\"'][^>]*>" nil t) (mm-write-region (point-min) (point-max) file nil nil nil 'binary t) (set-default-file-modes current-file-modes))))) -(defun mm-pipe-part (handle) - "Pipe HANDLE to a process." - (let* ((name (mail-content-type-get (mm-handle-type handle) 'name)) - (command - (gnus-read-shell-command - "Shell command on MIME part: " mm-last-shell-command))) +(defun mm-pipe-part (handle &optional cmd) + "Pipe HANDLE to a process. +Use CMD as the process." + (let ((name (mail-content-type-get (mm-handle-type handle) 'name)) + (command (or cmd + (gnus-read-shell-command + "Shell command on MIME part: " mm-last-shell-command)))) (mm-with-unibyte-buffer (mm-insert-part handle) (mm-add-meta-html-tag handle) @@ -1659,5 +1676,4 @@ If RECURSIVE, search recursively." (provide 'mm-decode) -;; arch-tag: 4f35d360-56b8-4030-9388-3ed82d359b9b ;;; mm-decode.el ends here