projects
/
gnus
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
(shr-add-font): Use overlays for combining faces.
[gnus]
/
lisp
/
shr.el
diff --git
a/lisp/shr.el
b/lisp/shr.el
index
f7f9205
..
4a778b8
100644
(file)
--- a/
lisp/shr.el
+++ b/
lisp/shr.el
@@
-51,6
+51,8
@@
fit these criteria."
:type 'regexp)
(defvar shr-folding-mode nil)
:type 'regexp)
(defvar shr-folding-mode nil)
+(defvar shr-state nil)
+(defvar shr-start nil)
(defvar shr-width 70)
(defvar shr-width 70)
@@
-68,7
+70,9
@@
fit these criteria."
;;;###autoload
(defun shr-insert-document (dom)
;;;###autoload
(defun shr-insert-document (dom)
- (shr-descend (shr-transform-dom dom)))
+ (let ((shr-state nil)
+ (shr-start nil))
+ (shr-descend (shr-transform-dom dom))))
(defun shr-descend (dom)
(let ((function (intern (concat "shr-" (symbol-name (car dom))) obarray)))
(defun shr-descend (dom)
(let ((function (intern (concat "shr-" (symbol-name (car dom))) obarray)))
@@
-103,19
+107,20
@@
fit these criteria."
(shr-fontize-cont cont 'strikethru))
(defun shr-fontize-cont (cont type)
(shr-fontize-cont cont 'strikethru))
(defun shr-fontize-cont (cont type)
- (let (
(start (point))
)
+ (let (
shr-start
)
(shr-generic cont)
(shr-generic cont)
- (shr-add-font start (point) type)))
+ (shr-add-font s
hr-s
tart (point) type)))
(defun shr-add-font (start end type)
(defun shr-add-font (start end type)
- (put-text-property start end 'face type))
+ (let ((overlay (make-overlay start end)))
+ (overlay-put overlay 'face type)))
(defun shr-a (cont)
(defun shr-a (cont)
- (let ((
start (point
))
-
(url (cdr (assq :href cont)))
)
+ (let ((
url (cdr (assq :href cont)
))
+
shr-start
)
(shr-generic cont)
(widget-convert-button
(shr-generic cont)
(widget-convert-button
- 'link start (point)
+ 'link s
hr-s
tart (point)
:action 'shr-browse-url
:url url
:keymap widget-keymap
:action 'shr-browse-url
:url url
:keymap widget-keymap
@@
-134,14
+139,15
@@
fit these criteria."
((and shr-blocked-images
(string-match shr-blocked-images url))
(insert alt))
((and shr-blocked-images
(string-match shr-blocked-images url))
(insert alt))
- ((url-is-cached
url
)
+ ((url-is-cached
(browse-url-url-encode-chars url "[&)$ ]")
)
(shr-put-image (shr-get-image-data url) (point) alt))
(t
(insert alt)
(url-retrieve url 'shr-image-fetched
(list (current-buffer) start (point-marker))
t)))
(shr-put-image (shr-get-image-data url) (point) alt))
(t
(insert alt)
(url-retrieve url 'shr-image-fetched
(list (current-buffer) start (point-marker))
t)))
- (insert " "))))
+ (insert " ")
+ (setq shr-state 'image))))
(defun shr-image-fetched (status buffer start end)
(when (and (buffer-name buffer)
(defun shr-image-fetched (status buffer start end)
(when (and (buffer-name buffer)
@@
-204,6
+210,9
@@
fit these criteria."
(insert "\n")))
(defun shr-insert (text)
(insert "\n")))
(defun shr-insert (text)
+ (when (eq shr-state 'image)
+ (insert "\n")
+ (setq shr-state nil))
(cond
((eq shr-folding-mode 'none)
(insert t))
(cond
((eq shr-folding-mode 'none)
(insert t))
@@
-211,11
+220,16
@@
fit these criteria."
(let (column)
(dolist (elem (split-string text))
(setq column (current-column))
(let (column)
(dolist (elem (split-string text))
(setq column (current-column))
- (if (zerop column)
- (insert elem)
+ (when (plusp column)
(if (> (+ column (length elem) 1) shr-width)
(if (> (+ column (length elem) 1) shr-width)
- (insert "\n" elem)
- (insert " " elem))))))))
+ (insert "\n")
+ (insert " ")))
+ ;; 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))))))
(defun shr-get-image-data (url)
"Get image data for URL.
(defun shr-get-image-data (url)
"Get image data for URL.