(or how
(setq how gnus-article-browse-delete-temp)))
(when (and (eq how 'ask)
- (y-or-n-p (format
- "Delete all %s temporary HTML file(s)? "
- (length gnus-article-browse-html-temp-list)))
+ (gnus-y-or-n-p (format
+ "Delete all %s temporary HTML file(s)? "
+ (length gnus-article-browse-html-temp-list)))
(setq how t)))
(dolist (file gnus-article-browse-html-temp-list)
(when (and (file-exists-p file)
"View all \"text/html\" parts from LIST.
Recurse into multiparts."
;; Internal function used by `gnus-article-browse-html-article'.
- (let ((showed))
+ (let (type file charset tmp-file showed)
;; Find and show the html-parts.
(dolist (handle list)
;; If HTML, show it:
- (when (listp handle)
- (cond ((and (bufferp (car handle))
- (string-match "text/html" (car (mm-handle-type handle))))
- (let ((tmp-file (mm-make-temp-file
- ;; Do we need to care for 8.3 filenames?
- "mm-" nil ".html"))
- (charset (mail-content-type-get (mm-handle-type handle)
- 'charset)))
- (if charset
- ;; Add a meta html tag to specify charset.
- (mm-with-unibyte-buffer
- (insert
- (if (eq charset 'gnus-decoded)
- (mm-encode-coding-string (mm-get-part handle)
- (setq charset 'utf-8))
- (mm-get-part handle)))
- (goto-char (point-min))
- (let ((case-fold-search t))
- (if (re-search-forward "\
-<meta[\t\n\r ]+http-equiv=\"content-type\"[^>]+>" nil t)
- nil ;; Don't modify existing meta tag.
- (setq charset (format "\
-<meta http-equiv=\"Content-Type\" content=\"text/html; charset=%s\">" charset))
- (if (re-search-forward "<head>[\t\n\r ]*" nil t)
- (insert charset "\n")
- (re-search-forward "\
-<html\\(?:[\t\n\r ]+[^>]+\\|[\t\n\r ]*\\)>[\t\n\r ]*" nil t)
- (insert "<head>\n" charset "\n</head>\n"))))
+ (cond ((not (listp handle)))
+ ((or (equal (car (setq type (mm-handle-type handle))) "text/html")
+ (and (equal (car type) "message/external-body")
+ (setq file (or (mail-content-type-get type 'name)
+ (mail-content-type-get
+ (mm-handle-disposition handle)
+ 'filename)))
+ (or (mm-handle-cache handle)
+ (condition-case code
+ (progn (mm-extern-cache-contents handle) t)
+ (error
+ (gnus-message 3 "%s" (error-message-string code))
+ (when (>= gnus-verbose 3) (sit-for 2))
+ nil)))
+ (progn
+ (setq handle (mm-handle-cache handle)
+ type (mm-handle-type handle))
+ (equal (car type) "text/html"))))
+ (when (or (setq charset (mail-content-type-get type 'charset))
+ (not file))
+ (setq tmp-file (mm-make-temp-file
+ ;; Do we need to care for 8.3 filenames?
+ "mm-" nil ".html")))
+ (if charset
+ ;; Add a meta html tag to specify charset.
+ (mm-with-unibyte-buffer
+ (insert (if (eq charset 'gnus-decoded)
+ (mm-encode-coding-string (mm-get-part handle)
+ (setq charset 'utf-8))
+ (mm-get-part handle)))
+ (if (or (mm-add-meta-html-tag handle charset)
+ (not file))
(mm-write-region (point-min) (point-max)
- tmp-file nil nil nil 'binary t))
- (mm-save-part-to-file handle tmp-file))
- (add-to-list 'gnus-article-browse-html-temp-list tmp-file)
- (add-hook 'gnus-summary-prepare-exit-hook
- 'gnus-article-browse-delete-temp-files)
- (add-hook 'gnus-exit-gnus-hook
- (lambda ()
- (gnus-article-browse-delete-temp-files t)))
- ;; FIXME: Warn if there's an <img> tag?
- (browse-url-of-file tmp-file)
- (setq showed t)))
- ;; If multipart, recurse
- ((and (stringp (car handle))
- (string-match "^multipart/" (car handle))
- (setq showed
- (or showed
- (gnus-article-browse-html-parts handle))))))))
+ tmp-file nil nil nil 'binary t)
+ (setq tmp-file nil)))
+ (when tmp-file
+ (mm-save-part-to-file handle tmp-file)))
+ (when tmp-file
+ (add-to-list 'gnus-article-browse-html-temp-list tmp-file))
+ (add-hook 'gnus-summary-prepare-exit-hook
+ 'gnus-article-browse-delete-temp-files)
+ (add-hook 'gnus-exit-gnus-hook
+ (lambda ()
+ (gnus-article-browse-delete-temp-files t)))
+ ;; FIXME: Warn if there's an <img> tag?
+ (browse-url-of-file (or tmp-file (expand-file-name file)))
+ (setq showed t))
+ ;; If multipart, recurse
+ ((and (stringp (car handle))
+ (string-match "^multipart/" (car handle))
+ (setq showed
+ (or showed
+ (gnus-article-browse-html-parts handle)))))))
showed))
;; FIXME: Documentation in texi/gnus.texi missing.
(mm-save-part-to-file handle file)
file))))
+(defun mm-add-meta-html-tag (handle &optional 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."
+ (when (equal (mm-handle-media-type handle) "text/html")
+ (when (or charset
+ (setq charset (mail-content-type-get (mm-handle-type handle)
+ 'charset)))
+ (setq charset (format "\
+<meta http-equiv=\"Content-Type\" content=\"text/html; charset=%s\">" charset))
+ (let ((case-fold-search t))
+ (goto-char (point-min))
+ (if (re-search-forward "\
+<meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']\
+text/\\(\\sw+\\)\\(?:\;\\s-*charset=\\(.+?\\)\\)?[\"'][^>]*>" nil t)
+ (if (and (match-beginning 2)
+ (string-match "\\`html\\'" (match-string 1)))
+ ;; Don't modify existing meta tag.
+ nil
+ ;; Replace it with the one specifying charset.
+ (replace-match charset)
+ t)
+ (if (re-search-forward "<head>\\s-*" nil t)
+ (insert charset "\n")
+ (re-search-forward "<html\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t)
+ (insert "<head>\n" charset "\n</head>\n"))
+ t)))))
+
(defun mm-save-part-to-file (handle file)
(mm-with-unibyte-buffer
(mm-insert-part handle)
+ (mm-add-meta-html-tag handle)
(let ((current-file-modes (default-file-modes)))
(set-default-file-modes mm-attachment-file-modes)
(unwind-protect
(read-string "Shell command on MIME part: " mm-last-shell-command)))
(mm-with-unibyte-buffer
(mm-insert-part handle)
+ (mm-add-meta-html-tag handle)
(let ((coding-system-for-write 'binary))
(shell-command-on-region (point-min) (point-max) command nil)))))