summaryrefslogtreecommitdiff
path: root/lisp/gnus/shr.el
diff options
context:
space:
mode:
authorGnus developers <ding@gnus.org>2010-10-30 05:59:34 +0000
committerKatsumi Yamaoka <yamaoka@jpl.org>2010-10-30 05:59:34 +0000
commit99e65b2d2e79edf3ed0c4f00916098d4ea3767f4 (patch)
tree700dfa334160dd15bd301528982a1f53a734ffc9 /lisp/gnus/shr.el
parent88f43c67491e301d5e0fe4476d1a7203c64a3762 (diff)
downloademacs-99e65b2d2e79edf3ed0c4f00916098d4ea3767f4.tar.gz
emacs-99e65b2d2e79edf3ed0c4f00916098d4ea3767f4.tar.bz2
emacs-99e65b2d2e79edf3ed0c4f00916098d4ea3767f4.zip
Merge changes made in Gnus trunk.
gnus.el: Remove `gnus-nntp-service' variable. gnus.el: Make gnus-nntp-server and gnus-secondary-servers obsolete. gnus-sum.el (gnus-summary-delete-marked-as-read, gnus-summary-delete-marked-with): Remove obsolete defalias. gnus.el (gnus-use-long-file-name): Fix docstring. nnimap.el (nnimap-open-connection): Use AUTHENTICATE PLAIN on servers that say they support that. gnus-msg.el (gnus-inews-do-gcc): Don't have the backends do the slow *-request-group, which seems unnecessary. gnus-group.el (gnus-group-get-new-news-this-group): Don't have point move to the previous line on `M-g'. nnimap.el (nnimap-split-incoming-mail): Note that the INBOX has been selected. nnimap.el: Allow the user to say whether to split old messages or not in nnimap. shr.el (shr-tag-table-1): Only insert the images after the top-level table. shr.el (shr-tag-span): Drop colorisation of regions since we don't control the background color. shr.el (shr-tag-img): Ignore very small web bug type images. shr.el (shr-put-image): Add help-echo alt texts to the images. shr.el (shr-tag-video): Show the video poster image.
Diffstat (limited to 'lisp/gnus/shr.el')
-rw-r--r--lisp/gnus/shr.el65
1 files changed, 39 insertions, 26 deletions
diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el
index 8bb532eb27e..bbb7ff18a46 100644
--- a/lisp/gnus/shr.el
+++ b/lisp/gnus/shr.el
@@ -90,6 +90,7 @@ cid: URL as the argument.")
(defvar shr-list-mode nil)
(defvar shr-content-cache nil)
(defvar shr-kinsoku-shorten nil)
+(defvar shr-table-depth 0)
(defvar shr-map
(let ((map (make-sparse-keymap)))
@@ -369,18 +370,17 @@ redirects somewhere else."
(let ((alt (buffer-substring start end))
(inhibit-read-only t))
(delete-region start end)
- (shr-put-image data start alt))))))
+ (goto-char start)
+ (shr-put-image data alt))))))
(kill-buffer (current-buffer)))
-(defun shr-put-image (data point alt)
+(defun shr-put-image (data alt)
(if (display-graphic-p)
(let ((image (ignore-errors
(shr-rescale-image data))))
(when image
- (put-image image point alt)))
- (save-excursion
- (goto-char point)
- (insert alt))))
+ (insert-image image (or alt "*"))))
+ (insert alt)))
(defun shr-rescale-image (data)
(if (or (not (fboundp 'imagemagick-types))
@@ -470,14 +470,6 @@ Return a string with image data."
(defun shr-tag-s (cont)
(shr-fontize-cont cont 'strike-through))
-(defun shr-tag-span (cont)
- (let ((start (point))
- (color (cdr (assq 'color (shr-parse-style (cdr (assq :style cont)))))))
- (shr-generic cont)
- (when color
- (let ((overlay (make-overlay start (point))))
- (overlay-put overlay 'face (cons 'foreground-color color))))))
-
(defun shr-parse-style (style)
(when style
(let ((plist nil))
@@ -501,24 +493,43 @@ Return a string with image data."
(shr-urlify (or shr-start start) url)))
(defun shr-tag-object (cont)
- (let ((url (cdr (assq :src (cdr (assq 'embed cont)))))
- (start (point)))
+ (let ((start (point))
+ url)
+ (dolist (elem cont)
+ (when (eq (car elem) 'embed)
+ (setq url (or url (cdr (assq :src (cdr elem))))))
+ (when (and (eq (car elem) 'param)
+ (equal (cdr (assq :name (cdr elem))) "movie"))
+ (setq url (or url (cdr (assq :value (cdr elem)))))))
(when url
(shr-insert " [multimedia] ")
- (shr-urlify start url))))
+ (shr-urlify start url))
+ (shr-generic cont)))
+
+(defun shr-tag-video (cont)
+ (let ((image (cdr (assq :poster cont)))
+ (url (cdr (assq :src cont)))
+ (start (point)))
+ (shr-tag-img nil image)
+ (shr-urlify start url)))
-(defun shr-tag-img (cont)
- (when (and cont
- (cdr (assq :src cont)))
+(defun shr-tag-img (cont &optional url)
+ (when (or url
+ (and cont
+ (cdr (assq :src cont))))
(when (and (> (current-column) 0)
(not (eq shr-state 'image)))
(insert "\n"))
(let ((alt (cdr (assq :alt cont)))
- (url (cdr (assq :src cont))))
+ (url (or url (cdr (assq :src cont)))))
(let ((start (point-marker)))
(when (zerop (length alt))
(setq alt "[img]"))
(cond
+ ((or (member (cdr (assq :height cont)) '("0" "1"))
+ (member (cdr (assq :width cont)) '("0" "1")))
+ ;; Ignore zero-sized or single-pixel images.
+ )
((and (not shr-inhibit-images)
(string-match "\\`cid:" url))
(let ((url (substring url (match-end 0)))
@@ -526,7 +537,7 @@ Return a string with image data."
(if (or (not shr-content-function)
(not (setq image (funcall shr-content-function url))))
(insert alt)
- (shr-put-image image (point) alt))))
+ (shr-put-image image alt))))
((or shr-inhibit-images
(and shr-blocked-images
(string-match shr-blocked-images url)))
@@ -536,17 +547,17 @@ Return a string with image data."
(shr-insert (substring alt 0 8))
(shr-insert alt))))
((url-is-cached (shr-encode-url url))
- (shr-put-image (shr-get-image-data url) (point) alt))
+ (shr-put-image (shr-get-image-data url) alt))
(t
(insert alt)
(ignore-errors
(url-retrieve (shr-encode-url url) 'shr-image-fetched
(list (current-buffer) start (point-marker))
t))))
- (insert " ")
(put-text-property start (point) 'keymap shr-map)
(put-text-property start (point) 'shr-alt alt)
(put-text-property start (point) 'shr-image url)
+ (put-text-property start (point) 'help-echo alt)
(setq shr-state 'image)))))
(defun shr-tag-pre (cont)
@@ -630,6 +641,7 @@ Return a string with image data."
(setq cont (or (cdr (assq 'tbody cont))
cont))
(let* ((shr-inhibit-images t)
+ (shr-table-depth (1+ shr-table-depth))
(shr-kinsoku-shorten t)
;; Find all suggested widths.
(columns (shr-column-specs cont))
@@ -651,8 +663,9 @@ Return a string with image data."
;; Finally, insert all the images after the table. The Emacs buffer
;; model isn't strong enough to allow us to put the images actually
;; into the tables.
- (dolist (elem (shr-find-elements cont 'img))
- (shr-tag-img (cdr elem))))
+ (when (zerop shr-table-depth)
+ (dolist (elem (shr-find-elements cont 'img))
+ (shr-tag-img (cdr elem)))))
(defun shr-tag-table (cont)
(shr-ensure-paragraph)