-(defun shr-copy-url ()
- "Copy the URL under point to the kill ring.
-If called twice, then try to fetch the URL and see whether it
-redirects somewhere else."
- (interactive)
- (let ((url (get-text-property (point) 'shr-url)))
- (cond
- ((not url)
- (message "No URL under point"))
- ;; Resolve redirected URLs.
- ((equal url (car kill-ring))
- (url-retrieve
- url
- (lambda (a)
- (when (and (consp a)
- (eq (car a) :redirect))
- (with-temp-buffer
- (insert (cadr a))
- (goto-char (point-min))
- ;; Remove common tracking junk from the URL.
- (when (re-search-forward ".utm_.*" nil t)
- (replace-match "" t t))
- (message "Copied %s" (buffer-string))
- (copy-region-as-kill (point-min) (point-max)))))))
- ;; Copy the URL to the kill ring.
- (t
- (with-temp-buffer
- (insert url)
- (copy-region-as-kill (point-min) (point-max))
- (message "Copied %s" url))))))
-
-(defun shr-tag-img (cont)
- (when (and (> (current-column) 0)
- (not (eq shr-state 'image)))
- (insert "\n"))
- (let ((start (point-marker)))
- (let ((alt (cdr (assq :alt cont)))
- (url (cdr (assq :src cont))))
- (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))))
-
-(defun shr-show-alt-text ()
- "Show the ALT text of the image under point."
- (interactive)
- (let ((text (get-text-property (point) 'shr-alt)))
- (if (not text)
- (message "No image under point")
- (message "%s" text))))
-
-(defun shr-browse-image ()
- "Browse the image under point."
- (interactive)
- (let ((url (get-text-property (point) 'shr-image)))
- (if (not url)
- (message "No image under point")
- (message "Browsing %s..." url)
- (browse-url url))))
-