;;; mm-decode.el --- Functions for decoding MIME things
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
(cond ((locate-library "w3") 'w3)
((locate-library "w3m") 'w3m)
((executable-find "links") 'links)
- ((executable-find "lynx") 'lynx))
+ ((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."
- :type '(choice (symbol w3)
- (symbol w3m)
- (symbol links)
- (symbol lynx)
+`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)
(defcustom mm-inline-text-html-with-images nil
"If non-nil, Gnus will allow retrieving images in the HTML contents
-with <img> tags. It has no effect on Emacs/w3. For emacs-w3m, the
-value of the option `w3m-display-inline-images' will be bound with
-this value. In addition, the variable `w3m-safe-url-regexp' will be
-bound with the value nil if it is non-nil to make emacs-w3m show all
-images, however this behavior may be changed in the future."
+with <img> 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 <img> 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
mm-inline-image
(lambda (handle)
(mm-valid-and-fit-image-p 'xpm handle)))
- ("image/x-pixmap"
+ ("image/x-xpixmap"
mm-inline-image
(lambda (handle)
(mm-valid-and-fit-image-p 'xpm handle)))
(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")
'("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."
(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))
(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
(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)
(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)
(cond
(needsterm
- (unwind-protect
- (if window-system
- (start-process "*display*" nil
- mm-external-terminal-program
- "-e" shell-file-name
- shell-command-switch
- (mm-mailcap-command
- method file (mm-handle-type handle)))
- (require 'term)
- (require 'gnus-win)
- (set-buffer
- (setq buffer
- (make-term "display"
- shell-file-name
- nil
- shell-command-switch
- (mm-mailcap-command
- method file
- (mm-handle-type handle)))))
- (term-mode)
- (term-char-mode)
- (set-process-sentinel
- (get-buffer-process buffer)
- `(lambda (process state)
- (if (eq 'exit (process-status process))
- (gnus-configure-windows
- ',gnus-current-window-configuration))))
- (gnus-configure-windows 'display-term))
- (mm-handle-set-external-undisplayer handle (cons file buffer)))
- (message "Displaying %s..." (format method file))
+ (let ((command (mm-mailcap-command
+ method file (mm-handle-type handle))))
+ (unwind-protect
+ (if window-system
+ (start-process "*display*" nil
+ mm-external-terminal-program
+ "-e" shell-file-name
+ shell-command-switch command)
+ (require 'term)
+ (require 'gnus-win)
+ (set-buffer
+ (setq buffer
+ (make-term "display"
+ shell-file-name
+ nil
+ shell-command-switch command)))
+ (term-mode)
+ (term-char-mode)
+ (set-process-sentinel
+ (get-buffer-process buffer)
+ `(lambda (process state)
+ (if (eq 'exit (process-status process))
+ (gnus-configure-windows
+ ',gnus-current-window-configuration))))
+ (gnus-configure-windows 'display-term))
+ (mm-handle-set-external-undisplayer handle (cons file buffer)))
+ (message "Displaying %s..." command))
'external)
(copiousoutput
(with-current-buffer outbuf
(ignore-errors (kill-buffer buffer))))))
'inline)
(t
- (unwind-protect
- (start-process "*display*"
- (setq buffer
- (generate-new-buffer " *mm*"))
- shell-file-name
- shell-command-switch
- (mm-mailcap-command
- method file (mm-handle-type handle)))
- (mm-handle-set-external-undisplayer
- handle (cons file buffer)))
- (message "Displaying %s..." (format method file))
+ (let ((command (mm-mailcap-command
+ method file (mm-handle-type handle))))
+ (unwind-protect
+ (start-process "*display*"
+ (setq buffer
+ (generate-new-buffer " *mm*"))
+ shell-file-name
+ shell-command-switch command)
+ (mm-handle-set-external-undisplayer
+ handle (cons file buffer)))
+ (message "Displaying %s..." command))
'external)))))))
(defun mm-mailcap-command (method file type-list)
(beg 0)
(uses-stdin t)
out sub total)
- (while (string-match "%{\\([^}]+\\)}\\|%s\\|%t\\|%%" method beg)
+ (while (string-match "%{\\([^}]+\\)}\\|'%s'\\|\"%s\"\\|%s\\|%t\\|%%"
+ method beg)
(push (substring method beg (match-beginning 0)) out)
(setq beg (match-end 0)
total (match-string 0 method)
(cond
((string= total "%%")
(push "%" out))
- ((string= total "%s")
+ ((or (string= total "%s")
+ ;; We do our own quoting.
+ (string= total "'%s'")
+ (string= total "\"%s\""))
(setq uses-stdin nil)
(push (mm-quote-arg
(gnus-map-function mm-path-name-rewrite-functions file)) out))
"Return the contents of HANDLE as a string."
(mm-with-unibyte-buffer
(insert (with-current-buffer (mm-handle-buffer handle)
- (mm-with-unibyte-current-buffer-mule4
+ (mm-with-unibyte-current-buffer
(buffer-string))))
(mm-decode-content-transfer-encoding
(mm-handle-encoding handle)
(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? "
;; 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)
;; (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
(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)))
projects / gnus / blobdiff