;; * 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
: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"
: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
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
: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
: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
: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
: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
(width image-dired-thumb-width)
(height image-dired-thumb-height)))))
-(defun image-dired-create-thumb (original-file thumbnail-file)
+(defvar image-dired-queue nil
+ "List of items in the queue.
+Each item has the form (ORIGINAL-FILE TARGET-FILE).")
+
+(defvar image-dired-queue-active-jobs 0
+ "Number of active jobs in `image-dired-queue'.")
+
+(defvar image-dired-queue-active-limit 2
+ "Maximum number of concurrent jobs permitted for generating images.
+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)
(modif-time (floor (float-time (nth 5 (file-attributes 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.")
- (make-directory thumbnail-dir t))
- (call-process shell-file-name nil nil nil shell-command-switch command)))
+ (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)
+ (set-file-modes thumbnail-dir #o700))
+
+ ;; 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-queue-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))
+ (set-file-modes thumbnail-file #o600)
+ (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-queue'."
+ (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))))
+
+(defun image-dired-create-thumb (original-file thumbnail-file)
+ "Add a job for generating thumbnail to `image-dired-queue'."
+ (setq image-dired-queue
+ (nconc image-dired-queue
+ (list (list original-file thumbnail-file))))
+ (run-at-time 0 nil #'image-dired-thumb-queue-run))
;;;###autoload
(defun image-dired-dired-toggle-marked-thumbs (&optional arg)
(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))
(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.")
(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))
(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 ()
'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
"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
projects / emacs.git / commitdiff