emacs/lisp/image/image-converter.el
Lars Ingebrigtsen f5667953f7 Give better error messages in image-convert
* lisp/image/image-converter.el (image-convert): Make
image-convert bug out earlier on a wrong IMAGE-FORMAT value
(bug#38310).
2019-11-22 13:15:46 +01:00

247 lines
10 KiB
EmacsLisp

;;; image-converter.el --- Converting images from exotic formats -*- lexical-binding: t -*-
;; Copyright (C) 2019 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: images
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; The main interface function here is `image-convert'.
;;; Code:
(require 'cl-generic)
(eval-when-compile (require 'cl-lib))
(defcustom image-converter nil
"Type of the external image converter to use.
The value should a symbol, either `imagemagick', `graphicsmagick',
or `ffmpeg'.
If nil, Emacs will try to find one of the supported converters
installed on the system."
:group 'image
:type 'symbol
:version "27.1")
(defvar image-converter-regexp nil
"A regexp that matches the file name suffixes that can be converted.")
(defvar image-converter--converters
'((graphicsmagick :command ("gm" "convert") :probe ("-list" "format"))
(ffmpeg :command "ffmpeg" :probe "-decoders")
(imagemagick :command "convert" :probe ("-list" "format")))
"List of supported image converters to try.")
(defun image-convert-p (source &optional data-p)
"Return `image-convert' if SOURCE is an image that can be converted.
SOURCE can either be a file name or a string containing image
data. In the latter case, DATA-P should be non-nil. If DATA-P
is a string, it should be a MIME format string like
\"image/gif\"."
;; Find an installed image converter.
(unless image-converter
(image-converter--find-converter))
(and image-converter
(or (and (not data-p)
(string-match image-converter-regexp source))
(and data-p
(symbolp data-p)
(string-match "/" (symbol-name data-p))
(string-match
image-converter-regexp
(concat "foo." (image-converter--mime-type data-p)))))
'image-convert))
(defun image-convert (image &optional image-format)
"Convert IMAGE file to the PNG format.
IMAGE can either be a file name or image data.
To pass in image data, IMAGE should a string containing the image
data, and IMAGE-FORMAT should be a symbol with a MIME format name
like \"image/webp\". For instance:
(image-convert data-string 'image/bmp)
IMAGE can also be an image object as returned by `create-image'.
This function converts the image to PNG, and the converted image
data is returned as a string."
;; Find an installed image converter.
(unless image-converter
(image-converter--find-converter))
(unless image-converter
(error "No external image converters available"))
(when (and image-format
(not (= (length (split-string (symbol-name image-format) "/")) 2)))
(error "IMAGE-FORMAT should be a symbol like `image/png'"))
(with-temp-buffer
(set-buffer-multibyte nil)
(when-let ((err (image-converter--convert
image-converter
(if (listp image)
(plist-get (cdr image) :file)
image)
(if (listp image)
(plist-get (cdr image) :data-p)
image-format))))
(error "%s" err))
(if (listp image)
;; Return an image object that's the same as we were passed,
;; but ignore the :type value.
(apply #'create-image (buffer-string) 'png t
(cl-loop for (key val) on (cdr image) by #'cddr
unless (eq key :type)
append (list key val)))
(buffer-string))))
(defun image-converter--value (type elem)
"Return the value of ELEM of image converter TYPE."
(let ((value (plist-get (cdr (assq type image-converter--converters)) elem)))
(if (stringp value)
(list value)
value)))
(cl-defmethod image-converter--probe ((type (eql graphicsmagick)))
"Check whether the system has GraphicsMagick installed."
(with-temp-buffer
(let ((command (image-converter--value type :command))
formats)
(when (and (executable-find (car command))
(zerop (apply #'call-process (car command) nil '(t nil) nil
(append (cdr command)
(image-converter--value type :probe)))))
(goto-char (point-min))
(when (re-search-forward "^-" nil t)
(forward-line 1)
;; Lines look like
;; " 8BIM P rw- Photoshop resource format".
(while (re-search-forward "^ *\\([A-Z0-9]+\\) +. +r" nil t)
(push (downcase (match-string 1)) formats)))
(nreverse formats)))))
(cl-defmethod image-converter--probe ((type (eql imagemagick)))
"Check whether the system has ImageMagick installed."
(with-temp-buffer
(let ((command (image-converter--value type :command))
formats)
;; Can't check return value; ImageMagick convert usually returns
;; a non-zero result on "-list format".
(when (executable-find (car command))
(apply #'call-process (car command) nil '(t nil) nil
(append (cdr command) (image-converter--value type :probe))))
(goto-char (point-min))
(when (re-search-forward "^-" nil t)
(forward-line 1)
;; Lines look like
;; " WPG* r-- Word Perfect Graphics".
(while (re-search-forward "^ *\\([A-Z0-9]+\\)\\*? +r" nil t)
(push (downcase (match-string 1)) formats)))
(nreverse formats))))
(cl-defmethod image-converter--probe ((type (eql ffmpeg)))
"Check whether the system has ffmpeg installed."
(with-temp-buffer
(let ((command (image-converter--value type :command))
formats)
(when (and (executable-find (car command))
(zerop (apply #'call-process (car command) nil '(t nil) nil
(append (cdr command)
(image-converter--value type :probe)))))
(goto-char (point-min))
(when (re-search-forward "^ *-" nil t)
(forward-line 1)
;; Lines look like
;; " V....D alias_pix Alias/Wavefront PIX image"
(while (re-search-forward "^ *V[^ ]+ +\\([a-z0-9_]+\\)" nil t)
(push (match-string 1) formats)))
(nreverse formats)))))
(defun image-converter--find-converter ()
"Find an installed image converter."
(catch 'done
(dolist (elem image-converter--converters)
(when-let ((formats (image-converter--probe (car elem))))
(setq image-converter (car elem)
image-converter-regexp (concat "\\." (regexp-opt formats) "\\'"))
(throw 'done image-converter)))))
(cl-defmethod image-converter--convert ((type (eql graphicsmagick)) source
image-format)
"Convert using GraphicsMagick."
(image-converter--convert-magick type source image-format))
(cl-defmethod image-converter--convert ((type (eql imagemagick)) source
image-format)
"Convert using ImageMagick."
(image-converter--convert-magick type source image-format))
(defun image-converter--mime-type (image-format)
(and (symbolp image-format)
(cadr (split-string (symbol-name image-format) "/"))))
(defun image-converter--convert-magick (type source image-format)
(let ((command (image-converter--value type :command)))
(unless (zerop (if image-format
;; We have the image data in SOURCE.
(progn
(insert source)
(apply #'call-process-region (point-min) (point-max)
(car command) t t nil
(append
(cdr command)
(list (format "%s:-"
(image-converter--mime-type
image-format))
"png:-"))))
;; SOURCE is a file name.
(apply #'call-process (car command)
nil t nil
(append (cdr command)
(list (expand-file-name source) "png:-")))))
;; If the command failed, hopefully the buffer contains the
;; error message.
(buffer-string))))
(cl-defmethod image-converter--convert ((type (eql ffmpeg)) source
image-format)
"Convert using ffmpeg."
(let ((command (image-converter--value type :command)))
(unless (zerop (if image-format
(progn
(insert source)
(apply #'call-process-region
(point-min) (point-max) (car command)
t '(t nil) nil
(append
(cdr command)
(list "-i" "-"
"-c:v" "png"
"-f" "image2pipe" "-"))))
(apply #'call-process
(car command)
nil '(t nil) nil
(append (cdr command)
(list "-i" (expand-file-name source)
"-c:v" "png" "-f" "image2pipe"
"-")))))
"ffmpeg error when converting")))
(provide 'image-converter)
;;; image-converter.el ends here