diff options
author | Gnus developers <ding@gnus.org> | 2010-10-30 05:59:34 +0000 |
---|---|---|
committer | Katsumi Yamaoka <yamaoka@jpl.org> | 2010-10-30 05:59:34 +0000 |
commit | 99e65b2d2e79edf3ed0c4f00916098d4ea3767f4 (patch) | |
tree | 700dfa334160dd15bd301528982a1f53a734ffc9 /lisp/gnus/shr.el | |
parent | 88f43c67491e301d5e0fe4476d1a7203c64a3762 (diff) | |
download | emacs-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.el | 65 |
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) |