[Emacs-diffs] shr-fontified ab3901f 2/3: (shr-glyph-widths): Reimplemented based on `char-script-table'.

[Lars Ingebrigtsen]

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

    (shr-glyph-widths): Reimplemented based on `char-script-table'.
---
 lisp/ChangeLog  |    2 ++
 lisp/net/shr.el |   54 ++++++++++++++++++++++--------------------------------
 2 files changed, 24 insertions(+), 32 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ee84d1a..dbd5bb6 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -2,6 +2,8 @@
 
        * net/shr.el (shr-glyph-widths-fast): New function to call
        `font-get-glyphs' fewer times.
+       (shr-font-cache): New variable.
+       (shr-glyph-widths): Reimplemented based on `char-script-table'.
 
 2015-01-30  Lars Ingebrigtsen  <address@hidden>
 
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index dc2445c..00a2c39 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -134,6 +134,7 @@ cid: URL as the argument.")
 (defvar shr-folding-mode nil)
 (defvar shr-state nil)
 (defvar shr-start nil)
+(defvar shr-font-cache nil)
 (defvar shr-indentation 0)
 (defvar shr-internal-width nil)
 (defvar shr-list-mode nil)
@@ -207,6 +208,7 @@ DOM should be a parse tree as generated by
        (shr-base nil)
        (shr-depth 0)
        (shr-warning nil)
+       (shr-font-cache (make-hash-table :test 'eq))
        (shr-internal-width (or shr-width
                                (- (window-pixel-width)
                                   (* (frame-fringe-width) 2)))))
@@ -561,40 +563,28 @@ size, and full-buffer size."
 
 (defun shr-glyph-widths (start end)
   (let ((widths (make-vector (- end start) 0))
-       (string (buffer-substring start end))
-       (start 0))
-    (while (< start (length string))
-      (let ((glyphs (font-get-glyphs (font-at start nil string)
-                                    start (1+ start) string)))
-       (aset widths
-             start
-             (if (not (aref glyphs 0))
-                 ;; If we have a degenerate font, just say "10".
-                 10
-               (aref (aref glyphs 0) 4))))
-      (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))
+       (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 (1- pos) last-script) scripts)
+       (setq last-script script
+             script-start pos))
       (setq pos (1+ pos)))
-    (push (list font-start pos font) fonts)
+    (push (list script-start pos script) scripts)
     (setq pos 0)
-    (dolist (spec (nreverse fonts))
-      (let ((glyphs (font-get-glyphs (nth 2 spec)
-                                    (nth 0 spec) (nth 1 spec) string)))
+    (dolist (spec (nreverse scripts))
+      (let* ((font (or (gethash (nth 2 spec) shr-font-cache)
+                      (let ((font
+                             (font-at 0 nil (buffer-substring
+                                             (nth 0 spec) (1+ (nth 0 spec))))))
+                        (puthash (nth 2 spec) font shr-font-cache)
+                        font)))
+            (glyphs (font-get-glyphs font (nth 0 spec) (nth 1 spec))))
        (dotimes (i (length glyphs))
          (let ((glyph (aref glyphs i)))
            (aset widths