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 7ceaac31e7..b9c1d735f2 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 fc0e413248..fc6f591e0c 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 d3b9a362a0..2d0c9107fd 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)