diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index f543920..e87cdcb 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -1690,6 +1690,7 @@ If RECURSIVE, search recursively." (start end &optional base-url)) (declare-function shr-insert-document "shr" (dom)) (defvar shr-blocked-images) +(defvar shr-original-content) (defvar gnus-inhibit-images) (autoload 'gnus-blocked-images "gnus-art") @@ -1717,15 +1718,16 @@ If RECURSIVE, search recursively." (narrow-to-region (point) (point)) (shr-insert-document (mm-with-part handle - (insert (prog1 - (if (and charset - (setq charset - (mm-charset-to-coding-system charset)) - (not (eq charset 'ascii))) - (mm-decode-coding-string (buffer-string) charset) - (mm-string-as-multibyte (buffer-string))) - (erase-buffer) - (mm-enable-multibyte))) + (insert (setq shr-original-content + (prog1 + (if (and charset + (setq charset + (mm-charset-to-coding-system charset)) + (not (eq charset 'ascii))) + (mm-decode-coding-string (buffer-string) charset) + (mm-string-as-multibyte (buffer-string))) + (erase-buffer) + (mm-enable-multibyte)))) (goto-char (point-min)) (setq case-fold-search t) (while (re-search-forward diff --git a/lisp/shr.el b/lisp/shr.el index 401ac1a..6a5ca33 100644 --- a/lisp/shr.el +++ b/lisp/shr.el @@ -87,6 +87,10 @@ used." This is used for cid: URLs, and the function is called with the cid: URL as the argument.") +(defvar shr-original-content nil + "When set, this is the original HTML content we are rendering") +(make-variable-buffer-local 'shr-original-content) + ;;; Internal variables. (defvar shr-folding-mode nil) @@ -110,10 +114,27 @@ cid: URL as the argument.") (define-key map "v" 'shr-browse-url) (define-key map "o" 'shr-save-contents) (define-key map "\r" 'shr-browse-url) + (define-key map "\C-c\C-ss" 'shr-show-source) + (define-key map "\C-c\C-s?" 'shr-show-mini-help) + (define-key map "\C-c\C-si" 'shr-insert-images) + (define-key map "\C-c\C-sI" 'shr-hide-images) + (define-key map "\C-c\C-sc" 'shr-copy-url) map)) ;; Public functions and commands. +(defun shr-show-source () + "Show original source. +TODO: pop up a help-mode buffer." + (interactive) + shr-original-content) + +(defun shr-show-mini-help () + "Describe shr mode commands briefly." + (interactive) + (gnus-message 6 "%s" (substitute-command-keys "\\\\[shr-show-source]:Show source \\[shr-insert-images]:Insert all images \\[shr-hide-images]:Hide all images \\[shr-copy-url]:Copy URL \\[shr-show-mini-help]:This help"))) + + (defun shr-visit-file (file) (interactive "fHTML file name: ") (pop-to-buffer "*html*") @@ -191,6 +212,28 @@ redirects somewhere else." (list (current-buffer) (1- (point)) (point-marker)) t)))) +(defun shr-hide-images () + "Hide all the images in the buffer. +TODO: make it work." + (interactive) + (remove-images (point-min) (point-max))) + +(defun shr-insert-images () + "Insert all the unique images into the buffer." + (interactive) + (let (urls) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let ((url (get-text-property (point) 'image-url))) + (when (and url (not (member url urls))) + (add-to-list 'urls url) + (message "Inserting %s..." url) + (url-retrieve url 'shr-image-fetched + (list (current-buffer) (1- (point)) (point-marker)) + t)) + (forward-word)))))) + ;;; Utility functions. (defun shr-transform-dom (dom)