X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmm-decode.el;h=5f9cba6ff75fa9092cc1e2855aca68a8e0fb096e;hb=f7023e9df2a3d483f5cbd4e02afc7a6b6ed605cb;hp=54f61ec8475ae6c36d08a5a1e6d24449ce113f33;hpb=3738187cad20787b5b99c4061256e30e19ee721a;p=elisp%2Fgnus.git- diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 54f61ec..5f9cba6 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -1,5 +1,5 @@ ;;; mm-decode.el --- Functions for decoding MIME things -;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -22,23 +22,16 @@ ;;; Commentary: -;; Jaap-Henk Hoepman (jhh@xs4all.nl): -;; -;; Added support for delayed destroy of external MIME viewers. All external -;; viewers for mime types in mm-keep-viewer-alive-types will remain active -;; after switching articles or groups, and will only be removed when exiting -;; gnus. -;; - ;;; Code: (require 'mail-parse) -(require 'mailcap) +(require 'gnus-mailcap) (require 'mm-bodies) (eval-when-compile (require 'cl) (require 'term)) (eval-and-compile + (autoload 'executable-find "executable") (autoload 'mm-inline-partial "mm-partial") (autoload 'mm-inline-external-body "mm-extern") (autoload 'mm-insert-inline "mm-view")) @@ -103,6 +96,59 @@ `(list ,buffer ,type ,encoding ,undisplayer ,disposition ,description ,cache ,id)) +(defcustom mm-text-html-renderer + (cond ((locate-library "w3") 'w3) + ((locate-library "w3m") 'w3m) + ((executable-find "links") 'links) + ((executable-find "lynx") 'lynx) + (t 'html2text)) + "Render of HTML contents. +It is one of defined renderer types, or a rendering function. +The defined renderer types are: +`w3' : using Emacs/W3; +`w3m' : using emacs-w3m; +`links': using links; +`lynx' : using lynx; +`html2text' : using html2text; +`nil' : using external viewer." + :type '(choice (const w3) + (const w3m) + (const links) + (const lynx) + (const html2text) + (const nil) + (function)) + :version "21.3" + :group 'mime-display) + +(defvar mm-inline-text-html-renderer nil + "Function used for rendering inline HTML contents. +It is suggested to customize `mm-text-html-renderer' instead.") + +(defcustom mm-inline-text-html-with-images nil + "If non-nil, Gnus will allow retrieving images in the HTML contents +with tags. It has no effect on Emacs/w3. See also +the documentation for the option `mm-w3m-safe-url-regexp'." + :type 'boolean + :group 'mime-display) + +(defcustom mm-w3m-safe-url-regexp "\\`cid:" + "Regexp that matches safe url names. Some HTML mails might have a +trick of spammers using tags. It is likely to be intended to +verify whether you have read the mail. You can prevent your personal +informations from leaking by setting this to the regexp which matches +the safe url names. The value of the variable `w3m-safe-url-regexp' +will be bound with this value. You may set this value to nil if you +consider all the urls to be safe." + :type '(choice (regexp :tag "Regexp") + (const :tag "All URLs are safe" nil) + :group 'mime-display)) + +(defcustom mm-inline-text-html-with-w3m-keymap t + "If non-nil, use emacs-w3m command keys in the article buffer." + :type 'boolean + :group 'mime-display) + (defcustom mm-inline-media-tests '(("image/jpeg" mm-inline-image @@ -153,11 +199,12 @@ ("application/emacs-lisp" mm-display-elisp-inline identity) ("application/x-emacs-lisp" mm-display-elisp-inline identity) ("text/html" - mm-inline-text + mm-inline-text-html (lambda (handle) - (locate-library "w3"))) + (or mm-inline-text-html-renderer + mm-text-html-renderer))) ("text/x-vcard" - mm-inline-text + mm-inline-text-vcard (lambda (handle) (or (featurep 'vcard) (locate-library "vcard")))) @@ -197,6 +244,7 @@ (defcustom mm-inlined-types '("image/.*" "text/.*" "message/delivery-status" "message/rfc822" "message/partial" "message/external-body" "application/emacs-lisp" + "application/x-emacs-lisp" "application/pgp-signature" "application/x-pkcs7-signature" "application/pkcs7-signature" "application/x-pkcs7-mime" "application/pkcs7-mime") @@ -218,7 +266,8 @@ when selecting a different article." '("text/plain" "text/enriched" "text/richtext" "text/html" "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*" "message/rfc822" "text/x-patch" "application/pgp-signature" - "application/emacs-lisp" "application/x-pkcs7-signature" + "application/emacs-lisp" "application/x-emacs-lisp" + "application/x-pkcs7-signature" "application/pkcs7-signature" "application/x-pkcs7-mime" "application/pkcs7-mime") "A list of MIME types to be displayed automatically." @@ -421,13 +470,14 @@ for types in mm-keep-viewer-alive-types." (message "Destroying external MIME viewers") (mm-destroy-parts mm-postponed-undisplay-list))) -(defun mm-dissect-buffer (&optional no-strict-mime) +(defun mm-dissect-buffer (&optional no-strict-mime loose-mime) "Dissect the current buffer and return a list of MIME handles." (save-excursion (let (ct ctl type subtype cte cd description id result from) (save-restriction (mail-narrow-to-head) (when (or no-strict-mime + loose-mime (mail-fetch-field "mime-version")) (setq ct (mail-fetch-field "content-type") ctl (ignore-errors (mail-header-parse-content-type ct)) @@ -531,7 +581,9 @@ for types in mm-keep-viewer-alive-types." (save-restriction (narrow-to-region start (point)) (setq parts (nconc (list (mm-dissect-buffer t)) parts))))) - (forward-line 2) + (end-of-line 2) + (or (looking-at boundary) + (forward-line 1)) (setq start (point))) (when (and start (< start end)) (save-excursion @@ -543,14 +595,18 @@ for types in mm-keep-viewer-alive-types." (defun mm-copy-to-buffer () "Copy the contents of the current buffer to a fresh buffer." (save-excursion - (let ((obuf (current-buffer)) - beg) + (let ((flag enable-multibyte-characters) + (new-buffer (generate-new-buffer " *mm*"))) (goto-char (point-min)) (search-forward-regexp "^\n" nil t) - (setq beg (point)) - (set-buffer (generate-new-buffer " *mm*")) - (insert-buffer-substring obuf beg) - (current-buffer)))) + (save-restriction + (narrow-to-region (point) (point-max)) + (when flag + (set-buffer-multibyte nil)) + (copy-to-buffer new-buffer (point-min) (point-max)) + (when flag + (set-buffer-multibyte t))) + new-buffer))) (defun mm-display-parts (handle &optional no-default) (if (stringp (car handle)) @@ -622,13 +678,13 @@ external if displayed external." (mm-handle-set-undisplayer handle mm))))) ;; The function is a string to be executed. (mm-insert-part handle) - (let* ((dir (make-temp-name - (expand-file-name "emm." mm-tmp-directory))) - (filename (or + (let* ((dir (mm-make-temp-file + (expand-file-name "emm." mm-tmp-directory) 'dir)) + (filename (or (mail-content-type-get (mm-handle-disposition handle) 'filename) - (mail-content-type-get - (mm-handle-type handle) 'name))) + (mail-content-type-get + (mm-handle-type handle) 'name))) (mime-info (mailcap-mime-info (mm-handle-media-type handle) t)) (needsterm (or (assoc "needsterm" mime-info) @@ -636,12 +692,13 @@ external if displayed external." (copiousoutput (assoc "copiousoutput" mime-info)) file buffer) ;; We create a private sub-directory where we store our files. - (make-directory dir) (set-file-modes dir 448) (if filename - (setq file (expand-file-name (file-name-nondirectory filename) - dir)) - (setq file (make-temp-name (expand-file-name "mm." dir)))) + (setq file (expand-file-name + (gnus-map-function mm-file-name-rewrite-functions + (file-name-nondirectory filename)) + dir)) + (setq file (mm-make-temp-file (expand-file-name "mm." dir)))) (let ((coding-system-for-write mm-binary-coding-system)) (write-region (point-min) (point-max) file nil 'nomesg)) (message "Viewing with %s" method) @@ -971,9 +1028,8 @@ like underscores." (file-name-nondirectory filename)))) (setq file (read-file-name "Save MIME part to: " - (expand-file-name - (or filename name "") - (or mm-default-directory default-directory)))) + (or mm-default-directory default-directory) + nil nil (or filename name ""))) (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? " @@ -1107,7 +1163,7 @@ be determined." ;; Avoid testing `make-glyph' since W3 may define ;; a bogus version of it. (if (fboundp 'create-image) - (create-image (buffer-string) + (create-image (buffer-string) (or (mm-image-type-from-buffer) (intern type)) 'data-p) @@ -1122,7 +1178,7 @@ be determined." ;; (without a ton of work) is to write them ;; out to a file, and then create a file ;; specifier. - (let ((file (make-temp-name + (let ((file (mm-make-temp-file (expand-file-name "emm.xbm" mm-tmp-directory)))) (unwind-protect @@ -1133,11 +1189,11 @@ be determined." (delete-file file))))) (t (make-glyph - (vector + (vector (or (mm-image-type-from-buffer) (intern type)) :data (buffer-string)))))) - + (defun mm-image-fit-p (handle) "Say whether the image in HANDLE will fit the current window." (let ((image (mm-get-image handle)))