;;; 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>
`links': using links;
`lynx' : using lynx;
`html2text' : using html2text;
-`nil' : using external viewer."
- :type '(choice (symbol w3)
- (symbol w3m)
- (symbol links)
- (symbol lynx)
- (symbol html2text)
- (symbol nil)
+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)))
`upcase-initials'.")
(defvar mm-path-name-rewrite-functions nil
- "*List of functions used for rewriting path names of MIME parts.
-This is used when viewing parts externally , and is meant for
-transforming the path name so that non-compliant programs can
-find the file where it's saved.
+ "*List of functions for rewriting the full file names of MIME parts.
+This is used when viewing parts externally, and is meant for
+transforming the absolute name so that non-compliant programs can find
+the file where it's saved.
Each function takes a file name as input and returns a file name.")
;;; Internal variables.
-(defvar mm-dissection-list nil)
(defvar mm-last-shell-command "")
(defvar mm-content-id-alist nil)
(defvar mm-postponed-undisplay-list nil)
(if (equal "text/plain" (car ctl))
(assoc 'format ctl)
t))
- (let ((res (mm-make-handle
- (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
- (push (car res) mm-dissection-list)
- res)))
-
-(defun mm-remove-all-parts ()
- "Remove all MIME handles."
- (interactive)
- (mapcar 'mm-remove-part mm-dissection-list)
- (setq mm-dissection-list nil))
+ (mm-make-handle
+ (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
(defun mm-dissect-multipart (ctl)
(goto-char (point-min))
(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)))
+ (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)
(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
+ (setq file (expand-file-name
(gnus-map-function mm-file-name-rewrite-functions
- (file-name-nondirectory filename))
+ (file-name-nondirectory filename))
dir))
- (setq file (make-temp-name (expand-file-name "mm." 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? "
;; (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
(if notp
(not (equal (car ctl) type))
(equal (car ctl) type)))
- (setq result (buffer-substring (point-min) (point-max)))))))
+ (setq result (buffer-string))))))
(forward-line 1)
(setq start (point)))
(when (and (not result) start)
(if notp
(not (equal (car ctl) type))
(equal (car ctl) type)))
- (setq result (buffer-substring (point-min) (point-max)))))))
+ (setq result (buffer-string))))))
result))
(defvar mm-security-handle nil)
(defsubst mm-set-handle-multipart-parameter (handle parameter value)
;; HANDLE could be a CTL.
- (if handle
- (put-text-property 0 (length (car handle)) parameter value
- (car handle))))
+ (when handle
+ (put-text-property 0 (length (car handle)) parameter value
+ (car handle))))
(defun mm-possibly-verify-or-decrypt (parts ctl)
(let ((type (car ctl))
protocols nil)
(setq protocols (cdr protocols))))))
(setq func (nth 1 (assoc protocol mm-verify-function-alist)))
- (if (cond
- ((eq mm-verify-option 'never) nil)
- ((eq mm-verify-option 'always) t)
- ((eq mm-verify-option 'known)
- (and func
- (or (not (setq functest
- (nth 3 (assoc protocol
- mm-verify-function-alist))))
- (funcall functest parts ctl))))
- (t (y-or-n-p
+ (when (cond
+ ((eq mm-verify-option 'never) nil)
+ ((eq mm-verify-option 'always) t)
+ ((eq mm-verify-option 'known)
+ (and func
+ (or (not (setq functest
+ (nth 3 (assoc protocol
+ mm-verify-function-alist))))
+ (funcall functest parts ctl))))
+ (t
+ (y-or-n-p
(format "Verify signed (%s) part? "
(or (nth 2 (assoc protocol mm-verify-function-alist))
(format "protocol=%s" protocol))))))
- (save-excursion
- (if func
- (funcall func parts ctl)
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details
- (format "Unknown sign protocol (%s)" protocol))))))
+ (save-excursion
+ (if func
+ (funcall func parts ctl)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (format "Unknown sign protocol (%s)" protocol))))))
((equal subtype "encrypted")
(unless (setq protocol
(mm-handle-multipart-ctl-parameter ctl 'protocol))
parts nil)
(setq parts (cdr parts))))))
(setq func (nth 1 (assoc protocol mm-decrypt-function-alist)))
- (if (cond
- ((eq mm-decrypt-option 'never) nil)
- ((eq mm-decrypt-option 'always) t)
- ((eq mm-decrypt-option 'known)
- (and func
- (or (not (setq functest
- (nth 3 (assoc protocol
- mm-decrypt-function-alist))))
- (funcall functest parts ctl))))
- (t (y-or-n-p
+ (when (cond
+ ((eq mm-decrypt-option 'never) nil)
+ ((eq mm-decrypt-option 'always) t)
+ ((eq mm-decrypt-option 'known)
+ (and func
+ (or (not (setq functest
+ (nth 3 (assoc protocol
+ mm-decrypt-function-alist))))
+ (funcall functest parts ctl))))
+ (t
+ (y-or-n-p
(format "Decrypt (%s) part? "
(or (nth 2 (assoc protocol mm-decrypt-function-alist))
(format "protocol=%s" protocol))))))
- (save-excursion
- (if func
- (setq parts (funcall func parts ctl))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details
- (format "Unknown encrypt protocol (%s)" protocol))))))
+ (save-excursion
+ (if func
+ (setq parts (funcall func parts ctl))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (format "Unknown encrypt protocol (%s)" protocol))))))
(t nil))
parts))
projects / gnus / blobdiff