From be2aa135787e32fc93b2163834e7460056e6e1a7 Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Mon, 17 Jun 2013 22:06:27 +0000 Subject: [PATCH] lisp/gnus/{eww,shr}.el: Merge changes made in Gnus master lisp/gnus/eww.el (eww-tag-select): Don't render totally empty 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 , 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. diff --git a/lisp/gnus/eww.el b/lisp/gnus/eww.el index fc0e413248a..fc6f591e0ce 100644 --- a/lisp/gnus/eww.el +++ b/lisp/gnus/eww.el @@ -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))) diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index d3b9a362a0b..2d0c9107fd6 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el @@ -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) -- 2.11.4.GIT