diff options
Diffstat (limited to 'lisp/image-dired.el')
| -rw-r--r-- | lisp/image-dired.el | 425 |
1 files changed, 285 insertions, 140 deletions
diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 6902d742dbb..560cadbe75b 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 @@ Used together with `image-dired-cmd-create-thumbnail-options'." :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 @@ Used together with `image-dired-cmd-create-temp-image-options'." :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 @@ is replaced by the file name of the temporary file." 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 @@ Used together with `image-dired-cmd-rotate-thumbnail-options'." :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 @@ Used together with `image-dired-cmd-rotate-original-options'." :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 @@ Used together with `image-dired-cmd-write-exif-data-options'." :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 @@ Used together with `image-dired-cmd-read-exif-data-options'." :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,81 @@ DIMENSION should be either the symbol 'width or 'height." (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) @@ -649,25 +750,76 @@ DIMENSION should be either the symbol 'width or 'height." (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) @@ -867,10 +1019,9 @@ thumbnail buffer to be selected." (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)) @@ -1554,8 +1705,7 @@ With prefix argument ARG, create thumbnails even if they already exist (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.") @@ -1747,17 +1897,19 @@ original size." (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)) @@ -1811,14 +1963,10 @@ With prefix argument ARG, display image in its original size." (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 () @@ -1853,19 +2001,18 @@ overwritten. This confirmation can be turned off using '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 @@ -1931,32 +2078,30 @@ default value at the prompt." "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 |