X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-html.el;h=3b615675dabf623304aee83abebd20b746d40c2e;hb=340c8b70fc039577fbff744d6a224177be8436ee;hp=bfbdc41e98ceb2237765da221f00d460737a202f;hpb=a6fe5077e203cb918dfb1b2d82c56b8c56b21101;p=gnus

diff --git a/lisp/gnus-html.el b/lisp/gnus-html.el
index bfbdc41e9..3b615675d 100644
--- a/lisp/gnus-html.el
+++ b/lisp/gnus-html.el
@@ -29,9 +29,10 @@
 ;;; Code:
 
 (eval-when-compile (require 'cl))
-(eval-when-compile (require 'mm-decode))
 
 (require 'gnus-art)
+(eval-when-compile (require 'mm-decode))
+
 (require 'mm-url)
 (require 'url)
 (require 'url-cache)
@@ -57,12 +58,6 @@
   :group 'gnus-art
   :type 'integer)
 
-(defcustom gnus-blocked-images "."
-  "Images that have URLs matching this regexp will be blocked."
-  :version "24.1"
-  :group 'gnus-art
-  :type 'regexp)
-
 (defcustom gnus-max-image-proportion 0.9
   "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
@@ -191,29 +186,28 @@ CHARS is a regexp-like character alternative (e.g., \"[)$]\")."
 	    ;; URLs with cid: have their content stashed in other
 	    ;; parts of the MIME structure, so just insert them
 	    ;; immediately.
-	    (let ((handle (mm-get-content-id
-			   (setq url (match-string 1 url))))
-		  image)
-	      (when handle
-		(mm-with-part handle
-		  (setq image (gnus-create-image (buffer-string)
-						 nil t))))
+	    (let* ((handle (mm-get-content-id
+                            (setq url (match-string 1 url))))
+                   (image (when handle
+                            (gnus-create-image (mm-with-part handle (buffer-string))
+                                               nil t))))
 	      (when image
                 (let ((string (buffer-substring start end)))
                   (delete-region start end)
-                  (gnus-put-image image (gnus-string-or string "*") 'cid)
+                  (gnus-put-image (gnus-rescale-image image (gnus-html-maximum-image-size))
+                                  (gnus-string-or string "*") 'cid)
                   (gnus-add-image 'cid image))))
 	  ;; Normal, external URL.
           (let ((alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)"
                                               parameters)
                             (xml-substitute-special (match-string 2 parameters)))))
-            (gnus-put-text-property start end 'gnus-image-url url)
+            (gnus-put-text-property start end 'image-url url)
             (if (gnus-html-image-url-blocked-p
                  url
                  (if (buffer-live-p gnus-summary-buffer)
                      (with-current-buffer gnus-summary-buffer
-                       gnus-blocked-images)
-                   gnus-blocked-images))
+                       (gnus-blocked-images))
+                   (gnus-blocked-images)))
                 (progn
                   (widget-convert-button
                    'link start end
@@ -350,15 +344,19 @@ Use ALT-TEXT for the image string."
 (defun gnus-html-browse-image ()
   "Browse the image under point."
   (interactive)
-  (browse-url (get-text-property (point) 'gnus-image-url)))
+  (browse-url (get-text-property (point) 'image-url)))
 
 (defun gnus-html-browse-url ()
   "Browse the image under point."
   (interactive)
   (let ((url (get-text-property (point) 'gnus-string)))
-    (if (not url)
-	(message "No URL at point")
-      (browse-url url))))
+    (cond
+     ((not url)
+      (message "No link under point"))
+     ((string-match "^mailto:" url)
+      (gnus-url-mailto url))
+     (t
+      (browse-url url)))))
 
 (defun gnus-html-schedule-image-fetching (buffer image)
   "Retrieve IMAGE, and place it into BUFFER on arrival."
@@ -368,11 +366,12 @@ Use ALT-TEXT for the image string."
 		    'gnus-html-image-fetched
 		    (list buffer image))))
     (when (> (length (if (featurep 'xemacs)
-			 (split-string (function-arglist 'url-retrieve))
+			 (cdr (split-string (function-arglist 'url-retrieve)))
 		       (help-function-arglist 'url-retrieve)))
 	     4)
       (setq args (nconc args (list t))))
-    (apply #'url-retrieve args)))
+    (ignore-errors
+      (apply #'url-retrieve args))))
 
 (defun gnus-html-image-fetched (status buffer image)
   "Callback function called when image has been fetched."
@@ -398,12 +397,27 @@ Return a string with image data."
               (search-forward "\r\n\r\n" nil t))
       (buffer-substring (point) (point-max)))))
 
+(defun gnus-html-maximum-image-size ()
+  "Return the maximum size of an image according to `gnus-max-image-proportion'."
+  (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)))))))
+
 (defun gnus-html-put-image (data url &optional alt-text)
+  "Put an image with DATA from URL and optional ALT-TEXT."
   (when (gnus-graphic-display-p)
     (let* ((start (text-property-any (point-min) (point-max)
-				     'gnus-image-url url))
+				     'image-url url))
            (end (when start
-                  (next-single-property-change start 'gnus-image-url))))
+                  (next-single-property-change start 'image-url))))
       ;; Image found?
       (when start
         (let* ((image
@@ -434,19 +448,7 @@ Return a string with image data."
                                  (= (car size) 30)
                                  (= (cdr size) 30))))
                   ;; Good image, add it!
-                  (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)))))))))
+                  (let ((image (gnus-rescale-image image (gnus-html-maximum-image-size))))
                     (delete-region start end)
                     (gnus-put-image image alt-text 'external)
                     (gnus-put-text-property start (point) 'help-echo alt-text)
@@ -457,7 +459,7 @@ Return a string with image data."
 					    'gnus-alt-text alt-text)
                     (when url
                       (gnus-put-text-property start (point)
-					      'gnus-image-url url))
+					      'image-url url))
                     (gnus-add-image 'external image)
                     t)
                 ;; Bad image, try to show something else
@@ -494,10 +496,11 @@ This only works if the article in question is HTML."
 (defun gnus-html-prefetch-images (summary)
   (when (buffer-live-p summary)
     (let ((blocked-images (with-current-buffer summary
-                            gnus-blocked-images)))
+                            (gnus-blocked-images))))
       (save-match-data
-	(while (re-search-forward "<img[^>]+src=[\"']\\([^\"']+\\)" nil t)
-	  (let ((url (gnus-html-encode-url (match-string 1))))
+	(while (re-search-forward "<img[^>]+src=[\"']\\(http[^\"']+\\)" nil t)
+	  (let ((url (gnus-html-encode-url
+		      (mm-url-decode-entities-string (match-string 1)))))
 	    (unless (gnus-html-image-url-blocked-p url blocked-images)
               (when (gnus-html-cache-expired url gnus-html-image-cache-ttl)
                 (gnus-html-schedule-image-fetching nil