Merge branch 'master' into yata-completing

ChangeLog

@@ -1,3 +1,18 @@
+2009-12-06  Tadashi MATSUO  <matsuo@i.ci.ritsumei.ac.jp>
+
+	* twittering-mode.el (twittering-use-wget): new variable for
+	specifying whether the external command `wget' should be used.
+	(twittering-retrieve-image): new function for retrieving icon
+	images with/without wget.
+	(twittering-get-twits): retrieve images with
+	`twittering-retrieve-image'.
+	(twittering-use-convert): add a new variable specifying whether
+	the external command `convert' should be used.
+	(twittering-make-display-spec-for-icon): new function for
+	generating properties for icon with/without cropping the image.
+	(twittering-retrieve-image-without-wget): write an image as binary
+	explicitly.
+
 2009-12-05  Satoshi Yatagawa  <yata_github@y.hauN.org>
 
 	* twittering-mode.el (twittering-get-username-with-completion):

twittering-mode.el

@@ -289,13 +289,20 @@ directory. You should change through function'twittering-icon-mode'")
 
 (defvar twittering-image-stack nil)
 (defvar twittering-image-type-cache nil)
-(defvar twittering-convert-program "/usr/bin/convert")
+(defvar twittering-convert-program (executable-find "convert"))
 (defvar twittering-convert-fix-size nil)
+(defvar twittering-use-convert (not (null (executable-find "convert")))
+  "*This variable makes a sense only if `twittering-convert-fix-size'
+is non-nil. If this variable is non-nil, icon images are converted by
+invoking \"convert\". Otherwise, cropped images are displayed.")
+(defvar twittering-use-wget nil
+  "*If non-nil, icon images are retrieved by invoking \"wget\".
+Otherwise, they are retrieved by `url-retrieve'.")
 
 (defun twittering-image-type (file-name)
   (if (and (not (assoc file-name twittering-image-type-cache))
 	   (file-exists-p file-name))
-      (if twittering-convert-fix-size
+      (if (and twittering-convert-fix-size twittering-use-convert)
 	  (let ((tmpfile (make-temp-file "emacstwit" nil ".png")))
 	    (let ((coding-system-for-read 'raw-text)
 		  (coding-system-for-write 'binary))
@@ -311,7 +318,8 @@ directory. You should change through function'twittering-icon-mode'")
       			 ((string-match "JPEG" file-output) 'jpeg)
       			 ((string-match "PNG" file-output) 'png)
       			 ((string-match "GIF" file-output) 'gif)
-      			 ((string-match "bitmap" file-output)
+      			 ((and twittering-use-convert
+			       (string-match "bitmap" file-output))
       			  (let ((coding-system-for-read 'raw-text)
       				(coding-system-for-write 'binary))
       			    (with-temp-buffer
@@ -684,6 +692,32 @@ directory. You should change through function'twittering-icon-mode'")
   (concat (md5 icon-url nil nil 'iso-2022-7bit)
 	  (or (ffap-file-suffix icon-url) ".img")))
 
+(defun twittering-make-display-spec-for-icon (fullpath)
+  "Return the specification for `display' text property, which limits
+the size of an icon image FULLPATH up to FIXED-LENGTH.
+
+If the size of the image exceeds FIXED-LENGTH, the center of the
+image are displayed."
+  (let* ((image-spec
+	  `(image :type ,(twittering-image-type fullpath)
+		  :file ,fullpath)))
+    (if (and twittering-convert-fix-size (not twittering-use-convert))
+	(let* ((size (if (file-exists-p fullpath)
+			 (image-size image-spec t)
+		       '(48 . 48)))
+	       (width (car size))
+	       (height (cdr size))
+	       (fixed-length twittering-convert-fix-size)
+	       (half-fixed-length (/ fixed-length 2))
+	       (slice-spec
+		(if (or (< fixed-length width) (< fixed-length height))
+		    `(slice ,(max 0 (- (/ width 2) half-fixed-length))
+			    ,(max 0 (- (/ height 2) half-fixed-length))
+			    ,fixed-length ,fixed-length)
+		  `(slice 0 0 ,fixed-length ,fixed-length))))
+	  `(display (,image-spec ,slice-spec)))
+      `(display ,image-spec))))
+
 (defun twittering-format-status (status format-str)
   ;; Formatting strategy:
   ;; 
@@ -713,11 +747,9 @@ directory. You should change through function'twittering-icon-mode'")
 		    (add-to-list 'twittering-image-stack profile-image-url))
 
 		  (when (and icon-string twittering-icon-mode)
-		    (set-text-properties
-		     1 2 `(display
-			   (image :type ,(twittering-image-type fullpath)
-				  :file ,fullpath))
-		     icon-string)
+		    (let ((display-spec
+			   (twittering-make-display-spec-for-icon fullpath)))
+		      (set-text-properties 1 2 display-spec icon-string))
 		    icon-string)
 		  )))))
     (let ((cursor 0)
@@ -1277,28 +1309,52 @@ If STATUS-DATUM is already in DATA-VAR, return nil. If not, return t."
 	(twittering-http-get (twittering-last-host) method
 			     noninteractive parameters))))
 
-  (if (and twittering-icon-mode window-system)
-      (if twittering-image-stack
-	  (dolist (url twittering-image-stack)
-	    (let ((file (concat twittering-tmp-dir "/" (twittering-icon-path url))))
-	    (unless (file-exists-p file)
-	      (let ((proc
-		     (funcall
-		      #'start-process
-		      "wget-images"
-		      (twittering-wget-buffer)
-		      "wget"
-		      "--quiet"
-		      (format "--directory-prefix=%s" twittering-tmp-dir)
-		      "-O" file
-		      url)))
-		(set-process-sentinel
-		 proc
-		 (lambda (proc stat)
-		   (clear-image-cache)
-		   (save-excursion
-		     (set-buffer (twittering-wget-buffer))
-		     ))))))))))
+  (if (and twittering-icon-mode window-system
+	   twittering-image-stack)
+      (twittering-retrieve-image twittering-image-stack)
+    ))
+
+(defun twittering-retrieve-image (images)
+  (if twittering-use-wget
+      (twittering-retrieve-image-with-wget images)
+    (twittering-retrieve-image-without-wget images)))
+
+(defun twittering-retrieve-image-without-wget (image-urls)
+  (require 'url)
+  (dolist (url image-urls)
+    (let ((file (concat twittering-tmp-dir "/" (twittering-icon-path url))))
+      (unless (file-exists-p file)
+	(url-retrieve
+	 url `(lambda (status)
+		(let ((coding-system-for-write 'binary))
+		  (goto-char (point-min))
+		  (search-forward-regexp "^$")
+		  (goto-char (1+ (point)))
+		  (delete-region (point-min) (point))
+		  (write-file ,file))))
+	))))
+
+(defun twittering-retrieve-image-with-wget (image-urls)
+  (dolist (url image-urls)
+    (let ((file (concat twittering-tmp-dir "/" (twittering-icon-path url))))
+      (unless (file-exists-p file)
+	(let ((proc
+	       (funcall
+		#'start-process
+		"wget-images"
+		(twittering-wget-buffer)
+		"wget"
+		"--quiet"
+		(format "--directory-prefix=%s" twittering-tmp-dir)
+		"-O" file
+		url)))
+	  (set-process-sentinel
+	   proc
+	   (lambda (proc stat)
+	     (clear-image-cache)
+	     (save-excursion
+	       (set-buffer (twittering-wget-buffer))
+	       ))))))))
 
 (defun twittering-friends-timeline ()
   (interactive)