X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-html.el;h=d0414e786014cc92a70aa3d6494ceb4da877f6f4;hb=5468e915c342bcc54b4aa87f69742ed61587a21c;hp=a6a243adc09ed1e892854f30d2697b8a5245cbc5;hpb=ba2fe997b36918f5ed20351fe6871a9931f5eb09;p=gnus diff --git a/lisp/gnus-html.el b/lisp/gnus-html.el index a6a243adc..d0414e786 100644 --- a/lisp/gnus-html.el +++ b/lisp/gnus-html.el @@ -105,12 +105,7 @@ CHARS is a regexp-like character alternative (e.g., \"[)$]\")." (match-string 0 encoded-text))) t t encoded-text) s (1+ s))) - encoded-text)))) - ;; XEmacs does not have window-inside-pixel-edges - (defalias 'gnus-window-inside-pixel-edges - (if (fboundp 'window-inside-pixel-edges) - 'window-inside-pixel-edges - 'window-pixel-edges))) + encoded-text))))) (defun gnus-html-encode-url (url) "Encode URL." @@ -271,7 +266,7 @@ Use ALT-TEXT for the image string." (setq tag (match-string 1) parameters (match-string 2) start (match-beginning 0)) - (when (plusp (length parameters)) + (when (> (length parameters) 0) (set-text-properties 0 (1- (length parameters)) nil parameters)) (delete-region start (point)) (when (search-forward (concat "") nil t) @@ -436,7 +431,19 @@ Return a string with image data." (= (car size) 30) (= (cdr size) 30)))) ;; Good image, add it! - (let ((image (gnus-html-rescale-image image data size))) + (let ((image (gnus-rescale-image + image + (let ((edges (gnus-window-inside-pixel-edges + (get-buffer-window (current-buffer))))) + ;; (width . height) + (cons + ;; Aimed width + (truncate + (* gnus-max-image-proportion + (- (nth 2 edges) (nth 0 edges)))) + ;; Aimed height + (truncate (* gnus-max-image-proportion + (- (nth 3 edges) (nth 1 edges))))))))) (delete-region start end) (gnus-put-image image alt-text 'external) (gnus-put-text-property start (point) 'help-echo alt-text) @@ -459,31 +466,6 @@ Return a string with image data." (gnus-add-image 'internal image)) nil)))))))) -(defun gnus-html-rescale-image (image data size) - (if (or (not (fboundp 'imagemagick-types)) - (not (get-buffer-window (current-buffer)))) - image - (let* ((width (car size)) - (height (cdr size)) - (edges (gnus-window-inside-pixel-edges - (get-buffer-window (current-buffer)))) - (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 (> height window-height) - (setq image (or (create-image data 'imagemagick t - :height window-height) - image)) - (setq size (image-size image t))) - (when (> (car size) window-width) - (setq image (or - (create-image data 'imagemagick t - :width window-width) - image))) - image))) - (defun gnus-html-image-url-blocked-p (url blocked-images) "Find out if URL is blocked by BLOCKED-IMAGES." (let ((ret (and blocked-images