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.
: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.")
(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))
(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))
: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))
;; 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)))
(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)))
(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)))
(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)))))
(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
(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)))))
(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)))
(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")))))
;; 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."
(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."
(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)
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)
(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)
(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))
(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)
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)
projects / emacs.git / commitdiff