- (widget-convert-button
- 'link (or shr-start start) (point)
- :help-echo url)
- (put-text-property (or shr-start start) (point) 'keymap shr-map)
- (put-text-property (or shr-start start) (point) 'shr-url url)))
-
-(defun shr-tag-img (cont)
- (when (and (> (current-column) 0)
- (not (eq shr-state 'image)))
- (insert "\n"))
- (let ((alt (cdr (assq :alt cont)))
- (url (cdr (assq :src cont)))
- (align (cdr (assq :align cont))))
- (cond ((string= align "right")
- (insert
- (make-string (- fill-column (- (point) (line-beginning-position))) ? )))
- ((string= align "center")
- (insert
- (make-string (- (/ fill-column 2) (- (point) (line-beginning-position))) ? ))))
- (let ((start (point-marker)))
- (when (zerop (length alt))
- (setq alt "[img]"))
- (cond
- ((and (not shr-inhibit-images)
- (string-match "\\`cid:" url))
- (let ((url (substring url (match-end 0)))
- image)
- (if (or (not shr-content-function)
- (not (setq image (funcall shr-content-function url))))
- (insert alt)
- (shr-put-image image (point) alt))))
- ((or shr-inhibit-images
- (and shr-blocked-images
- (string-match shr-blocked-images url)))
- (setq shr-start (point))
- (let ((shr-state 'space))
- (if (> (length alt) 8)
- (shr-insert (substring alt 0 8))
- (shr-insert alt))))
- ((url-is-cached (browse-url-url-encode-chars url "[&)$ ]"))
- (shr-put-image (shr-get-image-data url) (point) alt))
- (t
- (insert alt)
- (ignore-errors
- (url-retrieve url 'shr-image-fetched
- (list (current-buffer) start (point-marker))
- t))))
- (insert " ")
- (put-text-property start (point) 'keymap shr-map)
- (put-text-property start (point) 'shr-alt alt)
- (put-text-property start (point) 'shr-image url)
- (setq shr-state 'image))))
+ (shr-urlify (or shr-start start) url)))
+
+(defun shr-tag-object (cont)
+ (let ((start (point))
+ url)
+ (dolist (elem cont)
+ (when (eq (car elem) 'embed)
+ (setq url (or url (cdr (assq :src (cdr elem))))))
+ (when (and (eq (car elem) 'param)
+ (equal (cdr (assq :name (cdr elem))) "movie"))
+ (setq url (or url (cdr (assq :value (cdr elem)))))))
+ (when url
+ (shr-insert " [multimedia] ")
+ (shr-urlify start url))
+ (shr-generic cont)))
+
+(defun shr-tag-video (cont)
+ (let ((image (cdr (assq :poster cont)))
+ (url (cdr (assq :src cont)))
+ (start (point)))
+ (shr-tag-img nil image)
+ (shr-urlify start url)))
+
+(defun shr-tag-img (cont &optional url)
+ (when (or url
+ (and cont
+ (cdr (assq :src cont))))
+ (when (and (> (current-column) 0)
+ (not (eq shr-state 'image)))
+ (insert "\n"))
+ (let ((alt (cdr (assq :alt cont)))
+ (url (or url (cdr (assq :src cont)))))
+ (let ((start (point-marker)))
+ (when (zerop (length alt))
+ (setq alt "*"))
+ (cond
+ ((or (member (cdr (assq :height cont)) '("0" "1"))
+ (member (cdr (assq :width cont)) '("0" "1")))
+ ;; Ignore zero-sized or single-pixel images.
+ )
+ ((and (not shr-inhibit-images)
+ (string-match "\\`cid:" url))
+ (let ((url (substring url (match-end 0)))
+ image)
+ (if (or (not shr-content-function)
+ (not (setq image (funcall shr-content-function url))))
+ (insert alt)
+ (shr-put-image image alt))))
+ ((or shr-inhibit-images
+ (and shr-blocked-images
+ (string-match shr-blocked-images url)))
+ (setq shr-start (point))
+ (let ((shr-state 'space))
+ (if (> (string-width alt) 8)
+ (shr-insert (truncate-string-to-width alt 8))
+ (shr-insert alt))))
+ ((url-is-cached (shr-encode-url url))
+ (shr-put-image (shr-get-image-data url) alt))
+ (t
+ (insert alt)
+ (ignore-errors
+ (url-retrieve (shr-encode-url url) 'shr-image-fetched
+ (list (current-buffer) start (point-marker))
+ t))))
+ (put-text-property start (point) 'keymap shr-map)
+ (put-text-property start (point) 'shr-alt alt)
+ (put-text-property start (point) 'image-url url)
+ (put-text-property start (point) 'image-displayer
+ (shr-image-displayer shr-content-function))
+ (put-text-property start (point) 'help-echo alt)
+ (setq shr-state 'image)))))