[Emacs-diffs] shr-fontified 3ebf0a6 1/3: Speed up line width computation

[Lars Ingebrigtsen]

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

    Speed up line width computation
    
    * net/shr.el (shr-glyph-widths-fast): New function to call
    `font-get-glyphs' fewer times.
---
 lisp/ChangeLog  |    5 ++++
 lisp/net/shr.el |   63 ++++++++++++++++++++++++++++++++++++++++++------------
 2 files changed, 54 insertions(+), 14 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index bbbfdf7..ee84d1a 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2015-01-31  Lars Ingebrigtsen  <address@hidden>
+
+       * net/shr.el (shr-glyph-widths-fast): New function to call
+       `font-get-glyphs' fewer times.
+
 2015-01-30  Lars Ingebrigtsen  <address@hidden>
 
        * net/shr.el (shr-insert-document): Subtract the fringe width to
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 3715d59..dc2445c 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -457,10 +457,11 @@ size, and full-buffer size."
     (while (< start (length string))
       (let ((glyphs (font-get-glyphs (font-at start nil string)
                                     start (1+ start) string)))
-       (if (not (aref glyphs 0))
-           ;; If we have a degenerate font, just say "10".
-           10
-         (setq width (+ width (aref (aref glyphs 0) 4)))))
+       (setq width
+             (if (not (aref glyphs 0))
+                 ;; If we have a degenerate font, just say "10".
+                 10
+               (+ width (aref (aref glyphs 0) 4)))))
       (setq start (1+ start)))
     width))
 
@@ -574,6 +575,37 @@ size, and full-buffer size."
       (setq start (1+ start)))
     widths))
 
+(defun shr-glyph-widths-fast (start end)
+  (let ((widths (make-vector (- end start) 0))
+       (string (buffer-substring start end))
+       (fonts nil)
+       (pos 0)
+       (font-start 0)
+       font last-font)
+    (while (< pos 1)
+      (setq font (font-at pos nil string))
+      (when (and last-font
+                (not (eq font last-font)))
+       (push (list font-start (1- pos) font) fonts)
+       (setq last-font font
+             font-start pos))
+      (setq pos (1+ pos)))
+    (push (list font-start pos font) fonts)
+    (setq pos 0)
+    (dolist (spec (nreverse fonts))
+      (let ((glyphs (font-get-glyphs (nth 2 spec)
+                                    (nth 0 spec) (nth 1 spec) string)))
+       (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-find-fill-point (start)
   (let ((bp (point))
        (end (point))
@@ -1410,16 +1442,19 @@ The preference is a float determined from 
`shr-prefer-media-type'."
 
 (defun shr-tag-li (dom)
   (shr-ensure-newline)
-  (shr-indent)
-  (let* ((bullet
-         (if (numberp shr-list-mode)
-             (prog1
-                 (format "%d " shr-list-mode)
-               (setq shr-list-mode (1+ shr-list-mode)))
-           shr-bullet))
-        (shr-indentation (+ shr-indentation (length bullet))))
-    (insert bullet)
-    (shr-generic dom)))
+  (let ((start (point)))
+    (shr-indent)
+    (let* ((bullet
+           (if (numberp shr-list-mode)
+               (prog1
+                   (format "%d " shr-list-mode)
+                 (setq shr-list-mode (1+ shr-list-mode)))
+             shr-bullet))
+          (shr-indentation (+ shr-indentation (length bullet))))
+      (insert bullet)
+      (shr-generic dom)
+      (put-text-property start (1+ start)
+                        'shr-indentation 0))))
 
 (defun shr-tag-br (dom)
   (when (and (not (bobp))