- (when images
- (gnus-html-schedule-image-fetching (current-buffer) (nreverse images)))))
-
-(defun gnus-html-schedule-image-fetching (buffer images)
- (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, images %s"
- buffer images)
- (let* ((url (caar images))
- (process (start-process
- "images" nil "curl"
- "-s" "--create-dirs"
- "--location"
- "--max-time" "60"
- "-o" (gnus-html-image-id url)
- url)))
- (process-kill-without-query process)
- (set-process-sentinel process 'gnus-html-curl-sentinel)
- (gnus-set-process-plist process (list 'images images
- 'buffer buffer))))
-
-(defun gnus-html-image-id (url)
- (expand-file-name (sha1 url) gnus-html-cache-directory))
-
-(defun gnus-html-curl-sentinel (process event)
- (when (string-match "finished" event)
- (let* ((images (gnus-process-get process 'images))
- (buffer (gnus-process-get process 'buffer))
- (spec (pop images))
- (file (gnus-html-image-id (car spec))))
- (when (and (buffer-live-p buffer)
- ;; If the position of the marker is 1, then that
- ;; means that the text it was in has been deleted;
- ;; i.e., that the user has selected a different
- ;; article before the image arrived.
- (not (= (marker-position (cadr spec)) (point-min))))
- (with-current-buffer buffer
- (let ((inhibit-read-only t)
- (string (buffer-substring (cadr spec) (caddr spec))))
- (delete-region (cadr spec) (caddr spec))
- (gnus-html-put-image file (cadr spec) string))))
- (when images
- (gnus-html-schedule-image-fetching buffer images)))))
-
-(defun gnus-html-put-image (file point string)
- (when (display-graphic-p)
- (let ((image (ignore-errors
- (gnus-create-image file))))
- (save-excursion
- (goto-char point)
- (if (and image
- ;; Kludge to avoid displaying 30x30 gif images, which
- ;; seems to be a signal of a broken image.
- (not (and (listp image)
- (eq (plist-get (cdr image) :type) 'gif)
- (= (car (image-size image t)) 30)
- (= (cdr (image-size image t)) 30))))
- (progn
- (gnus-put-image (gnus-html-rescale-image image)
- (gnus-string-or string "*"))
- t)
- (insert string)
- (when (fboundp 'find-image)
- (gnus-put-image (find-image
- '((:type xpm :file "lock-broken.xpm")))
- (gnus-string-or string "*")))
- nil)))))
-
-(defun gnus-html-rescale-image (image)
+ (mm-url-decode-entities)))
+
+(defun gnus-html-insert-image ()
+ "Fetch and insert the image under point."
+ (interactive)
+ (apply 'gnus-html-display-image (get-text-property (point) 'gnus-image)))
+
+(defun gnus-html-show-alt-text ()
+ "Show the ALT text of the image under point."
+ (interactive)
+ (message "%s" (get-text-property (point) 'gnus-alt-text)))
+
+(defun gnus-html-browse-image ()
+ "Browse the image under point."
+ (interactive)
+ (browse-url (get-text-property (point) 'gnus-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))))
+
+(defun gnus-html-schedule-image-fetching (buffer image)
+ "Retrieve IMAGE, and place it into BUFFER on arrival."
+ (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, image %s"
+ buffer image)
+ (let ((args (list (car image)
+ 'gnus-html-image-fetched
+ (list buffer image))))
+ (when (> (length (help-function-arglist 'url-retrieve)) 4)
+ (setq args (nconc args (list t))))
+ (apply #'url-retrieve args)))
+
+(defun gnus-html-image-fetched (status buffer image)
+ "Callback function called when image has been fetched."
+ (unless (plist-get status :error)
+ (when gnus-html-image-automatic-caching
+ (url-store-in-cache (current-buffer)))
+ (when (and (or (search-forward "\n\n" nil t)
+ (search-forward "\r\n\r\n" nil t))
+ (buffer-live-p buffer))
+ (let ((data (buffer-substring (point) (point-max))))
+ (with-current-buffer buffer
+ (let ((inhibit-read-only t))
+ (gnus-html-put-image data (car image) (cadr image)))))))
+ (kill-buffer (current-buffer)))
+
+(defun gnus-html-get-image-data (url)
+ "Get image data for URL.
+Return a string with image data."
+ (with-temp-buffer
+ (mm-disable-multibyte)
+ (url-cache-extract (url-cache-create-filename url))
+ (when (or (search-forward "\n\n" nil t)
+ (search-forward "\r\n\r\n" nil t))
+ (buffer-substring (point) (point-max)))))
+
+(defun gnus-html-put-image (data url &optional alt-text)
+ (when (gnus-graphic-display-p)
+ (let* ((start (text-property-any (point-min) (point-max)
+ 'gnus-image-url url))
+ (end (when start
+ (next-single-property-change start 'gnus-image-url))))
+ ;; Image found?
+ (when start
+ (let* ((image
+ (ignore-errors
+ (gnus-create-image data nil t)))
+ (size (and image
+ (if (featurep 'xemacs)
+ (cons (glyph-width image) (glyph-height image))
+ (image-size image t)))))
+ (save-excursion
+ (goto-char start)
+ (let ((alt-text (or alt-text
+ (buffer-substring-no-properties start end))))
+ (if (and image
+ ;; Kludge to avoid displaying 30x30 gif images, which
+ ;; seems to be a signal of a broken image.
+ (not (and (if (featurep 'xemacs)
+ (glyphp image)
+ (listp image))
+ (eq (if (featurep 'xemacs)
+ (let ((d (cdadar
+ (specifier-spec-list
+ (glyph-image image)))))
+ (and (vectorp d)
+ (aref d 0)))
+ (plist-get (cdr image) :type))
+ 'gif)
+ (= (car size) 30)
+ (= (cdr size) 30))))
+ ;; Good image, add it!
+ (let ((image (gnus-html-rescale-image image data size)))
+ (delete-region start end)
+ (gnus-put-image image alt-text 'external)
+ (gnus-put-text-property start (point) 'help-echo alt-text)
+ (gnus-overlay-put
+ (gnus-make-overlay start (point)) 'local-map
+ gnus-html-displayed-image-map)
+ (gnus-put-text-property start (point)
+ 'gnus-alt-text alt-text)
+ (when url
+ (gnus-put-text-property start (point)
+ 'gnus-image-url url))
+ (gnus-add-image 'external image)
+ t)
+ ;; Bad image, try to show something else
+ (when (fboundp 'find-image)
+ (delete-region start end)
+ (setq image (find-image
+ '((:type xpm :file "lock-broken.xpm"))))
+ (gnus-put-image image alt-text 'internal)
+ (gnus-add-image 'internal image))
+ nil))))))))
+
+(defun gnus-html-rescale-image (image data size)