From: Julien Danjou <julien@danjou.info>
To: ding@gnus.org
Cc: Julien Danjou <julien@danjou.info>
Subject: [PATCH] shr: render table with style
Date: Mon, 6 Dec 2010 18:30:08 +0100 [thread overview]
Message-ID: <1291656608-16263-1-git-send-email-julien@danjou.info> (raw)
Signed-off-by: Julien Danjou <julien@danjou.info>
---
Lars, is the following acceptable?
Tested with:
<body bgcolor="yellow">
Yellow background
<div style="background-color: green;">Green backgrounds</div>
<div style="color: red; background-color: white;">
Red on white
<table bgcolor="black"><tr><td>black background table with red text</td></tr></table>
<div style="color: white;">
white text on white background
<font color="orange">Orange text on white background</font>
<div>Same old, same old</div>
</div>
<div style="color: blue;">
Blue text on white background
</div>
</body>
You can test how it renders now and how it renders with that patch. :)
lisp/ChangeLog | 5 +++++
lisp/shr.el | 42 ++++++++++++++++++++++++++++--------------
2 files changed, 33 insertions(+), 14 deletions(-)
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 8f28c7e..d9bd701 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2010-12-06 Julien Danjou <julien@danjou.info>
+
+ * shr.el (shr-insert-table-ruler, shr-insert-table): Insert table
+ content with style.
+
2010-12-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
* shr.el (shr-tag-font): Colorize the region.
diff --git a/lisp/shr.el b/lisp/shr.el
index a860616..117ded1 100644
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -202,13 +202,9 @@ redirects somewhere else."
(if (fboundp function)
(funcall function (cdr dom))
(shr-generic (cdr dom)))
- (let ((color (cdr (assq 'color shr-stylesheet)))
- (background (cdr (assq 'background-color
- shr-stylesheet))))
- (when (and style
- shr-stylesheet
- (or color background))
- (shr-colorize-region start (point) color background)))))
+ (when (and style
+ shr-stylesheet)
+ (shr-colorize-region-with-style start (point)))))
(defun shr-generic (cont)
(dolist (sub cont)
@@ -293,6 +289,17 @@ redirects somewhere else."
(unless (string-match "[ \t\n]\\'" text)
(delete-char -1)))))
+(defun shr-colorize-with-style (start end)
+ (shr-colorize-region start end
+ (cdr (assq 'color shr-stylesheet))
+ (cdr (assq 'background-color
+ shr-stylesheet))))
+
+(defun shr-insert-with-style (&rest text)
+ (let ((start (point)))
+ (apply 'insert text)
+ (shr-colorize-with-style start (point))))
+
(defun shr-find-fill-point ()
(when (> (move-to-column shr-width) shr-width)
(backward-char 1))
@@ -892,6 +899,7 @@ ones, in case fg and bg are nil."
(body (or (cdr (assq 'tbody cont)) cont))
(footer (cdr (assq 'tfoot cont)))
(bgcolor (cdr (assq :bgcolor cont)))
+ (shr-stylesheet (list (cons 'background-color bgcolor)))
(nheader (if header (shr-max-columns header)))
(nbody (if body (shr-max-columns body)))
(nfooter (if footer (shr-max-columns footer))))
@@ -953,7 +961,8 @@ ones, in case fg and bg are nil."
max)))
(dotimes (i height)
(shr-indent)
- (insert shr-table-vertical-line "\n"))
+ (shr-insert-with-style
+ (concat (char-to-string shr-table-vertical-line) "\n")))
(dolist (column row)
(goto-char start)
(let ((lines (nth 2 column))
@@ -962,7 +971,8 @@ ones, in case fg and bg are nil."
(dolist (line lines)
(setq overlay-line (pop overlay-lines))
(end-of-line)
- (insert line shr-table-vertical-line)
+ (shr-insert-with-style
+ (concat line (char-to-string shr-table-vertical-line)))
(dolist (overlay overlay-line)
(let ((o (make-overlay (- (point) (nth 0 overlay) 1)
(- (point) (nth 1 overlay) 1)))
@@ -974,8 +984,9 @@ ones, in case fg and bg are nil."
;; possibly.
(dotimes (i (- height (length lines)))
(end-of-line)
- (insert (make-string (string-width (car lines)) ? )
- shr-table-vertical-line)
+ (shr-insert-with-style
+ (concat (make-string (string-width (car lines)) ? )
+ (char-to-string shr-table-vertical-line)))
(forward-line 1)))))
(shr-insert-table-ruler widths)))
@@ -983,10 +994,13 @@ ones, in case fg and bg are nil."
(when (and (bolp)
(> shr-indentation 0))
(shr-indent))
- (insert shr-table-corner)
+ (shr-insert-with-style
+ (char-to-string shr-table-corner))
(dotimes (i (length widths))
- (insert (make-string (aref widths i) shr-table-horizontal-line)
- shr-table-corner))
+ (shr-insert-with-style
+ (concat
+ (make-string (aref widths i) shr-table-horizontal-line)
+ (char-to-string shr-table-corner))))
(insert "\n"))
(defun shr-table-widths (table suggested-widths)
--
1.7.2.3
next reply other threads:[~2010-12-06 17:30 UTC|newest]
Thread overview: 20+ messages / expand[flat|nested] mbox.gz Atom feed top
2010-12-06 17:30 Julien Danjou [this message]
2010-12-06 17:39 ` Lars Magne Ingebrigtsen
2010-12-06 17:42 ` Lars Magne Ingebrigtsen
2010-12-06 18:07 ` Lars Magne Ingebrigtsen
2010-12-07 9:19 ` Julien Danjou
2010-12-07 10:50 ` Lars Magne Ingebrigtsen
2010-12-07 11:16 ` Julien Danjou
2010-12-07 11:31 ` Lars Magne Ingebrigtsen
2010-12-07 11:38 ` Julien Danjou
2010-12-07 11:48 ` Lars Magne Ingebrigtsen
2010-12-07 12:08 ` Julien Danjou
2010-12-07 12:14 ` Lars Magne Ingebrigtsen
2010-12-07 12:25 ` Julien Danjou
2010-12-07 12:32 ` Lars Magne Ingebrigtsen
2010-12-07 15:27 ` Julien Danjou
2010-12-07 16:34 ` Lars Magne Ingebrigtsen
2010-12-07 17:00 ` Julien Danjou
2010-12-16 17:27 ` Lars Magne Ingebrigtsen
2010-12-17 9:23 ` Julien Danjou
2010-12-07 9:13 ` Julien Danjou
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=1291656608-16263-1-git-send-email-julien@danjou.info \
--to=julien@danjou.info \
--cc=ding@gnus.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).