From 3557392c7682dc8b827fb3f49f785ded6ffcc62e Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Tue, 26 Aug 2014 23:28:03 +0000 Subject: [PATCH] gnus-art.el (gnus-article-browse-html-save-cid-content, gnus-article-browse-html-parts): Make cid file names relative --- lisp/ChangeLog | 5 +++++ lisp/gnus-art.el | 43 +++++++++++++++++++++++-------------------- 2 files changed, 28 insertions(+), 20 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 978b45ca2..f681d0544 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2014-08-26 Katsumi Yamaoka + + * 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 * mm-view.el (mm-display-inline-fontify): Make the working buffer diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index d55c703a3..d4bbfff48 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) - (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)))))))) + (setq file (or (mm-handle-filename handle) + (concat + (make-temp-name "cid") + (car (rassoc (car (mm-handle-type handle)) + 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 + (let ((case-fold-search t)) + (goto-char (point-min)) + (when (and (search-forward "" nil t) + (progn + (save-restriction + (narrow-to-region + (point) + (or (search-forward "" nil t) (point))) + (goto-char (point-min))) + (re-search-forward + "[\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 -- 2.34.1