* [RFC] making image-dired thumbnail creation asynchronous
@ 2016-12-16 2:36 Mark Oteiza
2016-12-16 8:21 ` Eli Zaretskii
0 siblings, 1 reply; 6+ messages in thread
From: Mark Oteiza @ 2016-12-16 2:36 UTC (permalink / raw)
To: emacs-devel
Hi,
The attached patch implements a TODO in image-dired, in addition to a
number of other things. If you feel so inclined to try the patch,
beware of running image-dired on a directory with many _large_ images,
as you may invoke the OOM killer :)
Itemizing the changes:
1. Turning all the -options defcustoms into lists of arguments, instead
of shell commands. We do not need to be abusing the shell.
2. Adding optipng as an option for shrinking PNG file sizes. My system
didn't have either pngcrush or pngnq before I started poking image-dired.
3. Restructuring thumbnail creation as a chain of asynchronous processes
firing each other off from their process sentinels, instead of a big
shell command.
The biggest problem right now is the aforementioned OOM killer problem:
that there is no notion of batching or scheduling and so potentially a
large number of "convert" processes get spun off. I'm not sure yet how
I want to go about implementing that.
A slight annoyance is that since the thumbnails are being created in the
background and the image objects (?) are being immediately inserted into
the buffer, there are lots of complaints from image.c of "Cannot find
image file". Still, this is much nicer than having to wait for
_everything_ to finish before being able to interact with emacs.
Also, is (redisplay) the right thing to call at the end a thumbnail's
creations so each of thumbnails get shown automatically as they are
created?
Finally, there are things like adding :version to defcustom,
executable-find checks, and adding to NEWS that will be done.
diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index 2925d0c..7198569 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -118,8 +118,6 @@
;; * From thumbs.el: Add the "modify" commands (emboss, negate,
;; monochrome etc).
;;
-;; * Asynchronous creation of thumbnails.
-;;
;; * Add `image-dired-display-thumbs-ring' and functions to cycle that. Find
;; out which is best, saving old batch just before inserting new, or
;; saving the current batch in the ring when inserting it. Adding it
@@ -230,14 +228,14 @@ image-dired-cmd-create-thumbnail-program
:group 'image-dired)
(defcustom image-dired-cmd-create-thumbnail-options
- "%p -size %wx%h \"%f\" -resize \"%wx%h>\" -strip jpeg:\"%t\""
- "Format of command used to create thumbnail image.
-Available options are %p which is replaced by
-`image-dired-cmd-create-thumbnail-program', %w which is replaced by
+ '("-size" "%wx%h" "%f" "-resize" "%wx%h>" "-strip" "jpeg:%t")
+ "Options of command used to create thumbnail image.
+Used with `image-dired-cmd-create-thumbnail-program'.
+Available format specifiers are: %w which is replaced by
`image-dired-thumb-width', %h which is replaced by `image-dired-thumb-height',
%f which is replaced by the file name of the original image and %t
which is replaced by the file name of the thumbnail file."
- :type 'string
+ :type '(repeat (string :tag "Argument"))
:group 'image-dired)
(defcustom image-dired-cmd-create-temp-image-program "convert"
@@ -247,14 +245,14 @@ image-dired-cmd-create-temp-image-program
:group 'image-dired)
(defcustom image-dired-cmd-create-temp-image-options
- "%p -size %wx%h \"%f\" -resize \"%wx%h>\" -strip jpeg:\"%t\""
- "Format of command used to create temporary image for display window.
-Available options are %p which is replaced by
-`image-dired-cmd-create-temp-image-program', %w and %h which is replaced by
+ '("-size" "%wx%h" "%f" "-resize" "%wx%h>" "-strip" "jpeg:%t")
+ "Options of command used to create temporary image for display window.
+Used together with `image-dired-cmd-create-temp-image-program',
+Available format specifiers are: %w and %h which are replaced by
the calculated max size for width and height in the image display window,
%f which is replaced by the file name of the original image and %t which
is replaced by the file name of the temporary file."
- :type 'string
+ :type '(repeat (string :tag "Argument"))
:group 'image-dired)
(defcustom image-dired-cmd-pngnq-program
@@ -264,14 +262,49 @@ image-dired-cmd-pngnq-program
It quantizes colors of PNG images down to 256 colors or fewer
using the Neuquant procedure."
:version "26.1"
- :type '(choice (const :tag "Not Set" nil) string)
+ :type '(choice (const :tag "Not Set" nil) file)
+ :group 'image-dired)
+
+(defcustom image-dired-cmd-pngnq-options
+ '("-f" "%t")
+ "Arguments to pass `image-dired-cmd-pngnq-program'."
+ ;; FIXME: explain/reference the format specifier(s)
+ :version "26.1"
+ :type '(repeat (string :tag "Argument"))
:group 'image-dired)
(defcustom image-dired-cmd-pngcrush-program (executable-find "pngcrush")
"The file name of the `pngcrush' program.
It optimizes the compression of PNG images. Also it adds PNG textual chunks
with the information required by the Thumbnail Managing Standard."
- :type '(choice (const :tag "Not Set" nil) string)
+ :type '(choice (const :tag "Not Set" nil) file)
+ :group 'image-dired)
+
+(defcustom image-dired-cmd-pngcrush-options
+ `("-q"
+ "-text" "b" "Description" "Thumbnail of file://%f"
+ "-text" "b" "Software" ,(emacs-version)
+ ;; "-text b \"Thumb::Image::Height\" \"%oh\" "
+ ;; "-text b \"Thumb::Image::Mimetype\" \"%mime\" "
+ ;; "-text b \"Thumb::Image::Width\" \"%ow\" "
+ "-text" "b" "Thumb::MTime" "%m"
+ ;; "-text b \"Thumb::Size\" \"%b\" "
+ "-text" "b" "Thumb::URI" "file://%f"
+ "%q" "%t")
+ "Arguments for `image-dired-cmd-pngcrush-program'."
+ :type '(repeat (string :tag "Argument"))
+ :group 'image-dired)
+
+(defcustom image-dired-cmd-optipng-program (executable-find "optipng")
+ "The file name of the `optipng' program."
+ :type '(choice (const :tag "Not Set" nil) file)
+ :group 'image-dired)
+
+(defcustom image-dired-cmd-optipng-options '("-o5" "%t")
+ "Arguments passed to `image-dired-optipng-program'."
+ ;; FIXME: refer to format specifiers
+ :type '(repeat (string :tag "Argument"))
+ :link '(url-link "man:optipng(1)")
:group 'image-dired)
(defcustom image-dired-cmd-create-standard-thumbnail-command
@@ -309,6 +342,22 @@ image-dired-cmd-create-standard-thumbnail-command
:type 'string
:group 'image-dired)
+(defcustom image-dired-cmd-create-standard-thumbnail-options
+ (append '("-size" "%wx%h" "%f")
+ (unless (or image-dired-cmd-pngcrush-program
+ image-dired-cmd-pngnq-program)
+ (list
+ "-set" "Thumb::MTime" "%m"
+ "-set" "Thumb::URI" "file://%f"
+ "-set" "Description" "Thumbnail of file://%f"
+ "-set" "Software" (emacs-version)))
+ '("-thumbnail" "%wx%h>" "png:%t"))
+ "Options for creating thumbnails according to the Thumbnail Managing Standard."
+ ;; FIXME: explain/reference the format specifier(s)
+ :version "26.1"
+ :type '(repeat (string :tag "Argument"))
+ :group 'image-dired)
+
(defcustom image-dired-cmd-rotate-thumbnail-program
"mogrify"
"Executable used to rotate thumbnail.
@@ -317,14 +366,14 @@ image-dired-cmd-rotate-thumbnail-program
:group 'image-dired)
(defcustom image-dired-cmd-rotate-thumbnail-options
- "%p -rotate %d \"%t\""
- "Format of command used to rotate thumbnail image.
-Available options are %p which is replaced by
-`image-dired-cmd-rotate-thumbnail-program', %d which is replaced by the
+ '("-rotate" "%d" "%t")
+ "Arguments of command used to rotate thumbnail image.
+Used with `image-dired-cmd-rotate-thumbnail-program'.
+Available format specifiers are: %d which is replaced by the
number of (positive) degrees to rotate the image, normally 90 or 270
\(for 90 degrees right and left), %t which is replaced by the file name
of the thumbnail file."
- :type 'string
+ :type '(repeat (string :tag "Argument"))
:group 'image-dired)
(defcustom image-dired-cmd-rotate-original-program
@@ -335,15 +384,15 @@ image-dired-cmd-rotate-original-program
:group 'image-dired)
(defcustom image-dired-cmd-rotate-original-options
- "%p -rotate %d -copy all -outfile %t \"%o\""
- "Format of command used to rotate original image.
-Available options are %p which is replaced by
-`image-dired-cmd-rotate-original-program', %d which is replaced by the
+ '("-rotate" "%d" "-copy" "all" "-outfile" "%t" "%o")
+ "Arguments of command used to rotate original image.
+Used with `image-dired-cmd-rotate-original-program'.
+Available format specifiers are: %d which is replaced by the
number of (positive) degrees to rotate the image, normally 90 or
270 \(for 90 degrees right and left), %o which is replaced by the
original image file name and %t which is replaced by
`image-dired-temp-image-file'."
- :type 'string
+ :type '(repeat (string :tag "Argument"))
:group 'image-dired)
(defcustom image-dired-temp-rotate-image-file
@@ -367,13 +416,13 @@ image-dired-cmd-write-exif-data-program
:group 'image-dired)
(defcustom image-dired-cmd-write-exif-data-options
- "%p -%t=\"%v\" \"%f\""
- "Format of command used to write EXIF data.
-Available options are %p which is replaced by
-`image-dired-cmd-write-exif-data-program', %f which is replaced by
+ '("-%t=%v" "%f")
+ "Arguments of command used to write EXIF data.
+Used with `image-dired-cmd-write-exif-data-program'.
+Available format specifiers are: %f which is replaced by
the image file name, %t which is replaced by the tag name and %v
which is replaced by the tag value."
- :type 'string
+ :type '(repeat (string :tag "Argument"))
:group 'image-dired)
(defcustom image-dired-cmd-read-exif-data-program
@@ -384,12 +433,12 @@ image-dired-cmd-read-exif-data-program
:group 'image-dired)
(defcustom image-dired-cmd-read-exif-data-options
- "%p -s -s -s -%t \"%f\""
- "Format of command used to read EXIF data.
-Available options are %p which is replaced by
-`image-dired-cmd-write-exif-data-program', %f which is replaced
+ '("-s" "-s" "-s" "-%t" "%f")
+ "Arguments of command used to read EXIF data.
+Used with `image-dired-cmd-read-exif-data-program'.
+Available format specifiers are: %f which is replaced
by the image file name and %t which is replaced by the tag name."
- :type 'string
+ :type '(repeat (string :tag "Argument"))
:group 'image-dired)
(defcustom image-dired-gallery-hidden-tags
@@ -650,25 +699,112 @@ image-dired-create-thumb
original-file)))))
(thumbnail-nq8-file (replace-regexp-in-string ".png\\'" "-nq8.png"
thumbnail-file))
- (command
- (format-spec
- (if (memq image-dired-thumbnail-storage '(standard standard-large))
- image-dired-cmd-create-standard-thumbnail-command
- image-dired-cmd-create-thumbnail-options)
- (list
- (cons ?p image-dired-cmd-create-thumbnail-program)
- (cons ?w width)
- (cons ?h height)
- (cons ?m modif-time)
- (cons ?f original-file)
- (cons ?q thumbnail-nq8-file)
- (cons ?t thumbnail-file))))
- thumbnail-dir)
+ (spec
+ (list
+ (cons ?w width)
+ (cons ?h height)
+ (cons ?m modif-time)
+ (cons ?f original-file)
+ (cons ?q thumbnail-nq8-file)
+ (cons ?t thumbnail-file)))
+ thumbnail-dir process)
(when (not (file-exists-p
(setq thumbnail-dir (file-name-directory thumbnail-file))))
(message "Creating thumbnail directory.")
(make-directory thumbnail-dir t))
- (call-process shell-file-name nil nil nil shell-command-switch command)))
+ ;; FIXME: explain wtf the following is doing
+ (setq process
+ (apply #'start-process "image-dired-create-thumbnail" nil
+ image-dired-cmd-create-thumbnail-program
+ (mapcar
+ (lambda (arg) (format-spec arg spec))
+ (if (memq image-dired-thumbnail-storage '(standard standard-large))
+ image-dired-cmd-create-standard-thumbnail-options
+ image-dired-cmd-create-thumbnail-options))))
+ ;; fire off png thumbnail manipulation asynchronously
+ (setf (process-sentinel process)
+ (lambda (process status)
+ (if (and (eq (process-status process) 'exit)
+ (zerop (process-exit-status process)))
+ (when (eq 'standard image-dired-thumbnail-storage)
+ (cond
+ (image-dired-cmd-pngnq-program
+ (image-dired-pngnq-thumb spec))
+ (image-dired-cmd-pngcrush-program
+ (image-dired-pngcrush-thumb spec))
+ (image-dired-cmd-optipng-program
+ (image-dired-optipng-thumb spec))))
+ (message "Thumb could not be created for %s: %s"
+ (abbreviate-file-name original-file)
+ (replace-regexp-in-string "\n" "" status)))))
+ process))
+
+(defun image-dired-pngnq-thumb (spec)
+ "Quantize thumbnail described by format SPEC with pngnq(1)."
+ (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)
+ (lambda (process status)
+ (if (and (eq (process-status process) 'exit)
+ (zerop (process-exit-status process)))
+ (if image-dired-cmd-pngcrush-program
+ (image-dired-pngcrush-thumb spec)
+ (let ((nq8 (cdr (assq ?q spec)))
+ (thumb (cdr (assq ?t spec))))
+ (rename-file nq8 thumb t))
+ (let ((callback (process-get process :callback)))
+ (when (functionp callback)
+ (funcall callback process status))))
+ (message "command %S %s" (process-command process)
+ (replace-regexp-in-string "\n" "" status)))))
+ process))
+
+(defun image-dired-pngcrush-thumb (spec)
+ "Optimize thumbnail decsribed by format SPEC with pngcrush(1)."
+ (when (not image-dired-cmd-pngnq-program)
+ (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))))
+ (message "crush: %S" (process-command process))
+ (setf (process-sentinel process)
+ (lambda (process status)
+ (if (and (eq (process-status process) 'exit)
+ (zerop (process-exit-status process)))
+ (let ((callback (process-get process :callback)))
+ (when (functionp callback)
+ (funcall callback process status)))
+ (message "command %S %s" (process-command process)
+ (replace-regexp-in-string "\n" "" status)))
+ (when (memq (process-status process) '(exit signal))
+ (let ((temp (cdr (assq ?q spec))))
+ (delete-file temp)))))
+ process))
+
+(defun image-dired-optipng-thumb (spec)
+ "Optimize thumbnail decsribed by format SPEC with optipng(1)."
+ (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)
+ (if (and (eq (process-status process) 'exit)
+ (zerop (process-exit-status process)))
+ (let ((callback (process-get process :callback)))
+ (when (functionp callback)
+ (funcall callback process status)))
+ (message "command %S %s" (process-command process)
+ (replace-regexp-in-string "\n" "" status)))))
+ process))
;;;###autoload
(defun image-dired-dired-toggle-marked-thumbs (&optional arg)
@@ -868,10 +1004,9 @@ image-dired-display-thumbs
(goto-char (point-max)))
(dolist (curr-file files)
(setq thumb-name (image-dired-thumb-name curr-file))
- (if (and (not (file-exists-p thumb-name))
- (not (= 0 (image-dired-create-thumb curr-file thumb-name))))
- (message "Thumb could not be created for file %s" curr-file)
- (image-dired-insert-thumbnail thumb-name curr-file dired-buf))))
+ (when (not (file-exists-p thumb-name))
+ (image-dired-create-thumb curr-file thumb-name))
+ (image-dired-insert-thumbnail thumb-name curr-file dired-buf)))
(if do-not-pop
(display-buffer buf)
(pop-to-buffer buf))
@@ -1553,8 +1688,7 @@ image-dired-create-thumbs
(clear-image-cache))
(when (or (not (file-exists-p thumb-name))
arg)
- (when (not (= 0 (image-dired-create-thumb curr-file thumb-name)))
- (error "Thumb could not be created"))))))
+ (image-dired-create-thumb curr-file thumb-name)))))
(defvar image-dired-slideshow-timer nil
"Slideshow timer.")
@@ -1746,17 +1880,19 @@ image-dired-display-image
(image-type 'jpeg))
(setq file (expand-file-name file))
(if (not original-size)
- (let* ((command
- (format-spec
- image-dired-cmd-create-temp-image-options
- (list
- (cons ?p image-dired-cmd-create-temp-image-program)
- (cons ?w (image-dired-display-window-width window))
- (cons ?h (image-dired-display-window-height window))
- (cons ?f file)
- (cons ?t new-file))))
- (ret (call-process shell-file-name nil nil nil
- shell-command-switch command)))
+ (let* ((spec
+ (list
+ (cons ?p image-dired-cmd-create-temp-image-program)
+ (cons ?w (image-dired-display-window-width window))
+ (cons ?h (image-dired-display-window-height window))
+ (cons ?f file)
+ (cons ?t new-file)))
+ (ret
+ (apply #'call-process
+ image-dired-cmd-create-temp-image-program nil nil nil
+ (mapcar
+ (lambda (arg) (format-spec arg spec))
+ image-dired-cmd-create-temp-image-options))))
(when (not (zerop ret))
(error "Could not resize image")))
(setq image-type (image-type-from-file-name file))
@@ -1808,15 +1944,11 @@ image-dired-rotate-thumbnail
'image-dired-cmd-rotate-thumbnail-program)
(if (not (image-dired-image-at-point-p))
(message "No thumbnail at point")
- (let ((file (image-dired-thumb-name (image-dired-original-file-name)))
- command)
- (setq command (format-spec
- image-dired-cmd-rotate-thumbnail-options
- (list
- (cons ?p image-dired-cmd-rotate-thumbnail-program)
- (cons ?d degrees)
- (cons ?t (expand-file-name file)))))
- (call-process shell-file-name nil nil nil shell-command-switch command)
+ (let* ((file (image-dired-thumb-name (image-dired-original-file-name)))
+ (spec (list (cons ?d degrees) (cons ?t (expand-file-name file)))))
+ (apply #'call-process image-dired-cmd-rotate-thumbnail-program nil nil nil
+ (mapcar (lambda (arg) (format-spec arg spec))
+ image-dired-cmd-rotate-thumbnail-options))
;; Clear the cache to refresh image. I wish I could just refresh
;; the current file but I do not know how to do that. Yet...
(clear-image-cache))))
@@ -1852,19 +1984,18 @@ image-dired-rotate-original
'image-dired-cmd-rotate-original-program)
(if (not (image-dired-image-at-point-p))
(message "No image at point")
- (let ((file (image-dired-original-file-name))
- command)
+ (let* ((file (image-dired-original-file-name))
+ (spec
+ (list
+ (cons ?d degrees)
+ (cons ?o (expand-file-name file))
+ (cons ?t image-dired-temp-rotate-image-file))))
(unless (eq 'jpeg (image-type file))
(error "Only JPEG images can be rotated!"))
- (setq command (format-spec
- image-dired-cmd-rotate-original-options
- (list
- (cons ?p image-dired-cmd-rotate-original-program)
- (cons ?d degrees)
- (cons ?o (expand-file-name file))
- (cons ?t image-dired-temp-rotate-image-file))))
- (if (not (= 0 (call-process shell-file-name nil nil nil
- shell-command-switch command)))
+ (if (not (= 0 (apply #'call-process image-dired-cmd-rotate-original-program
+ nil nil nil
+ (mapcar (lambda (arg) (format-spec arg spec))
+ image-dired-cmd-rotate-original-options))))
(error "Could not rotate image")
(image-dired-display-image image-dired-temp-rotate-image-file)
(if (or (and image-dired-rotate-original-ask-before-overwrite
@@ -1930,32 +2061,30 @@ image-dired-set-exif-data
"In FILE, set EXIF tag TAG-NAME to value TAG-VALUE."
(image-dired--check-executable-exists
'image-dired-cmd-write-exif-data-program)
- (let (command)
- (setq command (format-spec
- image-dired-cmd-write-exif-data-options
- (list
- (cons ?p image-dired-cmd-write-exif-data-program)
- (cons ?f (expand-file-name file))
- (cons ?t tag-name)
- (cons ?v tag-value))))
- (call-process shell-file-name nil nil nil shell-command-switch command)))
+ (let ((spec
+ (list
+ (cons ?f (expand-file-name file))
+ (cons ?t tag-name)
+ (cons ?v tag-value))))
+ (apply #'call-process image-dired-cmd-write-exif-data-program nil nil nil
+ (mapcar (lambda (arg) (format-spec arg spec))
+ image-dired-cmd-write-exif-data-options))))
(defun image-dired-get-exif-data (file tag-name)
"From FILE, return EXIF tag TAG-NAME."
(image-dired--check-executable-exists
'image-dired-cmd-read-exif-data-program)
(let ((buf (get-buffer-create "*image-dired-get-exif-data*"))
- command tag-value)
- (setq command (format-spec
- image-dired-cmd-read-exif-data-options
- (list
- (cons ?p image-dired-cmd-read-exif-data-program)
- (cons ?f file)
- (cons ?t tag-name))))
+ (spec (list (cons ?f file) (cons ?t tag-name)))
+ tag-value)
(with-current-buffer buf
(delete-region (point-min) (point-max))
- (if (not (eq (call-process shell-file-name nil t nil
- shell-command-switch command) 0))
+ (if (not (eq (apply #'call-process image-dired-cmd-read-exif-data-program
+ nil t nil
+ (mapcar
+ (lambda (arg) (format-spec arg spec))
+ image-dired-cmd-read-exif-data-options))
+ 0))
(error "Could not get EXIF tag")
(goto-char (point-min))
;; Clean buffer from newlines and carriage returns before
^ permalink raw reply related [flat|nested] 6+ messages in thread* Re: [RFC] making image-dired thumbnail creation asynchronous
2016-12-16 2:36 [RFC] making image-dired thumbnail creation asynchronous Mark Oteiza
@ 2016-12-16 8:21 ` Eli Zaretskii
2016-12-16 13:15 ` Mark Oteiza
0 siblings, 1 reply; 6+ messages in thread
From: Eli Zaretskii @ 2016-12-16 8:21 UTC (permalink / raw)
To: Mark Oteiza; +Cc: emacs-devel
> From: Mark Oteiza <mvoteiza@udel.edu>
> Date: Thu, 15 Dec 2016 21:36:38 -0500
>
> The biggest problem right now is the aforementioned OOM killer problem:
> that there is no notion of batching or scheduling and so potentially a
> large number of "convert" processes get spun off. I'm not sure yet how
> I want to go about implementing that.
Would load-average help you?
Or we could add a function that returns the amount of free VM on the
system.
Or you could arbitrarily limit the number of such processes to some
small value.
> Also, is (redisplay) the right thing to call at the end a thumbnail's
> creations so each of thumbnails get shown automatically as they are
> created?
Please tell the details of how Emacs is notified about thumbnail
creation (or point to the code which does that), because I don't see
why you would need to explicitly trigger redisplay. It should happen
automatically whenever the buffer contents changes in any way that
affects the displayed portion.
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [RFC] making image-dired thumbnail creation asynchronous
2016-12-16 8:21 ` Eli Zaretskii
@ 2016-12-16 13:15 ` Mark Oteiza
2016-12-16 13:47 ` Eli Zaretskii
0 siblings, 1 reply; 6+ messages in thread
From: Mark Oteiza @ 2016-12-16 13:15 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: emacs-devel
On 16/12/16 at 10:21am, Eli Zaretskii wrote:
> > From: Mark Oteiza <mvoteiza@udel.edu>
> > Date: Thu, 15 Dec 2016 21:36:38 -0500
> >
> > The biggest problem right now is the aforementioned OOM killer problem:
> > that there is no notion of batching or scheduling and so potentially a
> > large number of "convert" processes get spun off. I'm not sure yet how
> > I want to go about implementing that.
>
> Would load-average help you?
>
> Or we could add a function that returns the amount of free VM on the
> system.
>
> Or you could arbitrarily limit the number of such processes to some
> small value.
The latter would probably be the easiest.
> > Also, is (redisplay) the right thing to call at the end a thumbnail's
> > creations so each of thumbnails get shown automatically as they are
> > created?
>
> Please tell the details of how Emacs is notified about thumbnail
> creation (or point to the code which does that), because I don't see
> why you would need to explicitly trigger redisplay. It should happen
> automatically whenever the buffer contents changes in any way that
> affects the displayed portion.
@@ -868,10 +1004,9 @@ image-dired-display-thumbs
(goto-char (point-max)))
(dolist (curr-file files)
(setq thumb-name (image-dired-thumb-name curr-file))
- (if (and (not (file-exists-p thumb-name))
- (not (= 0 (image-dired-create-thumb curr-file thumb-name))))
- (message "Thumb could not be created for file %s" curr-file)
- (image-dired-insert-thumbnail thumb-name curr-file dired-buf))))
+ (when (not (file-exists-p thumb-name))
+ (image-dired-create-thumb curr-file thumb-name))
+ (image-dired-insert-thumbnail thumb-name curr-file dired-buf)))
(if do-not-pop
(display-buffer buf)
(pop-to-buffer buf))
Here is the relevant hunk. image-dired-create-thumb is the starting
point for asynchronous thumbnail creation. At this point,
image-dired-insert-thumbnail is called immediately after invoking
image-dired-create-thumb, so in practice the buffer has already been
populated with images for files that potentially do not yet exist; i.e.
the buffer contents are already finished changing before thumbnails are
created.
There is currently nothing notifying Emacs once a thumbnail has been
created, but it would go somewhere in image-dired-create-thumb or one of
the functions its sentinel calls (the hunk previous to the one I pasted)
^ permalink raw reply [flat|nested] 6+ messages in thread* Re: [RFC] making image-dired thumbnail creation asynchronous
2016-12-16 13:15 ` Mark Oteiza
@ 2016-12-16 13:47 ` Eli Zaretskii
2016-12-16 14:16 ` Mark Oteiza
0 siblings, 1 reply; 6+ messages in thread
From: Eli Zaretskii @ 2016-12-16 13:47 UTC (permalink / raw)
To: Mark Oteiza; +Cc: emacs-devel
> Date: Fri, 16 Dec 2016 08:15:31 -0500
> From: Mark Oteiza <mvoteiza@udel.edu>
> Cc: emacs-devel@gnu.org
>
> @@ -868,10 +1004,9 @@ image-dired-display-thumbs
> (goto-char (point-max)))
> (dolist (curr-file files)
> (setq thumb-name (image-dired-thumb-name curr-file))
> - (if (and (not (file-exists-p thumb-name))
> - (not (= 0 (image-dired-create-thumb curr-file thumb-name))))
> - (message "Thumb could not be created for file %s" curr-file)
> - (image-dired-insert-thumbnail thumb-name curr-file dired-buf))))
> + (when (not (file-exists-p thumb-name))
> + (image-dired-create-thumb curr-file thumb-name))
> + (image-dired-insert-thumbnail thumb-name curr-file dired-buf)))
> (if do-not-pop
> (display-buffer buf)
> (pop-to-buffer buf))
>
> Here is the relevant hunk. image-dired-create-thumb is the starting
> point for asynchronous thumbnail creation. At this point,
> image-dired-insert-thumbnail is called immediately after invoking
> image-dired-create-thumb, so in practice the buffer has already been
> populated with images for files that potentially do not yet exist; i.e.
> the buffer contents are already finished changing before thumbnails are
> created.
>
> There is currently nothing notifying Emacs once a thumbnail has been
> created, but it would go somewhere in image-dired-create-thumb or one of
> the functions its sentinel calls (the hunk previous to the one I pasted)
If the function that senses that the file was created re-inserts the
thumbnail image into its buffer, redisplay will happen automatically.
AFAIK, we don't have any infrastructure for delayed loading of images
that would do the above for you, but I guess something like that could
be implemented based on file notifications.
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [RFC] making image-dired thumbnail creation asynchronous
2016-12-16 13:47 ` Eli Zaretskii
@ 2016-12-16 14:16 ` Mark Oteiza
2016-12-17 3:42 ` [PATCH] " Mark Oteiza
0 siblings, 1 reply; 6+ messages in thread
From: Mark Oteiza @ 2016-12-16 14:16 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: emacs-devel
On 16/12/16 at 03:47pm, Eli Zaretskii wrote:
> > Date: Fri, 16 Dec 2016 08:15:31 -0500
> > From: Mark Oteiza <mvoteiza@udel.edu>
> > Cc: emacs-devel@gnu.org
> >
> > @@ -868,10 +1004,9 @@ image-dired-display-thumbs
> > (goto-char (point-max)))
> > (dolist (curr-file files)
> > (setq thumb-name (image-dired-thumb-name curr-file))
> > - (if (and (not (file-exists-p thumb-name))
> > - (not (= 0 (image-dired-create-thumb curr-file thumb-name))))
> > - (message "Thumb could not be created for file %s" curr-file)
> > - (image-dired-insert-thumbnail thumb-name curr-file dired-buf))))
> > + (when (not (file-exists-p thumb-name))
> > + (image-dired-create-thumb curr-file thumb-name))
> > + (image-dired-insert-thumbnail thumb-name curr-file dired-buf)))
> > (if do-not-pop
> > (display-buffer buf)
> > (pop-to-buffer buf))
> >
> > Here is the relevant hunk. image-dired-create-thumb is the starting
> > point for asynchronous thumbnail creation. At this point,
> > image-dired-insert-thumbnail is called immediately after invoking
> > image-dired-create-thumb, so in practice the buffer has already been
> > populated with images for files that potentially do not yet exist; i.e.
> > the buffer contents are already finished changing before thumbnails are
> > created.
> >
> > There is currently nothing notifying Emacs once a thumbnail has been
> > created, but it would go somewhere in image-dired-create-thumb or one of
> > the functions its sentinel calls (the hunk previous to the one I pasted)
>
> If the function that senses that the file was created re-inserts the
> thumbnail image into its buffer, redisplay will happen automatically.
>
> AFAIK, we don't have any infrastructure for delayed loading of images
> that would do the above for you, but I guess something like that could
> be implemented based on file notifications.
Ah! I can call (clear-image-cache THUMB-FILE) in a sentinel and that
seems to do the right thing.
^ permalink raw reply [flat|nested] 6+ messages in thread
* Re: [PATCH] making image-dired thumbnail creation asynchronous
2016-12-16 14:16 ` Mark Oteiza
@ 2016-12-17 3:42 ` Mark Oteiza
0 siblings, 0 replies; 6+ messages in thread
From: Mark Oteiza @ 2016-12-17 3:42 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: emacs-devel
In addition to the changes mentioned in the initial posting: the
following implements asynchronous thumbnail generation for image-dired.
The number of concurrent processes is limited by
`image-dired-thumb-job-limit'.
diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index 96570a503f..01fb8c8deb 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -118,8 +118,6 @@
;; * From thumbs.el: Add the "modify" commands (emboss, negate,
;; monochrome etc).
;;
-;; * Asynchronous creation of thumbnails.
-;;
;; * Add `image-dired-display-thumbs-ring' and functions to cycle that. Find
;; out which is best, saving old batch just before inserting new, or
;; saving the current batch in the ring when inserting it. Adding it
@@ -230,14 +228,15 @@ image-dired-cmd-create-thumbnail-program
:group 'image-dired)
(defcustom image-dired-cmd-create-thumbnail-options
- "%p -size %wx%h \"%f\" -resize \"%wx%h>\" -strip jpeg:\"%t\""
- "Format of command used to create thumbnail image.
-Available options are %p which is replaced by
-`image-dired-cmd-create-thumbnail-program', %w which is replaced by
+ '("-size" "%wx%h" "%f" "-resize" "%wx%h>" "-strip" "jpeg:%t")
+ "Options of command used to create thumbnail image.
+Used with `image-dired-cmd-create-thumbnail-program'.
+Available format specifiers are: %w which is replaced by
`image-dired-thumb-width', %h which is replaced by `image-dired-thumb-height',
%f which is replaced by the file name of the original image and %t
which is replaced by the file name of the thumbnail file."
- :type 'string
+ :version "26.1"
+ :type '(repeat (string :tag "Argument"))
:group 'image-dired)
(defcustom image-dired-cmd-create-temp-image-program "convert"
@@ -247,14 +246,15 @@ image-dired-cmd-create-temp-image-program
:group 'image-dired)
(defcustom image-dired-cmd-create-temp-image-options
- "%p -size %wx%h \"%f\" -resize \"%wx%h>\" -strip jpeg:\"%t\""
- "Format of command used to create temporary image for display window.
-Available options are %p which is replaced by
-`image-dired-cmd-create-temp-image-program', %w and %h which is replaced by
+ '("-size" "%wx%h" "%f" "-resize" "%wx%h>" "-strip" "jpeg:%t")
+ "Options of command used to create temporary image for display window.
+Used together with `image-dired-cmd-create-temp-image-program',
+Available format specifiers are: %w and %h which are replaced by
the calculated max size for width and height in the image display window,
%f which is replaced by the file name of the original image and %t which
is replaced by the file name of the temporary file."
- :type 'string
+ :version "26.1"
+ :type '(repeat (string :tag "Argument"))
:group 'image-dired)
(defcustom image-dired-cmd-pngnq-program
@@ -264,49 +264,72 @@ image-dired-cmd-pngnq-program
It quantizes colors of PNG images down to 256 colors or fewer
using the Neuquant procedure."
:version "26.1"
- :type '(choice (const :tag "Not Set" nil) string)
+ :type '(choice (const :tag "Not Set" nil) file)
+ :group 'image-dired)
+
+(defcustom image-dired-cmd-pngnq-options
+ '("-f" "%t")
+ "Arguments to pass `image-dired-cmd-pngnq-program'.
+Available format specifiers are the same as in
+`image-dired-cmd-create-thumbnail-options'."
+ :version "26.1"
+ :type '(repeat (string :tag "Argument"))
:group 'image-dired)
(defcustom image-dired-cmd-pngcrush-program (executable-find "pngcrush")
"The file name of the `pngcrush' program.
It optimizes the compression of PNG images. Also it adds PNG textual chunks
with the information required by the Thumbnail Managing Standard."
- :type '(choice (const :tag "Not Set" nil) string)
+ :type '(choice (const :tag "Not Set" nil) file)
:group 'image-dired)
-(defcustom image-dired-cmd-create-standard-thumbnail-command
- (concat
- "%p -size %wx%h \"%f\" "
- (unless (or image-dired-cmd-pngcrush-program image-dired-cmd-pngnq-program)
- (concat
- "-set \"Thumb::MTime\" \"%m\" "
- "-set \"Thumb::URI\" \"file://%f\" "
- "-set \"Description\" \"Thumbnail of file://%f\" "
- "-set \"Software\" \"" (emacs-version) "\" "))
- "-thumbnail \"%wx%h>\" png:\"%t\""
- (if image-dired-cmd-pngnq-program
- (concat
- " ; " image-dired-cmd-pngnq-program " -f \"%t\""
- (unless image-dired-cmd-pngcrush-program
- " ; mv %q %t")))
- (if image-dired-cmd-pngcrush-program
- (concat
- (unless image-dired-cmd-pngcrush-program
- " ; cp %t %q")
- " ; " image-dired-cmd-pngcrush-program " -q "
- "-text b \"Description\" \"Thumbnail of file://%f\" "
- "-text b \"Software\" \"" (emacs-version) "\" "
- ;; "-text b \"Thumb::Image::Height\" \"%oh\" "
- ;; "-text b \"Thumb::Image::Mimetype\" \"%mime\" "
- ;; "-text b \"Thumb::Image::Width\" \"%ow\" "
- "-text b \"Thumb::MTime\" \"%m\" "
- ;; "-text b \"Thumb::Size\" \"%b\" "
- "-text b \"Thumb::URI\" \"file://%f\" "
- "%q %t"
- " ; rm %q")))
- "Command to create thumbnails according to the Thumbnail Managing Standard."
+(defcustom image-dired-cmd-pngcrush-options
+ `("-q"
+ "-text" "b" "Description" "Thumbnail of file://%f"
+ "-text" "b" "Software" ,(emacs-version)
+ ;; "-text b \"Thumb::Image::Height\" \"%oh\" "
+ ;; "-text b \"Thumb::Image::Mimetype\" \"%mime\" "
+ ;; "-text b \"Thumb::Image::Width\" \"%ow\" "
+ "-text" "b" "Thumb::MTime" "%m"
+ ;; "-text b \"Thumb::Size\" \"%b\" "
+ "-text" "b" "Thumb::URI" "file://%f"
+ "%q" "%t")
+ "Arguments for `image-dired-cmd-pngcrush-program'.
+Available format specifiers are the same as in
+`image-dired-cmd-create-thumbnail-options', with %q for a
+temporary file name (typically generated by pnqnq)"
:version "26.1"
- :type 'string
+ :type '(repeat (string :tag "Argument"))
+ :group 'image-dired)
+
+(defcustom image-dired-cmd-optipng-program (executable-find "optipng")
+ "The file name of the `optipng' program."
+ :type '(choice (const :tag "Not Set" nil) file)
+ :group 'image-dired)
+
+(defcustom image-dired-cmd-optipng-options '("-o5" "%t")
+ "Arguments passed to `image-dired-optipng-program'.
+Available format specifiers are described in
+`image-dired-cmd-create-thumbnail-options'."
+ :type '(repeat (string :tag "Argument"))
+ :link '(url-link "man:optipng(1)")
+ :group 'image-dired)
+
+(defcustom image-dired-cmd-create-standard-thumbnail-options
+ (append '("-size" "%wx%h" "%f")
+ (unless (or image-dired-cmd-pngcrush-program
+ image-dired-cmd-pngnq-program)
+ (list
+ "-set" "Thumb::MTime" "%m"
+ "-set" "Thumb::URI" "file://%f"
+ "-set" "Description" "Thumbnail of file://%f"
+ "-set" "Software" (emacs-version)))
+ '("-thumbnail" "%wx%h>" "png:%t"))
+ "Options for creating thumbnails according to the Thumbnail Managing Standard.
+Available format specifiers are the same as in
+`image-dired-cmd-create-thumbnail-options', with %m for file modification time."
+ :version "26.1"
+ :type '(repeat (string :tag "Argument"))
:group 'image-dired)
(defcustom image-dired-cmd-rotate-thumbnail-program
@@ -317,14 +340,15 @@ image-dired-cmd-rotate-thumbnail-program
:group 'image-dired)
(defcustom image-dired-cmd-rotate-thumbnail-options
- "%p -rotate %d \"%t\""
- "Format of command used to rotate thumbnail image.
-Available options are %p which is replaced by
-`image-dired-cmd-rotate-thumbnail-program', %d which is replaced by the
+ '("-rotate" "%d" "%t")
+ "Arguments of command used to rotate thumbnail image.
+Used with `image-dired-cmd-rotate-thumbnail-program'.
+Available format specifiers are: %d which is replaced by the
number of (positive) degrees to rotate the image, normally 90 or 270
\(for 90 degrees right and left), %t which is replaced by the file name
of the thumbnail file."
- :type 'string
+ :version "26.1"
+ :type '(repeat (string :tag "Argument"))
:group 'image-dired)
(defcustom image-dired-cmd-rotate-original-program
@@ -335,15 +359,16 @@ image-dired-cmd-rotate-original-program
:group 'image-dired)
(defcustom image-dired-cmd-rotate-original-options
- "%p -rotate %d -copy all -outfile %t \"%o\""
- "Format of command used to rotate original image.
-Available options are %p which is replaced by
-`image-dired-cmd-rotate-original-program', %d which is replaced by the
+ '("-rotate" "%d" "-copy" "all" "-outfile" "%t" "%o")
+ "Arguments of command used to rotate original image.
+Used with `image-dired-cmd-rotate-original-program'.
+Available format specifiers are: %d which is replaced by the
number of (positive) degrees to rotate the image, normally 90 or
270 \(for 90 degrees right and left), %o which is replaced by the
original image file name and %t which is replaced by
`image-dired-temp-image-file'."
- :type 'string
+ :version "26.1"
+ :type '(repeat (string :tag "Argument"))
:group 'image-dired)
(defcustom image-dired-temp-rotate-image-file
@@ -367,13 +392,14 @@ image-dired-cmd-write-exif-data-program
:group 'image-dired)
(defcustom image-dired-cmd-write-exif-data-options
- "%p -%t=\"%v\" \"%f\""
- "Format of command used to write EXIF data.
-Available options are %p which is replaced by
-`image-dired-cmd-write-exif-data-program', %f which is replaced by
+ '("-%t=%v" "%f")
+ "Arguments of command used to write EXIF data.
+Used with `image-dired-cmd-write-exif-data-program'.
+Available format specifiers are: %f which is replaced by
the image file name, %t which is replaced by the tag name and %v
which is replaced by the tag value."
- :type 'string
+ :version "26.1"
+ :type '(repeat (string :tag "Argument"))
:group 'image-dired)
(defcustom image-dired-cmd-read-exif-data-program
@@ -384,12 +410,13 @@ image-dired-cmd-read-exif-data-program
:group 'image-dired)
(defcustom image-dired-cmd-read-exif-data-options
- "%p -s -s -s -%t \"%f\""
- "Format of command used to read EXIF data.
-Available options are %p which is replaced by
-`image-dired-cmd-write-exif-data-program', %f which is replaced
+ '("-s" "-s" "-s" "-%t" "%f")
+ "Arguments of command used to read EXIF data.
+Used with `image-dired-cmd-read-exif-data-program'.
+Available format specifiers are: %f which is replaced
by the image file name and %t which is replaced by the tag name."
- :type 'string
+ :version "26.1"
+ :type '(repeat (string :tag "Argument"))
:group 'image-dired)
(defcustom image-dired-gallery-hidden-tags
@@ -640,7 +667,84 @@ image-dired-thumb-size
(width image-dired-thumb-width)
(height image-dired-thumb-height)))))
-(defun image-dired-create-thumb (original-file thumbnail-file)
+\f
+;; Thumbnail generation
+
+(defvar image-dired-thumb-queue nil
+ "List of items in the queue.
+Each item has the form (ORIGINAL-FILE THUMBNAIL-FILE).")
+
+(defvar image-dired-thumb-active-jobs 0
+ "Number of active jobs in `image-dired-thumb-queue'.")
+
+(defvar image-dired-thumb-job-limit 2
+ "Maximum number of concurrent jobs permitted for generating thumbnails.
+Increase at own risk.")
+
+(defun image-dired-pngnq-thumb (spec)
+ "Quantize thumbnail described by format SPEC with pngnq(1)."
+ (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)
+ (lambda (process status)
+ (if (and (eq (process-status process) 'exit)
+ (zerop (process-exit-status process)))
+ ;; Pass off to pngcrush, or just rename the
+ ;; THUMB-nq8.png file back to THUMB.png
+ (if (and image-dired-cmd-pngcrush-program
+ (executable-find image-dired-cmd-pngcrush-program))
+ (image-dired-pngcrush-thumb spec)
+ (let ((nq8 (cdr (assq ?q spec)))
+ (thumb (cdr (assq ?t spec))))
+ (rename-file nq8 thumb t)))
+ (message "command %S %s" (process-command process)
+ (replace-regexp-in-string "\n" "" status)))))
+ process))
+
+(defun image-dired-pngcrush-thumb (spec)
+ "Optimize thumbnail decsribed by format SPEC with pngcrush(1)."
+ ;; If pngnq wasn't run, then the THUMB-nq8.png file does not exist.
+ ;; pngcrush needs an infile and outfile, so we just copy THUMB to
+ ;; THUMB-nq8.png and use the latter as a temp file.
+ (when (not image-dired-cmd-pngnq-program)
+ (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)
+ (replace-regexp-in-string "\n" "" status)))
+ (when (memq (process-status process) '(exit signal))
+ (let ((temp (cdr (assq ?q spec))))
+ (delete-file temp)))))
+ process))
+
+(defun image-dired-optipng-thumb (spec)
+ "Optimize thumbnail decsribed by format SPEC with optipng(1)."
+ (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)
+ (replace-regexp-in-string "\n" "" status)))))
+ process))
+
+(defun image-dired-create-thumb-1 (original-file thumbnail-file)
"For ORIGINAL-FILE, create thumbnail image named THUMBNAIL-FILE."
(image-dired--check-executable-exists
'image-dired-cmd-create-thumbnail-program)
@@ -650,25 +754,77 @@ image-dired-create-thumb
original-file)))))
(thumbnail-nq8-file (replace-regexp-in-string ".png\\'" "-nq8.png"
thumbnail-file))
- (command
- (format-spec
- (if (memq image-dired-thumbnail-storage '(standard standard-large))
- image-dired-cmd-create-standard-thumbnail-command
- image-dired-cmd-create-thumbnail-options)
- (list
- (cons ?p image-dired-cmd-create-thumbnail-program)
- (cons ?w width)
- (cons ?h height)
- (cons ?m modif-time)
- (cons ?f original-file)
- (cons ?q thumbnail-nq8-file)
- (cons ?t thumbnail-file))))
- thumbnail-dir)
- (when (not (file-exists-p
- (setq thumbnail-dir (file-name-directory thumbnail-file))))
- (message "Creating thumbnail directory.")
+ (spec
+ (list
+ (cons ?w width)
+ (cons ?h height)
+ (cons ?m modif-time)
+ (cons ?f original-file)
+ (cons ?q thumbnail-nq8-file)
+ (cons ?t thumbnail-file)))
+ (thumbnail-dir (file-name-directory thumbnail-file))
+ process)
+ (when (not (file-exists-p thumbnail-dir))
+ (message "Creating thumbnail directory")
(make-directory thumbnail-dir t))
- (call-process shell-file-name nil nil nil shell-command-switch command)))
+
+ ;; Thumbnail file creation processes begin here and are marshalled
+ ;; in a queue by `image-dired-create-thumb'.
+ (setq process
+ (apply #'start-process "image-dired-create-thumbnail" nil
+ image-dired-cmd-create-thumbnail-program
+ (mapcar
+ (lambda (arg) (format-spec arg spec))
+ (if (memq image-dired-thumbnail-storage
+ '(standard standard-large))
+ image-dired-cmd-create-standard-thumbnail-options
+ image-dired-cmd-create-thumbnail-options))))
+
+ (setf (process-sentinel process)
+ (lambda (process status)
+ ;; Trigger next in queue once a thumbnail has been created
+ (cl-decf image-dired-thumb-active-jobs)
+ (image-dired-thumb-queue-run)
+ (if (not (and (eq (process-status process) 'exit)
+ (zerop (process-exit-status process))))
+ (message "Thumb could not be created for %s: %s"
+ (abbreviate-file-name original-file)
+ (replace-regexp-in-string "\n" "" status))
+ (clear-image-cache thumbnail-file)
+ ;; PNG thumbnail has been created since we are
+ ;; following the XDG thumbnail spec, so try to optimize
+ (when (memq image-dired-thumbnail-storage
+ '(standard standard-large))
+ (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)))))))
+ process))
+
+(defun image-dired-thumb-queue-run ()
+ "Run a queued job if one exists and not too many jobs are running.
+Queued items live in `image-dired-thumb-queue'."
+ (while (and image-dired-thumb-queue
+ (< image-dired-thumb-active-jobs
+ image-dired-thumb-job-limit))
+ (cl-incf image-dired-thumb-active-jobs)
+ (apply #'image-dired-create-thumb-1 (pop image-dired-thumb-queue))))
+
+(defun image-dired-create-thumb (original-file thumbnail-file)
+ "Add a job for generating thumbnail to `image-dired-thumb-queue'."
+ (setq image-dired-thumb-queue
+ (nconc image-dired-thumb-queue
+ (list (list original-file thumbnail-file))))
+ (run-at-time 0 nil #'image-dired-thumb-queue-run))
+
+\f
+;; Interactive
;;;###autoload
(defun image-dired-dired-toggle-marked-thumbs (&optional arg)
@@ -868,10 +1024,9 @@ image-dired-display-thumbs
(goto-char (point-max)))
(dolist (curr-file files)
(setq thumb-name (image-dired-thumb-name curr-file))
- (if (and (not (file-exists-p thumb-name))
- (not (= 0 (image-dired-create-thumb curr-file thumb-name))))
- (message "Thumb could not be created for file %s" curr-file)
- (image-dired-insert-thumbnail thumb-name curr-file dired-buf))))
+ (when (not (file-exists-p thumb-name))
+ (image-dired-create-thumb curr-file thumb-name))
+ (image-dired-insert-thumbnail thumb-name curr-file dired-buf)))
(if do-not-pop
(display-buffer buf)
(pop-to-buffer buf))
@@ -1425,6 +1580,8 @@ image-dired-display-image-mode-map
(define-key map [remap scroll-down] 'image-scroll-down)
(define-key map [remap scroll-up-command] 'image-scroll-up)
(define-key map [remap scroll-down-command] 'image-scroll-down)
+ (define-key map [remap scroll-left] 'image-scroll-left)
+ (define-key map [remap scroll-right] 'image-scroll-right)
(define-key map [remap move-beginning-of-line] 'image-bol)
(define-key map [remap move-end-of-line] 'image-eol)
(define-key map [remap beginning-of-buffer] 'image-bob)
@@ -1553,8 +1710,7 @@ image-dired-create-thumbs
(clear-image-cache (expand-file-name thumb-name)))
(when (or (not (file-exists-p thumb-name))
arg)
- (when (not (= 0 (image-dired-create-thumb curr-file thumb-name)))
- (error "Thumb could not be created"))))))
+ (image-dired-create-thumb curr-file thumb-name)))))
(defvar image-dired-slideshow-timer nil
"Slideshow timer.")
@@ -1746,17 +1902,19 @@ image-dired-display-image
(image-type 'jpeg))
(setq file (expand-file-name file))
(if (not original-size)
- (let* ((command
- (format-spec
- image-dired-cmd-create-temp-image-options
- (list
- (cons ?p image-dired-cmd-create-temp-image-program)
- (cons ?w (image-dired-display-window-width window))
- (cons ?h (image-dired-display-window-height window))
- (cons ?f file)
- (cons ?t new-file))))
- (ret (call-process shell-file-name nil nil nil
- shell-command-switch command)))
+ (let* ((spec
+ (list
+ (cons ?p image-dired-cmd-create-temp-image-program)
+ (cons ?w (image-dired-display-window-width window))
+ (cons ?h (image-dired-display-window-height window))
+ (cons ?f file)
+ (cons ?t new-file)))
+ (ret
+ (apply #'call-process
+ image-dired-cmd-create-temp-image-program nil nil nil
+ (mapcar
+ (lambda (arg) (format-spec arg spec))
+ image-dired-cmd-create-temp-image-options))))
(when (not (zerop ret))
(error "Could not resize image")))
(setq image-type (image-type-from-file-name file))
@@ -1810,14 +1968,10 @@ image-dired-rotate-thumbnail
(message "No thumbnail at point")
(let* ((file (image-dired-thumb-name (image-dired-original-file-name)))
(thumb (expand-file-name file))
- command)
- (setq command (format-spec
- image-dired-cmd-rotate-thumbnail-options
- (list
- (cons ?p image-dired-cmd-rotate-thumbnail-program)
- (cons ?d degrees)
- (cons ?t thumb))))
- (call-process shell-file-name nil nil nil shell-command-switch command)
+ (spec (list (cons ?d degrees) (cons ?t thumb))))
+ (apply #'call-process image-dired-cmd-rotate-thumbnail-program nil nil nil
+ (mapcar (lambda (arg) (format-spec arg spec))
+ image-dired-cmd-rotate-thumbnail-options))
(clear-image-cache thumb))))
(defun image-dired-rotate-thumbnail-left ()
@@ -1852,19 +2006,18 @@ image-dired-rotate-original
'image-dired-cmd-rotate-original-program)
(if (not (image-dired-image-at-point-p))
(message "No image at point")
- (let ((file (image-dired-original-file-name))
- command)
+ (let* ((file (image-dired-original-file-name))
+ (spec
+ (list
+ (cons ?d degrees)
+ (cons ?o (expand-file-name file))
+ (cons ?t image-dired-temp-rotate-image-file))))
(unless (eq 'jpeg (image-type file))
(error "Only JPEG images can be rotated!"))
- (setq command (format-spec
- image-dired-cmd-rotate-original-options
- (list
- (cons ?p image-dired-cmd-rotate-original-program)
- (cons ?d degrees)
- (cons ?o (expand-file-name file))
- (cons ?t image-dired-temp-rotate-image-file))))
- (if (not (= 0 (call-process shell-file-name nil nil nil
- shell-command-switch command)))
+ (if (not (= 0 (apply #'call-process image-dired-cmd-rotate-original-program
+ nil nil nil
+ (mapcar (lambda (arg) (format-spec arg spec))
+ image-dired-cmd-rotate-original-options))))
(error "Could not rotate image")
(image-dired-display-image image-dired-temp-rotate-image-file)
(if (or (and image-dired-rotate-original-ask-before-overwrite
@@ -1930,32 +2083,30 @@ image-dired-set-exif-data
"In FILE, set EXIF tag TAG-NAME to value TAG-VALUE."
(image-dired--check-executable-exists
'image-dired-cmd-write-exif-data-program)
- (let (command)
- (setq command (format-spec
- image-dired-cmd-write-exif-data-options
- (list
- (cons ?p image-dired-cmd-write-exif-data-program)
- (cons ?f (expand-file-name file))
- (cons ?t tag-name)
- (cons ?v tag-value))))
- (call-process shell-file-name nil nil nil shell-command-switch command)))
+ (let ((spec
+ (list
+ (cons ?f (expand-file-name file))
+ (cons ?t tag-name)
+ (cons ?v tag-value))))
+ (apply #'call-process image-dired-cmd-write-exif-data-program nil nil nil
+ (mapcar (lambda (arg) (format-spec arg spec))
+ image-dired-cmd-write-exif-data-options))))
(defun image-dired-get-exif-data (file tag-name)
"From FILE, return EXIF tag TAG-NAME."
(image-dired--check-executable-exists
'image-dired-cmd-read-exif-data-program)
(let ((buf (get-buffer-create "*image-dired-get-exif-data*"))
- command tag-value)
- (setq command (format-spec
- image-dired-cmd-read-exif-data-options
- (list
- (cons ?p image-dired-cmd-read-exif-data-program)
- (cons ?f file)
- (cons ?t tag-name))))
+ (spec (list (cons ?f file) (cons ?t tag-name)))
+ tag-value)
(with-current-buffer buf
(delete-region (point-min) (point-max))
- (if (not (eq (call-process shell-file-name nil t nil
- shell-command-switch command) 0))
+ (if (not (eq (apply #'call-process image-dired-cmd-read-exif-data-program
+ nil t nil
+ (mapcar
+ (lambda (arg) (format-spec arg spec))
+ image-dired-cmd-read-exif-data-options))
+ 0))
(error "Could not get EXIF tag")
(goto-char (point-min))
;; Clean buffer from newlines and carriage returns before
^ permalink raw reply related [flat|nested] 6+ messages in thread
end of thread, other threads:[~2016-12-17 3:42 UTC | newest]
Thread overview: 6+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2016-12-16 2:36 [RFC] making image-dired thumbnail creation asynchronous Mark Oteiza
2016-12-16 8:21 ` Eli Zaretskii
2016-12-16 13:15 ` Mark Oteiza
2016-12-16 13:47 ` Eli Zaretskii
2016-12-16 14:16 ` Mark Oteiza
2016-12-17 3:42 ` [PATCH] " Mark Oteiza
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).