Re: shr-map keymap issues

[Ted Zlatanov <tzz@lifelogs.com>]

[-- Attachment #1: Type: text/plain, Size: 1003 bytes --]

On Fri, 15 Apr 2011 13:58:58 -0500 Ted Zlatanov <tzz@lifelogs.com> wrote: 

TZ> 1) `c' should copy the URL, like Info does
TZ> 2) `i' and `I' are OK, but we should also have a way to hide images and
TZ> to copy their URL.  It would be nice to also provide "insert all images"
TZ> and "hide all images".

TZ> 3) `h' should show the source HTML in a temporary popup buffer, using
TZ> html-helper-mode.  Ideally the cursor should be placed on the element
TZ> you were browsing in the shr buffer.

TZ> 4) `?' should show a help message (I know about `C-h m', this would be short).

TZ> 5) `+' and `-' should expand and collaps the current element.

TZ> I think there's a lot more shr.el could use from emacs-w3m, but these
TZ> are the things I'd really like.  I can probably implement some of them.

Lars, I implemented a few of these.  Please see the attached patch and
see if you can add it (and fix the two TODO items).  I don't know shr.el
well so please tell me if I did something stupid.

Thanks
Ted


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: shr-keys.patch --]
[-- Type: text/x-diff, Size: 3912 bytes --]

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-map>\\[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)