Commit be2aa135 authored by Lars Magne Ingebrigtsen's avatar Lars Magne Ingebrigtsen Committed by Katsumi Yamaoka

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.
parent ec6ecaad
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.
......
......@@ -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)))
......
......@@ -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)
......
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