[Emacs-diffs] shr-fontified e449d32 1/7: Use `window-text-pixel-size'

[Lars Ingebrigtsen]

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

    Use `window-text-pixel-size'
---
 lisp/ChangeLog  |    1 +
 lisp/net/shr.el |   92 ++++++++++++++-----------------------------------------
 2 files changed, 24 insertions(+), 69 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 3203289..8bf7567 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,6 +1,7 @@
 2015-02-05  Lars Ingebrigtsen  <address@hidden>
 
        * net/shr.el (shr-pixel-column): Base in `shr-glyph-widths'.
+       (shr-pixel-column): Implemented via `window-text-pixel-size'.
 
 2015-01-31  Lars Ingebrigtsen  <address@hidden>
 
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 4023833..8faa2a0 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -455,11 +455,8 @@ size, and full-buffer size."
   (load "kinsoku" nil t))
 
 (defun shr-pixel-column ()
-  (let ((glyphs (shr-glyph-widths (line-beginning-position) (point)))
-       (total 0))
-    (dotimes (i (length glyphs))
-      (setq total (+ total (aref glyphs i))))
-    total))
+  (car (window-text-pixel-size nil (line-beginning-position) (point)
+                              nil nil nil (current-buffer))))
 
 (defun shr-string-pixel-width (string)
   (with-temp-buffer
@@ -521,78 +518,35 @@ size, and full-buffer size."
     (put-text-property start (1+ start) 'shr-indentation nil)
     (when (> indentation 0)
       (insert (make-string indentation ?\s)))
-    (let ((widths (if (> shr-table-depth 0)
-                     (let ((line (buffer-substring
-                                  start (line-end-position))))
-                       (or (gethash line shr-fill-cache)
-                           (let ((widths (shr-glyph-widths
-                                          start (line-end-position))))
-                             (puthash line widths shr-fill-cache)
-                             widths)))
-                   (shr-glyph-widths start (line-end-position))))
-         (max-width 0)
-         (this-width 0)
-         (i 0))
-      (while (< i (length widths))
-       (while (and (< i (length widths))
-                   (< this-width shr-internal-width))
-         (setq this-width (+ this-width (aref widths i))
-               i (1+ i))
-         (unless (eolp)
-           (forward-char 1)))
-       (if (< this-width shr-internal-width)
-           (setq max-width (max max-width this-width))
+    (let ((max-width 0)
+         (this-width 0))
+      (shr-goto-pixel-column shr-internal-width)
+      (if (< (setq this-width (shr-pixel-column)) shr-internal-width)
+         (setq max-width (max max-width this-width))
+       (while (> this-width shr-internal-width)
          ;; We have to do some folding.  First find the first
          ;; previous point suitable for folding.
          (let ((end (point)))
            (shr-find-fill-point (line-beginning-position))
-           ;; Adjust the index to where we moved when finding the
-           ;; fill point.
-           (let ((new-index (+ i (- (point) end))))
-             (if (> new-index i)
-                 (dotimes (idx (- new-index i))
-                   (setq this-width (+ this-width (aref widths (+ i idx)))))
-               (dotimes (idx (- i new-index))
-                 (setq this-width (- this-width (aref widths
-                                                      (+ new-index idx))))))
-             (setq max-width (max max-width this-width)
-                   i new-index
-                   this-width 0))
            (when (= (preceding-char) ?\s)
              (delete-char -1))
-           (insert "\n"))))
+           (insert "\n"))
+         (shr-goto-pixel-column shr-internal-width)
+         (setq this-width (shr-pixel-column)
+               max-width (max max-width this-width))))
       max-width)))
 
-(defun shr-glyph-widths (start end)
-  (let ((widths (make-vector (- end start) 0))
-       (scripts nil)
-       (pos start)
-       (script-start start)
-       (last-script (aref char-script-table (char-after start)))
-       script)
-    (while (< pos end)
-      (setq script (aref char-script-table (char-after pos)))
-      (when (not (eq script last-script))
-       (push (list script-start pos last-script) scripts)
-       (setq last-script script
-             script-start pos))
-      (setq pos (1+ pos)))
-    (push (list script-start pos script) scripts)
-    (setq pos 0)
-    (dolist (spec (nreverse scripts))
-      (let* ((font (font-at 0 nil (buffer-substring
-                                  (nth 0 spec) (1+ (nth 0 spec)))))
-            (glyphs (font-get-glyphs font (nth 0 spec) (nth 1 spec))))
-       (dotimes (i (length glyphs))
-         (let ((glyph (aref glyphs i)))
-           (aset widths
-                 pos
-                 (if (not glyph)
-                     ;; If we have a degenerate font, just say "10".
-                     10
-                   (aref glyph 4)))
-           (setq pos (1+ pos))))))
-    widths))
+(defun shr-goto-pixel-column (pixels)
+  (vertical-motion (cons (/ pixels (frame-char-width)) 0))
+  (if (> (shr-pixel-column) pixels)
+      (while (and (> (shr-pixel-column) pixels)
+                 (not (bolp)))
+       (forward-char -1))
+    (while (and (< (shr-pixel-column) pixels)
+               (not (eolp)))
+      (forward-char 1))
+    (unless (eolp)
+      (forward-char 1))))
 
 (defun shr-find-fill-point (start)
   (let ((bp (point))