diff options
| author | Mark Oteiza | 2016-12-19 19:47:06 -0500 |
|---|---|---|
| committer | Mark Oteiza | 2016-12-19 19:47:06 -0500 |
| commit | 36b9973dec65c8daf57d1cb73f0de5a3c59279fc (patch) | |
| tree | 08f21997fe0ae87a2f4c0bf7326cd8c0d2557c06 | |
| parent | 85aebc12de28667cdccde5b080972453544d015e (diff) | |
| download | emacs-36b9973dec65c8daf57d1cb73f0de5a3c59279fc.tar.gz emacs-36b9973dec65c8daf57d1cb73f0de5a3c59279fc.zip | |
Implement asynchronous thumbnail generation in image-dired
Additionally, all FOO-options defcustoms that were in fact shell command
strings have been converted to argument lists. Another method for
shrinking PNG thumbs with optipng(1) has been added.
* lisp/image-dired.el: Remove TODO item in commentary.
(image-dired-cmd-create-thumbnail-options):
(image-dired-cmd-create-temp-image-options):
(image-dired-cmd-rotate-thumbnail-options):
(image-dired-cmd-rotate-original-options):
(image-dired-cmd-write-exif-data-options):
(image-dired-cmd-read-exif-data-options): Convert to argument lists.
(image-dired-cmd-pngnq-program, image-dired-cmd-pngcrush-program):
Change string type to file.
(image-dired-cmd-create-standard-thumbnail-command): Remove.
(image-dired-cmd-pngnq-options):
(image-dired-cmd-create-standard-thumbnail-options):
(image-dired-cmd-optipng-program, image-dired-cmd-optipng-options):
New defcustoms.
(image-dired-queue, image-dired-queue-active-jobs):
(image-dired-queue-active-limit): New variables.
(image-dired-pngnq-thumb, image-dired-pngcrush-thumb):
(image-dired-optipng-thumb): New functions.
(image-dired-create-thumb-1): Renamed from image-dired-create-thumb.
Use start-process instead of call-process. Set file modes. Trigger
PNG file optimization in process sentinel.
(image-dired-thumb-queue-run, image-dired-create-thumb): New functions.
(image-dired-display-thumbs):
(image-dired-create-thumbs): Don't expect call-process return value.
(image-dired-display-image, image-dired-rotate-thumbnail): Use
start-process instead of call-process.
(image-dired-rotate-original, image-dired-set-exif-data):
(image-dired-get-exif-data): Adapt to arguments being an arg list.
| -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 @@ | |||
| 118 | ;; * From thumbs.el: Add the "modify" commands (emboss, negate, | 118 | ;; * From thumbs.el: Add the "modify" commands (emboss, negate, |
| 119 | ;; monochrome etc). | 119 | ;; monochrome etc). |
| 120 | ;; | 120 | ;; |
| 121 | ;; * Asynchronous creation of thumbnails. | ||
| 122 | ;; | ||
| 123 | ;; * Add `image-dired-display-thumbs-ring' and functions to cycle that. Find | 121 | ;; * Add `image-dired-display-thumbs-ring' and functions to cycle that. Find |
| 124 | ;; out which is best, saving old batch just before inserting new, or | 122 | ;; out which is best, saving old batch just before inserting new, or |
| 125 | ;; saving the current batch in the ring when inserting it. Adding it | 123 | ;; 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'." | |||
| 230 | :group 'image-dired) | 228 | :group 'image-dired) |
| 231 | 229 | ||
| 232 | (defcustom image-dired-cmd-create-thumbnail-options | 230 | (defcustom image-dired-cmd-create-thumbnail-options |
| 233 | "%p -size %wx%h \"%f\" -resize \"%wx%h>\" -strip jpeg:\"%t\"" | 231 | '("-size" "%wx%h" "%f" "-resize" "%wx%h>" "-strip" "jpeg:%t") |
| 234 | "Format of command used to create thumbnail image. | 232 | "Options of command used to create thumbnail image. |
| 235 | Available options are %p which is replaced by | 233 | Used with `image-dired-cmd-create-thumbnail-program'. |
| 236 | `image-dired-cmd-create-thumbnail-program', %w which is replaced by | 234 | Available format specifiers are: %w which is replaced by |
| 237 | `image-dired-thumb-width', %h which is replaced by `image-dired-thumb-height', | 235 | `image-dired-thumb-width', %h which is replaced by `image-dired-thumb-height', |
| 238 | %f which is replaced by the file name of the original image and %t | 236 | %f which is replaced by the file name of the original image and %t |
| 239 | which is replaced by the file name of the thumbnail file." | 237 | which is replaced by the file name of the thumbnail file." |
| 240 | :type 'string | 238 | :version "26.1" |
| 239 | :type '(repeat (string :tag "Argument")) | ||
| 241 | :group 'image-dired) | 240 | :group 'image-dired) |
| 242 | 241 | ||
| 243 | (defcustom image-dired-cmd-create-temp-image-program "convert" | 242 | (defcustom image-dired-cmd-create-temp-image-program "convert" |
| @@ -247,14 +246,15 @@ Used together with `image-dired-cmd-create-temp-image-options'." | |||
| 247 | :group 'image-dired) | 246 | :group 'image-dired) |
| 248 | 247 | ||
| 249 | (defcustom image-dired-cmd-create-temp-image-options | 248 | (defcustom image-dired-cmd-create-temp-image-options |
| 250 | "%p -size %wx%h \"%f\" -resize \"%wx%h>\" -strip jpeg:\"%t\"" | 249 | '("-size" "%wx%h" "%f" "-resize" "%wx%h>" "-strip" "jpeg:%t") |
| 251 | "Format of command used to create temporary image for display window. | 250 | "Options of command used to create temporary image for display window. |
| 252 | Available options are %p which is replaced by | 251 | Used together with `image-dired-cmd-create-temp-image-program', |
| 253 | `image-dired-cmd-create-temp-image-program', %w and %h which is replaced by | 252 | Available format specifiers are: %w and %h which are replaced by |
| 254 | the calculated max size for width and height in the image display window, | 253 | the calculated max size for width and height in the image display window, |
| 255 | %f which is replaced by the file name of the original image and %t which | 254 | %f which is replaced by the file name of the original image and %t which |
| 256 | is replaced by the file name of the temporary file." | 255 | is replaced by the file name of the temporary file." |
| 257 | :type 'string | 256 | :version "26.1" |
| 257 | :type '(repeat (string :tag "Argument")) | ||
| 258 | :group 'image-dired) | 258 | :group 'image-dired) |
| 259 | 259 | ||
| 260 | (defcustom image-dired-cmd-pngnq-program | 260 | (defcustom image-dired-cmd-pngnq-program |
| @@ -264,49 +264,72 @@ is replaced by the file name of the temporary file." | |||
| 264 | It quantizes colors of PNG images down to 256 colors or fewer | 264 | It quantizes colors of PNG images down to 256 colors or fewer |
| 265 | using the Neuquant procedure." | 265 | using the Neuquant procedure." |
| 266 | :version "26.1" | 266 | :version "26.1" |
| 267 | :type '(choice (const :tag "Not Set" nil) string) | 267 | :type '(choice (const :tag "Not Set" nil) file) |
| 268 | :group 'image-dired) | ||
| 269 | |||
| 270 | (defcustom image-dired-cmd-pngnq-options | ||
| 271 | '("-f" "%t") | ||
| 272 | "Arguments to pass `image-dired-cmd-pngnq-program'. | ||
| 273 | Available format specifiers are the same as in | ||
| 274 | `image-dired-cmd-create-thumbnail-options'." | ||
| 275 | :version "26.1" | ||
| 276 | :type '(repeat (string :tag "Argument")) | ||
| 268 | :group 'image-dired) | 277 | :group 'image-dired) |
| 269 | 278 | ||
| 270 | (defcustom image-dired-cmd-pngcrush-program (executable-find "pngcrush") | 279 | (defcustom image-dired-cmd-pngcrush-program (executable-find "pngcrush") |
| 271 | "The file name of the `pngcrush' program. | 280 | "The file name of the `pngcrush' program. |
| 272 | It optimizes the compression of PNG images. Also it adds PNG textual chunks | 281 | It optimizes the compression of PNG images. Also it adds PNG textual chunks |
| 273 | with the information required by the Thumbnail Managing Standard." | 282 | with the information required by the Thumbnail Managing Standard." |
| 274 | :type '(choice (const :tag "Not Set" nil) string) | 283 | :type '(choice (const :tag "Not Set" nil) file) |
| 275 | :group 'image-dired) | 284 | :group 'image-dired) |
| 276 | 285 | ||
| 277 | (defcustom image-dired-cmd-create-standard-thumbnail-command | 286 | (defcustom image-dired-cmd-pngcrush-options |
| 278 | (concat | 287 | `("-q" |
| 279 | "%p -size %wx%h \"%f\" " | 288 | "-text" "b" "Description" "Thumbnail of file://%f" |
| 280 | (unless (or image-dired-cmd-pngcrush-program image-dired-cmd-pngnq-program) | 289 | "-text" "b" "Software" ,(emacs-version) |
| 281 | (concat | 290 | ;; "-text b \"Thumb::Image::Height\" \"%oh\" " |
| 282 | "-set \"Thumb::MTime\" \"%m\" " | 291 | ;; "-text b \"Thumb::Image::Mimetype\" \"%mime\" " |
| 283 | "-set \"Thumb::URI\" \"file://%f\" " | 292 | ;; "-text b \"Thumb::Image::Width\" \"%ow\" " |
| 284 | "-set \"Description\" \"Thumbnail of file://%f\" " | 293 | "-text" "b" "Thumb::MTime" "%m" |
| 285 | "-set \"Software\" \"" (emacs-version) "\" ")) | 294 | ;; "-text b \"Thumb::Size\" \"%b\" " |
| 286 | "-thumbnail \"%wx%h>\" png:\"%t\"" | 295 | "-text" "b" "Thumb::URI" "file://%f" |
| 287 | (if image-dired-cmd-pngnq-program | 296 | "%q" "%t") |
| 288 | (concat | 297 | "Arguments for `image-dired-cmd-pngcrush-program'. |
| 289 | " ; " image-dired-cmd-pngnq-program " -f \"%t\"" | 298 | Available format specifiers are the same as in |
| 290 | (unless image-dired-cmd-pngcrush-program | 299 | `image-dired-cmd-create-thumbnail-options', with %q for a |
| 291 | " ; mv %q %t"))) | 300 | temporary file name (typically generated by pnqnq)" |
| 292 | (if image-dired-cmd-pngcrush-program | ||
| 293 | (concat | ||
| 294 | (unless image-dired-cmd-pngcrush-program | ||
| 295 | " ; cp %t %q") | ||
| 296 | " ; " image-dired-cmd-pngcrush-program " -q " | ||
| 297 | "-text b \"Description\" \"Thumbnail of file://%f\" " | ||
| 298 | "-text b \"Software\" \"" (emacs-version) "\" " | ||
| 299 | ;; "-text b \"Thumb::Image::Height\" \"%oh\" " | ||
| 300 | ;; "-text b \"Thumb::Image::Mimetype\" \"%mime\" " | ||
| 301 | ;; "-text b \"Thumb::Image::Width\" \"%ow\" " | ||
| 302 | "-text b \"Thumb::MTime\" \"%m\" " | ||
| 303 | ;; "-text b \"Thumb::Size\" \"%b\" " | ||
| 304 | "-text b \"Thumb::URI\" \"file://%f\" " | ||
| 305 | "%q %t" | ||
| 306 | " ; rm %q"))) | ||
| 307 | "Command to create thumbnails according to the Thumbnail Managing Standard." | ||
| 308 | :version "26.1" | 301 | :version "26.1" |
| 309 | :type 'string | 302 | :type '(repeat (string :tag "Argument")) |
| 303 | :group 'image-dired) | ||
| 304 | |||
| 305 | (defcustom image-dired-cmd-optipng-program (executable-find "optipng") | ||
| 306 | "The file name of the `optipng' program." | ||
| 307 | :type '(choice (const :tag "Not Set" nil) file) | ||
| 308 | :group 'image-dired) | ||
| 309 | |||
| 310 | (defcustom image-dired-cmd-optipng-options '("-o5" "%t") | ||
| 311 | "Arguments passed to `image-dired-optipng-program'. | ||
| 312 | Available format specifiers are described in | ||
| 313 | `image-dired-cmd-create-thumbnail-options'." | ||
| 314 | :type '(repeat (string :tag "Argument")) | ||
| 315 | :link '(url-link "man:optipng(1)") | ||
| 316 | :group 'image-dired) | ||
| 317 | |||
| 318 | (defcustom image-dired-cmd-create-standard-thumbnail-options | ||
| 319 | (append '("-size" "%wx%h" "%f") | ||
| 320 | (unless (or image-dired-cmd-pngcrush-program | ||
| 321 | image-dired-cmd-pngnq-program) | ||
| 322 | (list | ||
| 323 | "-set" "Thumb::MTime" "%m" | ||
| 324 | "-set" "Thumb::URI" "file://%f" | ||
| 325 | "-set" "Description" "Thumbnail of file://%f" | ||
| 326 | "-set" "Software" (emacs-version))) | ||
| 327 | '("-thumbnail" "%wx%h>" "png:%t")) | ||
| 328 | "Options for creating thumbnails according to the Thumbnail Managing Standard. | ||
| 329 | Available format specifiers are the same as in | ||
| 330 | `image-dired-cmd-create-thumbnail-options', with %m for file modification time." | ||
| 331 | :version "26.1" | ||
| 332 | :type '(repeat (string :tag "Argument")) | ||
| 310 | :group 'image-dired) | 333 | :group 'image-dired) |
| 311 | 334 | ||
| 312 | (defcustom image-dired-cmd-rotate-thumbnail-program | 335 | (defcustom image-dired-cmd-rotate-thumbnail-program |
| @@ -317,14 +340,15 @@ Used together with `image-dired-cmd-rotate-thumbnail-options'." | |||
| 317 | :group 'image-dired) | 340 | :group 'image-dired) |
| 318 | 341 | ||
| 319 | (defcustom image-dired-cmd-rotate-thumbnail-options | 342 | (defcustom image-dired-cmd-rotate-thumbnail-options |
| 320 | "%p -rotate %d \"%t\"" | 343 | '("-rotate" "%d" "%t") |
| 321 | "Format of command used to rotate thumbnail image. | 344 | "Arguments of command used to rotate thumbnail image. |
| 322 | Available options are %p which is replaced by | 345 | Used with `image-dired-cmd-rotate-thumbnail-program'. |
| 323 | `image-dired-cmd-rotate-thumbnail-program', %d which is replaced by the | 346 | Available format specifiers are: %d which is replaced by the |
| 324 | number of (positive) degrees to rotate the image, normally 90 or 270 | 347 | number of (positive) degrees to rotate the image, normally 90 or 270 |
| 325 | \(for 90 degrees right and left), %t which is replaced by the file name | 348 | \(for 90 degrees right and left), %t which is replaced by the file name |
| 326 | of the thumbnail file." | 349 | of the thumbnail file." |
| 327 | :type 'string | 350 | :version "26.1" |
| 351 | :type '(repeat (string :tag "Argument")) | ||
| 328 | :group 'image-dired) | 352 | :group 'image-dired) |
| 329 | 353 | ||
| 330 | (defcustom image-dired-cmd-rotate-original-program | 354 | (defcustom image-dired-cmd-rotate-original-program |
| @@ -335,15 +359,16 @@ Used together with `image-dired-cmd-rotate-original-options'." | |||
| 335 | :group 'image-dired) | 359 | :group 'image-dired) |
| 336 | 360 | ||
| 337 | (defcustom image-dired-cmd-rotate-original-options | 361 | (defcustom image-dired-cmd-rotate-original-options |
| 338 | "%p -rotate %d -copy all -outfile %t \"%o\"" | 362 | '("-rotate" "%d" "-copy" "all" "-outfile" "%t" "%o") |
| 339 | "Format of command used to rotate original image. | 363 | "Arguments of command used to rotate original image. |
| 340 | Available options are %p which is replaced by | 364 | Used with `image-dired-cmd-rotate-original-program'. |
| 341 | `image-dired-cmd-rotate-original-program', %d which is replaced by the | 365 | Available format specifiers are: %d which is replaced by the |
| 342 | number of (positive) degrees to rotate the image, normally 90 or | 366 | number of (positive) degrees to rotate the image, normally 90 or |
| 343 | 270 \(for 90 degrees right and left), %o which is replaced by the | 367 | 270 \(for 90 degrees right and left), %o which is replaced by the |
| 344 | original image file name and %t which is replaced by | 368 | original image file name and %t which is replaced by |
| 345 | `image-dired-temp-image-file'." | 369 | `image-dired-temp-image-file'." |
| 346 | :type 'string | 370 | :version "26.1" |
| 371 | :type '(repeat (string :tag "Argument")) | ||
| 347 | :group 'image-dired) | 372 | :group 'image-dired) |
| 348 | 373 | ||
| 349 | (defcustom image-dired-temp-rotate-image-file | 374 | (defcustom image-dired-temp-rotate-image-file |
| @@ -367,13 +392,14 @@ Used together with `image-dired-cmd-write-exif-data-options'." | |||
| 367 | :group 'image-dired) | 392 | :group 'image-dired) |
| 368 | 393 | ||
| 369 | (defcustom image-dired-cmd-write-exif-data-options | 394 | (defcustom image-dired-cmd-write-exif-data-options |
| 370 | "%p -%t=\"%v\" \"%f\"" | 395 | '("-%t=%v" "%f") |
| 371 | "Format of command used to write EXIF data. | 396 | "Arguments of command used to write EXIF data. |
| 372 | Available options are %p which is replaced by | 397 | Used with `image-dired-cmd-write-exif-data-program'. |
| 373 | `image-dired-cmd-write-exif-data-program', %f which is replaced by | 398 | Available format specifiers are: %f which is replaced by |
| 374 | the image file name, %t which is replaced by the tag name and %v | 399 | the image file name, %t which is replaced by the tag name and %v |
| 375 | which is replaced by the tag value." | 400 | which is replaced by the tag value." |
| 376 | :type 'string | 401 | :version "26.1" |
| 402 | :type '(repeat (string :tag "Argument")) | ||
| 377 | :group 'image-dired) | 403 | :group 'image-dired) |
| 378 | 404 | ||
| 379 | (defcustom image-dired-cmd-read-exif-data-program | 405 | (defcustom image-dired-cmd-read-exif-data-program |
| @@ -384,12 +410,13 @@ Used together with `image-dired-cmd-read-exif-data-options'." | |||
| 384 | :group 'image-dired) | 410 | :group 'image-dired) |
| 385 | 411 | ||
| 386 | (defcustom image-dired-cmd-read-exif-data-options | 412 | (defcustom image-dired-cmd-read-exif-data-options |
| 387 | "%p -s -s -s -%t \"%f\"" | 413 | '("-s" "-s" "-s" "-%t" "%f") |
| 388 | "Format of command used to read EXIF data. | 414 | "Arguments of command used to read EXIF data. |
| 389 | Available options are %p which is replaced by | 415 | Used with `image-dired-cmd-read-exif-data-program'. |
| 390 | `image-dired-cmd-write-exif-data-program', %f which is replaced | 416 | Available format specifiers are: %f which is replaced |
| 391 | by the image file name and %t which is replaced by the tag name." | 417 | by the image file name and %t which is replaced by the tag name." |
| 392 | :type 'string | 418 | :version "26.1" |
| 419 | :type '(repeat (string :tag "Argument")) | ||
| 393 | :group 'image-dired) | 420 | :group 'image-dired) |
| 394 | 421 | ||
| 395 | (defcustom image-dired-gallery-hidden-tags | 422 | (defcustom image-dired-gallery-hidden-tags |
| @@ -640,7 +667,81 @@ DIMENSION should be either the symbol 'width or 'height." | |||
| 640 | (width image-dired-thumb-width) | 667 | (width image-dired-thumb-width) |
| 641 | (height image-dired-thumb-height))))) | 668 | (height image-dired-thumb-height))))) |
| 642 | 669 | ||
| 643 | (defun image-dired-create-thumb (original-file thumbnail-file) | 670 | (defvar image-dired-queue nil |
| 671 | "List of items in the queue. | ||
| 672 | Each item has the form (ORIGINAL-FILE TARGET-FILE).") | ||
| 673 | |||
| 674 | (defvar image-dired-queue-active-jobs 0 | ||
| 675 | "Number of active jobs in `image-dired-queue'.") | ||
| 676 | |||
| 677 | (defvar image-dired-queue-active-limit 2 | ||
| 678 | "Maximum number of concurrent jobs permitted for generating images. | ||
| 679 | Increase at own risk.") | ||
| 680 | |||
| 681 | (defun image-dired-pngnq-thumb (spec) | ||
| 682 | "Quantize thumbnail described by format SPEC with pngnq(1)." | ||
| 683 | (let ((process | ||
| 684 | (apply #'start-process "image-dired-pngnq" nil | ||
| 685 | image-dired-cmd-pngnq-program | ||
| 686 | (mapcar (lambda (arg) (format-spec arg spec)) | ||
| 687 | image-dired-cmd-pngnq-options)))) | ||
| 688 | (setf (process-sentinel process) | ||
| 689 | (lambda (process status) | ||
| 690 | (if (and (eq (process-status process) 'exit) | ||
| 691 | (zerop (process-exit-status process))) | ||
| 692 | ;; Pass off to pngcrush, or just rename the | ||
| 693 | ;; THUMB-nq8.png file back to THUMB.png | ||
| 694 | (if (and image-dired-cmd-pngcrush-program | ||
| 695 | (executable-find image-dired-cmd-pngcrush-program)) | ||
| 696 | (image-dired-pngcrush-thumb spec) | ||
| 697 | (let ((nq8 (cdr (assq ?q spec))) | ||
| 698 | (thumb (cdr (assq ?t spec)))) | ||
| 699 | (rename-file nq8 thumb t))) | ||
| 700 | (message "command %S %s" (process-command process) | ||
| 701 | (replace-regexp-in-string "\n" "" status))))) | ||
| 702 | process)) | ||
| 703 | |||
| 704 | (defun image-dired-pngcrush-thumb (spec) | ||
| 705 | "Optimize thumbnail decsribed by format SPEC with pngcrush(1)." | ||
| 706 | ;; If pngnq wasn't run, then the THUMB-nq8.png file does not exist. | ||
| 707 | ;; pngcrush needs an infile and outfile, so we just copy THUMB to | ||
| 708 | ;; THUMB-nq8.png and use the latter as a temp file. | ||
| 709 | (when (not image-dired-cmd-pngnq-program) | ||
| 710 | (let ((temp (cdr (assq ?q spec))) | ||
| 711 | (thumb (cdr (assq ?t spec)))) | ||
| 712 | (copy-file thumb temp))) | ||
| 713 | (let ((process | ||
| 714 | (apply #'start-process "image-dired-pngcrush" nil | ||
| 715 | image-dired-cmd-pngcrush-program | ||
| 716 | (mapcar (lambda (arg) (format-spec arg spec)) | ||
| 717 | image-dired-cmd-pngcrush-options)))) | ||
| 718 | (setf (process-sentinel process) | ||
| 719 | (lambda (process status) | ||
| 720 | (unless (and (eq (process-status process) 'exit) | ||
| 721 | (zerop (process-exit-status process))) | ||
| 722 | (message "command %S %s" (process-command process) | ||
| 723 | (replace-regexp-in-string "\n" "" status))) | ||
| 724 | (when (memq (process-status process) '(exit signal)) | ||
| 725 | (let ((temp (cdr (assq ?q spec)))) | ||
| 726 | (delete-file temp))))) | ||
| 727 | process)) | ||
| 728 | |||
| 729 | (defun image-dired-optipng-thumb (spec) | ||
| 730 | "Optimize thumbnail decsribed by format SPEC with optipng(1)." | ||
| 731 | (let ((process | ||
| 732 | (apply #'start-process "image-dired-optipng" nil | ||
| 733 | image-dired-cmd-optipng-program | ||
| 734 | (mapcar (lambda (arg) (format-spec arg spec)) | ||
| 735 | image-dired-cmd-optipng-options)))) | ||
| 736 | (setf (process-sentinel process) | ||
| 737 | (lambda (process status) | ||
| 738 | (unless (and (eq (process-status process) 'exit) | ||
| 739 | (zerop (process-exit-status process))) | ||
| 740 | (message "command %S %s" (process-command process) | ||
| 741 | (replace-regexp-in-string "\n" "" status))))) | ||
| 742 | process)) | ||
| 743 | |||
| 744 | (defun image-dired-create-thumb-1 (original-file thumbnail-file) | ||
| 644 | "For ORIGINAL-FILE, create thumbnail image named THUMBNAIL-FILE." | 745 | "For ORIGINAL-FILE, create thumbnail image named THUMBNAIL-FILE." |
| 645 | (image-dired--check-executable-exists | 746 | (image-dired--check-executable-exists |
| 646 | 'image-dired-cmd-create-thumbnail-program) | 747 | 'image-dired-cmd-create-thumbnail-program) |
| @@ -649,25 +750,76 @@ DIMENSION should be either the symbol 'width or 'height." | |||
| 649 | (modif-time (floor (float-time (nth 5 (file-attributes original-file))))) | 750 | (modif-time (floor (float-time (nth 5 (file-attributes original-file))))) |
| 650 | (thumbnail-nq8-file (replace-regexp-in-string ".png\\'" "-nq8.png" | 751 | (thumbnail-nq8-file (replace-regexp-in-string ".png\\'" "-nq8.png" |
| 651 | thumbnail-file)) | 752 | thumbnail-file)) |
| 652 | (command | 753 | (spec |
| 653 | (format-spec | 754 | (list |
| 654 | (if (memq image-dired-thumbnail-storage '(standard standard-large)) | 755 | (cons ?w width) |
| 655 | image-dired-cmd-create-standard-thumbnail-command | 756 | (cons ?h height) |
| 656 | image-dired-cmd-create-thumbnail-options) | 757 | (cons ?m modif-time) |
| 657 | (list | 758 | (cons ?f original-file) |
| 658 | (cons ?p image-dired-cmd-create-thumbnail-program) | 759 | (cons ?q thumbnail-nq8-file) |
| 659 | (cons ?w width) | 760 | (cons ?t thumbnail-file))) |
| 660 | (cons ?h height) | 761 | (thumbnail-dir (file-name-directory thumbnail-file)) |
| 661 | (cons ?m modif-time) | 762 | process) |
| 662 | (cons ?f original-file) | 763 | (when (not (file-exists-p thumbnail-dir)) |
| 663 | (cons ?q thumbnail-nq8-file) | 764 | (message "Creating thumbnail directory") |
| 664 | (cons ?t thumbnail-file)))) | 765 | (make-directory thumbnail-dir t) |
| 665 | thumbnail-dir) | 766 | (set-file-modes thumbnail-dir #o700)) |
| 666 | (when (not (file-exists-p | 767 | |
| 667 | (setq thumbnail-dir (file-name-directory thumbnail-file)))) | 768 | ;; Thumbnail file creation processes begin here and are marshalled |
| 668 | (message "Creating thumbnail directory.") | 769 | ;; in a queue by `image-dired-create-thumb'. |
| 669 | (make-directory thumbnail-dir t)) | 770 | (setq process |
| 670 | (call-process shell-file-name nil nil nil shell-command-switch command))) | 771 | (apply #'start-process "image-dired-create-thumbnail" nil |
| 772 | image-dired-cmd-create-thumbnail-program | ||
| 773 | (mapcar | ||
| 774 | (lambda (arg) (format-spec arg spec)) | ||
| 775 | (if (memq image-dired-thumbnail-storage | ||
| 776 | '(standard standard-large)) | ||
| 777 | image-dired-cmd-create-standard-thumbnail-options | ||
| 778 | image-dired-cmd-create-thumbnail-options)))) | ||
| 779 | |||
| 780 | (setf (process-sentinel process) | ||
| 781 | (lambda (process status) | ||
| 782 | ;; Trigger next in queue once a thumbnail has been created | ||
| 783 | (cl-decf image-dired-queue-active-jobs) | ||
| 784 | (image-dired-thumb-queue-run) | ||
| 785 | (if (not (and (eq (process-status process) 'exit) | ||
| 786 | (zerop (process-exit-status process)))) | ||
| 787 | (message "Thumb could not be created for %s: %s" | ||
| 788 | (abbreviate-file-name original-file) | ||
| 789 | (replace-regexp-in-string "\n" "" status)) | ||
| 790 | (set-file-modes thumbnail-file #o600) | ||
| 791 | (clear-image-cache thumbnail-file) | ||
| 792 | ;; PNG thumbnail has been created since we are | ||
| 793 | ;; following the XDG thumbnail spec, so try to optimize | ||
| 794 | (when (memq image-dired-thumbnail-storage | ||
| 795 | '(standard standard-large)) | ||
| 796 | (cond | ||
| 797 | ((and image-dired-cmd-pngnq-program | ||
| 798 | (executable-find image-dired-cmd-pngnq-program)) | ||
| 799 | (image-dired-pngnq-thumb spec)) | ||
| 800 | ((and image-dired-cmd-pngcrush-program | ||
| 801 | (executable-find image-dired-cmd-pngcrush-program)) | ||
| 802 | (image-dired-pngcrush-thumb spec)) | ||
| 803 | ((and image-dired-cmd-optipng-program | ||
| 804 | (executable-find image-dired-cmd-optipng-program)) | ||
| 805 | (image-dired-optipng-thumb spec))))))) | ||
| 806 | process)) | ||
| 807 | |||
| 808 | (defun image-dired-thumb-queue-run () | ||
| 809 | "Run a queued job if one exists and not too many jobs are running. | ||
| 810 | Queued items live in `image-dired-queue'." | ||
| 811 | (while (and image-dired-queue | ||
| 812 | (< image-dired-queue-active-jobs | ||
| 813 | image-dired-queue-active-limit)) | ||
| 814 | (cl-incf image-dired-queue-active-jobs) | ||
| 815 | (apply #'image-dired-create-thumb-1 (pop image-dired-queue)))) | ||
| 816 | |||
| 817 | (defun image-dired-create-thumb (original-file thumbnail-file) | ||
| 818 | "Add a job for generating thumbnail to `image-dired-queue'." | ||
| 819 | (setq image-dired-queue | ||
| 820 | (nconc image-dired-queue | ||
| 821 | (list (list original-file thumbnail-file)))) | ||
| 822 | (run-at-time 0 nil #'image-dired-thumb-queue-run)) | ||
| 671 | 823 | ||
| 672 | ;;;###autoload | 824 | ;;;###autoload |
| 673 | (defun image-dired-dired-toggle-marked-thumbs (&optional arg) | 825 | (defun image-dired-dired-toggle-marked-thumbs (&optional arg) |
| @@ -867,10 +1019,9 @@ thumbnail buffer to be selected." | |||
| 867 | (goto-char (point-max))) | 1019 | (goto-char (point-max))) |
| 868 | (dolist (curr-file files) | 1020 | (dolist (curr-file files) |
| 869 | (setq thumb-name (image-dired-thumb-name curr-file)) | 1021 | (setq thumb-name (image-dired-thumb-name curr-file)) |
| 870 | (if (and (not (file-exists-p thumb-name)) | 1022 | (when (not (file-exists-p thumb-name)) |
| 871 | (not (= 0 (image-dired-create-thumb curr-file thumb-name)))) | 1023 | (image-dired-create-thumb curr-file thumb-name)) |
| 872 | (message "Thumb could not be created for file %s" curr-file) | 1024 | (image-dired-insert-thumbnail thumb-name curr-file dired-buf))) |
| 873 | (image-dired-insert-thumbnail thumb-name curr-file dired-buf)))) | ||
| 874 | (if do-not-pop | 1025 | (if do-not-pop |
| 875 | (display-buffer buf) | 1026 | (display-buffer buf) |
| 876 | (pop-to-buffer buf)) | 1027 | (pop-to-buffer buf)) |
| @@ -1554,8 +1705,7 @@ With prefix argument ARG, create thumbnails even if they already exist | |||
| 1554 | (clear-image-cache (expand-file-name thumb-name))) | 1705 | (clear-image-cache (expand-file-name thumb-name))) |
| 1555 | (when (or (not (file-exists-p thumb-name)) | 1706 | (when (or (not (file-exists-p thumb-name)) |
| 1556 | arg) | 1707 | arg) |
| 1557 | (when (not (= 0 (image-dired-create-thumb curr-file thumb-name))) | 1708 | (image-dired-create-thumb curr-file thumb-name))))) |
| 1558 | (error "Thumb could not be created")))))) | ||
| 1559 | 1709 | ||
| 1560 | (defvar image-dired-slideshow-timer nil | 1710 | (defvar image-dired-slideshow-timer nil |
| 1561 | "Slideshow timer.") | 1711 | "Slideshow timer.") |
| @@ -1747,17 +1897,19 @@ original size." | |||
| 1747 | (image-type 'jpeg)) | 1897 | (image-type 'jpeg)) |
| 1748 | (setq file (expand-file-name file)) | 1898 | (setq file (expand-file-name file)) |
| 1749 | (if (not original-size) | 1899 | (if (not original-size) |
| 1750 | (let* ((command | 1900 | (let* ((spec |
| 1751 | (format-spec | 1901 | (list |
| 1752 | image-dired-cmd-create-temp-image-options | 1902 | (cons ?p image-dired-cmd-create-temp-image-program) |
| 1753 | (list | 1903 | (cons ?w (image-dired-display-window-width window)) |
| 1754 | (cons ?p image-dired-cmd-create-temp-image-program) | 1904 | (cons ?h (image-dired-display-window-height window)) |
| 1755 | (cons ?w (image-dired-display-window-width window)) | 1905 | (cons ?f file) |
| 1756 | (cons ?h (image-dired-display-window-height window)) | 1906 | (cons ?t new-file))) |
| 1757 | (cons ?f file) | 1907 | (ret |
| 1758 | (cons ?t new-file)))) | 1908 | (apply #'call-process |
| 1759 | (ret (call-process shell-file-name nil nil nil | 1909 | image-dired-cmd-create-temp-image-program nil nil nil |
| 1760 | shell-command-switch command))) | 1910 | (mapcar |
| 1911 | (lambda (arg) (format-spec arg spec)) | ||
| 1912 | image-dired-cmd-create-temp-image-options)))) | ||
| 1761 | (when (not (zerop ret)) | 1913 | (when (not (zerop ret)) |
| 1762 | (error "Could not resize image"))) | 1914 | (error "Could not resize image"))) |
| 1763 | (setq image-type (image-type-from-file-name file)) | 1915 | (setq image-type (image-type-from-file-name file)) |
| @@ -1811,14 +1963,10 @@ With prefix argument ARG, display image in its original size." | |||
| 1811 | (message "No thumbnail at point") | 1963 | (message "No thumbnail at point") |
| 1812 | (let* ((file (image-dired-thumb-name (image-dired-original-file-name))) | 1964 | (let* ((file (image-dired-thumb-name (image-dired-original-file-name))) |
| 1813 | (thumb (expand-file-name file)) | 1965 | (thumb (expand-file-name file)) |
| 1814 | command) | 1966 | (spec (list (cons ?d degrees) (cons ?t thumb)))) |
| 1815 | (setq command (format-spec | 1967 | (apply #'call-process image-dired-cmd-rotate-thumbnail-program nil nil nil |
| 1816 | image-dired-cmd-rotate-thumbnail-options | 1968 | (mapcar (lambda (arg) (format-spec arg spec)) |
| 1817 | (list | 1969 | image-dired-cmd-rotate-thumbnail-options)) |
| 1818 | (cons ?p image-dired-cmd-rotate-thumbnail-program) | ||
| 1819 | (cons ?d degrees) | ||
| 1820 | (cons ?t thumb)))) | ||
| 1821 | (call-process shell-file-name nil nil nil shell-command-switch command) | ||
| 1822 | (clear-image-cache thumb)))) | 1970 | (clear-image-cache thumb)))) |
| 1823 | 1971 | ||
| 1824 | (defun image-dired-rotate-thumbnail-left () | 1972 | (defun image-dired-rotate-thumbnail-left () |
| @@ -1853,19 +2001,18 @@ overwritten. This confirmation can be turned off using | |||
| 1853 | 'image-dired-cmd-rotate-original-program) | 2001 | 'image-dired-cmd-rotate-original-program) |
| 1854 | (if (not (image-dired-image-at-point-p)) | 2002 | (if (not (image-dired-image-at-point-p)) |
| 1855 | (message "No image at point") | 2003 | (message "No image at point") |
| 1856 | (let ((file (image-dired-original-file-name)) | 2004 | (let* ((file (image-dired-original-file-name)) |
| 1857 | command) | 2005 | (spec |
| 2006 | (list | ||
| 2007 | (cons ?d degrees) | ||
| 2008 | (cons ?o (expand-file-name file)) | ||
| 2009 | (cons ?t image-dired-temp-rotate-image-file)))) | ||
| 1858 | (unless (eq 'jpeg (image-type file)) | 2010 | (unless (eq 'jpeg (image-type file)) |
| 1859 | (error "Only JPEG images can be rotated!")) | 2011 | (error "Only JPEG images can be rotated!")) |
| 1860 | (setq command (format-spec | 2012 | (if (not (= 0 (apply #'call-process image-dired-cmd-rotate-original-program |
| 1861 | image-dired-cmd-rotate-original-options | 2013 | nil nil nil |
| 1862 | (list | 2014 | (mapcar (lambda (arg) (format-spec arg spec)) |
| 1863 | (cons ?p image-dired-cmd-rotate-original-program) | 2015 | image-dired-cmd-rotate-original-options)))) |
| 1864 | (cons ?d degrees) | ||
| 1865 | (cons ?o (expand-file-name file)) | ||
| 1866 | (cons ?t image-dired-temp-rotate-image-file)))) | ||
| 1867 | (if (not (= 0 (call-process shell-file-name nil nil nil | ||
| 1868 | shell-command-switch command))) | ||
| 1869 | (error "Could not rotate image") | 2016 | (error "Could not rotate image") |
| 1870 | (image-dired-display-image image-dired-temp-rotate-image-file) | 2017 | (image-dired-display-image image-dired-temp-rotate-image-file) |
| 1871 | (if (or (and image-dired-rotate-original-ask-before-overwrite | 2018 | (if (or (and image-dired-rotate-original-ask-before-overwrite |
| @@ -1931,32 +2078,30 @@ default value at the prompt." | |||
| 1931 | "In FILE, set EXIF tag TAG-NAME to value TAG-VALUE." | 2078 | "In FILE, set EXIF tag TAG-NAME to value TAG-VALUE." |
| 1932 | (image-dired--check-executable-exists | 2079 | (image-dired--check-executable-exists |
| 1933 | 'image-dired-cmd-write-exif-data-program) | 2080 | 'image-dired-cmd-write-exif-data-program) |
| 1934 | (let (command) | 2081 | (let ((spec |
| 1935 | (setq command (format-spec | 2082 | (list |
| 1936 | image-dired-cmd-write-exif-data-options | 2083 | (cons ?f (expand-file-name file)) |
| 1937 | (list | 2084 | (cons ?t tag-name) |
| 1938 | (cons ?p image-dired-cmd-write-exif-data-program) | 2085 | (cons ?v tag-value)))) |
| 1939 | (cons ?f (expand-file-name file)) | 2086 | (apply #'call-process image-dired-cmd-write-exif-data-program nil nil nil |
| 1940 | (cons ?t tag-name) | 2087 | (mapcar (lambda (arg) (format-spec arg spec)) |
| 1941 | (cons ?v tag-value)))) | 2088 | image-dired-cmd-write-exif-data-options)))) |
| 1942 | (call-process shell-file-name nil nil nil shell-command-switch command))) | ||
| 1943 | 2089 | ||
| 1944 | (defun image-dired-get-exif-data (file tag-name) | 2090 | (defun image-dired-get-exif-data (file tag-name) |
| 1945 | "From FILE, return EXIF tag TAG-NAME." | 2091 | "From FILE, return EXIF tag TAG-NAME." |
| 1946 | (image-dired--check-executable-exists | 2092 | (image-dired--check-executable-exists |
| 1947 | 'image-dired-cmd-read-exif-data-program) | 2093 | 'image-dired-cmd-read-exif-data-program) |
| 1948 | (let ((buf (get-buffer-create "*image-dired-get-exif-data*")) | 2094 | (let ((buf (get-buffer-create "*image-dired-get-exif-data*")) |
| 1949 | command tag-value) | 2095 | (spec (list (cons ?f file) (cons ?t tag-name))) |
| 1950 | (setq command (format-spec | 2096 | tag-value) |
| 1951 | image-dired-cmd-read-exif-data-options | ||
| 1952 | (list | ||
| 1953 | (cons ?p image-dired-cmd-read-exif-data-program) | ||
| 1954 | (cons ?f file) | ||
| 1955 | (cons ?t tag-name)))) | ||
| 1956 | (with-current-buffer buf | 2097 | (with-current-buffer buf |
| 1957 | (delete-region (point-min) (point-max)) | 2098 | (delete-region (point-min) (point-max)) |
| 1958 | (if (not (eq (call-process shell-file-name nil t nil | 2099 | (if (not (eq (apply #'call-process image-dired-cmd-read-exif-data-program |
| 1959 | shell-command-switch command) 0)) | 2100 | nil t nil |
| 2101 | (mapcar | ||
| 2102 | (lambda (arg) (format-spec arg spec)) | ||
| 2103 | image-dired-cmd-read-exif-data-options)) | ||
| 2104 | 0)) | ||
| 1960 | (error "Could not get EXIF tag") | 2105 | (error "Could not get EXIF tag") |
| 1961 | (goto-char (point-min)) | 2106 | (goto-char (point-min)) |
| 1962 | ;; Clean buffer from newlines and carriage returns before | 2107 | ;; Clean buffer from newlines and carriage returns before |