diff options
| author | Katsumi Yamaoka | 2010-03-30 04:03:00 +0000 |
|---|---|---|
| committer | Katsumi Yamaoka | 2010-03-30 04:03:00 +0000 |
| commit | 20c0b2cea26e858fd8d8706f2851c73af673e677 (patch) | |
| tree | 28d4412305287e840374ee4fbdf94b9eb35ac54f /lisp | |
| parent | 32a8894e5b88564765dc67955751f75d2c9dabcf (diff) | |
| download | emacs-20c0b2cea26e858fd8d8706f2851c73af673e677.tar.gz emacs-20c0b2cea26e858fd8d8706f2851c73af673e677.zip | |
2010-03-30 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-art.el (gnus-article-browse-delete-temp-files): Delete
directories as well.
(gnus-article-browse-html-parts): Work for images that do not specify
file names; delete temp directory when quitting; insert header at the
right place; use file: scheme for image files.
2010-03-30 Eric Schulte <schulte.eric@gmail.com>
* gnus-art.el (gnus-article-browse-html-save-cid-image): New function.
(gnus-article-browse-html-parts): Use it to make temporary cid image
files in addition to html file so that browser may display them.
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/gnus/ChangeLog | 14 | ||||
| -rw-r--r-- | lisp/gnus/gnus-art.el | 47 |
2 files changed, 59 insertions, 2 deletions
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 6786dff9b59..5fddceec0fb 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,17 @@ | |||
| 1 | 2010-03-30 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 2 | |||
| 3 | * gnus-art.el (gnus-article-browse-delete-temp-files): Delete | ||
| 4 | directories as well. | ||
| 5 | (gnus-article-browse-html-parts): Work for images that do not specify | ||
| 6 | file names; delete temp directory when quitting; insert header at the | ||
| 7 | right place; use file: scheme for image files. | ||
| 8 | |||
| 9 | 2010-03-30 Eric Schulte <schulte.eric@gmail.com> | ||
| 10 | |||
| 11 | * gnus-art.el (gnus-article-browse-html-save-cid-image): New function. | ||
| 12 | (gnus-article-browse-html-parts): Use it to make temporary cid image | ||
| 13 | files in addition to html file so that browser may display them. | ||
| 14 | |||
| 1 | 2010-03-29 Katsumi Yamaoka <yamaoka@jpl.org> | 15 | 2010-03-29 Katsumi Yamaoka <yamaoka@jpl.org> |
| 2 | 16 | ||
| 3 | * mm-decode.el (mm-add-meta-html-tag): Fix regexp matching meta tag. | 17 | * mm-decode.el (mm-add-meta-html-tag): Fix regexp matching meta tag. |
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index b3b156f69dc..9288101759f 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el | |||
| @@ -2819,12 +2819,43 @@ summary buffer." | |||
| 2819 | ;; `how' is neither `nil', `ask' nor `t' (i.e. `file'): | 2819 | ;; `how' is neither `nil', `ask' nor `t' (i.e. `file'): |
| 2820 | (gnus-y-or-n-p | 2820 | (gnus-y-or-n-p |
| 2821 | (format "Delete temporary HTML file `%s'? " file)))) | 2821 | (format "Delete temporary HTML file `%s'? " file)))) |
| 2822 | (delete-file file))) | 2822 | (if (file-directory-p file) |
| 2823 | (gnus-delete-directory file) | ||
| 2824 | (delete-file file)))) | ||
| 2823 | ;; Also remove file from the list when not deleted or if file doesn't | 2825 | ;; Also remove file from the list when not deleted or if file doesn't |
| 2824 | ;; exist anymore. | 2826 | ;; exist anymore. |
| 2825 | (setq gnus-article-browse-html-temp-list nil)) | 2827 | (setq gnus-article-browse-html-temp-list nil)) |
| 2826 | gnus-article-browse-html-temp-list) | 2828 | gnus-article-browse-html-temp-list) |
| 2827 | 2829 | ||
| 2830 | (defun gnus-article-browse-html-save-cid-image (cid dir) | ||
| 2831 | "Save CID contents to a file in DIR. Return file name." | ||
| 2832 | (save-match-data | ||
| 2833 | (gnus-with-article-buffer | ||
| 2834 | (let (cid-handle cid-tmp-file cid-type) | ||
| 2835 | (mapc | ||
| 2836 | (lambda (handle) | ||
| 2837 | (when (and (listp handle) | ||
| 2838 | (stringp (car (last handle))) | ||
| 2839 | (string= (format "<%s>" cid) | ||
| 2840 | (car (last handle)))) | ||
| 2841 | (setq cid-handle handle) | ||
| 2842 | (setq cid-tmp-file | ||
| 2843 | (expand-file-name | ||
| 2844 | (or (mail-content-type-get | ||
| 2845 | (mm-handle-disposition handle) 'filename) | ||
| 2846 | (mail-content-type-get | ||
| 2847 | (setq cid-type (mm-handle-type handle)) 'name) | ||
| 2848 | (concat (make-temp-name "cid") | ||
| 2849 | (or (car (rassoc (car cid-type) | ||
| 2850 | mailcap-mime-extensions)) | ||
| 2851 | ""))) | ||
| 2852 | dir)))) | ||
| 2853 | gnus-article-mime-handles) | ||
| 2854 | (when (and cid-handle cid-tmp-file) | ||
| 2855 | (mm-save-part-to-file cid-handle | ||
| 2856 | cid-tmp-file) | ||
| 2857 | (concat "file://" cid-tmp-file)))))) | ||
| 2858 | |||
| 2828 | (defun gnus-article-browse-html-parts (list &optional header) | 2859 | (defun gnus-article-browse-html-parts (list &optional header) |
| 2829 | "View all \"text/html\" parts from LIST. | 2860 | "View all \"text/html\" parts from LIST. |
| 2830 | Recurse into multiparts. The optional HEADER that should be a decoded | 2861 | Recurse into multiparts. The optional HEADER that should be a decoded |
| @@ -2862,7 +2893,7 @@ message header will be added to the bodies of the \"text/html\" parts." | |||
| 2862 | ;; Add a meta html tag to specify charset and a header. | 2893 | ;; Add a meta html tag to specify charset and a header. |
| 2863 | (cond | 2894 | (cond |
| 2864 | (header | 2895 | (header |
| 2865 | (let (title eheader body hcharset coding) | 2896 | (let (title eheader body hcharset coding cid-image-dir) |
| 2866 | (with-temp-buffer | 2897 | (with-temp-buffer |
| 2867 | (mm-enable-multibyte) | 2898 | (mm-enable-multibyte) |
| 2868 | (setq case-fold-search t) | 2899 | (setq case-fold-search t) |
| @@ -2943,6 +2974,18 @@ message header will be added to the bodies of the \"text/html\" parts." | |||
| 2943 | (re-search-forward | 2974 | (re-search-forward |
| 2944 | "</head\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t)) | 2975 | "</head\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t)) |
| 2945 | (insert eheader) | 2976 | (insert eheader) |
| 2977 | ;; resolve cid images | ||
| 2978 | (while (re-search-forward | ||
| 2979 | "<img src=\"\\(cid:\\([^\"]+\\)\\)\"" | ||
| 2980 | nil t) | ||
| 2981 | (unless cid-image-dir | ||
| 2982 | (setq cid-image-dir (make-temp-file "cid" t)) | ||
| 2983 | (add-to-list 'gnus-article-browse-html-temp-list | ||
| 2984 | cid-image-dir)) | ||
| 2985 | (replace-match | ||
| 2986 | (gnus-article-browse-html-save-cid-image | ||
| 2987 | (match-string 2) cid-image-dir) | ||
| 2988 | nil nil nil 1)) | ||
| 2946 | (mm-write-region (point-min) (point-max) | 2989 | (mm-write-region (point-min) (point-max) |
| 2947 | tmp-file nil nil nil 'binary t)))) | 2990 | tmp-file nil nil nil 'binary t)))) |
| 2948 | (charset | 2991 | (charset |