[RFC] making image-dired thumbnail creation asynchronous

[Mark Oteiza <mvoteiza@udel.edu>]

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