(defcustom image-dired-cmd-create-thumbnail-program
(if (executable-find "gm") "gm" "convert")
- "Executable used to create thumbnail.
-Used together with `image-dired-cmd-create-thumbnail-options'."
+ "File name of the executable used to create thumbnails.
+Used together with `image-dired-cmd-create-thumbnail-options'.
+On MS-Windows, if such an executable is not available, Emacs
+will use `w32image-create-thumbnail' to create thumbnails."
:type 'file
:version "29.1")
"-strip" "jpeg:%t")))
(if (executable-find "gm") (cons "convert" opts) opts))
"Options of command used to create thumbnail image.
-Used with `image-dired-cmd-create-thumbnail-program'.
+Used with `image-dired-cmd-create-thumbnail-program', if that is
+available.
Available format specifiers are:
%s, %w and %h, which are replaced by `image-dired-thumb-size'
%f which is replaced by the file name of the original image and
(or (executable-find "pngquant")
(executable-find "pngnq-s9")
(executable-find "pngnq"))
- "The file name of the `pngquant' or `pngnq' program.
+ "The executable file name of the `pngquant' or `pngnq' program.
It quantizes colors of PNG images down to 256 colors or fewer
using the NeuQuant algorithm."
:version "29.1"
:version "29.1")
(defcustom image-dired-cmd-pngcrush-program (executable-find "pngcrush")
- "The file name of the `pngcrush' program.
+ "The executable file name of the `pngcrush' program.
It optimizes the compression of PNG images. It also adds PNG textual chunks
with the information required by the Thumbnail Managing Standard."
:type '(choice (const :tag "Not Set" nil) file))
:type '(repeat (string :tag "Argument")))
(defcustom image-dired-cmd-optipng-program (executable-find "optipng")
- "The file name of the `optipng' program."
+ "The executable file name of the `optipng' program."
:version "26.1"
:type '(choice (const :tag "Not Set" nil) file))
(defcustom image-dired-cmd-optipng-options '("-o5" "%t")
"Arguments passed to `image-dired-cmd-optipng-program'.
-The value can use format specifiers described in
+The value can use the same %-format specifiers as in
`image-dired-cmd-create-thumbnail-options'."
:version "26.1"
:type '(repeat (string :tag "Argument"))
"-thumbnail" "%wx%h>" "png:%t")))
(if (executable-find "gm") (cons "convert" opts) opts))
"Options for creating thumbnails according to the Thumbnail Managing Standard.
+Used with `image-dired-cmd-create-thumbnail-program', if that is available.
The value can use the same %-format specifiers as in
`image-dired-cmd-create-thumbnail-options', with \"%m\" for file
-modification time."
+modification time.
+On MS-Windows, if the `convert' command is not available, and
+`w32image-create-thumbnail' is used instead, the textual chunks
+specified by the \"-set\" options will not be injected, and instead
+they are added by `pngcrush' if that is available."
:type '(repeat (string :tag "Argument"))
:version "29.1")
(defcustom image-dired-cmd-rotate-original-program "jpegtran"
- "Executable program used to rotate original image.
+ "Executable file of a program used to rotate original image.
Used together with `image-dired-cmd-rotate-original-options'."
:type 'file)
(defcustom image-dired-temp-rotate-image-file
(expand-file-name ".image-dired_rotate_temp"
(locate-user-emacs-file "image-dired/"))
- "Temporary file for rotate operations."
+ "Temporary file for image rotation operations."
:type 'file)
(defcustom image-dired-cmd-write-exif-data-program "exiftool"
- "Program used to write EXIF data to image.
+ "Executable file of a program used to write EXIF data to images.
Used together with `image-dired-cmd-write-exif-data-options'."
:type 'file)
(defcustom image-dired-cmd-write-exif-data-options '("-%t=%v" "%f")
- "Arguments of command used to write EXIF data.
+ "Arguments of the command used to write EXIF data.
Used with `image-dired-cmd-write-exif-data-program'.
The value can use the following format specifiers are:
%f which is replaced by the image file name,
Increase at your own risk. If you want to experiment with this,
consider setting `image-dired-debug' to a non-nil value to see
the time spent on generating thumbnails. Run `clear-image-cache'
-and remove the cached thumbnail files between each trial run.")
+and remove the cached thumbnail files between each trial run.
+This is unused on MS-Windows when `w32image-create-thumbnail' is
+used instead of ImageMagick or GraphicsMagick commands.
+In addition, even if those commands are available, the actual number
+of concurrent jobs will be limited by 30 from above, since Emacs
+on MS-Windows cannot have too many concurrent sub-processes.")
(defun image-dired-pngnq-thumb (spec)
"Quantize thumbnail described by format SPEC with command `pngnq'."
- (let ((process
- (apply #'start-process "image-dired-pngnq" nil
- image-dired-cmd-pngnq-program
- (mapcar (lambda (arg) (format-spec arg spec))
- image-dired-cmd-pngnq-options))))
- (setf (process-sentinel process)
+ (let* ((snt
(lambda (process status)
- (if (and (eq (process-status process) 'exit)
- (zerop (process-exit-status process)))
+ (if (or (and (processp process) ; async case
+ (eq (process-status process) 'exit)
+ (zerop (process-exit-status process)))
+ (zerop status)) ; sync case
;; Pass off to pngcrush, or just rename the
;; THUMB-nq8.png file back to THUMB.png
(if (and image-dired-cmd-pngcrush-program
(let ((nq8 (cdr (assq ?q spec)))
(thumb (cdr (assq ?t spec))))
(rename-file nq8 thumb t)))
- (message "command %S %s" (process-command process)
- (string-replace "\n" "" status)))))
- process))
+ (if (processp process)
+ (message "command %S %s" (process-command process)
+ (string-replace "\n" "" status))))))
+ (proc
+ (let ((args (mapcar (lambda (arg) (format-spec arg spec))
+ image-dired-cmd-pngnq-options)))
+ (if (eq system-type 'windows-nt)
+ ;; Cannot safely use 'start-process' here, since awe
+ ;; could be called to produce thumbnails for many
+ ;; images, and we have a hard limitation of 32
+ ;; simultaneous sub-processes on MS-Windows.
+ (apply #'call-process
+ image-dired-cmd-pngnq-program nil nil nil args)
+ (apply #'start-process
+ "image-dired-pngnq" nil
+ image-dired-cmd-pngnq-program args)))))
+ (if (processp proc)
+ (setf (process-sentinel proc) snt)
+ (unless (zerop proc)
+ (message "command %S failed" image-dired-cmd-pngnq-program))
+ (funcall snt image-dired-cmd-pngnq-program proc))
+ proc))
(defun image-dired-pngcrush-thumb (spec)
"Optimize thumbnail described by format SPEC with command `pngcrush'."
(let ((temp (cdr (assq ?q spec)))
(thumb (cdr (assq ?t spec))))
(copy-file thumb temp)))
- (let ((process
- (apply #'start-process "image-dired-pngcrush" nil
- image-dired-cmd-pngcrush-program
- (mapcar (lambda (arg) (format-spec arg spec))
- image-dired-cmd-pngcrush-options))))
- (setf (process-sentinel process)
- (lambda (process status)
- (unless (and (eq (process-status process) 'exit)
- (zerop (process-exit-status process)))
- (message "command %S %s" (process-command process)
- (string-replace "\n" "" status)))
- (when (memq (process-status process) '(exit signal))
- (let ((temp (cdr (assq ?q spec))))
- (delete-file temp)))))
- process))
+ (let* ((args (mapcar
+ (lambda (arg)
+ (format-spec arg spec))
+ image-dired-cmd-pngcrush-options))
+ (snt (lambda (process status)
+ (unless (or (and (processp process)
+ (eq (process-status process) 'exit)
+ (zerop (process-exit-status process)))
+ (zerop status))
+ (if (processp process)
+ (message "command %S %s" (process-command process)
+ (string-replace "\n" "" status))
+ (message "command %S failed with status %s"
+ process status))
+ (when (or (not (processp process))
+ (memq (process-status process) '(exit signal)))
+ (let ((temp (cdr (assq ?q spec))))
+ (delete-file temp))))))
+ (proc
+ (if (eq system-type 'windows-nt)
+ ;; See above for the reasons we don't use 'start-process'
+ ;; on MS-Windows.
+ (apply #'call-process
+ image-dired-cmd-pngcrush-program nil nil nil args)
+ (apply #'start-process "image-dired-pngcrush" nil
+ image-dired-cmd-pngcrush-program args))))
+ (if (processp proc)
+ (setf (process-sentinel proc) snt)
+ (funcall snt image-dired-cmd-pngcrush-program proc))
+ proc))
(defun image-dired-optipng-thumb (spec)
"Optimize thumbnail described by format SPEC with command `optipng'."
- (let ((process
- (apply #'start-process "image-dired-optipng" nil
- image-dired-cmd-optipng-program
- (mapcar (lambda (arg) (format-spec arg spec))
- image-dired-cmd-optipng-options))))
- (setf (process-sentinel process)
- (lambda (process status)
- (unless (and (eq (process-status process) 'exit)
- (zerop (process-exit-status process)))
- (message "command %S %s" (process-command process)
- (string-replace "\n" "" status)))))
- process))
+ (let* ((args (mapcar
+ (lambda (arg)
+ (format-spec arg spec))
+ image-dired-cmd-optipng-options))
+ (snt (lambda (process status)
+ (unless (or (and (processp process)
+ (eq (process-status process) 'exit)
+ (zerop (process-exit-status process)))
+ (zerop status))
+ (if (processp process)
+ (message "command %S %s" (process-command process)
+ (string-replace "\n" "" status))
+ (message "command %S failed with status %s"
+ process status)))))
+ (proc
+ (if (eq system-type 'windows-nt)
+ ;; See above for the reasons we don't use 'start-process'
+ ;; on MS-Windows.
+ (apply #'call-process
+ image-dired-cmd-optipng-program nil nil nil args)
+ (apply #'start-process "image-dired-optipng" nil
+ image-dired-cmd-optipng-program args))))
+ (if (processp proc)
+ (setf (process-sentinel proc) snt)
+ (funcall snt image-dired-cmd-optipng-program proc))
+ proc))
(defun image-dired-create-thumb-1 (original-file thumbnail-file)
"For ORIGINAL-FILE, create thumbnail image named THUMBNAIL-FILE."
(message "Failed to create a thumbnail for %s"
(abbreviate-file-name original-file))
(clear-image-cache thumbnail-file)
- ;; FIXME: Add PNG optimization like image-dired-create-thumb-1 does.
- )
+ ;; PNG thumbnail has been created since we are following the XDG
+ ;; thumbnail spec, so try to optimize.
+ (when (memq image-dired-thumbnail-storage
+ image-dired--thumbnail-standard-sizes)
+ (let* ((modif-time (format-time-string
+ "%s" (file-attribute-modification-time
+ (file-attributes original-file))))
+ (thumbnail-nq8-file (replace-regexp-in-string
+ ".png\\'" "-nq8.png" thumbnail-file))
+ (spec `((?s . ,size) (?w . ,size) (?h . ,size)
+ (?m . ,modif-time)
+ (?f . ,original-file)
+ (?q . ,thumbnail-nq8-file)
+ (?t . ,thumbnail-file))))
+ (cond
+ ((and image-dired-cmd-pngnq-program
+ (executable-find image-dired-cmd-pngnq-program))
+ (image-dired-pngnq-thumb spec))
+ ((and image-dired-cmd-pngcrush-program
+ (executable-find image-dired-cmd-pngcrush-program))
+ (image-dired-pngcrush-thumb spec))
+ ((and image-dired-cmd-optipng-program
+ (executable-find image-dired-cmd-optipng-program))
+ (image-dired-optipng-thumb spec))))))
;; Trigger next in queue once a thumbnail has been created.
(image-dired-thumb-queue-run)))
'w32image-create-thumbnail)
'function))
;; We have a usable gm/convert command; queue thethumbnail jobs.
- (while (and image-dired-queue
- (< image-dired-queue-active-jobs
- image-dired-queue-active-limit))
- (cl-incf image-dired-queue-active-jobs)
- (apply #'image-dired-create-thumb-1 (pop image-dired-queue)))
- ;; We are on MS-Windows and need to generate thumbnails by our
- ;; lonesome selves.
+ (let ((max-jobs
+ (if (eq system-type 'windows-nt)
+ ;; Can't have more than 32 concurrent sub-processes on
+ ;; MS-Windows.
+ (min 30 image-dired-queue-active-limit)
+ image-dired-queue-active-limit)))
+ (while (and image-dired-queue
+ (< image-dired-queue-active-jobs max-jobs))
+ (cl-incf image-dired-queue-active-jobs)
+ (apply #'image-dired-create-thumb-1 (pop image-dired-queue))))
+ ;; We are on MS-Windows with ImageMagick/GraphicsMagick, and need to
+ ;; generate thumbnails by our lonesome selves.
(if image-dired-queue
(let* ((job (pop image-dired-queue))
(orig-file (car job))
projects / emacs.git / commitdiff