From a6e0787ddafd545a57b57d97725a26b2fcf26ab7 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 2 Feb 2012 10:32:42 +0100 Subject: [PATCH] shr image zoom fixups * shr.el (shr-put-image): Remove underlines from sliced images. (shr-zoom-image): Compute the region to be replaced more correctly. --- lisp/ChangeLog | 5 +++++ lisp/shr.el | 32 ++++++++++++++++++++------------ 2 files changed, 25 insertions(+), 12 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7255fe982..d94f35260 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2012-02-02 Lars Ingebrigtsen + + * shr.el (shr-put-image): Remove underlines from sliced images. + (shr-zoom-image): Compute the region to be replaced more correctly. + 2012-02-02 Katsumi Yamaoka * gnus-msg.el (gnus-gcc-self-resent-messages): New user option. diff --git a/lisp/shr.el b/lisp/shr.el index 5a045916b..83392cd9f 100644 --- a/lisp/shr.el +++ b/lisp/shr.el @@ -226,17 +226,16 @@ size, and full-buffer size." (if (not url) (message "No image under point") ;; Delete the old picture. - (beginning-of-line) - (while (get-text-property (point) 'display) - (forward-line -1)) - (forward-line 1) + (while (get-text-property (point) 'image-url) + (forward-char -1)) + (forward-char 1) (let ((start (point))) - (while (get-text-property (point) 'display) - (forward-line 1)) - (forward-line -1) - (delete-region start (point)) - (forward-char 1) - (put-text-property start (point) 'display nil)) + (while (get-text-property (point) 'image-url) + (forward-char 1)) + (forward-char -1) + (put-text-property start (point) 'display nil) + (when (> (- (point) start) 2) + (delete-region start (1- (point))))) (message "Inserting %s..." url) (url-retrieve url 'shr-image-fetched (list (current-buffer) (1- (point)) (point-marker) @@ -547,10 +546,16 @@ size, and full-buffer size." (with-current-buffer buffer (save-excursion (let ((alt (buffer-substring start end)) + (properties (text-properties-at start)) (inhibit-read-only t)) (delete-region start end) (goto-char start) - (funcall shr-put-image-function data alt flags))))))) + (funcall shr-put-image-function data alt flags) + (while properties + (let ((type (pop properties)) + (value (pop properties))) + (unless (memq type '(display image-size)) + (put-text-property start (point) type value)))))))))) (kill-buffer (current-buffer))) (defun shr-put-image (data alt &optional flags) @@ -574,7 +579,10 @@ size, and full-buffer size." (> (car (image-size image t)) 400)) (insert "\n")) (if (eq size 'original) - (insert-sliced-image image (or alt "*") nil 20 1) + (let ((overlays (overlays-at (point)))) + (insert-sliced-image image (or alt "*") nil 20 1) + (dolist (overlay overlays) + (overlay-put overlay 'face 'default))) (insert-image image (or alt "*"))) (put-text-property start (point) 'image-size size) (when (image-animated-p image) -- 2.34.1