changeset 111058:ea17726e9043

shr.el (shr-save-contents): New command and keystroke.
author Katsumi Yamaoka <yamaoka@jpl.org>
date Wed, 20 Oct 2010 00:02:35 +0000
parents 097fe1170a9a
children 938faaa83cf1
files lisp/gnus/ChangeLog lisp/gnus/shr.el
diffstat 2 files changed, 19 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog	Tue Oct 19 23:26:28 2010 +0000
+++ b/lisp/gnus/ChangeLog	Wed Oct 20 00:02:35 2010 +0000
@@ -2,6 +2,7 @@
 
 	* shr.el (shr-find-fill-point): Don't leave blanks at the start of some
 	lines.
+	(shr-save-contents): New command and keystroke.
 
 	* nndoc.el (nndoc-type-alist): Add git support.
 	(nndoc-git-type-p): New function.
--- a/lisp/gnus/shr.el	Tue Oct 19 23:26:28 2010 +0000
+++ b/lisp/gnus/shr.el	Wed Oct 20 00:02:35 2010 +0000
@@ -98,6 +98,7 @@
     (define-key map "I" 'shr-insert-image)
     (define-key map "u" 'shr-copy-url)
     (define-key map "v" 'shr-browse-url)
+    (define-key map "o" 'shr-save-contents)
     (define-key map "\r" 'shr-browse-url)
     map))
 
@@ -323,6 +324,23 @@
 	(message "No link under point")
       (browse-url url))))
 
+(defun shr-save-contents (directory)
+  "Save the contents from URL in a file."
+  (interactive "DSave contents of URL to directory: ")
+  (let ((url (get-text-property (point) 'shr-url)))
+    (if (not url)
+	(message "No link under point")
+      (url-retrieve (shr-encode-url url)
+		    'shr-store-contents (list url directory)))))
+
+(defun shr-store-contents (status url directory)
+  (unless (plist-get status :error)
+    (when (or (search-forward "\n\n" nil t)
+	      (search-forward "\r\n\r\n" nil t))
+      (write-region (point) (point-max)
+		    (expand-file-name (file-name-nondirectory url)
+				      directory)))))
+
 (defun shr-image-fetched (status buffer start end)
   (when (and (buffer-name buffer)
 	     (not (plist-get status :error)))