Put all the images after the table.

[gnus] / lisp / shr.el

diff --git a/lisp/shr.el b/lisp/shr.el
index c51bb46..d6eb19e 100644 (file)
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -56,6 +56,7 @@ fit these criteria."
 (defvar shr-state nil)
 (defvar shr-start nil)
 (defvar shr-indentation 0)
+(defvar shr-inhibit-images nil)
 
 (defvar shr-width 70)
 
@@ -64,8 +65,9 @@ fit these criteria."
     (define-key map "a" 'shr-show-alt-text)
     (define-key map "i" 'shr-browse-image)
     (define-key map "I" 'shr-insert-image)
-    (define-key map "u" 'shr-copy-string)
+    (define-key map "u" 'shr-copy-url)
     (define-key map "v" 'shr-browse-url)
+    (define-key map "\r" 'shr-browse-url)
     map))
 
 (defun shr-transform-dom (dom)
@@ -124,6 +126,9 @@ fit these criteria."
 (defun shr-tag-i (cont)
   (shr-fontize-cont cont 'italic))
 
+(defun shr-tag-em (cont)
+  (shr-fontize-cont cont 'bold))
+
 (defun shr-tag-u (cont)
   (shr-fontize-cont cont 'underline))
 
@@ -142,17 +147,53 @@ fit these criteria."
 
 (defun shr-tag-a (cont)
   (let ((url (cdr (assq :href cont)))
+       (start (point))
        shr-start)
     (shr-generic cont)
     (widget-convert-button
-     'link shr-start (point)
-     :action 'shr-browse-url
-     :url url
-     :keymap widget-keymap
-     :help-echo url)))
+     'link (or shr-start start) (point)
+     :help-echo url)
+    (put-text-property (or shr-start start) (point) 'keymap shr-map)
+    (put-text-property (or shr-start start) (point) 'shr-url url)))
 
-(defun shr-browse-url (widget &rest stuff)
-  (browse-url (widget-get widget :url)))
+(defun shr-browse-url ()
+  "Browse the URL under point."
+  (interactive)
+  (let ((url (get-text-property (point) 'shr-url)))
+    (if (not url)
+       (message "No link under point")
+      (browse-url url))))
+
+(defun shr-copy-url ()
+  "Copy the URL under point to the kill ring.
+If called twice, then try to fetch the URL and see whether it
+redirects somewhere else."
+  (interactive)
+  (let ((url (get-text-property (point) 'shr-url)))
+    (cond
+     ((not url)
+      (message "No URL under point"))
+     ;; Resolve redirected URLs.
+     ((equal url (car kill-ring))
+      (url-retrieve
+       url
+       (lambda (a)
+        (when (and (consp a)
+                   (eq (car a) :redirect))
+          (with-temp-buffer
+            (insert (cadr a))
+            (goto-char (point-min))
+            ;; Remove common tracking junk from the URL.
+            (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 the URL to the kill ring.
+     (t
+      (with-temp-buffer
+       (insert url)
+       (copy-region-as-kill (point-min) (point-max))
+       (message "Copied %s" url))))))
 
 (defun shr-tag-img (cont)
   (when (and (> (current-column) 0)
@@ -164,8 +205,10 @@ fit these criteria."
       (when (zerop (length alt))
        (setq alt "[img]"))
       (cond
-       ((and shr-blocked-images
-            (string-match shr-blocked-images url))
+       ((or shr-inhibit-images
+           (and shr-blocked-images
+                (string-match shr-blocked-images url)))
+       (setq shr-start (point))
        (insert alt))
        ((url-is-cached (browse-url-url-encode-chars url "[&)$ ]"))
        (shr-put-image (shr-get-image-data url) (point) alt))
@@ -174,10 +217,10 @@ fit these criteria."
        (url-retrieve url 'shr-image-fetched
                      (list (current-buffer) start (point-marker))
                      t)))
+      (insert " ")
       (put-text-property start (point) 'keymap shr-map)
       (put-text-property start (point) 'shr-alt alt)
       (put-text-property start (point) 'shr-image url)
-      (insert " ")
       (setq shr-state 'image))))
 
 (defun shr-show-alt-text ()
@@ -255,7 +298,8 @@ fit these criteria."
 (defun shr-tag-blockquote (cont)
   (shr-ensure-paragraph)
   (let ((shr-indentation (+ shr-indentation 4)))
-    (shr-generic cont)))
+    (shr-generic cont))
+  (shr-ensure-paragraph))
 
 (defun shr-ensure-newline ()
   (unless (zerop (current-column))
@@ -308,10 +352,12 @@ fit these criteria."
 Return a string with image data."
   (with-temp-buffer
     (mm-disable-multibyte)
-    (url-cache-extract (url-cache-create-filename url))
-    (when (or (search-forward "\n\n" nil t)
-              (search-forward "\r\n\r\n" nil t))
-      (buffer-substring (point) (point-max)))))
+    (when (ignore-errors
+           (url-cache-extract (url-cache-create-filename url))
+           t)
+      (when (or (search-forward "\n\n" nil t)
+               (search-forward "\r\n\r\n" nil t))
+       (buffer-substring (point) (point-max))))))
 
 (defvar shr-list-mode nil)
 
@@ -371,8 +417,20 @@ Return a string with image data."
   (let* ((columns (shr-column-specs cont))
         (suggested-widths (shr-pro-rate-columns columns))
         (sketch (shr-make-table cont suggested-widths))
-        (sketch-widths (shr-table-widths sketch (length suggested-widths))))
-    (shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths)))
+        (sketch-widths (shr-table-widths sketch (length suggested-widths)))
+        (shr-inhibit-images t))
+    (shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths))
+  (dolist (elem (shr-find-elements cont 'img))
+    (shr-tag-img (cdr elem))))
+
+(defun shr-find-elements (cont type)
+  (let (result)
+    (dolist (elem cont)
+      (cond ((eq (car elem) type)
+            (push elem result))
+           ((consp (cdr elem))
+            (setq result (nconc (shr-find-elements (cdr elem) type) result)))))
+    (nreverse result)))
 
 (defun shr-insert-table (table widths)
   (shr-insert-table-ruler widths)
@@ -434,7 +492,8 @@ Return a string with image data."
 
 (defun shr-render-td (cont width fill)
   (with-temp-buffer
-    (let ((shr-width width))
+    (let ((shr-width width)
+         (shr-indentation 0))
       (shr-generic cont))
     (while (re-search-backward "\n *$" nil t)
       (delete-region (match-beginning 0) (match-end 0)))
@@ -448,7 +507,8 @@ Return a string with image data."
        (goto-char (point-min))
        (while (not (eobp))
          (end-of-line)
-         (insert (make-string (- width (current-column)) ? ))
+         (when (> (- width (current-column)) 0)
+           (insert (make-string (- width (current-column)) ? )))
          (forward-line 1)))
       (list max (count-lines (point-min) (point-max)) (buffer-string)))))