mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-27 07:37:33 +00:00
Code Issues Releases Activity

gnus-html.el: Rescale images in article buffers for Emacs versions that support this. This is currently only Emacs 24 compiled with imagemagick support.

Browse Source
This commit is contained in:
Lars Magne Ingebrigtsen 2010-09-01 23:53:57 +00:00 committed by Katsumi Yamaoka
parent 6ca07e4960
commit 7d7520b969
2 changed files with 34 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lisp/gnus/ChangeLog
View File

@ -7,6 +7,9 @@
2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org> 2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-html.el (gnus-html-wash-tags): Delete the IMG_ALT region. * gnus-html.el (gnus-html-wash-tags): Delete the IMG_ALT region.
(gnus-max-image-proportion): New variable.
(gnus-html-rescale-image): New function.
(gnus-html-put-image): Rescale images.
2010-09-01 Stefan Monnier <monnier@iro.umontreal.ca> 2010-09-01 Stefan Monnier <monnier@iro.umontreal.ca>

32
lisp/gnus/gnus-html.el
View File

@ -56,6 +56,16 @@
:group 'gnus-art :group 'gnus-art
:type 'regexp) :type 'regexp)
(defcustom gnus-max-image-proportion 0.7
"How big pictures displayed are in relation to the window they're in.
A value of 0.7 means that they are allowed to take up 70% of the
width and height of the window. If they are larger than this,
and Emacs supports it, then the images will be rescaled down to
fit these criteria."
:version "24.1"
:group 'gnus-art
:type 'float)
;;;###autoload ;;;###autoload
(defun gnus-article-html (handle) (defun gnus-article-html (handle)
(let ((article-buffer (current-buffer))) (let ((article-buffer (current-buffer)))
@ -219,13 +229,33 @@
(= (car (image-size image t)) 30) (= (car (image-size image t)) 30)
(= (cdr (image-size image t)) 30)))) (= (cdr (image-size image t)) 30))))
(progn (progn
(gnus-put-image image) (gnus-put-image (gnus-html-rescale-image image))
t) t)
(when (fboundp 'find-image) (when (fboundp 'find-image)
(gnus-put-image (find-image (gnus-put-image (find-image
'((:type xpm :file "lock-broken.xpm"))))) '((:type xpm :file "lock-broken.xpm")))))
nil))))) nil)))))
(defun gnus-html-rescale-image (image)
(if (not (fboundp 'imagemagick-types))
image
(let* ((width (car (image-size image t)))
(height (cdr (image-size image t)))
(edges (window-pixel-edges))
(window-width (truncate (* gnus-max-image-proportion
(- (nth 2 edges) (nth 0 edges)))))
(window-height (truncate (* gnus-max-image-proportion
(- (nth 3 edges) (nth 1 edges)))))
scaled-image)
(when (> width window-width)
(setq window-height (truncate (* window-height
(/ (* 1.0 window-width) width)))))
(if (> height window-height)
(or (create-image file 'imagemagick nil
:height window-height)
image)
image))))
(defun gnus-html-prune-cache () (defun gnus-html-prune-cache ()
(let ((total-size 0) (let ((total-size 0)
files) files)