[gnus git] branch master updated: m0-7-105-g80f5224 =3= * shr.el (shr-render-td): Support horizontal alignment. ; Make eww use `add-face-text-property', too. ; Get correct presedence for font data
Lars Magne Ingebrigtsen <[email protected]>
| Newsgroups | gmane.emacs.gnus.cvs |
|---|---|
| Message-ID | <[email protected]> |
via 80f5224e3cabb33c5244a34a1caaf0a66e3db10d (commit)
via b4e3caa6187781b601cb64618da784c4244a812d (commit)
via c51a478e5206246505408b920b26fd998cd2bb7c (commit)
from 29d6ab084e7af7bfd2a6da38fde6eadfbe075bfa (commit)
- Log -----------------------------------------------------------------
commit 80f5224e3cabb33c5244a34a1caaf0a66e3db10d
Author: Lars Magne Ingebrigtsen <[email protected]>
Date: Mon Jun 17 12:20:30 2013 +0200
* shr.el (shr-render-td): Support horizontal alignment.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index cb643db..951b062 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,7 @@
2013-06-17 Lars Magne Ingebrigtsen <[email protected]>
+ * shr.el (shr-render-td): Support horizontal alignment.
+
* eww.el (eww-put-color): Removed.
(eww-colorize-region): Use `add-face-text-property'.
diff --git a/lisp/shr.el b/lisp/shr.el
index e7169c5..d3b9a36 100644
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -1449,11 +1449,23 @@ ones, in case fg and bg are nil."
(if (zerop (buffer-size))
(insert (make-string width ? ))
;; Otherwise, fill the buffer.
+ (let ((align (cdr (assq :align cont)))
+ length)
(while (not (eobp))
(end-of-line)
- (when (> (- width (current-column)) 0)
- (insert (make-string (- width (current-column)) ? )))
- (forward-line 1)))
+ (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
commit b4e3caa6187781b601cb64618da784c4244a812d
Author: Lars Magne Ingebrigtsen <[email protected]>
Date: Mon Jun 17 12:07:08 2013 +0200
Make eww use `add-face-text-property', too.
(shr-make-overlay): Obsolete function.
* eww.el (eww-put-color): Removed.
(eww-colorize-region): Use `add-face-text-property'.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 68879f3..cb643db 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,7 +1,11 @@
2013-06-17 Lars Magne Ingebrigtsen <[email protected]>
+ * eww.el (eww-put-color): Removed.
+ (eww-colorize-region): Use `add-face-text-property'.
+
* shr.el (shr-add-font): Append face data, so that we get the correct
presedence: The innermost value (which is applied first) wins.
+ (shr-make-overlay): Obsolete function.
* mm-decode.el (mm-convert-shr-links): New function to convert
new-style shr URL links into widgets.
diff --git a/lisp/eww.el b/lisp/eww.el
index 6460ee7..fc0e413 100644
--- a/lisp/eww.el
+++ b/lisp/eww.el
@@ -172,12 +172,11 @@
(let ((new-colors (shr-color-check fg bg)))
(when new-colors
(when fg
- (eww-put-color start end :foreground (cadr new-colors)))
+ (add-face-text-property start end
+ (list :foreground (cadr new-colors))))
(when bg
- (eww-put-color start end :background (car new-colors)))))))
-
-(defun eww-put-color (start end type color)
- (shr-put-color-1 start end type color))
+ (add-face-text-property start end
+ (list :background (car new-colors))))))))
(defun eww-display-raw (charset)
(let ((data (buffer-substring (point) (point-max))))
diff --git a/lisp/shr.el b/lisp/shr.el
index ff8c918..e7169c5 100644
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -609,11 +609,6 @@ size, and full-buffer size."
(dolist (type types)
(shr-add-font (or shr-start (point)) (point) type))))
-(defun shr-make-overlay (beg end &optional buffer front-advance rear-advance)
- (let ((overlay (make-overlay beg end buffer front-advance rear-advance)))
- (overlay-put overlay 'evaporate t)
- overlay))
-
;; Add face to the region, but avoid putting the font properties on
;; blank text at the start of the line, and the newline at the end, to
;; avoid ugliness.
commit c51a478e5206246505408b920b26fd998cd2bb7c
Author: Lars Magne Ingebrigtsen <[email protected]>
Date: Mon Jun 17 11:55:17 2013 +0200
Get correct presedence for font data
* shr.el (shr-add-font): Append face data, so that we get the correct
presedence: The innermost value (which is applied first) wins.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f7d942f..68879f3 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,8 @@
2013-06-17 Lars Magne Ingebrigtsen <[email protected]>
+ * shr.el (shr-add-font): Append face data, so that we get the correct
+ presedence: The innermost value (which is applied first) wins.
+
* mm-decode.el (mm-convert-shr-links): New function to convert
new-style shr URL links into widgets.
(mm-shr): Use it.
diff --git a/lisp/shr.el b/lisp/shr.el
index b394607..ff8c918 100644
--- a/lisp/shr.el
+++ b/lisp/shr.el
@@ -623,7 +623,7 @@ size, and full-buffer size."
(while (< (point) end)
(when (bolp)
(skip-chars-forward " "))
- (add-face-text-property (point) (min (line-end-position) end) type)
+ (add-face-text-property (point) (min (line-end-position) end) type t)
(if (< (line-end-position) end)
(forward-line 1)
(goto-char end)))))
@@ -843,32 +843,11 @@ ones, in case fg and bg are nil."
(let ((new-colors (shr-color-check fg bg)))
(when new-colors
(when fg
- (shr-put-color start end :foreground (cadr new-colors)))
+ (shr-add-font start end (list :foreground (cadr new-colors))))
(when bg
- (shr-put-color start end :background (car new-colors))))
+ (shr-add-font start end (list :background (car new-colors)))))
new-colors)))
-;; Put a color in the region, but avoid putting colors on blank
-;; text at the start of the line, and the newline at the end, to avoid
-;; ugliness. Also, don't overwrite any existing color information,
-;; since this can be called recursively, and we want the "inner" color
-;; to win.
-(defun shr-put-color (start end type color)
- (save-excursion
- (goto-char start)
- (while (< (point) end)
- (when (and (bolp)
- (not (eq type :background)))
- (skip-chars-forward " "))
- (when (> (line-end-position) (point))
- (shr-put-color-1 (point) (min (line-end-position) end) type color))
- (if (< (line-end-position) end)
- (forward-line 1)
- (goto-char end)))
- (when (and (eq type :background)
- (= shr-table-depth 0))
- (shr-expand-newlines start end color))))
-
(defun shr-expand-newlines (start end color)
(save-restriction
;; Skip past all white space at the start and ends.
@@ -919,24 +898,6 @@ ones, in case fg and bg are nil."
'before-string)))))
(+ width previous-width))))
-(defun shr-put-color-1 (start end type color)
- (let* ((old-props (get-text-property start 'face))
- (do-put (and (listp old-props)
- (not (memq type old-props))))
- change)
- (while (< start end)
- (setq change (next-single-property-change start 'face nil end))
- (when do-put
- (add-face-text-property start change (list type color)))
- (setq old-props (get-text-property change 'face))
- (setq do-put (and (listp old-props)
- (not (memq type old-props))))
- (setq start change))
- (when (and do-put
- (> end start))
- (put-text-property start end 'face
- (nconc (list type color old-props))))))
-
;;; Tag-specific rendering rules.
(defun shr-tag-body (cont)
@@ -1381,7 +1342,8 @@ ones, in case fg and bg are nil."
(insert (make-string (string-width (car lines)) ? )
shr-table-vertical-line)
(when (nth 4 column)
- (shr-put-color start (1- (point)) :background (nth 4 column))))
+ (shr-add-font start (1- (point))
+ (list :background (nth 4 column)))))
(forward-line 1)))))
(shr-insert-table-ruler widths)))
@@ -1567,7 +1529,7 @@ ones, in case fg and bg are nil."
;; Emacs less than 24.3
(unless (fboundp 'add-face-text-property)
- (defun add-face-text-property (beg end face)
+ (defun add-face-text-property (beg end face &optional appendp object)
"Combine FACE BEG and END."
(let ((b beg))
(while (< b end)
@@ -1578,9 +1540,13 @@ ones, in case fg and bg are nil."
face)
((and (consp oldval)
(not (keywordp (car oldval))))
- (cons face oldval))
+ (if appendp
+ (nconc oldval (list face))
+ (cons face oldval)))
(t
- (list face oldval)))))))))
+ (if appendp
+ (list oldval face)
+ (list face oldval))))))))))
(provide 'shr)
-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.
Summary of changes:
lisp/ChangeLog | 9 ++++++
lisp/eww.el | 9 ++---
lisp/shr.el | 85 +++++++++++++++++++-------------------------------------
3 files changed, 42 insertions(+), 61 deletions(-)
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".
The branch, master has been updated
hooks/post-receive
--
Gnus Project