[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] shr-fontified cab5f01 3/3: Make shr use variable-width fon
|
From: |
Lars Ingebrigtsen |
|
Subject: |
[Emacs-diffs] shr-fontified cab5f01 3/3: Make shr use variable-width fonts |
|
Date: |
Wed, 28 Jan 2015 02:23:00 +0000 |
branch: shr-fontified
commit cab5f013407b5d8aadab2fbb3f2eac8dd5716133
Author: Lars Magne Ingebrigtsen <address@hidden>
Commit: Lars Magne Ingebrigtsen <address@hidden>
Make shr use variable-width fonts
* lisp/net/shr.el (shr-pixel-column, shr-string-pixel-width)
(shr-move-to-pixel-column): New functions.
(shr-insert): Use a proportional font.
(shr-render-td): Change all table computations to use pixel widths.
(shr-insert-table): Do the alignment here.
---
lisp/ChangeLog | 8 ++++
lisp/net/shr.el | 108 +++++++++++++++++++++++++++++-------------------------
2 files changed, 66 insertions(+), 50 deletions(-)
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d17dff2..df066a2 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
+2015-01-28 Lars Ingebrigtsen <address@hidden>
+
+ * net/shr.el (shr-pixel-column, shr-string-pixel-width)
+ (shr-move-to-pixel-column): New functions.
+ (shr-insert): Use a proportional font.
+ (shr-render-td): Change all table computations to use pixel widths.
+ (shr-insert-table): Do the alignment here.
+
2015-01-26 Lars Ingebrigtsen <address@hidden>
* net/shr.el (shr-make-table-1): Fix colspan typo.
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 59c277b..6384466 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -57,18 +57,18 @@ fit these criteria."
:group 'shr
:type '(choice (const nil) regexp))
-(defcustom shr-table-horizontal-line nil
+(defcustom shr-table-horizontal-line ?-
"Character used to draw horizontal table lines.
If nil, don't draw horizontal table lines."
:group 'shr
:type '(choice (const nil) character))
-(defcustom shr-table-vertical-line ?\s
+(defcustom shr-table-vertical-line ?|
"Character used to draw vertical table lines."
:group 'shr
:type 'character)
-(defcustom shr-table-corner ?\s
+(defcustom shr-table-corner ?+
"Character used to draw table corners."
:group 'shr
:type 'character)
@@ -135,7 +135,7 @@ cid: URL as the argument.")
(defvar shr-state nil)
(defvar shr-start nil)
(defvar shr-indentation 0)
-(defvar shr-internal-width (or shr-width (1- (window-width))))
+(defvar shr-internal-width nil)
(defvar shr-list-mode nil)
(defvar shr-content-cache nil)
(defvar shr-kinsoku-shorten nil)
@@ -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 (1- (window-width)))))
+ (shr-internal-width (or shr-width (- (window-pixel-width) 20))))
(shr-descend dom)
(shr-remove-trailing-whitespace start (point))
(when shr-warning
@@ -421,7 +421,7 @@ size, and full-buffer size."
(let ((shr-indentation 0)
(shr-state nil)
(shr-start nil)
- (shr-internal-width (window-width)))
+ (shr-internal-width (- (window-pixel-width) 10)))
(shr-insert text)
(buffer-string)))))
@@ -447,7 +447,35 @@ size, and full-buffer size."
(unless (shr-char-kinsoku-bol-p (make-char 'japanese-jisx0208 33 35))
(load "kinsoku" nil t))
+(defun shr-pixel-column ()
+ (let ((width 0)
+ (string (buffer-substring (line-beginning-position) (point)))
+ (start 0))
+ (while (< start (length string))
+ (let ((glyphs (font-get-glyphs (font-at start nil string)
+ start (1+ start) string)))
+ (setq width (+ width (aref (aref glyphs 0) 4))))
+ (setq start (1+ start)))
+ width))
+
+(defun shr-string-pixel-width (string)
+ (with-temp-buffer
+ (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)))
@@ -486,7 +514,7 @@ size, and full-buffer size."
(insert elem)
(setq shr-state nil)
(let (found)
- (while (and (> (current-column) shr-internal-width)
+ (while (and (> (shr-pixel-column) shr-internal-width)
(> shr-internal-width 0)
(progn
(setq found (shr-find-fill-point))
@@ -501,7 +529,7 @@ size, and full-buffer size."
(when (> shr-indentation 0)
(shr-indent))
(end-of-line))
- (if (<= (current-column) shr-internal-width)
+ (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.
@@ -512,7 +540,7 @@ size, and full-buffer size."
(delete-char -1)))))
(defun shr-find-fill-point ()
- (when (> (move-to-column shr-internal-width) shr-internal-width)
+ (when (> (shr-move-to-pixel-column shr-internal-width) shr-internal-width)
(backward-char 1))
(let ((bp (point))
failed)
@@ -552,7 +580,7 @@ size, and full-buffer size."
;; so we look for the second best position.
(while (and (progn
(forward-char 1)
- (<= (current-column) shr-internal-width))
+ (<= (shr-pixel-column) shr-internal-width))
(progn
(setq bp (point))
(shr-char-kinsoku-eol-p (following-char)))))
@@ -1392,7 +1420,7 @@ The preference is a float determined from
`shr-prefer-media-type'."
(defun shr-tag-hr (_dom)
(shr-ensure-newline)
- (insert (make-string shr-internal-width shr-hr-line) "\n"))
+ (insert (make-string (window-width) shr-hr-line) "\n"))
(defun shr-tag-title (dom)
(shr-heading dom 'bold 'underline))
@@ -1424,7 +1452,7 @@ The preference is a float determined from
`shr-prefer-media-type'."
(shr-kinsoku-shorten t)
;; Find all suggested widths.
(columns (shr-column-specs dom))
- ;; Compute how many characters wide each TD should be.
+ ;; Compute how many pixels wide each TD should be.
(suggested-widths (shr-pro-rate-columns columns))
;; Do a "test rendering" to see how big each TD is (this can
;; be smaller (if there's little text) or bigger (if there's
@@ -1432,7 +1460,9 @@ The preference is a float determined from
`shr-prefer-media-type'."
(sketch (shr-make-table dom suggested-widths))
;; Compute the "natural" width by setting each column to 500
;; characters and see how wide they really render.
- (natural (shr-make-table dom (make-vector (length columns) 500)))
+ (natural (shr-make-table
+ dom (make-vector (length columns)
+ (* 500 (shr-string-pixel-width "x")))))
(sketch-widths (shr-table-widths sketch natural suggested-widths)))
;; This probably won't work very well.
(when (> (+ (loop for width across sketch-widths
@@ -1545,6 +1575,8 @@ The preference is a float determined from
`shr-prefer-media-type'."
(shr-insert-table-ruler widths))
(dolist (row table)
(let ((start (point))
+ (align 0)
+ (column-number 0)
(height (let ((max 0))
(dolist (column row)
(setq max (max max (cadr column))))
@@ -1554,17 +1586,23 @@ The preference is a float determined from
`shr-prefer-media-type'."
(insert shr-table-vertical-line "\n"))
(dolist (column row)
(goto-char start)
+ (setq align (+ align 20 (aref widths column-number))
+ column-number (1+ column-number))
(let ((lines (nth 2 column)))
(dolist (line lines)
(end-of-line)
- (insert line shr-table-vertical-line)
+ (insert line
+ (propertize " " 'display
+ `(space :align-to (,align)))
+ shr-table-vertical-line)
(forward-line 1))
;; Add blank lines at padding at the bottom of the TD,
;; possibly.
(dotimes (i (- height (length lines)))
(end-of-line)
(let ((start (point)))
- (insert (make-string (string-width (car lines)) ? )
+ (insert (propertize " " 'display
+ `(space :align-to (,align)))
shr-table-vertical-line)
(when (nth 4 column)
(shr-add-font start (1- (point))
@@ -1729,38 +1767,8 @@ The preference is a float determined from
`shr-prefer-media-type'."
(let ((max 0))
(while (not (eobp))
(end-of-line)
- (setq max (max max (current-column)))
+ (setq max (max max (shr-pixel-column)))
(forward-line 1))
- (when fill
- (goto-char (point-min))
- ;; If the buffer is totally empty, then put a single blank
- ;; line here.
- (if (zerop (buffer-size))
- (insert (make-string width ? ))
- ;; Otherwise, fill the buffer.
- (let ((align (dom-attr dom 'align))
- length)
- (while (not (eobp))
- (end-of-line)
- (setq length (- width (current-column)))
- (when (> length 0)
- (cond
- ((equal align "right")
- (beginning-of-line)
- (insert (make-string length ? )))
- ((equal align "center")
- (insert (make-string (/ length 2) ? ))
- (beginning-of-line)
- (insert (make-string (- length (/ length 2)) ? )))
- (t
- (insert (make-string length ? )))))
- (forward-line 1))))
- (when style
- (setq actual-colors
- (shr-colorize-region
- (point-min) (point-max)
- (cdr (assq 'color shr-stylesheet))
- (cdr (assq 'background-color shr-stylesheet))))))
(if fill
(list max
(count-lines (point-min) (point-max))
@@ -1788,7 +1796,8 @@ The preference is a float determined from
`shr-prefer-media-type'."
(aset widths i (max (truncate (* (aref columns i)
total-percentage
(- shr-internal-width
- (1+ (length columns)))))
+ (* (1+ (length columns))
+ (shr-string-pixel-width "-")))))
10)))
widths))
@@ -1798,9 +1807,8 @@ The preference is a float determined from
`shr-prefer-media-type'."
(dolist (row (dom-non-text-children dom))
(when (eq (dom-tag row) 'tr)
(let ((i 0))
- (dolist (column (dom-children row))
- (when (and (not (stringp column))
- (memq (dom-tag column) '(td th)))
+ (dolist (column (dom-non-string-children row))
+ (when (memq (dom-tag column) '(td th))
(let ((width (dom-attr column 'width)))
(when (and width
(string-match "\\([0-9]+\\)%" width)