andros/emacs-gpu
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

2010-03-30 Katsumi Yamaoka <yamaoka@jpl.org>

Browse source 
* 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.
This commit is contained in:
Katsumi Yamaoka 2010-03-30 04:03:00 +00:00
parent 32a8894e5b
commit 20c0b2cea2
2 changed files with 59 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
lisp/gnus/ChangeLog
View file

@ -1,3 +1,17 @@
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.
2010-03-29 Katsumi Yamaoka <yamaoka@jpl.org>
* mm-decode.el (mm-add-meta-html-tag): Fix regexp matching meta tag.

47
lisp/gnus/gnus-art.el
View file

@ -2819,12 +2819,43 @@ summary buffer."
;; `how' is neither `nil', `ask' nor `t' (i.e. `file'):
(gnus-y-or-n-p
(format "Delete temporary HTML file `%s'? " file))))
(delete-file file)))
(if (file-directory-p file)
(gnus-delete-directory file)
(delete-file file))))
;; Also remove file from the list when not deleted or if file doesn't
;; exist anymore.
(setq gnus-article-browse-html-temp-list nil))
gnus-article-browse-html-temp-list)
(defun gnus-article-browse-html-save-cid-image (cid dir)
"Save CID contents to a file in DIR. Return file name."
(save-match-data
(gnus-with-article-buffer
(let (cid-handle cid-tmp-file cid-type)
(mapc
(lambda (handle)
(when (and (listp handle)
(stringp (car (last handle)))
(string= (format "<%s>" cid)
(car (last handle))))
(setq cid-handle handle)
(setq cid-tmp-file
(expand-file-name
(or (mail-content-type-get
(mm-handle-disposition handle) 'filename)
(mail-content-type-get
(setq cid-type (mm-handle-type handle)) 'name)
(concat (make-temp-name "cid")
(or (car (rassoc (car cid-type)
mailcap-mime-extensions))
"")))
dir))))
gnus-article-mime-handles)
(when (and cid-handle cid-tmp-file)
(mm-save-part-to-file cid-handle
cid-tmp-file)
(concat "file://" cid-tmp-file))))))
(defun gnus-article-browse-html-parts (list &optional header)
"View all \"text/html\" parts from LIST.
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."
;; Add a meta html tag to specify charset and a header.
(cond
(header
(let (title eheader body hcharset coding)
(let (title eheader body hcharset coding cid-image-dir)
(with-temp-buffer
(mm-enable-multibyte)
(setq case-fold-search t)
@ -2943,6 +2974,18 @@ message header will be added to the bodies of the \"text/html\" parts."
(re-search-forward
"</head\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t))
(insert eheader)
;; resolve cid images
(while (re-search-forward
"<img src=\"\\(cid:\\([^\"]+\\)\\)\""
nil t)
(unless cid-image-dir
(setq cid-image-dir (make-temp-file "cid" t))
(add-to-list 'gnus-article-browse-html-temp-list
cid-image-dir))
(replace-match
(gnus-article-browse-html-save-cid-image
(match-string 2) cid-image-dir)
nil nil nil 1))
(mm-write-region (point-min) (point-max)
tmp-file nil nil nil 'binary t))))
(charset