(defgroup shr nil
"Simple HTML Renderer"
+ :version "24.1"
:group 'mail)
(defcustom shr-max-image-proportion 0.9
;; Public functions and commands.
(defun shr-visit-file (file)
+ "Parse FILE as an HTML document, and render it in a new buffer."
(interactive "fHTML file name: ")
(pop-to-buffer "*html*")
(erase-buffer)
;;;###autoload
(defun shr-insert-document (dom)
+ "Render the parsed document DOM into the current buffer.
+DOM should be a parse tree as generated by
+`libxml-parse-html-region' or similar."
(setq shr-content-cache nil)
- (let ((shr-state nil)
+ (let ((start (point))
+ (shr-state nil)
(shr-start nil)
(shr-base nil)
(shr-width (or shr-width (window-width))))
- (shr-descend (shr-transform-dom dom))))
+ (shr-descend (shr-transform-dom dom))
+ (shr-remove-trailing-whitespace start (point))))
+
+(defun shr-remove-trailing-whitespace (start end)
+ (let ((width (window-width)))
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char start)
+ (while (not (eobp))
+ (end-of-line)
+ (when (> (current-column) width)
+ (dolist (overlay (overlays-at (point)))
+ (when (overlay-get overlay 'before-string)
+ (overlay-put overlay 'before-string nil))))
+ (forward-line 1)))))
(defun shr-copy-url ()
"Copy the URL under point to the kill ring.
(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-region-as-kill (point-min) (point-max)))))
+ nil t))
;; Copy the URL to the kill ring.
(t
(with-temp-buffer
(message "Inserting %s..." url)
(url-retrieve url 'shr-image-fetched
(list (current-buffer) (1- (point)) (point-marker))
- t))))
+ t t))))
;;; Utility functions.
((not url)
(message "No link under point"))
((string-match "^mailto:" url)
- (browse-url-mailto url))
+ (browse-url-mail url))
(t
(browse-url url)))))
(if (not url)
(message "No link under point")
(url-retrieve (shr-encode-url url)
- 'shr-store-contents (list url directory)))))
+ 'shr-store-contents (list url directory)
+ nil t))))
(defun shr-store-contents (status url directory)
(unless (plist-get status :error)
;; url-cache-extract autoloads url-cache.
(declare-function url-cache-create-filename "url-cache" (url))
(autoload 'mm-disable-multibyte "mm-util")
-(autoload 'browse-url-mailto "browse-url")
+(autoload 'browse-url-mail "browse-url")
(defun shr-get-image-data (url)
"Get image data for URL.
(delete-region (point) end))))
(url-retrieve url 'shr-image-fetched
(list (current-buffer) start end)
- t)))))
+ t t)))))
(defun shr-heading (cont &rest types)
(shr-ensure-paragraph)
(let ((file (url-cache-create-filename (shr-encode-url url))))
(when (file-exists-p file)
(delete-file file))))
- (funcall
- (if (fboundp 'url-queue-retrieve)
- 'url-queue-retrieve
- 'url-retrieve)
+ (url-queue-retrieve
(shr-encode-url url) 'shr-image-fetched
(list (current-buffer) start (set-marker (make-marker) (1- (point))))
- t)))
+ t t)))
(when (zerop shr-table-depth) ;; We are not in a table.
(put-text-property start (point) 'keymap shr-map)
(put-text-property start (point) 'shr-alt alt)