This is a long and ugly solution which does work. Instead of messing around with mu4e-action-view-in-browser the unsafelinks function can be inserted into gnus-article-browse-html-parts and redefine itredefined like so
This is a long and ugly solution which does work. Instead of messing around with mu4e-action-view-in-browser the unsafelinks function can be inserted into gnus-article-browse-html-parts and redefine it like so
This is a long and ugly solution which does work. Instead of messing around with mu4e-action-view-in-browser the unsafelinks function can be inserted into gnus-article-browse-html-parts and redefined like so
This is a long and ugly solution which does work. Instead of messing around with mu4e-action-view-in-browser the unsafelinks function can be inserted into gnus-article-browse-html-parts and redefine it like so
(defun gnus-article-browse-html-parts (list &optional header)
"View all \"text/html\" parts from LIST.
Recurse into multiparts. The optional HEADER that should be a decoded
message header will be added to the bodies of the \"text/html\" parts."
;; Internal function used by `gnus-article-browse-html-article'.
(let (type file charset content cid-dir tmp-file showed)
;; Find and show the html-parts.
(dolist (handle list)
;; If HTML, show it:
(cond ((not (listp handle)))
((or (equal (car (setq type (mm-handle-type handle))) "text/html")
(and (equal (car type) "message/external-body")
(or header
(setq file (mm-handle-filename handle)))
(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"))))
(setq charset (mail-content-type-get type 'charset)
content (mm-get-part handle))
(with-temp-buffer
(if (eq charset 'gnus-decoded)
(mm-enable-multibyte)
(mm-disable-multibyte))
(insert content)
(unsafelinks) ; <<<<insert this
;; resolve cid contents
(let ((case-fold-search t)
st base regexp cid-file)
(goto-char (point-min))
(when (and (re-search-forward "<head[\t\n >]" nil t)
(progn
(setq st (match-end 0))
(re-search-forward "</head[\t\n >]" nil t))
(re-search-backward "<base\
\\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n ]+href=\"\\([^\"]+\\)\"[^>]*>" st t))
(setq base (match-string 1))
(replace-match "<!--\\&-->")
(setq st (point))
(dolist (tag '(("a" . "href") ("form" . "action")
("img" . "src")))
(setq regexp (concat "<" (car tag)
"\\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n ]+"
(cdr tag) "=\"\\([^\"]+\\)"))
(while (re-search-forward regexp nil t)
(insert (prog1
(condition-case nil
(save-match-data
(url-expand-file-name (match-string 1)
base))
(error (match-string 1)))
(delete-region (match-beginning 1)
(match-end 1)))))
(goto-char st)))
(while (re-search-forward "\
<img[\t\n ]+\\(?:[^\t\n >]+[\t\n ]+\\)*src=\"\\(cid:\\([^\"]+\\)\\)\""
nil t)
(unless cid-dir
(setq cid-dir (make-temp-file "cid" t))
(add-to-list 'gnus-article-browse-html-temp-list cid-dir))
(setq file nil
content nil)
(when (setq cid-file
(gnus-article-browse-html-save-cid-content
(match-string 2)
(with-current-buffer gnus-article-buffer
gnus-article-mime-handles)
cid-dir))
(replace-match cid-file nil nil nil 1))))
(unless content (setq content (buffer-string))))
(when (or charset header (not file))
(setq tmp-file (make-temp-file
;; Do we need to care for 8.3 filenames?
"mm-" nil ".html")))
;; Add a meta html tag to specify charset and a header.
(cond
(header
(let (title eheader body hcharset coding)
(with-temp-buffer
(mm-enable-multibyte)
(setq case-fold-search t)
(insert header "\n")
(setq title (message-fetch-field "subject"))
(unsafelinks) ; <<<<insert this
(goto-char (point-min))
(while (re-search-forward "\\(<\\)\\|\\(>\\)\\|\\(&\\)\\|\n"
nil t)
(replace-match (cond ((match-beginning 1) "<")
((match-beginning 2) ">")
((match-beginning 3) "&")
(t "<br>\n"))))
(goto-char (point-min))
(while (re-search-forward "^[\t ]+" nil t)
(dotimes (i (prog1
(current-column)
(delete-region (match-beginning 0)
(match-end 0))))
(insert " ")))
(goto-char (point-min))
(insert "<div align=\"left\">\n")
(goto-char (point-max))
(insert "</div>\n<hr>\n")
;; We have to examine charset one by one since
;; charset specified in parts might be different.
(if (eq charset 'gnus-decoded)
(setq charset 'utf-8
eheader (encode-coding-string (buffer-string)
charset)
title (when title
(encode-coding-string title charset))
body (encode-coding-string content charset))
(setq hcharset (mm-find-mime-charset-region (point-min)
(point-max)))
(cond ((= (length hcharset) 1)
(setq hcharset (car hcharset)
coding (mm-charset-to-coding-system
hcharset nil t)))
((> (length hcharset) 1)
(setq hcharset 'utf-8
coding hcharset)))
(if coding
(if charset
(progn
(setq body
(mm-charset-to-coding-system charset
nil t))
(if (eq coding body)
(setq eheader (encode-coding-string
(buffer-string) coding)
title (when title
(encode-coding-string
title coding))
body content)
(setq charset 'utf-8
eheader (encode-coding-string
(buffer-string) charset)
title (when title
(encode-coding-string
title charset))
body (encode-coding-string
(decode-coding-string
content body)
charset))))
(setq charset hcharset
eheader (encode-coding-string
(buffer-string) coding)
title (when title
(encode-coding-string
title coding))
body content))
(setq eheader (encode-coding-string
(buffer-string) 'utf-8)
body content)))
(erase-buffer)
(mm-disable-multibyte)
(insert body)
(unsafelinks) ; <<<<insert this
(when charset
(mm-add-meta-html-tag handle charset t))
(when title
(goto-char (point-min))
(unless (search-forward "<title>" nil t)
(re-search-forward "<head>\\s-*" nil t)
(insert "<title>" title "</title>\n")))
(goto-char (point-min))
(or (re-search-forward
"<body\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t)
(re-search-forward
"</head\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t))
(insert eheader)
(mm-write-region (point-min) (point-max)
tmp-file nil nil nil 'binary t))))
(charset
(mm-with-unibyte-buffer
(insert (if (eq charset 'gnus-decoded)
(encode-coding-string content
(setq charset 'utf-8))
content))
(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)
(setq tmp-file nil))))
(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
((equal (mm-handle-media-supertype handle) "multipart")
(when (gnus-article-browse-html-parts handle header)
(setq showed t)))
((equal (mm-handle-media-type handle) "message/rfc822")
(mm-with-multibyte-buffer
(mm-insert-part handle)
(setq handle (mm-dissect-buffer t t))
(when (and (bufferp (car handle))
(stringp (car (mm-handle-type handle))))
(setq handle (list handle)))
(when header
(article-decode-encoded-words)
(let ((gnus-visible-headers
(or (get 'gnus-visible-headers 'standard-value)
gnus-visible-headers)))
(article-hide-headers))
(goto-char (point-min))
(search-forward "\n\n" nil 'move)
(skip-chars-backward "\t\n ")
(setq header (buffer-substring (point-min) (point)))))
(when (prog1
(gnus-article-browse-html-parts handle header)
(mm-destroy-parts handle))
(setq showed t)))))
showed))