Mercurial > emacs
comparison lisp/gnus/gnus-art.el @ 107578:3ca642fe505f
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.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Tue, 30 Mar 2010 04:03:00 +0000 |
| parents | 0fe940324254 |
| children | 1e23ce3cbd8b |
comparison
equal
deleted
inserted
replaced
| 107577:df4f6d6be3b3 | 107578:3ca642fe505f |
|---|---|
| 2817 (when (and (file-exists-p file) | 2817 (when (and (file-exists-p file) |
| 2818 (or (eq how t) | 2818 (or (eq how t) |
| 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) |
| 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)))))) | |
| 2827 | 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 |
| 2831 message header will be added to the bodies of the \"text/html\" parts." | 2862 message header will be added to the bodies of the \"text/html\" parts." |
| 2860 ;; Do we need to care for 8.3 filenames? | 2891 ;; Do we need to care for 8.3 filenames? |
| 2861 "mm-" nil ".html"))) | 2892 "mm-" nil ".html"))) |
| 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) |
| 2869 (insert header "\n") | 2900 (insert header "\n") |
| 2870 (setq title (message-fetch-field "subject")) | 2901 (setq title (message-fetch-field "subject")) |
| 2941 (or (re-search-forward | 2972 (or (re-search-forward |
| 2942 "<body\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t) | 2973 "<body\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t) |
| 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 |
| 2949 (mm-with-unibyte-buffer | 2992 (mm-with-unibyte-buffer |
| 2950 (insert (if (eq charset 'gnus-decoded) | 2993 (insert (if (eq charset 'gnus-decoded) |