From 7d43e6ed260c7e920b656a21a4876b87b277d81d Mon Sep 17 00:00:00 2001 From: dickmao Date: Fri, 15 Jan 2021 18:02:44 -0500 Subject: [PATCH] Avoid gif89a explosions With the increased use of gif89a, my gnus is achieving memory consumption singularity more frequently. * lisp/net/shr.el (shr-put-image): When content-type is application/octet-stream, do not attempt insert-image. * test/src/xdisp-tests.el (xdisp-tests--window-text-pixel-size, xdisp-tests--window-text-pixel-size-leading-space, xdisp-tests--window-text-pixel-size-trailing-space): `make check` currently fails without conditioning these tests for graphics display. --- lisp/net/shr.el | 53 ++++++++++++++++++++------------------ test/src/xdisp-tests.el | 57 ++++++++++++++++++++++------------------- 2 files changed, 58 insertions(+), 52 deletions(-) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 9c3740fccc..eb69668f32 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1109,46 +1109,49 @@ shr-put-image "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 (image) + (when (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 - :format content-type)) - ((eq content-type 'image/svg+xml) - (when (image-type-available-p 'svg) - (create-image data 'svg t :ascent 100))) - ((eq size 'full) - (ignore-errors - (shr-rescale-image data content-type - (plist-get flags :width) - (plist-get flags :height)))) - (t - (ignore-errors - (shr-rescale-image data content-type - (plist-get flags :width) - (plist-get flags :height))))))) + (start (point))) + (setq image + (cond + ((eq size 'original) + (create-image data nil t :ascent 100 + :format content-type)) + ((eq content-type 'image/svg+xml) + (when (image-type-available-p 'svg) + (create-image data 'svg t :ascent 100))) + ((eq content-type 'application/octet-stream) + nil) + ((eq size 'full) + (ignore-errors + (shr-rescale-image data content-type + (plist-get flags :width) + (plist-get flags :height)))) + (t + (ignore-errors + (shr-rescale-image data content-type + (plist-get flags :width) + (plist-get flags :height)))))) (when image ;; When inserting big-ish pictures, put them at the ;; beginning of the line. - (when (and (> (current-column) 0) + (when (and (> (current-column) 0) (> (car (image-size image t)) 400)) (insert "\n")) (if (eq size 'original) (insert-sliced-image image (or alt "*") nil 20 1) (insert-image image (or alt "*"))) - (put-text-property start (point) 'image-size size) - (when (and shr-image-animate + (put-text-property start (point) 'image-size size) + (when (and shr-image-animate (cdr (image-multi-frame-p image))) - (image-animate image nil 60))) - image) - (insert (or alt "")))) + (image-animate image nil 60))))) + (or image (insert (or alt ""))))) (defun shr--image-type () "Emacs image type to use when displaying images. diff --git a/test/src/xdisp-tests.el b/test/src/xdisp-tests.el index ec96d777ff..de92d26ef8 100644 --- a/test/src/xdisp-tests.el +++ b/test/src/xdisp-tests.el @@ -72,34 +72,37 @@ xdisp-tests--minibuffer-scroll (should (equal (nth 0 posns) (nth 1 posns))) (should (equal (nth 1 posns) (nth 2 posns))))) -(ert-deftest xdisp-tests--window-text-pixel-size () ;; bug#45748 - (with-temp-buffer - (insert "xxx") - (let* ((window - (display-buffer (current-buffer) '(display-buffer-in-child-frame . nil))) - (char-width (frame-char-width)) - (size (window-text-pixel-size nil t t))) - (delete-frame (window-frame window)) - (should (equal (/ (car size) char-width) 3))))) +(when (display-graphic-p) + (ert-deftest xdisp-tests--window-text-pixel-size () ;; bug#45748 + (with-temp-buffer + (insert "xxx") + (let* ((window + (display-buffer (current-buffer) '(display-buffer-in-child-frame . nil))) + (char-width (frame-char-width)) + (size (window-text-pixel-size nil t t))) + (delete-frame (window-frame window)) + (should (equal (/ (car size) char-width) 3)))))) -(ert-deftest xdisp-tests--window-text-pixel-size-leading-space () ;; bug#45748 - (with-temp-buffer - (insert " xx") - (let* ((window - (display-buffer (current-buffer) '(display-buffer-in-child-frame . nil))) - (char-width (frame-char-width)) - (size (window-text-pixel-size nil t t))) - (delete-frame (window-frame window)) - (should (equal (/ (car size) char-width) 3))))) +(when (display-graphic-p) + (ert-deftest xdisp-tests--window-text-pixel-size-leading-space () ;; bug#45748 + (with-temp-buffer + (insert " xx") + (let* ((window + (display-buffer (current-buffer) '(display-buffer-in-child-frame . nil))) + (char-width (frame-char-width)) + (size (window-text-pixel-size nil t t))) + (delete-frame (window-frame window)) + (should (equal (/ (car size) char-width) 3)))))) -(ert-deftest xdisp-tests--window-text-pixel-size-trailing-space () ;; bug#45748 - (with-temp-buffer - (insert "xx ") - (let* ((window - (display-buffer (current-buffer) '(display-buffer-in-child-frame . nil))) - (char-width (frame-char-width)) - (size (window-text-pixel-size nil t t))) - (delete-frame (window-frame window)) - (should (equal (/ (car size) char-width) 3))))) +(when (display-graphic-p) + (ert-deftest xdisp-tests--window-text-pixel-size-trailing-space () ;; bug#45748 + (with-temp-buffer + (insert "xx ") + (let* ((window + (display-buffer (current-buffer) '(display-buffer-in-child-frame . nil))) + (char-width (frame-char-width)) + (size (window-text-pixel-size nil t t))) + (delete-frame (window-frame window)) + (should (equal (/ (car size) char-width) 3)))))) ;;; xdisp-tests.el ends here -- 2.26.2