lisp/gnus/{eww,shr}.el: Merge changes made in Gnus master

lisp/gnus/eww.el (eww-tag-select): Don't render totally empty <select> forms.
(eww-convert-widgets): Don't bug out if the first widget starts at the beginning of the buffer.
(eww-convert-widgets): Fix last patch.

lisp/gnus/shr.el (shr-insert-table): Respect border-collapse: collapse.
(shr-tag-base): Protect against base specs that are degenerate.
(shr-ensure-paragraph): Don't delete empty lines that have text properties, because these may be input fields.

lisp/gnus/eww.el (eww-convert-widgets): Put `help-echo' on input fields so that we can navigate to them.

lisp/gnus/shr.el (shr-colorize-region): Put the colours over the entire region.
(shr-inhibit-decoration): New variable.
(shr-add-font): Use it to inhibit text property decorations while doing preliminary table renderings.  This speeds up typical Wikipedia page renderings by 15%.
(shr-tag-span): Don't respect the <title>, because that overwrites the help-echo from links inside the spans.
(shr-next-link): Use `help-echo' for navigation, so that we can navigate to form elements, too.

lisp/gnus/eww.el (eww-button): New face.
(eww-convert-widgets): Use it to make submit buttons more button-like.

3 files changed, 142 insertions, 73 deletions

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 7ceaac31e7e..b9c1d735f2d 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,5 +1,31 @@
 2013-06-17  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
+        * eww.el (eww-tag-select): Don't render totally empty <select> forms.
+        (eww-convert-widgets): Don't bug out if the first widget starts at the
+        beginning of the buffer.
+        (eww-convert-widgets): Fix last patch.
+
+        * shr.el (shr-insert-table): Respect border-collapse: collapse.
+        (shr-tag-base): Protect against base specs that are degenerate.
+        (shr-ensure-paragraph): Don't delete empty lines that have text
+        properties, because these may be input fields.
+
+        * eww.el (eww-convert-widgets): Put `help-echo' on input fields so that
+        we can navigate to them.
+
+        * shr.el (shr-colorize-region): Put the colours over the entire region.
+        (shr-inhibit-decoration): New variable.
+        (shr-add-font): Use it to inhibit text property decorations while doing
+        preliminary table renderings.  This speeds up typical Wikipedia page
+        renderings by 15%.
+        (shr-tag-span): Don't respect the <title>, because that overwrites the
+        help-echo from links inside the spans.
+        (shr-next-link): Use `help-echo' for navigation, so that we can
+        navigate to form elements, too.
+
+        * eww.el (eww-button): New face.
+        (eww-convert-widgets): Use it to make submit buttons more button-like.
+
         * mm-decode.el (mm-convert-shr-links): Override the shr local map, so
         that Gnus commands work.
 
diff --git a/lisp/gnus/eww.el b/lisp/gnus/eww.el
index fc0e413248a..fc6f591e0ce 100644
--- a/lisp/gnus/eww.el
+++ b/lisp/gnus/eww.el
@@ -43,6 +43,14 @@
   :group 'eww
   :type 'string)
 
+(defface eww-button
+  '((((type x w32 ns) (class color))    ; Like default mode line
+     :box (:line-width 2 :style released-button)
+     :background "lightgrey" :foreground "black"))
+  "Face for eww buffer buttons."
+  :version "24.4"
+  :group 'eww)
+
 (defvar eww-current-url nil)
 (defvar eww-current-title ""
   "Title of current page.")
@@ -268,34 +276,39 @@
   (let* ((start (point))
          (type (downcase (or (cdr (assq :type cont))
                              "text")))
+         (value (cdr (assq :value cont)))
          (widget
           (cond
            ((equal type "submit")
             (list 'push-button
                   :notify 'eww-submit
                   :name (cdr (assq :name cont))
-                  :value (cdr (assq :value cont))
+                  :value (if (zerop (length value))
+                             "Submit"
+                           value)
                   :eww-form eww-form
-                  (or (cdr (assq :value cont)) "Submit")))
+                  (or (if (zerop (length value))
+                          "Submit"
+                        value))))
            ((or (equal type "radio")
                 (equal type "checkbox"))
             (list 'checkbox
                   :notify 'eww-click-radio
                   :name (cdr (assq :name cont))
-                  :checkbox-value (cdr (assq :value cont))
+                  :checkbox-value value
                   :checkbox-type type
                   :eww-form eww-form
                   (cdr (assq :checked cont))))
            ((equal type "hidden")
             (list 'hidden
                   :name (cdr (assq :name cont))
-                  :value (cdr (assq :value cont))))
+                  :value value))
            (t
             (list 'editable-field
                   :size (string-to-number
                          (or (cdr (assq :size cont))
                              "40"))
-                  :value (or (cdr (assq :value cont)) "")
+                  :value (or value "")
                   :secret (and (equal type "password") ?*)
                   :action 'eww-submit
                   :name (cdr (assq :name cont))
@@ -303,7 +316,8 @@
     (nconc eww-form (list widget))
     (unless (eq (car widget) 'hidden)
       (apply 'widget-create widget)
-      (put-text-property start (point) 'eww-widget widget))))
+      (put-text-property start (point) 'eww-widget widget)
+      (insert " "))))
 
 (defun eww-tag-textarea (cont)
   (let* ((start (point))
@@ -336,13 +350,14 @@
                     :value (cdr (assq :value (cdr elem)))
                     :tag (cdr (assq 'text (cdr elem))))
               options)))
-    ;; If we have no selected values, default to the first value.
-    (unless (plist-get (cdr menu) :value)
-      (nconc menu (list :value (nth 2 (car options)))))
-    (nconc menu options)
-    (apply 'widget-create menu)
-    (put-text-property start (point) 'eww-widget menu)
-    (shr-ensure-paragraph)))
+    (when options
+      ;; If we have no selected values, default to the first value.
+      (unless (plist-get (cdr menu) :value)
+        (nconc menu (list :value (nth 2 (car options)))))
+      (nconc menu options)
+      (apply 'widget-create menu)
+      (put-text-property start (point) 'eww-widget menu)
+      (shr-ensure-paragraph))))
 
 (defun eww-click-radio (widget &rest ignore)
   (let ((form (plist-get (cdr widget) :eww-form))
@@ -434,7 +449,9 @@
     ;; so we need to nix out the list of widgets and recreate them.
     (setq widget-field-list nil
           widget-field-new nil)
-    (while (setq start (next-single-property-change start 'eww-widget))
+    (while (setq start (if (get-text-property start 'eww-widget)
+                           start
+                         (next-single-property-change start 'eww-widget)))
       (setq widget (get-text-property start 'eww-widget))
       (goto-char start)
       (let ((end (next-single-property-change start 'eww-widget)))
@@ -445,7 +462,13 @@
         (delete-region start end))
       (when (and widget
                  (not (eq (car widget) 'hidden)))
-        (apply 'widget-create widget)))
+        (apply 'widget-create widget)
+        (put-text-property start (point) 'help-echo
+                           (if (memq (car widget) '(text editable-field))
+                               "Input field"
+                             "Button"))
+        (when (eq (car widget) 'push-button)
+          (add-face-text-property start (point) 'eww-button t))))
     (widget-setup)
     (eww-fix-widget-keymap)))
 
diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el
index d3b9a362a0b..2d0c9107fd6 100644
--- a/lisp/gnus/shr.el
+++ b/lisp/gnus/shr.el
@@ -125,6 +125,7 @@ cid: URL as the argument.")
 (defvar shr-ignore-cache nil)
 (defvar shr-external-rendering-functions nil)
 (defvar shr-target-id nil)
+(defvar shr-inhibit-decoration nil)
 
 (defvar shr-map
   (let ((map (make-sparse-keymap)))
@@ -222,9 +223,9 @@ redirects somewhere else."
 (defun shr-next-link ()
   "Skip to the next link."
   (interactive)
-  (let ((skip (text-property-any (point) (point-max) 'shr-url nil)))
+  (let ((skip (text-property-any (point) (point-max) 'help-echo nil)))
     (if (not (setq skip (text-property-not-all skip (point-max)
-                                               'shr-url nil)))
+                                               'help-echo nil)))
         (message "No next link")
       (goto-char skip)
       (message "%s" (get-text-property (point) 'help-echo)))))
@@ -236,11 +237,11 @@ redirects somewhere else."
         (found nil))
     ;; Skip past the current link.
     (while (and (not (bobp))
-                (get-text-property (point) 'shr-url))
+                (get-text-property (point) 'help-echo))
       (forward-char -1))
     ;; Find the previous link.
     (while (and (not (bobp))
-                (not (setq found (get-text-property (point) 'shr-url))))
+                (not (setq found (get-text-property (point) 'help-echo))))
       (forward-char -1))
     (if (not found)
         (progn
@@ -248,7 +249,7 @@ redirects somewhere else."
           (goto-char start))
       ;; Put point at the start of the link.
       (while (and (not (bobp))
-                  (get-text-property (point) 'shr-url))
+                  (get-text-property (point) 'help-echo))
         (forward-char -1))
       (forward-char 1)
       (message "%s" (get-text-property (point) 'help-echo)))))
@@ -349,7 +350,7 @@ size, and full-buffer size."
         (shr-stylesheet shr-stylesheet)
         (start (point)))
     (when style
-      (if (string-match "color\\|display" style)
+      (if (string-match "color\\|display\\|border-collapse" style)
           (setq shr-stylesheet (nconc (shr-parse-style style)
                                       shr-stylesheet))
         (setq style nil)))
@@ -595,7 +596,14 @@ size, and full-buffer size."
           (insert "\n"))
       (if (save-excursion
             (beginning-of-line)
-            (looking-at " *$"))
+            ;; If the current line is totally blank, and doesn't even
+            ;; have any face properties set, then delete the blank
+            ;; space.
+            (and (looking-at " *$")
+                 (not (get-text-property (point) 'face))
+                 (not (= (next-single-property-change (point) 'face nil
+                                                      (line-end-position))
+                         (line-end-position)))))
           (delete-region (match-beginning 0) (match-end 0))
         (insert "\n\n")))))
 
@@ -613,15 +621,16 @@ size, and full-buffer size."
 ;; blank text at the start of the line, and the newline at the end, to
 ;; avoid ugliness.
 (defun shr-add-font (start end type)
-  (save-excursion
-    (goto-char start)
-    (while (< (point) end)
-      (when (bolp)
-        (skip-chars-forward " "))
-      (add-face-text-property (point) (min (line-end-position) end) type t)
-      (if (< (line-end-position) end)
-          (forward-line 1)
-        (goto-char end)))))
+  (unless shr-inhibit-decoration
+    (save-excursion
+      (goto-char start)
+      (while (< (point) end)
+        (when (bolp)
+          (skip-chars-forward " "))
+        (add-face-text-property (point) (min (line-end-position) end) type t)
+        (if (< (line-end-position) end)
+            (forward-line 1)
+          (goto-char end))))))
 
 (defun shr-browse-url ()
   "Browse the URL under point."
@@ -797,12 +806,13 @@ START, and END.  Note that START and END should be markers."
   (shr-ensure-paragraph))
 
 (defun shr-urlify (start url &optional title)
+  (when (and title (string-match "ctx" title)) (debug))
   (shr-add-font start (point) 'shr-link)
   (add-text-properties
    start (point)
    (list 'shr-url url
-         'local-map shr-map
-         'help-echo (if title (format "%s (%s)" url title) url))))
+         'help-echo (if title (format "%s (%s)" url title) url)
+         'local-map shr-map)))
 
 (defun shr-encode-url (url)
   "Encode URL."
@@ -834,13 +844,18 @@ ones, in case fg and bg are nil."
                (shr-color-visible bg fg)))))))
 
 (defun shr-colorize-region (start end fg &optional bg)
-  (when (or fg bg)
+  (when (and (not shr-inhibit-decoration)
+             (or fg bg))
     (let ((new-colors (shr-color-check fg bg)))
       (when new-colors
         (when fg
-          (shr-add-font start end (list :foreground (cadr new-colors))))
+          (add-face-text-property start end
+                                  (list :foreground (cadr new-colors))
+                                  t))
         (when bg
-          (shr-add-font start end (list :background (car new-colors)))))
+          (add-face-text-property start end
+                                  (list :background (car new-colors))
+                                  t)))
       new-colors)))
 
 (defun shr-expand-newlines (start end color)
@@ -1008,7 +1023,9 @@ ones, in case fg and bg are nil."
       plist)))
 
 (defun shr-tag-base (cont)
-  (setq shr-base (shr-parse-base (cdr (assq :href cont))))
+  (let ((base (cdr (assq :href cont))))
+    (when base
+      (setq shr-base (shr-parse-base base))))
   (shr-generic cont))
 
 (defun shr-tag-a (cont)
@@ -1017,7 +1034,8 @@ ones, in case fg and bg are nil."
         (start (point))
         shr-start)
     (shr-generic cont)
-    (when url
+    (when (and url
+               (not shr-inhibit-decoration))
       (shr-urlify (or shr-start start) (shr-expand-url url) title))))
 
 (defun shr-tag-object (cont)
@@ -1154,11 +1172,7 @@ ones, in case fg and bg are nil."
   (shr-generic cont))
 
 (defun shr-tag-span (cont)
-  (let ((title (cdr (assq :title cont))))
-    (shr-generic cont)
-    (when (and title
-               shr-start)
-      (put-text-property shr-start (point) 'help-echo title))))
+  (shr-generic cont))
 
 (defun shr-tag-h1 (cont)
   (shr-heading cont 'bold 'underline))
@@ -1312,35 +1326,40 @@ ones, in case fg and bg are nil."
     (nreverse result)))
 
 (defun shr-insert-table (table widths)
-  (shr-insert-table-ruler widths)
-  (dolist (row table)
-    (let ((start (point))
-          (height (let ((max 0))
-                    (dolist (column row)
-                      (setq max (max max (cadr column))))
-                    max)))
-      (dotimes (i height)
-        (shr-indent)
-        (insert shr-table-vertical-line "\n"))
-      (dolist (column row)
-        (goto-char start)
-        (let ((lines (nth 2 column)))
-          (dolist (line lines)
-            (end-of-line)
-            (insert line shr-table-vertical-line)
-            (forward-line 1))
-          ;; Add blank lines at padding at the bottom of the TD,
-          ;; possibly.
-          (dotimes (i (- height (length lines)))
-            (end-of-line)
-            (let ((start (point)))
-              (insert (make-string (string-width (car lines)) ? )
-                      shr-table-vertical-line)
-              (when (nth 4 column)
-                (shr-add-font start (1- (point))
-                              (list :background (nth 4 column)))))
-            (forward-line 1)))))
-    (shr-insert-table-ruler widths)))
+  (let* ((collapse (equal (cdr (assq 'border-collapse shr-stylesheet))
+                          "collapse"))
+         (shr-table-vertical-line (if collapse "" shr-table-vertical-line)))
+    (unless collapse
+      (shr-insert-table-ruler widths))
+    (dolist (row table)
+      (let ((start (point))
+            (height (let ((max 0))
+                      (dolist (column row)
+                        (setq max (max max (cadr column))))
+                      max)))
+        (dotimes (i height)
+          (shr-indent)
+          (insert shr-table-vertical-line "\n"))
+        (dolist (column row)
+          (goto-char start)
+          (let ((lines (nth 2 column)))
+            (dolist (line lines)
+              (end-of-line)
+              (insert line shr-table-vertical-line)
+              (forward-line 1))
+            ;; Add blank lines at padding at the bottom of the TD,
+            ;; possibly.
+            (dotimes (i (- height (length lines)))
+              (end-of-line)
+              (let ((start (point)))
+                (insert (make-string (string-width (car lines)) ? )
+                        shr-table-vertical-line)
+                (when (nth 4 column)
+                  (shr-add-font start (1- (point))
+                                (list :background (nth 4 column)))))
+              (forward-line 1)))))
+      (unless collapse
+        (shr-insert-table-ruler widths)))))
 
 (defun shr-insert-table-ruler (widths)
   (when (and (bolp)
@@ -1393,7 +1412,8 @@ ones, in case fg and bg are nil."
         data)))
 
 (defun shr-make-table-1 (cont widths &optional fill)
-  (let ((trs nil))
+  (let ((trs nil)
+        (shr-inhibit-decoration (not fill)))
     (dolist (row cont)
       (when (eq (car row) 'tr)
         (let ((tds nil)