Katsumi Yamaoka
2014-08-26 23:27:56 UTC
via 3557392c7682dc8b827fb3f49f785ded6ffcc62e (commit)
from ba869402923d2adda4c143301e12659b9d7020f8 (commit)
- Log -----------------------------------------------------------------
commit 3557392c7682dc8b827fb3f49f785ded6ffcc62e
Author: Katsumi Yamaoka <***@jpl.org>
Date: Tue Aug 26 23:28:03 2014 +0000
gnus-art.el (gnus-article-browse-html-save-cid-content, gnus-article-browse-html-parts): Make cid file names relative
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 978b45c..f681d05 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2014-08-26 Katsumi 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 <***@jpl.org>
* mm-view.el (mm-display-inline-fontify): Make the working buffer
diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index d55c703..d4bbfff 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -2807,16 +2807,15 @@ Return file name."
cid handle directory))
(throw 'found file)))
((equal (concat "<" cid ">") (mm-handle-id handle))
- (setq file
- (expand-file-name
- (or (mm-handle-filename handle)
+ (setq file (or (mm-handle-filename handle)
(concat
(make-temp-name "cid")
(car (rassoc (car (mm-handle-type handle))
- mailcap-mime-extensions))))
- directory))
- (mm-save-part-to-file handle file)
- (throw 'found file))))))))
+ mailcap-mime-extensions)))))
+ (mm-save-part-to-file handle (expand-file-name file directory))
+ (throw 'found (concat (file-name-nondirectory
+ (directory-file-name directory))
+ "/" file)))))))))
(defun gnus-article-browse-html-parts (list &optional header)
"View all \"text/html\" parts from LIST.
@@ -2850,6 +2849,19 @@ message header will be added to the bodies of the \"text/html\" parts."
(mm-enable-multibyte)
(mm-disable-multibyte))
(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
(let ((case-fold-search t)
cid-file)
@@ -2868,16 +2880,7 @@ message header will be added to the bodies of the \"text/html\" parts."
(with-current-buffer gnus-article-buffer
gnus-article-mime-handles)
cid-dir))
- (when (eq system-type 'cygwin)
- (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))))
+ (replace-match cid-file nil nil nil 1))))
(unless content (setq content (buffer-string))))
(when (or charset header (not file))
(setq tmp-file (mm-make-temp-file
-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.
Summary of changes:
lisp/ChangeLog | 5 +++++
lisp/gnus-art.el | 43 +++++++++++++++++++++++--------------------
2 files changed, 28 insertions(+), 20 deletions(-)
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".
The branch, master has been updated
hooks/post-receive
from ba869402923d2adda4c143301e12659b9d7020f8 (commit)
- Log -----------------------------------------------------------------
commit 3557392c7682dc8b827fb3f49f785ded6ffcc62e
Author: Katsumi Yamaoka <***@jpl.org>
Date: Tue Aug 26 23:28:03 2014 +0000
gnus-art.el (gnus-article-browse-html-save-cid-content, gnus-article-browse-html-parts): Make cid file names relative
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 978b45c..f681d05 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2014-08-26 Katsumi 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 <***@jpl.org>
* mm-view.el (mm-display-inline-fontify): Make the working buffer
diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index d55c703..d4bbfff 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -2807,16 +2807,15 @@ Return file name."
cid handle directory))
(throw 'found file)))
((equal (concat "<" cid ">") (mm-handle-id handle))
- (setq file
- (expand-file-name
- (or (mm-handle-filename handle)
+ (setq file (or (mm-handle-filename handle)
(concat
(make-temp-name "cid")
(car (rassoc (car (mm-handle-type handle))
- mailcap-mime-extensions))))
- directory))
- (mm-save-part-to-file handle file)
- (throw 'found file))))))))
+ mailcap-mime-extensions)))))
+ (mm-save-part-to-file handle (expand-file-name file directory))
+ (throw 'found (concat (file-name-nondirectory
+ (directory-file-name directory))
+ "/" file)))))))))
(defun gnus-article-browse-html-parts (list &optional header)
"View all \"text/html\" parts from LIST.
@@ -2850,6 +2849,19 @@ message header will be added to the bodies of the \"text/html\" parts."
(mm-enable-multibyte)
(mm-disable-multibyte))
(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
(let ((case-fold-search t)
cid-file)
@@ -2868,16 +2880,7 @@ message header will be added to the bodies of the \"text/html\" parts."
(with-current-buffer gnus-article-buffer
gnus-article-mime-handles)
cid-dir))
- (when (eq system-type 'cygwin)
- (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))))
+ (replace-match cid-file nil nil nil 1))))
(unless content (setq content (buffer-string))))
(when (or charset header (not file))
(setq tmp-file (mm-make-temp-file
-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.
Summary of changes:
lisp/ChangeLog | 5 +++++
lisp/gnus-art.el | 43 +++++++++++++++++++++++--------------------
2 files changed, 28 insertions(+), 20 deletions(-)
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".
The branch, master has been updated
hooks/post-receive
--
Gnus Project
Gnus Project