[Emacs-diffs] trunk r113028: lisp/gnus/{eww, shr}.el: Merge changes made in Gnus master

[Katsumi Yamaoka]

------------------------------------------------------------
revno: 113028
revision-id: address@hidden
parent: address@hidden
author: Lars Magne Ingebrigtsen <address@hidden>
committer: Katsumi Yamaoka <address@hidden>
branch nick: trunk
timestamp: Mon 2013-06-17 22:06:27 +0000
message:
  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.
modified:
  lisp/gnus/ChangeLog            changelog-20091113204419-o5vbwnq5f7feedwu-1433
  lisp/gnus/eww.el               eww.el-20130610114603-80ap3gwnw4x4m5ix-1
  lisp/gnus/shr.el               shr.el-20101002102929-yfzewk55rsg0mn93-1

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2013-06-17 10:51:54 +0000
+++ b/lisp/gnus/ChangeLog       2013-06-17 22:06:27 +0000
@@ -1,5 +1,31 @@
 2013-06-17  Lars Magne Ingebrigtsen  <address@hidden>
 
+       * 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.
 

=== modified file 'lisp/gnus/eww.el'
--- a/lisp/gnus/eww.el  2013-06-17 10:51:54 +0000
+++ b/lisp/gnus/eww.el  2013-06-17 22:06:27 +0000
@@ -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)))
 

=== modified file 'lisp/gnus/shr.el'
--- a/lisp/gnus/shr.el  2013-06-17 10:51:54 +0000
+++ b/lisp/gnus/shr.el  2013-06-17 22:06:27 +0000
@@ -125,6 +125,7 @@
 (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 @@
 (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 @@
        (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 @@
          (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 @@
        (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 @@
          (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 @@
 ;; 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 @@
   (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 @@
                (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 @@
       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 @@
        (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 @@
   (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 @@
     (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 @@
        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)