[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] shr-fontified 1da4c13 1/4: Implement a faster pixel-based
|
From: |
Lars Ingebrigtsen |
|
Subject: |
[Emacs-diffs] shr-fontified 1da4c13 1/4: Implement a faster pixel-based text algorithm |
|
Date: |
Fri, 30 Jan 2015 05:46:15 +0000 |
branch: shr-fontified
commit 1da4c132935b57e20aea78d3bb5e264b07ae5717
Author: Lars Magne Ingebrigtsen <address@hidden>
Commit: Lars Magne Ingebrigtsen <address@hidden>
Implement a faster pixel-based text algorithm
* net/shr.el (shr-move-to-pixel-column): Removed.
(shr-insert): Don't do folding on insertion.
(shr-fold-lines): New function.
(shr-fold-line): Ditto.
(shr-glyph-widths): New function.
* net/eww.el (eww-display-html): Use shr's body renderer. They
were identical.
---
lisp/ChangeLog | 11 ++++
lisp/net/eww.el | 10 ----
lisp/net/shr.el | 156 ++++++++++++++++++++++++++++++-------------------------
3 files changed, 96 insertions(+), 81 deletions(-)
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index cfaeb9d..18914ce 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,14 @@
+2015-01-30 Lars Ingebrigtsen <address@hidden>
+
+ * net/eww.el (eww-display-html): Use shr's body renderer. They
+ were identical.
+
+ * net/shr.el (shr-move-to-pixel-column): Removed.
+ (shr-insert): Don't do folding on insertion.
+ (shr-fold-lines): New function.
+ (shr-fold-line): Ditto.
+ (shr-glyph-widths): New function.
+
2015-01-28 Lars Ingebrigtsen <address@hidden>
* net/shr.el (shr-pixel-column, shr-string-pixel-width)
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index ec7a0ba..1588d6a 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -409,7 +409,6 @@ See the `eww-search-prefix' variable for the search engine
used."
(form . eww-tag-form)
(input . eww-tag-input)
(textarea . eww-tag-textarea)
- (body . eww-tag-body)
(select . eww-tag-select)
(link . eww-tag-link)
(a . eww-tag-a))))
@@ -495,15 +494,6 @@ See the `eww-search-prefix' variable for the search engine
used."
(replace-regexp-in-string "[ \t\r\n]+" " " (dom-text dom))))
(eww-update-header-line-format))
-(defun eww-tag-body (dom)
- (let* ((start (point))
- (fgcolor (or (dom-attr dom 'fgcolor) (dom-attr dom 'text)))
- (bgcolor (dom-attr dom 'bgcolor))
- (shr-stylesheet (list (cons 'color fgcolor)
- (cons 'background-color bgcolor))))
- (shr-generic dom)
- (shr-colorize-region start (point) fgcolor bgcolor)))
-
(defun eww-display-raw (buffer &optional encode)
(let ((data (buffer-substring (point) (point-max))))
(unless (buffer-live-p buffer)
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index c25a656..6328796 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -207,7 +207,7 @@ DOM should be a parse tree as generated by
(shr-base nil)
(shr-depth 0)
(shr-warning nil)
- (shr-internal-width (or shr-width (- (window-pixel-width) 20))))
+ (shr-internal-width (or shr-width (- (window-pixel-width) 40))))
(shr-descend dom)
(shr-remove-trailing-whitespace start (point))
(when shr-warning
@@ -466,19 +466,7 @@ size, and full-buffer size."
(insert string)
(shr-pixel-column)))
-(defun shr-move-to-pixel-column (pixel)
- (move-to-column (/ pixel 10))
- (if (> (shr-pixel-column) pixel)
- (while (and (> (shr-pixel-column) pixel)
- (not (bolp)))
- (forward-char -1))
- (while (and (< (shr-pixel-column) pixel)
- (not (eolp)))
- (forward-char 1)))
- (shr-pixel-column))
-
(defun shr-insert (text)
- (setq text (propertize text 'face 'variable-pitch))
(when (and (eq shr-state 'image)
(not (bolp))
(not (string-match "\\`[ \t\n]+\\'" text)))
@@ -492,62 +480,85 @@ size, and full-buffer size."
(not (bolp))
(not (eq (char-after (1- (point))) ? )))
(insert " "))
- (dolist (elem (split-string text "[ \f\t\n\r\v ]+" t))
- (when (and (bolp)
- (> shr-indentation 0))
- (shr-indent))
- ;; No space is needed behind a wide character categorized as
- ;; kinsoku-bol, between characters both categorized as nospace,
- ;; or at the beginning of a line.
- (let (prev)
- (when (and (> (current-column) shr-indentation)
- (eq (preceding-char) ? )
- (or (= (line-beginning-position) (1- (point)))
- (and (shr-char-breakable-p
- (setq prev (char-after (- (point) 2))))
- (shr-char-kinsoku-bol-p prev))
- (and (shr-char-nospace-p prev)
- (shr-char-nospace-p (aref elem 0)))))
- (delete-char -1)))
- ;; The shr-start is a special variable that is used to pass
- ;; upwards the first point in the buffer where the text really
- ;; starts.
- (unless shr-start
- (setq shr-start (point)))
- (insert elem)
- (setq shr-state nil)
- (let (found)
- (while (and (> (shr-pixel-column) shr-internal-width)
- (> shr-internal-width 0)
- (progn
- (setq found (shr-find-fill-point))
- (not (eolp))))
- (when (eq (preceding-char) ? )
- (delete-char -1))
- (insert "\n")
- (unless found
- ;; No space is needed at the beginning of a line.
- (when (eq (following-char) ? )
- (delete-char 1)))
- (when (> shr-indentation 0)
- (shr-indent))
- (end-of-line))
- (if (<= (shr-pixel-column) shr-internal-width)
- (insert " ")
- ;; In case we couldn't get a valid break point (because of a
- ;; word that's longer than `shr-internal-width'), just break anyway.
- (insert "\n")
- (when (> shr-indentation 0)
- (shr-indent)))))
- (unless (string-match "[ \t\r\n ]\\'" text)
- (delete-char -1)))))
-
-(defun shr-find-fill-point ()
- (when (> (shr-move-to-pixel-column shr-internal-width) shr-internal-width)
- (backward-char 1))
+ (let ((start (point))
+ (bolp (bolp)))
+ (insert text)
+ (save-restriction
+ (narrow-to-region start (point))
+ (goto-char start)
+ (when (looking-at "[ \t\n ]+")
+ (replace-match "" t t))
+ (while (re-search-forward "[ \t\n ]+" nil t)
+ (replace-match " " t t))
+ (goto-char (point-max)))
+ ;; We may have removed everything we inserted if if was just
+ ;; spaces.
+ (unless (= start (point))
+ ;; Mark all lines that should possibly be folded afterwards.
+ (when bolp
+ (put-text-property start (1+ start)
+ 'shr-indentation shr-indentation))
+ (put-text-property start (point) 'face 'variable-pitch))))))
+
+(defun shr-fold-lines (start end)
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char start)
+ (when (get-text-property (point) 'shr-indentation)
+ (shr-fold-line))
+ (while (setq start (next-single-property-change start 'shr-indentation))
+ (goto-char start)
+ (shr-fold-line))
+ (goto-char (point-max))))
+
+(defun shr-fold-line ()
+ (let ((start (point))
+ (indentation (get-text-property (point) 'shr-indentation)))
+ (put-text-property start (1+ start) 'shr-indentation nil)
+ (when (> indentation 0)
+ (insert (make-string indentation ?\s)))
+ (let ((widths (shr-glyph-widths start (line-end-position)))
+ (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 (eobp)
+ (forward-char 1)))
+ (when (< i (length widths))
+ ;; 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.
+ (setq i (+ i (- end (point)))
+ this-width 0)
+ (insert "\n")))))))
+
+(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-find-fill-point (start)
(let ((bp (point))
+ (end (point))
failed)
- (while (not (or (setq failed (<= (current-column) shr-indentation))
+ (while (not (or (setq failed (<= (point) start))
(eq (preceding-char) ? )
(eq (following-char) ? )
(shr-char-breakable-p (preceding-char))
@@ -578,12 +589,12 @@ size, and full-buffer size."
(while (and (not (memq (preceding-char) (list ?\C-@ ?\n ? )))
(shr-char-kinsoku-eol-p (preceding-char)))
(backward-char 1))
- (when (setq failed (<= (current-column) shr-indentation))
+ (when (setq failed (<= (point) start))
;; There's no breakable point that doesn't violate kinsoku,
;; so we look for the second best position.
(while (and (progn
(forward-char 1)
- (<= (shr-pixel-column) shr-internal-width))
+ (<= (point) end))
(progn
(setq bp (point))
(shr-char-kinsoku-eol-p (following-char)))))
@@ -598,7 +609,7 @@ size, and full-buffer size."
(not (memq (preceding-char) (list ?\C-@ ?\n ? )))
(or (shr-char-kinsoku-eol-p (preceding-char))
(shr-char-kinsoku-bol-p (following-char)))))))
- (when (setq failed (<= (current-column) shr-indentation))
+ (when (setq failed (<= (point) start))
;; There's no breakable point that doesn't violate kinsoku,
;; so we go to the second best position.
(if (looking-at "\\(\\c<+\\)\\c<")
@@ -1038,7 +1049,8 @@ ones, in case fg and bg are nil."
(shr-stylesheet (list (cons 'color fgcolor)
(cons 'background-color bgcolor))))
(shr-generic dom)
- (shr-colorize-region start (point) fgcolor bgcolor)))
+ (shr-colorize-region start (point) fgcolor bgcolor)
+ (shr-fold-lines start (point))))
(defun shr-tag-style (_dom)
)
@@ -1766,6 +1778,8 @@ The preference is a float determined from
`shr-prefer-media-type'."
(let ((shr-internal-width width)
(shr-indentation 0))
(shr-descend dom))
+ (let ((shr-internal-width width))
+ (shr-fold-lines (point-min) (point-max)))
;; Delete padding at the bottom of the TDs.
(delete-region
(point)