+(defun shr-get-image-data (url)
+ "Get image data for URL.
+Return a string with image data."
+ (with-temp-buffer
+ (mm-disable-multibyte)
+ (when (ignore-errors
+ (url-cache-extract (url-cache-create-filename (shr-encode-url url)))
+ t)
+ (when (or (search-forward "\n\n" nil t)
+ (search-forward "\r\n\r\n" nil t))
+ (buffer-substring (point) (point-max))))))
+
+(defun shr-heading (cont &rest types)
+ (shr-ensure-paragraph)
+ (apply #'shr-fontize-cont cont types)
+ (shr-ensure-paragraph))
+
+(defun shr-urlify (start url)
+ (widget-convert-button
+ 'url-link start (point)
+ :help-echo url
+ :keymap shr-map
+ url)
+ (put-text-property start (point) 'shr-url url))
+
+(defun shr-encode-url (url)
+ "Encode URL."
+ (browse-url-url-encode-chars url "[)$ ]"))
+
+;;; Tag-specific rendering rules.
+
+(defun shr-tag-p (cont)
+ (shr-ensure-paragraph)
+ (shr-indent)
+ (shr-generic cont)
+ (shr-ensure-paragraph))
+
+(defun shr-tag-div (cont)
+ (shr-ensure-newline)
+ (shr-indent)
+ (shr-generic cont)
+ (shr-ensure-newline))
+
+(defun shr-tag-b (cont)
+ (shr-fontize-cont cont 'bold))
+
+(defun shr-tag-i (cont)
+ (shr-fontize-cont cont 'italic))
+
+(defun shr-tag-em (cont)
+ (shr-fontize-cont cont 'bold))
+
+(defun shr-tag-strong (cont)
+ (shr-fontize-cont cont 'bold))
+
+(defun shr-tag-u (cont)
+ (shr-fontize-cont cont 'underline))
+
+(defun shr-tag-s (cont)
+ (shr-fontize-cont cont 'strike-through))
+
+(defun shr-tag-span (cont)
+ (let ((start (point))
+ (color (cdr (assq 'color (shr-parse-style (cdr (assq :style cont)))))))
+ (shr-generic cont)
+ (when color
+ (let ((overlay (make-overlay start (point))))
+ (overlay-put overlay 'face (cons 'foreground-color color))))))
+
+(defun shr-parse-style (style)
+ (when style
+ (let ((plist nil))
+ (dolist (elem (split-string style ";"))
+ (when elem
+ (setq elem (split-string elem ":"))
+ (when (and (car elem)
+ (cadr elem))
+ (let ((name (replace-regexp-in-string "^ +\\| +$" "" (car elem)))
+ (value (replace-regexp-in-string "^ +\\| +$" "" (cadr elem))))
+ (push (cons (intern name obarray)
+ value)
+ plist)))))
+ plist)))
+
+(defun shr-tag-a (cont)
+ (let ((url (cdr (assq :href cont)))
+ (start (point))
+ shr-start)
+ (shr-generic cont)
+ (shr-urlify (or shr-start start) url)))
+
+(defun shr-tag-object (cont)
+ (let ((url (cdr (assq :src (cdr (assq 'embed cont)))))
+ (start (point)))
+ (when url
+ (shr-insert " [multimedia] ")
+ (shr-urlify start url))))
+
+(defun shr-tag-img (cont)
+ (when (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 (cdr (assq :src cont))))
+ (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 (shr-encode-url url))
+ (shr-put-image (shr-get-image-data url) (point) alt))
+ (t
+ (insert alt)
+ (ignore-errors
+ (url-retrieve (shr-encode-url 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)))))
+