+(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)
+
+(defun eww-tag-form (cont)
+ (let ((eww-form
+ (list (assq :method cont)
+ (assq :action cont)))
+ (start (point)))
+ (shr-ensure-paragraph)
+ (shr-generic cont)
+ (unless (bolp)
+ (insert "\n"))
+ (insert "\n")
+ (when (> (point) start)
+ (put-text-property start (1+ start)
+ 'eww-form eww-form))))
+
+(defun eww-tag-input (cont)
+ (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 (if (zerop (length value))
+ "Submit"
+ value)
+ :eww-form eww-form
+ (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 value
+ :checkbox-type type
+ :eww-form eww-form
+ (cdr (assq :checked cont))))
+ ((equal type "hidden")
+ (list 'hidden
+ :name (cdr (assq :name cont))
+ :value value))
+ (t
+ (list 'editable-field
+ :size (string-to-number
+ (or (cdr (assq :size cont))
+ "40"))
+ :value value
+ :secret (and (equal type "password") ?*)
+ :action 'eww-submit
+ :name (cdr (assq :name cont))
+ :eww-form eww-form)))))
+ (nconc eww-form (list widget))
+ (unless (eq (car widget) 'hidden)
+ (apply 'widget-create widget)
+ (put-text-property start (point) 'eww-widget widget)
+ (insert " "))))
+
+(defun eww-tag-textarea (cont)
+ (let* ((start (point))
+ (widget
+ (list 'text
+ :size (string-to-number
+ (or (cdr (assq :cols cont))
+ "40"))
+ :value (or (cdr (assq 'text cont)) "")
+ :action 'eww-submit
+ :name (cdr (assq :name cont))
+ :eww-form eww-form)))
+ (nconc eww-form (list widget))
+ (apply 'widget-create widget)
+ (put-text-property start (point) 'eww-widget widget)))
+
+(defun eww-tag-select (cont)
+ (shr-ensure-paragraph)
+ (let ((menu (list 'menu-choice
+ :name (cdr (assq :name cont))
+ :eww-form eww-form))
+ (options nil)
+ (start (point)))
+ (dolist (elem cont)
+ (when (eq (car elem) 'option)
+ (when (cdr (assq :selected (cdr elem)))
+ (nconc menu (list :value
+ (cdr (assq :value (cdr elem))))))
+ (push (list 'item
+ :value (cdr (assq :value (cdr elem)))
+ :tag (cdr (assq 'text (cdr elem))))
+ options)))
+ (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))
+ (name (plist-get (cdr widget) :name)))
+ (when (equal (plist-get (cdr widget) :type) "radio")
+ (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))
+ values)
+ (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))))
+ (when (eq (plist-get (cdr field) :eww-form) form)
+ (let ((name (plist-get (cdr field) :name)))
+ (when name
+ (cond
+ ((eq (car field) 'checkbox)
+ (when (widget-value field)
+ (push (cons name (plist-get (cdr field) :checkbox-value))
+ values)))
+ ((eq (car field) 'push-button)
+ ;; We want the values from buttons if we hit a button,
+ ;; if it's the first button in the DOM after the field
+ ;; hit ENTER on.
+ (when (and (eq (car widget) 'push-button)
+ (eq widget field))
+ (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)))
+ ;; If we hit ENTER in a non-button field, include the value of the
+ ;; first submit button after it.
+ (unless (eq (car widget) 'push-button)
+ (let ((rest form)
+ (name (plist-get (cdr widget) :name)))
+ (when rest
+ (while (and rest
+ (or (not (consp (car rest)))
+ (not (equal name (plist-get (cdar rest) :name)))))
+ (pop rest)))
+ (while rest
+ (let ((elem (pop rest)))
+ (when (and (consp (car rest))
+ (eq (car elem) 'push-button))
+ (push (cons (plist-get (cdr elem) :name)
+ (plist-get (cdr elem) :value))
+ values)
+ (setq rest nil))))))
+ (if (and (stringp (cdr (assq :method form)))
+ (equal (downcase (cdr (assq :method form))) "post"))
+ (let ((url-request-method "POST")
+ (url-request-extra-headers
+ '(("Content-Type" . "application/x-www-form-urlencoded")))
+ (url-request-data (mm-url-encode-www-form-urlencoded values)))
+ (eww-browse-url (shr-expand-url (cdr (assq :action form))
+ eww-current-url)))
+ (eww-browse-url
+ (concat
+ (if (cdr (assq :action form))
+ (shr-expand-url (cdr (assq :action form))
+ eww-current-url)
+ eww-current-url)
+ "?"
+ (mm-url-encode-www-form-urlencoded values))))))
+
+(defun eww-convert-widgets ()
+ (let ((start (point-min))
+ widget)
+ ;; Some widgets come from different buffers (rendered for tables),
+ ;; 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))
+ (setq widget (get-text-property start 'eww-widget))
+ (goto-char start)
+ (let ((end (next-single-property-change start 'eww-widget)))
+ (dolist (overlay (overlays-in start end))
+ (when (or (plist-get (overlay-properties overlay) 'button)
+ (plist-get (overlay-properties overlay) 'field))
+ (delete-overlay overlay)))
+ (delete-region start end))
+ (when (and widget
+ (not (eq (car widget) 'hidden)))
+ (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)))
+
+(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))))
+