[gnus git] branch master updated: m0-1-34-ge58062d =2= Fix up declaration for last checkin. ; New shr.el command for zooming on images

       via  e58062d06f30bd04030328765096c3632c50b36d (commit)
       via  683fb2629c78efa622d0cea4b61800903b0dcb6d (commit)
      from  15ceddb656d3650b6626205b58629b68f67a86c3 (commit)


- Log -----------------------------------------------------------------
commit e58062d06f30bd04030328765096c3632c50b36d
Author: Lars Ingebrigtsen <[email protected]>
Date:   Wed Feb 1 21:44:49 2012 +0100

    Fix up declaration for last checkin.

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index a5101fe..2839a60 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -6193,7 +6193,7 @@ Provided for backwards compatibility."
 	     (not gnus-inhibit-hiding))
     (gnus-article-hide-headers)))
 
-(declare-function shr-put-image "shr" (data alt))
+(declare-function shr-put-image "shr" (data alt &optional flags))
 
 (defun gnus-shr-put-image (data alt &optional flags)
   "Put image DATA with a string ALT.  Enable image to be deleted."

commit 683fb2629c78efa622d0cea4b61800903b0dcb6d
Author: Lars Ingebrigtsen <[email protected]>
Date:   Wed Feb 1 21:43:24 2012 +0100

    New shr.el command for zooming on images
    
    * gnus-art.el (gnus-shr-put-image): Take and pass on a `flags'
    parameter to allow controlling the scaling.
    
    * shr.el (shr-zoom-image): New command and keystroke.
    (shr-put-image): Take a `size' flag to say how to scale the image.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fbb9f7d..dfc2fd0 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,11 @@
 2012-02-01  Lars Ingebrigtsen  <[email protected]>
 
+	* gnus-art.el (gnus-shr-put-image): Take and pass on a `flags'
+	parameter to allow controlling the scaling.
+
+	* shr.el (shr-zoom-image): New command and keystroke.
+	(shr-put-image): Take a `size' flag to say how to scale the image.
+
 	* gnus-compat.el: Redefine `delete-directory' to provide recursive
 	deletion unless already defined.
 
diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 4f6d4d6..a5101fe 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -6195,10 +6195,11 @@ Provided for backwards compatibility."
 
 (declare-function shr-put-image "shr" (data alt))
 
-(defun gnus-shr-put-image (data alt)
+(defun gnus-shr-put-image (data alt &optional flags)
   "Put image DATA with a string ALT.  Enable image to be deleted."
   (let ((image (shr-put-image data (propertize (or alt "*")
-					       'gnus-image-category 'shr))))
+					       'gnus-image-category 'shr)
+			      flags)))
     (when image
       (gnus-add-image 'shr image))))
 
diff --git a/lisp/shr.el b/lisp/shr.el
index acce766..5a04591 100644
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -118,6 +118,7 @@ cid: URL as the argument.")
   (let ((map (make-sparse-keymap)))
     (define-key map "a" 'shr-show-alt-text)
     (define-key map "i" 'shr-browse-image)
+    (define-key map "z" 'shr-zoom-image)
     (define-key map "I" 'shr-insert-image)
     (define-key map "u" 'shr-copy-url)
     (define-key map "v" 'shr-browse-url)
@@ -214,6 +215,41 @@ the URL of the image to the kill buffer instead."
 		    (list (current-buffer) (1- (point)) (point-marker))
 		    t))))
 
+(defun shr-zoom-image ()
+  "Toggle the image size.
+The size will be rotated between the default size, the original
+size, and full-buffer size."
+  (interactive)
+  (let ((url (get-text-property (point) 'image-url))
+	(size (get-text-property (point) 'image-size))
+	(buffer-read-only nil))
+    (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)
+      (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))
+      (message "Inserting %s..." url)
+      (url-retrieve url 'shr-image-fetched
+		    (list (current-buffer) (1- (point)) (point-marker)
+			  (list (cons 'size
+				      (cond ((or (eq size 'default)
+						 (null size))
+					     'original)
+					    ((eq size 'original)
+					     'full)
+					    ((eq size 'full)
+					     'default)))))
+		    t))))
+
 ;;; Utility functions.
 
 (defun shr-transform-dom (dom)
@@ -501,7 +537,7 @@ the URL of the image to the kill buffer instead."
 		    (expand-file-name (file-name-nondirectory url)
 				      directory)))))
 
-(defun shr-image-fetched (status buffer start end)
+(defun shr-image-fetched (status buffer start end &optional flags)
   (when (and (buffer-name buffer)
 	     (not (plist-get status :error)))
     (url-store-in-cache (current-buffer))
@@ -514,27 +550,41 @@ the URL of the image to the kill buffer instead."
 		  (inhibit-read-only t))
 	      (delete-region start end)
 	      (goto-char start)
-	      (funcall shr-put-image-function data alt)))))))
+	      (funcall shr-put-image-function data alt flags)))))))
   (kill-buffer (current-buffer)))
 
-(defun shr-put-image (data alt)
+(defun shr-put-image (data alt &optional flags)
   "Put image DATA with a string ALT.  Return image."
   (if (display-graphic-p)
-      (let ((image (ignore-errors
-                     (shr-rescale-image data))))
+      (let* ((size (cdr (assq 'size flags)))
+	     (start (point))
+	     (image (cond
+		     ((eq size 'original)
+		      (create-image data nil t :ascent 100))
+		     ((eq size 'full)
+		      (ignore-errors
+			(shr-rescale-image data t)))
+		     (t
+		      (ignore-errors
+			(shr-rescale-image data))))))
         (when image
 	  ;; When inserting big-ish pictures, put them at the
 	  ;; beginning of the line.
 	  (when (and (> (current-column) 0)
 		     (> (car (image-size image t)) 400))
 	    (insert "\n"))
-	  (insert-image image (or alt "*"))
+	  (if (eq size 'original)
+	      (insert-sliced-image image (or alt "*") nil 20 1)
+	    (insert-image image (or alt "*")))
+	  (put-text-property start (point) 'image-size size)
 	  (when (image-animated-p image)
 	    (image-animate image nil 60)))
 	image)
     (insert alt)))
 
-(defun shr-rescale-image (data)
+(defun shr-rescale-image (data &optional force)
+  "Rescale DATA, if too big, to fit the current buffer.
+If FORCE, rescale the image anyway."
   (let ((image (create-image data nil t :ascent 100)))
     (if (or (not (fboundp 'imagemagick-types))
 	    (not (get-buffer-window (current-buffer))))
@@ -549,7 +599,8 @@ the URL of the image to the kill buffer instead."
 	     (window-height (truncate (* shr-max-image-proportion
 					 (- (nth 3 edges) (nth 1 edges)))))
 	     scaled-image)
-	(when (> height window-height)
+	(when (or force
+		  (> height window-height))
 	  (setq image (or (create-image data 'imagemagick t
 					:height window-height
 					:ascent 100)

-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.

Summary of changes:
 lisp/ChangeLog   |    6 +++++
 lisp/gnus-art.el |    7 +++--
 lisp/shr.el      |   67 +++++++++++++++++++++++++++++++++++++++++++++++------
 3 files changed, 69 insertions(+), 11 deletions(-)

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".

The branch, master has been updated


hooks/post-receive
-- 
Gnus Project