Commit 6539413d authored by Katsumi Yamaoka's avatar Katsumi Yamaoka

gnus-art.el (gnus-article-browse-html-save-cid-content,...

gnus-art.el (gnus-article-browse-html-save-cid-content, gnus-article-browse-html-parts): Make cid file names relative
parent aaae978c
2014-08-26 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (gnus-article-browse-html-save-cid-content)
(gnus-article-browse-html-parts): Make cid file names relative.
2014-08-21 Katsumi Yamaoka <yamaoka@jpl.org> 2014-08-21 Katsumi Yamaoka <yamaoka@jpl.org>
* mm-view.el (mm-display-inline-fontify): Make the working buffer * mm-view.el (mm-display-inline-fontify): Make the working buffer
......
...@@ -2806,16 +2806,15 @@ Return file name." ...@@ -2806,16 +2806,15 @@ Return file name."
cid handle directory)) cid handle directory))
(throw 'found file))) (throw 'found file)))
((equal (concat "<" cid ">") (mm-handle-id handle)) ((equal (concat "<" cid ">") (mm-handle-id handle))
(setq file (setq file (or (mm-handle-filename handle)
(expand-file-name
(or (mm-handle-filename handle)
(concat (concat
(make-temp-name "cid") (make-temp-name "cid")
(car (rassoc (car (mm-handle-type handle)) (car (rassoc (car (mm-handle-type handle))
mailcap-mime-extensions)))) mailcap-mime-extensions)))))
directory)) (mm-save-part-to-file handle (expand-file-name file directory))
(mm-save-part-to-file handle file) (throw 'found (concat (file-name-nondirectory
(throw 'found file)))))))) (directory-file-name directory))
"/" file)))))))))
(defun gnus-article-browse-html-parts (list &optional header) (defun gnus-article-browse-html-parts (list &optional header)
"View all \"text/html\" parts from LIST. "View all \"text/html\" parts from LIST.
...@@ -2849,6 +2848,19 @@ message header will be added to the bodies of the \"text/html\" parts." ...@@ -2849,6 +2848,19 @@ message header will be added to the bodies of the \"text/html\" parts."
(mm-enable-multibyte) (mm-enable-multibyte)
(mm-disable-multibyte)) (mm-disable-multibyte))
(insert content) (insert content)
;; remove <base>
(let ((case-fold-search t))
(goto-char (point-min))
(when (and (search-forward "<head>" nil t)
(progn
(save-restriction
(narrow-to-region
(point)
(or (search-forward "</head>" nil t) (point)))
(goto-char (point-min)))
(re-search-forward
"[\t\n ]*<base[\t\n ]+[^>]+>[\t\n ]*" nil t)))
(replace-match "\n")))
;; resolve cid contents ;; resolve cid contents
(let ((case-fold-search t) (let ((case-fold-search t)
cid-file) cid-file)
...@@ -2867,16 +2879,7 @@ message header will be added to the bodies of the \"text/html\" parts." ...@@ -2867,16 +2879,7 @@ message header will be added to the bodies of the \"text/html\" parts."
(with-current-buffer gnus-article-buffer (with-current-buffer gnus-article-buffer
gnus-article-mime-handles) gnus-article-mime-handles)
cid-dir)) cid-dir))
(when (eq system-type 'cygwin) (replace-match cid-file nil nil nil 1))))
(setq cid-file
(concat "/" (substring
(with-output-to-string
(call-process "cygpath" nil
standard-output
nil "-m" cid-file))
0 -1))))
(replace-match (concat "file://" cid-file)
nil nil nil 1))))
(unless content (setq content (buffer-string)))) (unless content (setq content (buffer-string))))
(when (or charset header (not file)) (when (or charset header (not file))
(setq tmp-file (mm-make-temp-file (setq tmp-file (mm-make-temp-file
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment