lisp/gnus/eww.el (eww-tag-input): Implement submit buttons

(eww-click-radio): Implement radio and checkboxes
(eww-submit): Handle hidden elements
(eww-submit): Get submit button logic right
lisp/gnus/shr.el (shr-expand-url): Expand URLs that start with a slash correctly

lisp/gnus/ChangeLog

 2013-06-10  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+	* shr.el (shr-expand-url): Expand URLs that start with a slash
+	correctly.
+
+	* eww.el (eww-submit): Get submit button logic right.
+
+	* shr.el (shr-final-table-render): New variable to signal when we're
+	doing the final table rendering so that we can collect more data at
+	that point.
+
 	* eww.el (eww-submit): Make form submission work.
+	(eww-tag-input): Implement submit buttons.
+	(eww-click-radio): Implement radio and checkboxes.
+	(eww-submit): Handle hidden elements.
 	* shr.el (shr-descend): Allow other packages to override (or provide)
 	rendering of elements.

lisp/gnus/eww.el

@@ -118,6 +118,7 @@
   (let ((map (make-sparse-keymap)))
     (suppress-keymap map)
     (define-key map "q" 'eww-quit)
+    (define-key map "g" 'eww-reload)
     (define-key map [tab] 'widget-forward)
     (define-key map [backtab] 'widget-backward)
     (define-key map [delete] 'scroll-down-command)
@@ -158,6 +159,12 @@
   (let ((prev (pop eww-history)))
     (url-retrieve (car prev) 'eww-render (list (car prev) (cadr prev)))))
 
+(defun eww-reload ()
+  "Reload the current page."
+  (interactive)
+  (url-retrieve eww-current-url 'eww-render
+		(list eww-current-url (point))))
+
 ;; Form support.
 
 (defvar eww-form nil)
@@ -174,40 +181,112 @@
 		       'eww-form eww-form)))
 
 (defun eww-tag-input (cont)
-  (let ((start (point))
-	(widget (list
-		 'editable-field
-		 :size (string-to-number
-			(or (cdr (assq :size cont))
-			    "40"))
-		 :value (or (cdr (assq :value cont)) "")
-		 :action 'eww-submit
-		 :name (cdr (assq :name cont))
-		 :eww-form eww-form)))
-    (apply 'widget-create widget)
-    (shr-generic cont)
+  (let* ((start (point))
+	 (type (downcase (or (cdr (assq :type cont))
+			     "text")))
+	 (widget
+	  (cond
+	   ((equal type "submit")
+	    (list
+	     'push-button
+	     :notify 'eww-submit
+	     :name (cdr (assq :name cont))
+	     :eww-form eww-form
+	     (or (cdr (assq :value cont)) "Submit")))
+	   ((or (equal type "radio")
+		(equal type "checkbox"))
+	    (list 'checkbox
+		  :notify 'eww-click-radio
+		  :name (cdr (assq :name cont))
+		  :checkbox-value (cdr (assq :value cont))
+		  :eww-form eww-form
+		  (cdr (assq :checked cont))))
+	   ((equal type "hidden")
+	    (list 'hidden
+		  :name (cdr (assq :name cont))
+		  :value (cdr (assq :value cont))))
+	   (t
+	    (list
+	     'editable-field
+	     :size (string-to-number
+		    (or (cdr (assq :size cont))
+			"40"))
+	     :value (or (cdr (assq :value cont)) "")
+	     :action 'eww-submit
+	     :name (cdr (assq :name cont))
+	     :eww-form eww-form)))))
+    (if (eq (car widget) 'hidden)
+	(when shr-final-table-render
+	  (nconc eww-form (list widget)))
+      (apply 'widget-create widget))
     (put-text-property start (point) 'eww-widget widget)))
 
-(defun eww-submit (widget dummy)
-  (let ((form (getf (cdr widget) :eww-form))
+(defun eww-click-radio (widget &rest ignore)
+  (let ((form (plist-get (cdr widget) :eww-form))
+	(name (plist-get (cdr widget) :name)))
+    (if (widget-value widget)
+	;; Switch all the other radio buttons off.
+	(dolist (overlay (overlays-in (point-min) (point-max)))
+	  (let ((field (plist-get (overlay-properties overlay) 'button)))
+	    (when (and (eq (plist-get (cdr field) :eww-form) form)
+		       (equal name (plist-get (cdr field) :name)))
+	      (unless (eq field widget)
+		(widget-value-set field nil)))))
+      (widget-value-set widget t))
+    (eww-fix-widget-keymap)))
+
+(defun eww-submit (widget &rest ignore)
+  (let ((form (plist-get (cdr widget) :eww-form))
+	(first-button t)
 	values)
-    (dolist (overlay (overlays-in (point-min) (point-max)))
-      (let ((field (getf (overlay-properties overlay) 'field)))
-	(when (eq (getf (cdr field) :eww-form) form)
-	  (let ((name (getf (cdr field) :name)))
+    (dolist (overlay (sort (overlays-in (point-min) (point-max))
+			   (lambda (o1 o2)
+			     (< (overlay-start o1) (overlay-start o2)))))
+      (let ((field (or (plist-get (overlay-properties overlay) 'field)
+		       (plist-get (overlay-properties overlay) 'button)
+		       (plist-get (overlay-properties overlay) 'eww-hidden))))
+	(when (eq (plist-get (cdr field) :eww-form) form)
+	  (let ((name (plist-get (cdr field) :name)))
 	    (when name
-	      (push (cons name (widget-value field))
-		    values))))))
+	      (cond
+	       ((eq (car field) 'checkbox)
+		(when (widget-value field)
+		  (push (cons name (plist-get (cdr field) :checkbox-value))
+			values)))
+	       ((eq (car field) 'eww-hidden)
+		(push (cons name (plist-get (cdr field) :value))
+		      values))
+	       ((eq (car field) 'push-button)
+		;; We want the values from buttons if we hit a button,
+		;; or we're submitting something and this is the first
+		;; button displayed.
+		(when (or (and (eq (car widget) 'push-button)
+			       (eq widget field))
+			  (and (not (eq (car widget) 'push-button))
+			       (eq (car field) 'push-button)
+			       first-button))
+		  (setq first-button nil)
+		  (push (cons name (widget-value field))
+			values)))
+	       (t
+		(push (cons name (widget-value field))
+		      values))))))))
+    (dolist (elem form)
+      (when (and (consp elem)
+		 (eq (car elem) 'hidden))
+	(push (cons (plist-get (cdr elem) :name)
+		    (plist-get (cdr elem) :value))
+	      values)))
     (let ((shr-base eww-current-url))
-      (if (and (stringp (getf form :method))
-	       (equal (downcase (getf form :method)) "post"))
+      (if (and (stringp (plist-get form :method))
+	       (equal (downcase (plist-get form :method)) "post"))
 	  (let ((url-request-method "POST")
 		(url-request-data (mm-url-encode-www-form-urlencoded values)))
-	    (eww-browse-url (shr-expand-url (getf form :action))))
+	    (eww-browse-url (shr-expand-url (plist-get form :action))))
 	(eww-browse-url
 	 (shr-expand-url
 	  (concat
-	   (getf form :action)
+	   (cdr (assq :action form))
 	   "?"
 	   (mm-url-encode-www-form-urlencoded values))))))))
 
@@ -217,10 +296,19 @@
     (while (setq start (next-single-property-change start 'eww-widget))
       (setq widget (get-text-property start 'eww-widget))
       (goto-char start)
-      (delete-region start (next-single-property-change start 'eww-widget))
-      (apply 'widget-create widget)
-      (put-text-property start (point) 'not-read-only t))
-    (widget-setup)))
+      (let ((end (next-single-property-change start 'eww-widget)))
+	(dolist (overlay (overlays-in start end))
+	  (when (plist-get (overlay-properties overlay) 'button)
+	    (delete-overlay overlay)))
+	(delete-region start end))
+      (apply 'widget-create widget))
+    (widget-setup)
+    (eww-fix-widget-keymap)))
+
+(defun eww-fix-widget-keymap ()
+  (dolist (overlay (overlays-in (point-min) (point-max)))
+    (when (plist-get (overlay-properties overlay) 'button)
+      (overlay-put overlay 'local-map widget-keymap))))
 
 (provide 'eww)
 

lisp/gnus/shr.el

@@ -115,6 +115,7 @@ cid: URL as the argument.")
 (defvar shr-base nil)
 (defvar shr-ignore-cache nil)
 (defvar shr-external-rendering-functions nil)
+(defvar shr-final-table-render nil)
 
 (defvar shr-map
   (let ((map (make-sparse-keymap)))
@@ -490,6 +491,7 @@ size, and full-buffer size."
       ;; Absolute URL.
       url
     (let ((base shr-base))
+      ;; Chop off query string.
       (when (string-match "^\\([^?]+\\)[?]" base)
 	(setq base (match-string 1 base)))
       (cond
@@ -499,6 +501,9 @@ size, and full-buffer size."
        ((and (not (string-match "/\\'" base))
 	     (not (string-match "\\`/" url)))
 	(concat base "/" url))
+       ((and (string-match "\\`/" url)
+	     (string-match "\\(\\`[^:]*://[^/]+\\)/" base))
+	(concat (match-string 1 base) url))
        (t
 	(concat base url))))))
 
@@ -1177,7 +1182,8 @@ ones, in case fg and bg are nil."
 	     (frame-width))
       (setq truncate-lines t))
     ;; Then render the table again with these new "hard" widths.
-    (shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths))
+    (let ((shr-final-table-render t))
+      (shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths)))
   ;; Finally, insert all the images after the table.  The Emacs buffer
   ;; model isn't strong enough to allow us to put the images actually
   ;; into the tables.