aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog6
-rw-r--r--lisp/net/eww.el2
-rw-r--r--lisp/net/shr.el37
3 files changed, 35 insertions, 10 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c6f11fec11a..17648f6a540 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,11 @@
12013-08-13 Lars Magne Ingebrigtsen <larsi@gnus.org> 12013-08-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
2 2
3 * net/shr.el (shr-parse-image-data): New function to grab both the
4 data itself and the Content-Type.
5 (shr-put-image): Use it.
6
7 * net/eww.el (eww-display-image): Ditto.
8
3 * image.el (image-content-type-suffixes): New variable. 9 * image.el (image-content-type-suffixes): New variable.
4 10
52013-08-13 Fabián Ezequiel Gallina <fgallina@gnu.org> 112013-08-13 Fabián Ezequiel Gallina <fgallina@gnu.org>
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index a689ff2ae9f..34934a03549 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -304,7 +304,7 @@ word(s) will be searched for via `eww-search-prefix'."
304 (goto-char (point-min)))) 304 (goto-char (point-min))))
305 305
306(defun eww-display-image () 306(defun eww-display-image ()
307 (let ((data (buffer-substring (point) (point-max)))) 307 (let ((data (shr-parse-image-data)))
308 (eww-setup-buffer) 308 (eww-setup-buffer)
309 (let ((inhibit-read-only t)) 309 (let ((inhibit-read-only t))
310 (shr-put-image data nil)) 310 (shr-put-image data nil))
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index bc454292360..ed47c502e11 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -705,7 +705,7 @@ If EXTERNAL, browse the URL using `shr-external-browser'."
705 (url-store-in-cache image-buffer) 705 (url-store-in-cache image-buffer)
706 (when (or (search-forward "\n\n" nil t) 706 (when (or (search-forward "\n\n" nil t)
707 (search-forward "\r\n\r\n" nil t)) 707 (search-forward "\r\n\r\n" nil t))
708 (let ((data (buffer-substring (point) (point-max)))) 708 (let ((data (shr-parse-image-data)))
709 (with-current-buffer buffer 709 (with-current-buffer buffer
710 (save-excursion 710 (save-excursion
711 (let ((alt (buffer-substring start end)) 711 (let ((alt (buffer-substring start end))
@@ -732,20 +732,28 @@ If EXTERNAL, browse the URL using `shr-external-browser'."
732 (setq payload (base64-decode-string payload))) 732 (setq payload (base64-decode-string payload)))
733 payload))) 733 payload)))
734 734
735(defun shr-put-image (data alt &optional flags) 735(defun shr-put-image (spec alt &optional flags)
736 "Put image DATA with a string ALT. Return image." 736 "Insert image SPEC with a string ALT. Return image.
737SPEC is either an image data blob, or a list where the first
738element is the data blob and the second element is the content-type."
737 (if (display-graphic-p) 739 (if (display-graphic-p)
738 (let* ((size (cdr (assq 'size flags))) 740 (let* ((size (cdr (assq 'size flags)))
741 (data (if (consp spec)
742 (car spec)
743 spec))
744 (content-type (and (consp spec)
745 (cadr spec)))
739 (start (point)) 746 (start (point))
740 (image (cond 747 (image (cond
741 ((eq size 'original) 748 ((eq size 'original)
742 (create-image data nil t :ascent 100)) 749 (create-image data nil t :ascent 100
750 :content-type content-type))
743 ((eq size 'full) 751 ((eq size 'full)
744 (ignore-errors 752 (ignore-errors
745 (shr-rescale-image data t))) 753 (shr-rescale-image data t content-type)))
746 (t 754 (t
747 (ignore-errors 755 (ignore-errors
748 (shr-rescale-image data)))))) 756 (shr-rescale-image data nil content-type))))))
749 (when image 757 (when image
750 ;; When inserting big-ish pictures, put them at the 758 ;; When inserting big-ish pictures, put them at the
751 ;; beginning of the line. 759 ;; beginning of the line.
@@ -767,7 +775,7 @@ If EXTERNAL, browse the URL using `shr-external-browser'."
767 image) 775 image)
768 (insert alt))) 776 (insert alt)))
769 777
770(defun shr-rescale-image (data &optional force) 778(defun shr-rescale-image (data &optional force content-type)
771 "Rescale DATA, if too big, to fit the current buffer. 779 "Rescale DATA, if too big, to fit the current buffer.
772If FORCE, rescale the image anyway." 780If FORCE, rescale the image anyway."
773 (if (or (not (fboundp 'imagemagick-types)) 781 (if (or (not (fboundp 'imagemagick-types))
@@ -782,7 +790,8 @@ If FORCE, rescale the image anyway."
782 :max-width (truncate (* shr-max-image-proportion 790 :max-width (truncate (* shr-max-image-proportion
783 (- (nth 2 edges) (nth 0 edges)))) 791 (- (nth 2 edges) (nth 0 edges))))
784 :max-height (truncate (* shr-max-image-proportion 792 :max-height (truncate (* shr-max-image-proportion
785 (- (nth 3 edges) (nth 1 edges)))))))) 793 (- (nth 3 edges) (nth 1 edges))))
794 :content-type content-type))))
786 795
787;; url-cache-extract autoloads url-cache. 796;; url-cache-extract autoloads url-cache.
788(declare-function url-cache-create-filename "url-cache" (url)) 797(declare-function url-cache-create-filename "url-cache" (url))
@@ -799,7 +808,17 @@ Return a string with image data."
799 t) 808 t)
800 (when (or (search-forward "\n\n" nil t) 809 (when (or (search-forward "\n\n" nil t)
801 (search-forward "\r\n\r\n" nil t)) 810 (search-forward "\r\n\r\n" nil t))
802 (buffer-substring (point) (point-max)))))) 811 (shr-parse-image-data)))))
812
813(defun shr-parse-image-data ()
814 (list
815 (buffer-substring (point) (point-max))
816 (save-excursion
817 (save-restriction
818 (narrow-to-region (point-min) (point))
819 (let ((content-type (mail-fetch-field "content-type")))
820 (and content-type
821 (intern content-type obarray)))))))
803 822
804(defun shr-image-displayer (content-function) 823(defun shr-image-displayer (content-function)
805 "Return a function to display an image. 824 "Return a function to display an image.