[Emacs-diffs] shr-fontified 1a2c4b6 1/6: * lisp/net/eww.el (eww-toggle-fonts): New command.

[Lars Ingebrigtsen]

branch: shr-fontified
commit 1a2c4b6e8b5f62326c61eff7f89027f5277edd80
Author: Lars Magne Ingebrigtsen <address@hidden>
Commit: Lars Magne Ingebrigtsen <address@hidden>

    * lisp/net/eww.el (eww-toggle-fonts): New command.
---
 lisp/ChangeLog  |    4 ++
 lisp/net/eww.el |   10 ++++
 lisp/net/shr.el |  132 +++++++++++++++++++++++++++++--------------------------
 3 files changed, 84 insertions(+), 62 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 3a9b1c1..e51bd5e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,7 @@
+2015-02-08  Lars Ingebrigtsen  <address@hidden>
+
+       * net/eww.el (eww-toggle-fonts): New command.
+
 2015-02-07  Lars Ingebrigtsen  <address@hidden>
 
        * net/shr.el (shr-tag-table-1): Add further caching when computing
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 1588d6a..c401701 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -643,6 +643,7 @@ the like."
     (define-key map "H" 'eww-list-histories)
     (define-key map "E" 'eww-set-character-encoding)
     (define-key map "S" 'eww-list-buffers)
+    (define-key map "F" 'eww-toggle-fonts)
 
     (define-key map "b" 'eww-add-bookmark)
     (define-key map "B" 'eww-list-bookmarks)
@@ -1415,6 +1416,15 @@ Differences in #targets are ignored."
       (eww-reload nil 'utf-8)
     (eww-reload nil charset)))
 
+(defun eww-toggle-fonts ()
+  "Toggle whether to use monospaced or font-enabled layouts."
+  (interactive)
+  (message "Fonts are now %s"
+          (if (setq shr-use-fonts (not shr-use-fonts))
+              "on"
+            "off"))
+  (eww-reload))
+
 ;;; Bookmarks code
 
 (defvar eww-bookmarks nil)
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 36e485f..5b3659d 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -229,6 +229,7 @@ DOM should be a parse tree as generated by
                                     (* (frame-fringe-width) 2))))))
     (shr-descend dom)
     (shr-remove-trailing-whitespace start (point))
+    (setq adom dom)
     (when shr-warning
       (message "%s" shr-warning))))
 
@@ -533,7 +534,9 @@ size, and full-buffer size."
 (defun shr-vertical-motion (column)
   (if (not shr-use-fonts)
       (move-to-column column)
-    (vertical-motion t(cons (/ shr-internal-width (frame-char-width)) 0))
+    (unless (eolp)
+      (forward-char 1))
+    (vertical-motion (cons (/ column (frame-char-width)) 0))
     (unless (eolp)
       (forward-char 1))))
 
@@ -1634,8 +1637,9 @@ The preference is a float determined from 
`shr-prefer-media-type'."
          ;; Sum up all the widths from the column.  (There may be
          ;; more than one if this is a "colspan" column.)
          (dotimes (i (nth 3 column))
-           (if (> column-number (1- (length widths)))
-               (setq align (+ align 20))
+           ;; The colspan directive may be wrong and there may not be
+           ;; that number of columns.
+           (when (<= column-number (1- (length widths)))
              (setq align (+ align
                             (aref widths column-number)
                             (* 2 shr-table-separator-pixel-width))))
@@ -1684,14 +1688,16 @@ The preference is a float determined from 
`shr-prefer-media-type'."
           (id (get-text-property (point) 'shr-table-id))
           (base (shr-pixel-column))
           elem)
-      (save-excursion
-       (while (setq elem (text-property-any (point) end 'shr-table-indent id))
-         (goto-char elem)
-         (let ((align (get-text-property (point) 'display)))
-           (put-text-property (point) (1+ (point)) 'display
-                              `(space :align-to (,(+ (car (nth 2 align))
-                                                     base)))))
-         (forward-char 1))))
+      (when id
+       (save-excursion
+         (while (setq elem (text-property-any
+                            (point) end 'shr-table-indent id))
+           (goto-char elem)
+           (let ((align (get-text-property (point) 'display)))
+             (put-text-property (point) (1+ (point)) 'display
+                                `(space :align-to (,(+ (car (nth 2 align))
+                                                       base)))))
+           (forward-char 1)))))
     (setq start (1+ start))))
 
 (defun shr-insert-table-ruler (widths)
@@ -1728,7 +1734,8 @@ The preference is a float determined from 
`shr-prefer-media-type'."
          (aset natural-widths i (max (aref natural-widths i) column))
          (setq i (1+ i)))))
     (let ((extra (- (apply '+ (append suggested-widths nil))
-                   (apply '+ (append widths nil))))
+                   (apply '+ (append widths nil))
+                   (* shr-table-separator-pixel-width 2)))
          (expanded-columns 0))
       ;; We have extra, unused space, so divide this space amongst the
       ;; columns.
@@ -1854,59 +1861,60 @@ The preference is a float determined from 
`shr-prefer-media-type'."
     (or (dom-attr dom cache)
        (let ((natural (dom-attr dom 'shr-td-cache-natural)))
          (and (not fill)
+              nil
               natural
               (>= width natural)
               natural))
-       (with-temp-buffer
-         (let ((bgcolor (dom-attr dom 'bgcolor))
-               (fgcolor (dom-attr dom 'fgcolor))
-               (style (dom-attr dom 'style))
-               (shr-stylesheet shr-stylesheet)
-               (max-width 0))
-           (when style
-             (setq style (and (string-match "color" style)
-                              (shr-parse-style style))))
-           (when bgcolor
-             (setq style (nconc (list (cons 'background-color bgcolor))
-                                style)))
-           (when fgcolor
-             (setq style (nconc (list (cons 'color fgcolor)) style)))
-           (when style
-             (setq shr-stylesheet (append style shr-stylesheet)))
-           (let ((shr-internal-width width)
-                 (shr-indentation 0))
-             (shr-descend dom))
-           (let ((shr-internal-width width))
-             (unless (= shr-internal-width 5000)
-               (shr-fold-lines (point-min) (point-max)))
-             (setq max-width (shr-pixel-buffer-width)))
-           (goto-char (point-max))
-           ;; Delete padding at the bottom of the TDs.
-           (delete-region
-            (point)
-            (progn
-              (skip-chars-backward " \t\n")
-              (end-of-line)
-              (point)))
-           (goto-char (point-min))
-           (let ((result
-                  (if fill
-                      (list max-width
-                            (count-lines (point-min) (point-max))
-                            (split-string (buffer-string) "\n")
-                            (if (dom-attr dom 'colspan)
-                                (string-to-number (dom-attr dom 'colspan))
-                              1)
-                            (cdr (assq 'color shr-stylesheet))
-                            (cdr (assq 'background-color shr-stylesheet)))
-                    max-width)))
-             (when (and (>= width 5000)
-                        (not fill))
-               (dom-set-attribute dom 'shr-td-cache-natural result ))
-             (when (eq cache 'shr-td-cache-2486-nil)
-               (debug))
-             (dom-set-attribute dom cache result)
-             result))))))
+       (let ((result (shr-render-td-1 dom width fill)))
+         (when (and (>= width 5000)
+                    (not fill))
+           (dom-set-attribute dom 'shr-td-cache-natural result ))
+         (dom-set-attribute dom cache result)
+         result))))
+
+(defun shr-render-td-1 (dom width fill)
+  (with-temp-buffer
+    (let ((bgcolor (dom-attr dom 'bgcolor))
+         (fgcolor (dom-attr dom 'fgcolor))
+         (style (dom-attr dom 'style))
+         (shr-stylesheet shr-stylesheet)
+         (max-width 0))
+      (when style
+       (setq style (and (string-match "color" style)
+                        (shr-parse-style style))))
+      (when bgcolor
+       (setq style (nconc (list (cons 'background-color bgcolor))
+                          style)))
+      (when fgcolor
+       (setq style (nconc (list (cons 'color fgcolor)) style)))
+      (when style
+       (setq shr-stylesheet (append style shr-stylesheet)))
+      (let ((shr-internal-width width)
+           (shr-indentation 0))
+       (shr-descend dom))
+      (let ((shr-internal-width width))
+       (unless (= shr-internal-width 5000)
+         (shr-fold-lines (point-min) (point-max)))
+       (setq max-width (shr-pixel-buffer-width)))
+      (goto-char (point-max))
+      ;; Delete padding at the bottom of the TDs.
+      (delete-region
+       (point)
+       (progn
+        (skip-chars-backward " \t\n")
+        (end-of-line)
+        (point)))
+      (goto-char (point-min))
+      (if fill
+         (list max-width
+               (count-lines (point-min) (point-max))
+               (split-string (buffer-string) "\n")
+               (if (dom-attr dom 'colspan)
+                   (string-to-number (dom-attr dom 'colspan))
+                 1)
+               (cdr (assq 'color shr-stylesheet))
+               (cdr (assq 'background-color shr-stylesheet)))
+       max-width))))
 
 (defun shr-buffer-width ()
   (goto-char (point-min))