From 21c58ae2a804b00812d3e609806326ac5d301e34 Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Tue, 13 Aug 2013 20:09:50 +0200 Subject: [PATCH] Make shr feed Content-Type to the image-creating libraries This finally makes it possible to display icons. * net/eww.el (eww-display-image): Ditto. * net/shr.el (shr-parse-image-data): New function to grab both the data itself and the Content-Type. (shr-put-image): Use it. --- lisp/ChangeLog | 6 ++++++ lisp/net/eww.el | 2 +- lisp/net/shr.el | 37 ++++++++++++++++++++++++++++--------- 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 @@ 2013-08-13 Lars Magne Ingebrigtsen + * net/shr.el (shr-parse-image-data): New function to grab both the + data itself and the Content-Type. + (shr-put-image): Use it. + + * net/eww.el (eww-display-image): Ditto. + * image.el (image-content-type-suffixes): New variable. 2013-08-13 Fabián Ezequiel Gallina 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'." (goto-char (point-min)))) (defun eww-display-image () - (let ((data (buffer-substring (point) (point-max)))) + (let ((data (shr-parse-image-data))) (eww-setup-buffer) (let ((inhibit-read-only t)) (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'." (url-store-in-cache image-buffer) (when (or (search-forward "\n\n" nil t) (search-forward "\r\n\r\n" nil t)) - (let ((data (buffer-substring (point) (point-max)))) + (let ((data (shr-parse-image-data))) (with-current-buffer buffer (save-excursion (let ((alt (buffer-substring start end)) @@ -732,20 +732,28 @@ If EXTERNAL, browse the URL using `shr-external-browser'." (setq payload (base64-decode-string payload))) payload))) -(defun shr-put-image (data alt &optional flags) - "Put image DATA with a string ALT. Return image." +(defun shr-put-image (spec alt &optional flags) + "Insert image SPEC with a string ALT. Return image. +SPEC is either an image data blob, or a list where the first +element is the data blob and the second element is the content-type." (if (display-graphic-p) (let* ((size (cdr (assq 'size flags))) + (data (if (consp spec) + (car spec) + spec)) + (content-type (and (consp spec) + (cadr spec))) (start (point)) (image (cond ((eq size 'original) - (create-image data nil t :ascent 100)) + (create-image data nil t :ascent 100 + :content-type content-type)) ((eq size 'full) (ignore-errors - (shr-rescale-image data t))) + (shr-rescale-image data t content-type))) (t (ignore-errors - (shr-rescale-image data)))))) + (shr-rescale-image data nil content-type)))))) (when image ;; When inserting big-ish pictures, put them at the ;; beginning of the line. @@ -767,7 +775,7 @@ If EXTERNAL, browse the URL using `shr-external-browser'." image) (insert alt))) -(defun shr-rescale-image (data &optional force) +(defun shr-rescale-image (data &optional force content-type) "Rescale DATA, if too big, to fit the current buffer. If FORCE, rescale the image anyway." (if (or (not (fboundp 'imagemagick-types)) @@ -782,7 +790,8 @@ If FORCE, rescale the image anyway." :max-width (truncate (* shr-max-image-proportion (- (nth 2 edges) (nth 0 edges)))) :max-height (truncate (* shr-max-image-proportion - (- (nth 3 edges) (nth 1 edges)))))))) + (- (nth 3 edges) (nth 1 edges)))) + :content-type content-type)))) ;; url-cache-extract autoloads url-cache. (declare-function url-cache-create-filename "url-cache" (url)) @@ -799,7 +808,17 @@ Return a string with image data." t) (when (or (search-forward "\n\n" nil t) (search-forward "\r\n\r\n" nil t)) - (buffer-substring (point) (point-max)))))) + (shr-parse-image-data))))) + +(defun shr-parse-image-data () + (list + (buffer-substring (point) (point-max)) + (save-excursion + (save-restriction + (narrow-to-region (point-min) (point)) + (let ((content-type (mail-fetch-field "content-type"))) + (and content-type + (intern content-type obarray))))))) (defun shr-image-displayer (content-function) "Return a function to display an image. -- 2.39.2