Commit f22255bd authored by Lars Magne Ingebrigtsen's avatar Lars Magne Ingebrigtsen Committed by Katsumi Yamaoka
Browse files

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
parent 08c0a604
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.
......
......@@ -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)
......
......@@ -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.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment