X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmm-decode.el;h=971c26e200a0e35030c3ef40207d3e4044c44b98;hb=d35146fa43e9e2d8d346073c3c0692162abf4759;hp=de2d1ed7f3ca26f710a055cb35f4162c0c15990e;hpb=935af32fa5a3d22163b9b626d770f5c16a766837;p=gnus diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index de2d1ed7f..971c26e20 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -1,6 +1,6 @@ ;;; mm-decode.el --- Functions for decoding MIME things -;; Copyright (C) 1998-2012 Free Software Foundation, Inc. +;; Copyright (C) 1998-2013 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -29,8 +29,7 @@ (require 'mail-parse) (require 'mm-bodies) -(eval-when-compile (require 'cl) - (require 'term)) +(eval-when-compile (require 'cl)) (autoload 'gnus-map-function "gnus-util") (autoload 'gnus-replace-in-string "gnus-util") @@ -769,23 +768,29 @@ external if displayed external." (mail-content-type-get (mm-handle-type handle) 'name) "")) - (external mm-enable-external)) - (if (and (mm-inlinable-p ehandle) - (mm-inlined-p ehandle)) - (progn - (forward-line 1) - (mm-display-inline handle) - 'inline) - (when (or method - (not no-default)) - (if (and (not method) - (equal "text" (car (split-string type "/")))) - (progn - (forward-line 1) - (mm-insert-inline handle (mm-get-part handle)) - 'inline) - (setq external - (and method ;; If nil, we always use "save". + (external mm-enable-external) + (decoder (assoc (car (mm-handle-type handle)) + (mm-archive-decoders)))) + (cond + ((and decoder + (executable-find (caddr decoder))) + (mm-archive-dissect-and-inline handle) + 'inline) + ((and (mm-inlinable-p ehandle) + (mm-inlined-p ehandle)) + (forward-line 1) + (mm-display-inline handle) + 'inline) + ((or method + (not no-default)) + (if (and (not method) + (equal "text" (car (split-string type "/")))) + (progn + (forward-line 1) + (mm-insert-inline handle (mm-get-part handle)) + 'inline) + (setq external + (and method ;; If nil, we always use "save". (stringp method) ;; 'mailcap-save-binary-file (or (eq mm-enable-external t) (and (eq mm-enable-external 'ask) @@ -798,15 +803,17 @@ external if displayed external." (concat " \"" (format method filename) "\"") "") - "? ")))))) - (if external - (mm-display-external - handle (or method 'mailcap-save-binary-file)) + "? ")))))) + (if external (mm-display-external - handle 'mailcap-save-binary-file))))))))) + handle (or method 'mailcap-save-binary-file)) + (mm-display-external + handle 'mailcap-save-binary-file))))))))) (declare-function gnus-configure-windows "gnus-win" (setting &optional force)) (defvar mailcap-mime-extensions) ; mailcap-mime-info autoloads +(declare-function term-mode "term" ()) +(declare-function term-char-mode "term" ()) (defun mm-display-external (handle method) "Display HANDLE using METHOD." @@ -1292,14 +1299,26 @@ PROMPT overrides the default one used to ask user for a file name." (when filename (setq filename (gnus-map-function mm-file-name-rewrite-functions (file-name-nondirectory filename)))) - (setq file - (read-file-name - (or prompt - (format "Save MIME part to (default %s): " - (or filename ""))) - (or mm-default-directory default-directory) - (expand-file-name (or filename "") - (or mm-default-directory default-directory)))) + (while + (progn + (setq file + (read-file-name + (or prompt + (format "Save MIME part to (default %s): " + (or filename ""))) + (or mm-default-directory default-directory) + (expand-file-name (or filename "") + (or mm-default-directory default-directory)))) + (cond ((or (not file) (equal file "")) + (message "Please enter a file name") + t) + ((and (file-directory-p file) + (not filename)) + (message "Please enter a non-directory file name") + t) + (t nil))) + (sit-for 2) + (discard-input)) (if (file-directory-p file) (setq file (expand-file-name filename file)) (setq file (expand-file-name @@ -1766,7 +1785,8 @@ If RECURSIVE, search recursively." (insert (prog1 (if (and charset (setq charset - (mm-charset-to-coding-system charset)) + (mm-charset-to-coding-system charset + nil t)) (not (eq charset 'ascii))) (mm-decode-coding-string (buffer-string) charset) (mm-string-as-multibyte (buffer-string))) @@ -1784,11 +1804,12 @@ If RECURSIVE, search recursively." (replace-match (char-to-string char)))) ;; Remove "soft hyphens". (goto-char (point-min)) - (while (search-forward "­" nil t) + (while (search-forward "­" nil t) (replace-match "" t t)) (libxml-parse-html-region (point-min) (point-max)))) (unless (bobp) (insert "\n")) + (mm-convert-shr-links) (mm-handle-set-undisplayer handle `(lambda () @@ -1796,6 +1817,23 @@ If RECURSIVE, search recursively." (delete-region ,(point-min-marker) ,(point-max-marker)))))))) +(defvar shr-map) + +(defun mm-convert-shr-links () + (let ((start (point-min)) + end) + (while (and start + (< start (point-max))) + (when (setq start (text-property-not-all start (point-max) 'shr-url nil)) + (setq end (next-single-property-change start 'shr-url nil (point-max))) + (widget-convert-button + 'url-link start end + :help-echo (get-text-property start 'help-echo) + :keymap shr-map + (get-text-property start 'shr-url)) + (put-text-property start end 'local-map nil) + (setq start end))))) + (defun mm-handle-filename (handle) "Return filename of HANDLE if any." (or (mail-content-type-get (mm-handle-type handle) @@ -1805,4 +1843,8 @@ If RECURSIVE, search recursively." (provide 'mm-decode) +;; Local Variables: +;; coding: utf-8 +;; End: + ;;; mm-decode.el ends here