(shr-save-contents): New command and keystroke.

[gnus] / lisp / shr.el

diff --git a/lisp/shr.el b/lisp/shr.el
index e360eab..98c473c 100644 (file)
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -98,6 +98,7 @@ cid: URL as the argument.")
     (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))
 
@@ -241,8 +242,8 @@ redirects somewhere else."
                  (insert "\n"))
          (put-text-property (1- (point)) (point) 'shr-break t)
          ;; No space is needed at the beginning of a line.
-         (if (eq (following-char) ? )
-             (delete-char 1)))
+         (when (eq (following-char) ? )
+           (delete-char 1)))
        (when (> shr-indentation 0)
          (shr-indent))
        (end-of-line))
@@ -280,6 +281,8 @@ redirects somewhere else."
              (while (and (> count 0)
                          (aref (char-category-set (following-char)) ?>))
                (forward-char 1)))
+           (when (eq (following-char) ? )
+             (forward-char 1))
            t)))))
 
 (defun shr-ensure-newline ()
@@ -321,6 +324,23 @@ redirects somewhere else."
        (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)))