Function: gnus-html-wash-images

gnus-html-wash-images is a byte-compiled function defined in gnus-html.el.gz.

Signature

(gnus-html-wash-images)

Documentation

Run through current buffer and replace img tags by images.

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-html.el.gz
(defun gnus-html-wash-images ()
  "Run through current buffer and replace img tags by images."
  (let ( parameters start end ;; tag string images
	 inhibit-images blocked-images)
    (if (buffer-live-p gnus-summary-buffer)
	(with-current-buffer gnus-summary-buffer
	  (setq inhibit-images gnus-inhibit-images
		blocked-images (gnus-blocked-images)))
      (setq inhibit-images gnus-inhibit-images
	    blocked-images (gnus-blocked-images)))
    (goto-char (point-min))
    ;; Search for all the images first.
    (while (re-search-forward "<img_alt \\([^>]*\\)>" nil t)
      (setq parameters (match-string 1)
	    start (match-beginning 0))
      (delete-region start (point))
      (when (search-forward "</img_alt>" (line-end-position) t)
	(delete-region (match-beginning 0) (match-end 0)))
      (setq end (point))
      (when (string-match "src=\"\\([^\"]+\\)" parameters)
	(let ((url (gnus-html-encode-url (match-string 1 parameters)))
	      (alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)"
					    parameters)
			  (xml-substitute-special (match-string 2 parameters)))))
	  (gnus-message 8 "gnus-html-wash-tags: fetching image URL %s" url)
	  (add-text-properties
	   start end
	   (list 'image-url url
		 'image-displayer (lambda (url start end)
				    (gnus-html-display-image url start end
							     alt-text))
		 'help-echo alt-text
		 'button t
		 'keymap gnus-html-image-map
		 'gnus-image (list url start end alt-text)))
	  (if (string-match "\\`cid:" url)
	      ;; 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 (substring url (match-end 0))))
		     (image (when (and handle
				       (not inhibit-images))
			      (gnus-create-image
			       (mm-with-part handle (buffer-string))
			       nil t))))
		(if image
		    (gnus-add-image
		     'cid
		     (gnus-put-image
		      (gnus-rescale-image
		       image (gnus-html-maximum-image-size))
		      (gnus-string-or (prog1
					  (buffer-substring start end)
					(delete-region start end))
				      "*")
		      'cid))
		  (make-text-button start end
				    'help-echo url
				    'keymap gnus-html-image-map)))
	    ;; Normal, external URL.
	    (if (or inhibit-images
		    (gnus-html-image-url-blocked-p url blocked-images))
		(make-text-button start end
				  'help-echo url
				  'keymap gnus-html-image-map)
	      ;; Non-blocked url
	      (let ((width
		     (when (string-match "width=\"?\\([0-9]+\\)" parameters)
		       (string-to-number (match-string 1 parameters))))
		    (height
		     (when (string-match "height=\"?\\([0-9]+\\)" parameters)
		       (string-to-number (match-string 1 parameters)))))
		;; Don't fetch images that are really small.  They're
		;; probably tracking pictures.
		(when (and (or (null height)
			       (> height 4))
			   (or (null width)
			       (> width 4)))
		  (gnus-html-display-image url start end alt-text))))))))))