From bc2a5c112796ea9f072984b471f980e4321263b3 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 22 Oct 2021 10:59:01 +0200 Subject: Add WebP image format support (Bug#51296) * configure.ac (--with-webp): New option. (HAVE_WEBP): New variable. (emacs_config_features): Add webp. * src/image.c (enum webp_keyword_index) [HAVE_WEBP]: New enum. (webp_format) [HAVE_WEBP]: New variable. (webp_image_p, init_webp_functions, webp_load) [HAVE_WEBP]: New functions for WebP support. (image_types) [HAVE_WEBP]: Define WebP format. (syms_of_image) [HAVE_WEBP]: New DEFSYM. Add image type Qwebp. * src/Makefile.in (LIBIMAGE): Add WEBP_LIBS. * lisp/files.el (auto-mode-alist): * lisp/image-file.el (image-file-name-extensions): * lisp/image.el (image-type-header-regexps) (image-type-file-name-regexps, image-type-auto-detectable): Add WebP support. * lisp/term/w32-win.el (dynamic-library-alist): Add the libwebp DLL. * INSTALL: * admin/CPP-DEFINES: * doc/lispref/display.texi (Image Formats, Other Image Types): * nt/INSTALL: Document WebP support. * test/lisp/image-tests.el (image-find-image) (image-type-from-file-name): Expand tests. * test/src/image-tests.el (image-tests--files): Add WebP. (image-tests-image-size/webp, image-tests-image-mask-p/webp) (image-tests-image-metadata/webp): New tests. * test/data/image/black.webp: New file. --- test/lisp/image-tests.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'test/lisp/image-tests.el') diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el index aa8600609c4..c34c152cc99 100644 --- a/test/lisp/image-tests.el +++ b/test/lisp/image-tests.el @@ -49,12 +49,14 @@ (should (equal image '(image))))) (ert-deftest image-find-image () - (find-image '((:type xpm :file "undo.xpm"))) - (find-image '((:type png :file "newsticker/rss-feed.png" :ascent center)))) + (should (listp (find-image '((:type xpm :file "undo.xpm"))))) + (should (listp (find-image '((:type png :file "newsticker/rss-feed.png" :ascent center))))) + (should-not (find-image '((:type png :file "does-not-exist-foo-bar.png"))))) (ert-deftest image-type-from-file-name () (should (eq (image-type-from-file-name "foo.jpg") 'jpeg)) - (should (eq (image-type-from-file-name "foo.png") 'png))) + (should (eq (image-type-from-file-name "foo.png") 'png)) + (should (eq (image-type-from-file-name "foo.webp") 'webp))) (ert-deftest image-type/from-filename () ;; On emba, `image-types' and `image-load-path' do not exist. -- cgit v1.2.3 From 418b54e49217f43d72e3d0cc3cfb583c791328a8 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 24 Oct 2021 12:07:48 +0200 Subject: Expand tests for image-type-from-file-header * test/lisp/image-tests.el (image-tests--files): New defconst. (image-tests--type-from-file-header): New defun. (image-type-from-file-header-test/jpeg) (image-type-from-file-header-test/pbm) (image-type-from-file-header-test/png) (image-type-from-file-header-test/svg) (image-type-from-file-header-test/tiff) (image-type-from-file-header-test/webp) (image-type-from-file-header-test/xbm) (image-type-from-file-header-test/xpm): New tests. (image-type-from-file-header-test): Delete test. --- test/lisp/image-tests.el | 56 +++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 51 insertions(+), 5 deletions(-) (limited to 'test/lisp/image-tests.el') diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el index c34c152cc99..79b0014f60a 100644 --- a/test/lisp/image-tests.el +++ b/test/lisp/image-tests.el @@ -28,6 +28,27 @@ (expand-file-name "images" data-directory) "Directory containing Emacs images.") +(defconst image-tests--files + `((gif . ,(expand-file-name "test/data/image/black.gif" + source-directory)) + (jpeg . ,(expand-file-name "test/data/image/black.jpg" + source-directory)) + (pbm . ,(expand-file-name "splash.pbm" + image-tests--emacs-images-directory)) + (png . ,(expand-file-name "splash.png" + image-tests--emacs-images-directory)) + (svg . ,(expand-file-name "splash.svg" + image-tests--emacs-images-directory)) + (tiff . ,(expand-file-name + "nextstep/GNUstep/Emacs.base/Resources/emacs.tiff" + source-directory)) + (webp . ,(expand-file-name "test/data/image/black.webp" + source-directory)) + (xbm . ,(expand-file-name "gnus/gnus.xbm" + image-tests--emacs-images-directory)) + (xpm . ,(expand-file-name "splash.xpm" + image-tests--emacs-images-directory)))) + (ert-deftest image--set-property () "Test `image--set-property' behavior." (let ((image (list 'image))) @@ -64,12 +85,37 @@ (bound-and-true-p image-load-path))) (should (eq (image-type "foo.jpg") 'jpeg))) -(ert-deftest image-type-from-file-header-test () +(defun image-tests--type-from-file-header (type) "Test image-type-from-file-header." - (should (eq (if (image-type-available-p 'svg) 'svg) - (image-type-from-file-header - (expand-file-name "splash.svg" - image-tests--emacs-images-directory))))) + (should (eq (if (image-type-available-p type) type) + (image-type-from-file-header (cdr (assq type image-tests--files)))))) + +(ert-deftest image-type-from-file-header-test/gif () + (image-tests--type-from-file-header 'gif)) + +(ert-deftest image-type-from-file-header-test/jpeg () + (image-tests--type-from-file-header 'jpeg)) + +(ert-deftest image-type-from-file-header-test/pbm () + (image-tests--type-from-file-header 'pbm)) + +(ert-deftest image-type-from-file-header-test/png () + (image-tests--type-from-file-header 'png)) + +(ert-deftest image-type-from-file-header-test/svg () + (image-tests--type-from-file-header 'svg)) + +(ert-deftest image-type-from-file-header-test/tiff () + (image-tests--type-from-file-header 'tiff)) + +(ert-deftest image-type-from-file-header-test/webp () + (image-tests--type-from-file-header 'webp)) + +(ert-deftest image-type-from-file-header-test/xbm () + (image-tests--type-from-file-header 'xbm)) + +(ert-deftest image-type-from-file-header-test/xpm () + (image-tests--type-from-file-header 'xpm)) (ert-deftest image-rotate () "Test `image-rotate'." -- cgit v1.2.3