diff options
Diffstat (limited to 'lisp/image-dired.el')
| -rw-r--r-- | lisp/image-dired.el | 1204 |
1 files changed, 640 insertions, 564 deletions
diff --git a/lisp/image-dired.el b/lisp/image-dired.el index a8274f52521..2af72fc4527 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -1,4 +1,4 @@ -;;; image-dired.el --- use dired to browse and manipulate your images +;;; image-dired.el --- use dired to browse and manipulate your images -*- lexical-binding: t -*- ;; ;; Copyright (C) 2005-2016 Free Software Foundation, Inc. ;; @@ -79,7 +79,7 @@ ;; ;; This information has been moved to the manual. Type `C-h r' to open ;; the Emacs manual and go to the node Thumbnails by typing `g -;; Thumbnails RET'. +;; Image-Dired RET'. ;; ;; Quickstart: M-x image-dired RET DIRNAME RET ;; @@ -104,9 +104,6 @@ ;; * Some sort of auto-rotate function based on rotate info in the ;; EXIF data. ;; -;; * Check if exiftool exist before trying to call it to give a better -;; error message. -;; ;; * Investigate if it is possible to also write the tags to the image ;; files. ;; @@ -121,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 @@ -154,21 +149,22 @@ (require 'dired) (require 'format-spec) +(require 'image-mode) (require 'widget) -(require 'cl-lib) - (eval-when-compile + (require 'cl-lib) (require 'wid-edit)) (defgroup image-dired nil "Use dired to browse your images as thumbnails, and more." :prefix "image-dired-" + :link '(info-link "(emacs) Image-Dired") :group 'multimedia) (defcustom image-dired-dir (locate-user-emacs-file "image-dired/") "Directory where thumbnail images are stored." - :type 'string + :type 'directory :group 'image-dired) (defcustom image-dired-thumbnail-storage 'use-image-dired-dir @@ -182,21 +178,22 @@ means that each thumbnail is stored in a subdirectory called stored and generated according to the Thumbnail Managing Standard that allows sharing of thumbnails across different programs." :type '(choice :tag "How to store thumbnail files" - (const :tag "Thumbnail Managing Standard" standard) (const :tag "Use image-dired-dir" use-image-dired-dir) + (const :tag "Thumbnail Managing Standard (normal 128x128)" standard) + (const :tag "Thumbnail Managing Standard (large 256x256)" standard-large) (const :tag "Per-directory" per-directory)) :group 'image-dired) (defcustom image-dired-db-file (expand-file-name ".image-dired_db" image-dired-dir) "Database file where file names and their associated tags are stored." - :type 'string + :type 'file :group 'image-dired) (defcustom image-dired-temp-image-file (expand-file-name ".image-dired_temp" image-dired-dir) "Name of temporary image file used by various commands." - :type 'string + :type 'file :group 'image-dired) (defcustom image-dired-gallery-dir @@ -204,7 +201,7 @@ that allows sharing of thumbnails across different programs." "Directory to store generated gallery html pages. This path needs to be \"shared\" to the public so that it can access the index.html page that image-dired creates." - :type 'string + :type 'directory :group 'image-dired) (defcustom image-dired-gallery-image-root-url @@ -227,127 +224,157 @@ expects to find pictures in this directory." "convert" "Executable used to create thumbnail. Used together with `image-dired-cmd-create-thumbnail-options'." - :type 'string + :type 'file :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" +(defcustom image-dired-cmd-create-temp-image-program "convert" "Executable used to create temporary image. Used together with `image-dired-cmd-create-temp-image-options'." - :type 'string + :type 'file :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 (executable-find "pngnq") +(defcustom image-dired-cmd-pngnq-program + (or (executable-find "pngnq") + (executable-find "pngnq-s9")) "The file name of the `pngnq' program. -It quantizes colors of PNG images down to 256 colors." - :type '(choice (const :tag "Not Set" nil) string) +It quantizes colors of PNG images down to 256 colors or fewer +using the NeuQuant algorithm." + :version "26.1" + :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 - image-dired-cmd-create-thumbnail-program " " - "-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." - :type 'string +(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 '(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 "mogrify" "Executable used to rotate thumbnail. Used together with `image-dired-cmd-rotate-thumbnail-options'." - :type 'string + :type 'file :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 "jpegtran" "Executable used to rotate original image. Used together with `image-dired-cmd-rotate-original-options'." - :type 'string + :type 'file :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 (expand-file-name ".image-dired_rotate_temp" image-dired-dir) "Temporary file for rotate operations." - :type 'string + :type 'file :group 'image-dired) (defcustom image-dired-rotate-original-ask-before-overwrite t @@ -361,33 +388,35 @@ original file with `image-dired-temp-rotate-image-file'." "exiftool" "Program used to write EXIF data to image. Used together with `image-dired-cmd-write-exif-data-options'." - :type 'string + :type '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 "exiftool" "Program used to read EXIF data to image. -Used together with `image-dired-cmd-read-exif-data-program-options'." - :type 'string +Used together with `image-dired-cmd-read-exif-data-options'." + :type 'file :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 @@ -397,7 +426,11 @@ Used by `image-dired-gallery-generate' to leave out \"hidden\" images." :type '(repeat string) :group 'image-dired) -(defcustom image-dired-thumb-size (if (eq 'standard image-dired-thumbnail-storage) 128 100) +(defcustom image-dired-thumb-size + (cond + ((eq 'standard image-dired-thumbnail-storage) 128) + ((eq 'standard-large image-dired-thumbnail-storage) 256) + (t 100)) "Size of thumbnails, in pixels. This is the default size for both `image-dired-thumb-width' and `image-dired-thumb-height'." @@ -520,6 +553,7 @@ before warning the user." (defmacro image-dired--with-db-file (&rest body) "Run BODY in a temp buffer containing `image-dired-db-file'. Return the last form in BODY." + (declare (indent 0) (debug t)) `(with-temp-buffer (if (file-exists-p image-dired-db-file) (insert-file-contents image-dired-db-file)) @@ -537,7 +571,6 @@ Create the thumbnails directory if it does not exist." (defun image-dired-insert-image (file type relief margin) "Insert image FILE of image TYPE, using RELIEF and MARGIN, at point." - (let ((i `(image :type ,type :file ,file :relief ,relief @@ -567,7 +600,8 @@ Add text properties ORIGINAL-FILE-NAME and ASSOCIATED-DIRED-BUFFER." (setq beg (point)) (image-dired-insert-image file ;; TODO: this should depend on the real file type - (if (eq 'standard image-dired-thumbnail-storage) + (if (memq image-dired-thumbnail-storage + '(standard standard-large)) 'png 'jpeg) image-dired-thumb-relief image-dired-thumb-margin) @@ -589,10 +623,16 @@ MD5-hash of the image file's directory name and add that to make the thumbnail file name unique. For per-directory storage, just add a subdirectory. For standard storage, produce the file name according to the Thumbnail Managing Standard." - (cond ((eq 'standard image-dired-thumbnail-storage) - (expand-file-name - (concat "~/.thumbnails/normal/" - (md5 (concat "file://" (expand-file-name file))) ".png"))) + (cond ((memq image-dired-thumbnail-storage '(standard standard-large)) + (let* ((xdg (getenv "XDG_CACHE_HOME")) + (dir (if (and xdg (file-name-absolute-p xdg)) + xdg "~/.cache")) + (thumbdir (cl-case image-dired-thumbnail-storage + (standard "thumbnails/normal") + (standard-large "thumbnails/large")))) + (expand-file-name + (concat (md5 (concat "file://" (expand-file-name file))) ".png") + (expand-file-name thumbdir dir)))) ((eq 'use-image-dired-dir image-dired-thumbnail-storage) (let* ((f (expand-file-name file)) (md5-hash @@ -613,33 +653,173 @@ according to the Thumbnail Managing Standard." (file-name-base f) (file-name-extension f)))))) -(defun image-dired-create-thumb (original-file thumbnail-file) +(defun image-dired--check-executable-exists (executable) + (unless (executable-find (symbol-value executable)) + (error "Executable %S not found" executable))) + +(defun image-dired-thumb-size (dimension) + "Return thumb size depending on `image-dired-thumbnail-storage'. +DIMENSION should be either the symbol 'width or 'height." + (cond + ((eq 'standard image-dired-thumbnail-storage) 128) + ((eq 'standard-large image-dired-thumbnail-storage) 256) + (t (cl-ecase dimension + (width image-dired-thumb-width) + (height image-dired-thumb-height))))) + +(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 described 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 described 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." - (let* ((width (int-to-string image-dired-thumb-width)) - (height (int-to-string image-dired-thumb-height)) - (modif-time (format "%.0f" (float-time (nth 5 (file-attributes - original-file))))) + (image-dired--check-executable-exists + 'image-dired-cmd-create-thumbnail-program) + (let* ((width (int-to-string (image-dired-thumb-size 'width))) + (height (int-to-string (image-dired-thumb-size '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 (eq 'standard image-dired-thumbnail-storage) - 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)) - (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 marshaled + ;; 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) @@ -650,25 +830,22 @@ of the marked files. If ARG is an integer, use the next ARG (or previous -ARG, if ARG<0) files." (interactive "P") (dired-map-over-marks - (let* ((image-pos (dired-move-to-filename)) - (image-file (dired-get-filename nil t)) - thumb-file - overlay) + (let ((image-pos (dired-move-to-filename)) + (image-file (dired-get-filename nil t)) + thumb-file + overlay) (when (and image-file (string-match-p (image-file-name-regexp) image-file)) (setq thumb-file (image-dired-get-thumbnail-image image-file)) ;; If image is not already added, then add it. - (let* ((cur-ovs (overlays-in (point) (1+ (point)))) - (thumb-ov (car (cl-remove-if-not - (lambda (ov) (overlay-get ov 'thumb-file)) - cur-ovs)))) + (let ((thumb-ov (cl-loop for ov in (overlays-in (point) (1+ (point))) + if (overlay-get ov 'thumb-file) return ov))) (if thumb-ov (delete-overlay thumb-ov) (put-image thumb-file image-pos) (setq overlay - (cl-loop for o in (overlays-in (point) (1+ (point))) - when (overlay-get o 'put-image) collect o into ov - finally return (car ov))) + (cl-loop for ov in (overlays-in (point) (1+ (point))) + if (overlay-get ov 'put-image) return ov)) (overlay-put overlay 'image-file image-file) (overlay-put overlay 'thumb-file thumb-file))))) arg ; Show or hide image on ARG next files. @@ -793,9 +970,9 @@ calling `image-dired-restore-window-configuration'." (setq truncate-lines t) (save-excursion (other-window 1) - (switch-to-buffer buf) + (pop-to-buffer-same-window buf) (select-window (split-window-below)) - (switch-to-buffer buf2) + (pop-to-buffer-same-window buf2) (other-window -2))))) (defun image-dired-restore-window-configuration () @@ -840,14 +1017,14 @@ thumbnail buffer to be selected." (if (not append) (erase-buffer) (goto-char (point-max))) - (mapc - (lambda (curr-file) - (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))) - files)) + (dolist (curr-file files) + (setq thumb-name (image-dired-thumb-name curr-file)) + (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)) (cond ((eq 'dynamic image-dired-line-up-method) (image-dired-line-up-dynamic)) ((eq 'fixed image-dired-line-up-method) @@ -857,10 +1034,7 @@ thumbnail buffer to be selected." ((eq 'none image-dired-line-up-method) nil) (t - (image-dired-line-up-dynamic)))) - (if do-not-pop - (display-buffer image-dired-thumbnail-buffer) - (pop-to-buffer image-dired-thumbnail-buffer)))) + (image-dired-line-up-dynamic)))))) ;;;###autoload (defun image-dired-show-all-from-dir (dir) @@ -868,7 +1042,7 @@ thumbnail buffer to be selected." If the number of files in DIR matching `image-file-name-regexp' exceeds `image-dired-show-all-from-dir-max-files', a warning will be displayed." - (interactive "DDir: ") + (interactive "DImage Dired: ") (dired dir) (dired-mark-files-regexp (image-file-name-regexp)) (let ((files (dired-get-marked-files))) @@ -1023,6 +1197,12 @@ With prefix argument ARG, remove tag from file at point." "Get original file name for thumbnail or display image at point." (get-text-property (point) 'original-file-name)) +(defun image-dired-file-name-at-point () + "Get abbreviated file name for thumbnail or display image at point." + (let ((f (image-dired-original-file-name))) + (when f + (abbreviate-file-name f)))) + (defun image-dired-associated-dired-buffer () "Get associated dired buffer at point." (get-text-property (point) 'associated-dired-buffer)) @@ -1104,7 +1284,7 @@ Optional prefix ARG says how many images to move; default is one image." (interactive "p") (let (pos (steps (or arg 1))) - (dotimes (i steps) + (dotimes (_ steps) (if (and (not (eobp)) (save-excursion (forward-char) @@ -1125,7 +1305,7 @@ Optional prefix ARG says how many images to move; default is one image." (interactive "p") (let (pos (steps (or arg 1))) - (dotimes (i steps) + (dotimes (_ steps) (if (and (not (bobp)) (save-excursion (backward-char) @@ -1143,7 +1323,9 @@ image." (defun image-dired-next-line () "Move to next line and display properties." (interactive) - (forward-line 1) + (let ((goal-column (current-column))) + (forward-line 1) + (move-to-column goal-column)) ;; If we end up in an empty spot, back up to the next thumbnail. (if (not (image-dired-image-at-point-p)) (image-dired-backward-image)) @@ -1155,7 +1337,9 @@ image." (defun image-dired-previous-line () "Move to previous line and display properties." (interactive) - (forward-line -1) + (let ((goal-column (current-column))) + (forward-line -1) + (move-to-column goal-column)) ;; If we end up in an empty spot, back up to the next ;; thumbnail. This should only happen if the user deleted a ;; thumbnail and did not refresh, so it is not very common. But we @@ -1169,14 +1353,14 @@ image." (defun image-dired-format-properties-string (buf file props comment) "Format display properties. BUF is the associated dired buffer, FILE is the original image file -name, PROPS is a list of tags and COMMENT is the image file's +name, PROPS is a stringified list of tags and COMMENT is the image file's comment." (format-spec image-dired-display-properties-format (list (cons ?b (or buf "")) (cons ?f file) - (cons ?t (or (princ props) "")) + (cons ?t (or props "")) (cons ?c (or comment ""))))) (defun image-dired-display-thumb-properties () @@ -1184,11 +1368,9 @@ comment." (if (not (eobp)) (let ((file-name (file-name-nondirectory (image-dired-original-file-name))) (dired-buf (buffer-name (image-dired-associated-dired-buffer))) - (props (mapconcat - 'princ - (get-text-property (point) 'tags) - ", ")) - (comment (get-text-property (point) 'comment))) + (props (mapconcat #'identity (get-text-property (point) 'tags) ", ")) + (comment (get-text-property (point) 'comment)) + (message-log-max nil)) (if file-name (message "%s" (image-dired-format-properties-string @@ -1274,197 +1456,140 @@ You probably want to use this together with (select-window window)) (message "Thumbnail buffer not visible")))) -(defvar image-dired-thumbnail-mode-map (make-sparse-keymap) - "Keymap for `image-dired-thumbnail-mode'.") - -(defvar image-dired-thumbnail-mode-line-up-map (make-sparse-keymap) +(defvar image-dired-thumbnail-mode-line-up-map + (let ((map (make-sparse-keymap))) + ;; map it to "g" so that the user can press it more quickly + (define-key map "g" 'image-dired-line-up-dynamic) + ;; "f" for "fixed" number of thumbs per row + (define-key map "f" 'image-dired-line-up) + ;; "i" for "interactive" + (define-key map "i" 'image-dired-line-up-interactive) + map) "Keymap for line-up commands in `image-dired-thumbnail-mode'.") -(defvar image-dired-thumbnail-mode-tag-map (make-sparse-keymap) +(defvar image-dired-thumbnail-mode-tag-map + (let ((map (make-sparse-keymap))) + ;; map it to "t" so that the user can press it more quickly + (define-key map "t" 'image-dired-tag-thumbnail) + ;; "r" for "remove" + (define-key map "r" 'image-dired-tag-thumbnail-remove) + map) "Keymap for tag commands in `image-dired-thumbnail-mode'.") -(defun image-dired-define-thumbnail-mode-keymap () - "Define keymap for `image-dired-thumbnail-mode'." - - ;; Keys - (define-key image-dired-thumbnail-mode-map [right] 'image-dired-forward-image) - (define-key image-dired-thumbnail-mode-map [left] 'image-dired-backward-image) - (define-key image-dired-thumbnail-mode-map [up] 'image-dired-previous-line) - (define-key image-dired-thumbnail-mode-map [down] 'image-dired-next-line) - (define-key image-dired-thumbnail-mode-map "\C-f" 'image-dired-forward-image) - (define-key image-dired-thumbnail-mode-map "\C-b" 'image-dired-backward-image) - (define-key image-dired-thumbnail-mode-map "\C-p" 'image-dired-previous-line) - (define-key image-dired-thumbnail-mode-map "\C-n" 'image-dired-next-line) - - (define-key image-dired-thumbnail-mode-map "d" 'image-dired-flag-thumb-original-file) - (define-key image-dired-thumbnail-mode-map [delete] - 'image-dired-flag-thumb-original-file) - (define-key image-dired-thumbnail-mode-map "m" 'image-dired-mark-thumb-original-file) - (define-key image-dired-thumbnail-mode-map "u" 'image-dired-unmark-thumb-original-file) - (define-key image-dired-thumbnail-mode-map "." 'image-dired-track-original-file) - (define-key image-dired-thumbnail-mode-map [tab] 'image-dired-jump-original-dired-buffer) - - ;; add line-up map - (define-key image-dired-thumbnail-mode-map "g" image-dired-thumbnail-mode-line-up-map) - - ;; map it to "g" so that the user can press it more quickly - (define-key image-dired-thumbnail-mode-line-up-map "g" 'image-dired-line-up-dynamic) - ;; "f" for "fixed" number of thumbs per row - (define-key image-dired-thumbnail-mode-line-up-map "f" 'image-dired-line-up) - ;; "i" for "interactive" - (define-key image-dired-thumbnail-mode-line-up-map "i" 'image-dired-line-up-interactive) - - ;; add tag map - (define-key image-dired-thumbnail-mode-map "t" image-dired-thumbnail-mode-tag-map) - - ;; map it to "t" so that the user can press it more quickly - (define-key image-dired-thumbnail-mode-tag-map "t" 'image-dired-tag-thumbnail) - ;; "r" for "remove" - (define-key image-dired-thumbnail-mode-tag-map "r" 'image-dired-tag-thumbnail-remove) - - (define-key image-dired-thumbnail-mode-map "\C-m" - 'image-dired-display-thumbnail-original-image) - (define-key image-dired-thumbnail-mode-map [C-return] - 'image-dired-thumbnail-display-external) - - (define-key image-dired-thumbnail-mode-map "l" 'image-dired-rotate-thumbnail-left) - (define-key image-dired-thumbnail-mode-map "r" 'image-dired-rotate-thumbnail-right) - - (define-key image-dired-thumbnail-mode-map "L" 'image-dired-rotate-original-left) - (define-key image-dired-thumbnail-mode-map "R" 'image-dired-rotate-original-right) - - (define-key image-dired-thumbnail-mode-map "D" - 'image-dired-thumbnail-set-image-description) - - (define-key image-dired-thumbnail-mode-map "\C-d" 'image-dired-delete-char) - (define-key image-dired-thumbnail-mode-map " " - 'image-dired-display-next-thumbnail-original) - (define-key image-dired-thumbnail-mode-map - (kbd "DEL") 'image-dired-display-previous-thumbnail-original) - (define-key image-dired-thumbnail-mode-map "c" 'image-dired-comment-thumbnail) - (define-key image-dired-thumbnail-mode-map "q" 'image-dired-kill-buffer-and-window) - - ;; Mouse - (define-key image-dired-thumbnail-mode-map [mouse-2] 'image-dired-mouse-display-image) - (define-key image-dired-thumbnail-mode-map [mouse-1] 'image-dired-mouse-select-thumbnail) - - ;; Seems I must first set C-down-mouse-1 to undefined, or else it - ;; will trigger the buffer menu. If I try to instead bind - ;; C-down-mouse-1 to `image-dired-mouse-toggle-mark', I get a message - ;; about C-mouse-1 not being defined afterwards. Annoying, but I - ;; probably do not completely understand mouse events. - - (define-key image-dired-thumbnail-mode-map [C-down-mouse-1] 'undefined) - (define-key image-dired-thumbnail-mode-map [C-mouse-1] 'image-dired-mouse-toggle-mark) - - ;; Menu - (define-key image-dired-thumbnail-mode-map [menu-bar image-dired] - (cons "Image-Dired" (make-sparse-keymap "Image-Dired"))) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-kill-buffer-and-window] - '("Quit" . image-dired-kill-buffer-and-window)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-delete-char] - '("Delete thumbnail from buffer" . image-dired-delete-char)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-tag-thumbnail-remove] - '("Remove tag from thumbnail" . image-dired-tag-thumbnail-remove)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-tag-thumbnail] - '("Tag thumbnail" . image-dired-tag-thumbnail)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-comment-thumbnail] - '("Comment thumbnail" . image-dired-comment-thumbnail)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-refresh-thumb] - '("Refresh thumb" . image-dired-refresh-thumb)) - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-line-up-dynamic] - '("Dynamic line up" . image-dired-line-up-dynamic)) - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-line-up] - '("Line up thumbnails" . image-dired-line-up)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-rotate-thumbnail-left] - '("Rotate thumbnail left" . image-dired-rotate-thumbnail-left)) - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-rotate-thumbnail-right] - '("Rotate thumbnail right" . image-dired-rotate-thumbnail-right)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-rotate-original-left] - '("Rotate original left" . image-dired-rotate-original-left)) - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-rotate-original-right] - '("Rotate original right" . image-dired-rotate-original-right)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-toggle-movement-tracking] - '("Toggle movement tracking on/off" . image-dired-toggle-movement-tracking)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-jump-original-dired-buffer] - '("Jump to dired buffer" . image-dired-jump-original-dired-buffer)) - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-track-original-file] - '("Track original" . image-dired-track-original-file)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-flag-thumb-original-file] - '("Flag original for deletion" . image-dired-flag-thumb-original-file)) - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-unmark-thumb-original-file] - '("Unmark original" . image-dired-unmark-thumb-original-file)) - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-mark-thumb-original-file] - '("Mark original" . image-dired-mark-thumb-original-file)) - - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-thumbnail-display-external] - '("Display in external viewer" . image-dired-thumbnail-display-external)) - (define-key image-dired-thumbnail-mode-map - [menu-bar image-dired image-dired-display-thumbnail-original-image] - '("Display image" . image-dired-display-thumbnail-original-image))) - -(defvar image-dired-display-image-mode-map (make-sparse-keymap) - "Keymap for `image-dired-display-image-mode'.") - -(defun image-dired-define-display-image-mode-keymap () - "Define keymap for `image-dired-display-image-mode'." - - ;; Keys - (define-key image-dired-display-image-mode-map "q" 'image-dired-kill-buffer-and-window) - - (define-key image-dired-display-image-mode-map "f" - 'image-dired-display-current-image-full) - - (define-key image-dired-display-image-mode-map "s" - 'image-dired-display-current-image-sized) - - ;; Menu - (define-key image-dired-display-image-mode-map [menu-bar image-dired] - (cons "Image-Dired" (make-sparse-keymap "Image-Dired"))) - - (define-key image-dired-display-image-mode-map - [menu-bar image-dired image-dired-kill-buffer-and-window] - '("Quit" . image-dired-kill-buffer-and-window)) - - (define-key image-dired-display-image-mode-map - [menu-bar image-dired image-dired-display-current-image-sized] - '("Display original, sized to fit" . image-dired-display-current-image-sized)) - - (define-key image-dired-display-image-mode-map - [menu-bar image-dired image-dired-display-current-image-full] - '("Display original, full size" . image-dired-display-current-image-full)) +(defvar image-dired-thumbnail-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [right] 'image-dired-forward-image) + (define-key map [left] 'image-dired-backward-image) + (define-key map [up] 'image-dired-previous-line) + (define-key map [down] 'image-dired-next-line) + (define-key map "\C-f" 'image-dired-forward-image) + (define-key map "\C-b" 'image-dired-backward-image) + (define-key map "\C-p" 'image-dired-previous-line) + (define-key map "\C-n" 'image-dired-next-line) + + (define-key map "d" 'image-dired-flag-thumb-original-file) + (define-key map [delete] 'image-dired-flag-thumb-original-file) + (define-key map "m" 'image-dired-mark-thumb-original-file) + (define-key map "u" 'image-dired-unmark-thumb-original-file) + (define-key map "." 'image-dired-track-original-file) + (define-key map [tab] 'image-dired-jump-original-dired-buffer) + + ;; add line-up map + (define-key map "g" image-dired-thumbnail-mode-line-up-map) + ;; add tag map + (define-key map "t" image-dired-thumbnail-mode-tag-map) + + (define-key map "\C-m" 'image-dired-display-thumbnail-original-image) + (define-key map [C-return] 'image-dired-thumbnail-display-external) + + (define-key map "l" 'image-dired-rotate-thumbnail-left) + (define-key map "r" 'image-dired-rotate-thumbnail-right) + (define-key map "L" 'image-dired-rotate-original-left) + (define-key map "R" 'image-dired-rotate-original-right) + + (define-key map "D" 'image-dired-thumbnail-set-image-description) + (define-key map "\C-d" 'image-dired-delete-char) + (define-key map " " 'image-dired-display-next-thumbnail-original) + (define-key map (kbd "DEL") 'image-dired-display-previous-thumbnail-original) + (define-key map "c" 'image-dired-comment-thumbnail) + + ;; Mouse + (define-key map [mouse-2] 'image-dired-mouse-display-image) + (define-key map [mouse-1] 'image-dired-mouse-select-thumbnail) + ;; Seems I must first set C-down-mouse-1 to undefined, or else it + ;; will trigger the buffer menu. If I try to instead bind + ;; C-down-mouse-1 to `image-dired-mouse-toggle-mark', I get a message + ;; about C-mouse-1 not being defined afterwards. Annoying, but I + ;; probably do not completely understand mouse events. + (define-key map [C-down-mouse-1] 'undefined) + (define-key map [C-mouse-1] 'image-dired-mouse-toggle-mark) + + ;; Menu + (easy-menu-define nil map + "Menu for `image-dired-thumbnail-mode'." + '("Image-Dired" + ["Quit" quit-window] + ["Delete thumbnail from buffer" image-dired-delete-char] + ["Remove tag from thumbnail" image-dired-tag-thumbnail-remove] + ["Tag thumbnail" image-dired-tag-thumbnail] + ["Comment thumbnail" image-dired-comment-thumbnail] + ["Refresh thumb" image-dired-refresh-thumb] + ["Dynamic line up" image-dired-line-up-dynamic] + ["Line up thumbnails" image-dired-line-up] + + ["Rotate thumbnail left" image-dired-rotate-thumbnail-left] + ["Rotate thumbnail right" image-dired-rotate-thumbnail-right] + ["Rotate original left" image-dired-rotate-original-left] + ["Rotate original right" image-dired-rotate-original-right] + + ["Toggle movement tracking on/off" image-dired-toggle-movement-tracking] + + ["Jump to dired buffer" image-dired-jump-original-dired-buffer] + ["Track original" image-dired-track-original-file] + + ["Flag original for deletion" image-dired-flag-thumb-original-file] + ["Unmark original" image-dired-unmark-thumb-original-file] + ["Mark original" image-dired-mark-thumb-original-file] + + ["Display in external viewer" image-dired-thumbnail-display-external] + ["Display image" image-dired-display-thumbnail-original-image])) + map) + "Keymap for `image-dired-thumbnail-mode'.") - ) +(defvar image-dired-display-image-mode-map + (let ((map (make-sparse-keymap))) + ;; `image-mode-map' has bindings that do not make sense in image-dired + ;; (set-keymap-parent map image-mode-map) + (define-key map "f" 'image-dired-display-current-image-full) + (define-key map "s" 'image-dired-display-current-image-sized) + (define-key map "g" nil) + + ;; Useful bindings from `image-mode-map' + (define-key map [remap forward-char] 'image-forward-hscroll) + (define-key map [remap backward-char] 'image-backward-hscroll) + (define-key map [remap right-char] 'image-forward-hscroll) + (define-key map [remap left-char] 'image-backward-hscroll) + (define-key map [remap previous-line] 'image-previous-line) + (define-key map [remap next-line] 'image-next-line) + (define-key map [remap scroll-up] 'image-scroll-up) + (define-key map [remap scroll-down] 'image-scroll-down) + (define-key map [remap scroll-up-command] 'image-scroll-up) + (define-key map [remap scroll-down-command] 'image-scroll-down) + (define-key map [remap scroll-left] 'image-scroll-left) + (define-key map [remap scroll-right] 'image-scroll-right) + (define-key map [remap move-beginning-of-line] 'image-bol) + (define-key map [remap move-end-of-line] 'image-eol) + (define-key map [remap beginning-of-buffer] 'image-bob) + (define-key map [remap end-of-buffer] 'image-eob) + + (easy-menu-define nil map + "Menu for `image-dired-display-image-mode-map'." + '("Image-Dired" + ["Quit" quit-window] + ["Display original, sized to fit" image-dired-display-current-image-sized] + ["Display original, full size" image-dired-display-current-image-full])) + map) + "Keymap for `image-dired-display-image-mode'.") (defun image-dired-display-current-image-full () "Display current image in full size." @@ -1483,116 +1608,85 @@ You probably want to use this together with (if file (progn (image-dired-display-image file) - (message "Full size image displayed")) + (message "Fitted image displayed")) (error "No original file name at point")))) (define-derived-mode image-dired-thumbnail-mode - fundamental-mode "image-dired-thumbnail" + special-mode "image-dired-thumbnail" "Browse and manipulate thumbnail images using dired. -Use `image-dired-dired' and `image-dired-setup-dired-keybindings' to get a -nice setup to start with." - (image-dired-define-thumbnail-mode-keymap) - (message "image-dired-thumbnail-mode enabled")) +Use `image-dired-minor-mode' to get a nice setup." + :group 'image-dired + (buffer-disable-undo) + (add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil t)) (define-derived-mode image-dired-display-image-mode - fundamental-mode "image-dired-image-display" + special-mode "image-dired-image-display" "Mode for displaying and manipulating original image. Resized or in full-size." - (image-dired-define-display-image-mode-keymap) - (message "image-dired-display-image-mode enabled")) + :group 'image-dired + (buffer-disable-undo) + (image-mode-setup-winprops) + (add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil t)) + +(defvar image-dired-minor-mode-map + (let ((map (make-sparse-keymap))) + ;; (set-keymap-parent map dired-mode-map) + ;; Hijack previous and next line movement. Let C-p and C-b be + ;; though... + (define-key map "p" 'image-dired-dired-previous-line) + (define-key map "n" 'image-dired-dired-next-line) + (define-key map [up] 'image-dired-dired-previous-line) + (define-key map [down] 'image-dired-dired-next-line) + + (define-key map (kbd "C-S-n") 'image-dired-next-line-and-display) + (define-key map (kbd "C-S-p") 'image-dired-previous-line-and-display) + (define-key map (kbd "C-S-m") 'image-dired-mark-and-display-next) + + (define-key map "\C-td" 'image-dired-display-thumbs) + (define-key map [tab] 'image-dired-jump-thumbnail-buffer) + (define-key map "\C-ti" 'image-dired-dired-display-image) + (define-key map "\C-tx" 'image-dired-dired-display-external) + (define-key map "\C-ta" 'image-dired-display-thumbs-append) + (define-key map "\C-t." 'image-dired-display-thumb) + (define-key map "\C-tc" 'image-dired-dired-comment-files) + (define-key map "\C-tf" 'image-dired-mark-tagged-files) + + ;; Menu for dired + (easy-menu-define nil map + "Menu for `image-dired-minor-mode'." + '("Image-dired" + ["Copy with EXIF file name" image-dired-copy-with-exif-file-name] + ["Comment files" image-dired-dired-comment-files] + ["Mark tagged files" image-dired-mark-tagged-files] + ["Jump to thumbnail buffer" image-dired-jump-thumbnail-buffer] + + ["Toggle movement tracking" image-dired-toggle-movement-tracking] + ["Toggle append browsing" image-dired-toggle-append-browsing] + ["Toggle display properties" image-dired-toggle-dired-display-properties] + + ["Display in external viewer" image-dired-dired-display-external] + ["Display image" image-dired-dired-display-image] + ["Display this thumbnail" image-dired-display-thumb] + ["Display thumbnails append" image-dired-display-thumbs-append] + + ["Create thumbnails for marked files" image-dired-create-thumbs] + + ["Mark and display next" image-dired-mark-and-display-next] + ["Display thumb for previous file" image-dired-previous-line-and-display] + ["Display thumb for next file" image-dired-next-line-and-display])) + map) + "Keymap for `image-dired-minor-mode'.") ;;;###autoload -(defun image-dired-setup-dired-keybindings () +(define-minor-mode image-dired-minor-mode "Setup easy-to-use keybindings for the commands to be used in dired mode. Note that n, p and <down> and <up> will be hijacked and bound to `image-dired-dired-x-line'." - (interactive) + :keymap image-dired-minor-mode-map) - ;; Hijack previous and next line movement. Let C-p and C-b be - ;; though... - - (define-key dired-mode-map "p" 'image-dired-dired-previous-line) - (define-key dired-mode-map "n" 'image-dired-dired-next-line) - (define-key dired-mode-map [up] 'image-dired-dired-previous-line) - (define-key dired-mode-map [down] 'image-dired-dired-next-line) - - (define-key dired-mode-map (kbd "C-S-n") 'image-dired-next-line-and-display) - (define-key dired-mode-map (kbd "C-S-p") 'image-dired-previous-line-and-display) - (define-key dired-mode-map (kbd "C-S-m") 'image-dired-mark-and-display-next) - - (define-key dired-mode-map "\C-td" 'image-dired-display-thumbs) - (define-key dired-mode-map "\C-tt" 'image-dired-tag-files) - (define-key dired-mode-map "\C-tr" 'image-dired-delete-tag) - (define-key dired-mode-map [tab] 'image-dired-jump-thumbnail-buffer) - (define-key dired-mode-map "\C-ti" 'image-dired-dired-display-image) - (define-key dired-mode-map "\C-tx" 'image-dired-dired-display-external) - (define-key dired-mode-map "\C-ta" 'image-dired-display-thumbs-append) - (define-key dired-mode-map "\C-t." 'image-dired-display-thumb) - (define-key dired-mode-map "\C-tc" 'image-dired-dired-comment-files) - (define-key dired-mode-map "\C-tf" 'image-dired-mark-tagged-files) - - ;; Menu for dired - (define-key dired-mode-map [menu-bar image-dired] - (cons "Image-Dired" (make-sparse-keymap "Image-Dired"))) - - (define-key dired-mode-map [menu-bar image-dired image-dired-copy-with-exif-file-name] - '("Copy with EXIF file name" . image-dired-copy-with-exif-file-name)) - - (define-key dired-mode-map [menu-bar image-dired image-dired-dired-comment-files] - '("Comment files" . image-dired-dired-comment-files)) - - (define-key dired-mode-map [menu-bar image-dired image-dired-mark-tagged-files] - '("Mark tagged files" . image-dired-mark-tagged-files)) - - (define-key dired-mode-map [menu-bar image-dired image-dired-delete-tag] - '("Remove tag from files" . image-dired-delete-tag)) - - (define-key dired-mode-map [menu-bar image-dired image-dired-tag-files] - '("Tag files" . image-dired-tag-files)) - - (define-key dired-mode-map [menu-bar image-dired image-dired-jump-thumbnail-buffer] - '("Jump to thumbnail buffer" . image-dired-jump-thumbnail-buffer)) - - (define-key dired-mode-map [menu-bar image-dired image-dired-toggle-movement-tracking] - '("Toggle movement tracking" . image-dired-toggle-movement-tracking)) - - (define-key dired-mode-map - [menu-bar image-dired image-dired-toggle-append-browsing] - '("Toggle append browsing" . image-dired-toggle-append-browsing)) - - (define-key dired-mode-map - [menu-bar image-dired image-dired-toggle-disp-props] - '("Toggle display properties" . image-dired-toggle-dired-display-properties)) - - (define-key dired-mode-map - [menu-bar image-dired image-dired-dired-display-external] - '("Display in external viewer" . image-dired-dired-display-external)) - (define-key dired-mode-map - [menu-bar image-dired image-dired-dired-display-image] - '("Display image" . image-dired-dired-display-image)) - (define-key dired-mode-map - [menu-bar image-dired image-dired-display-thumb] - '("Display this thumbnail" . image-dired-display-thumb)) - (define-key dired-mode-map - [menu-bar image-dired image-dired-display-thumbs-append] - '("Display thumbnails append" . image-dired-display-thumbs-append)) - (define-key dired-mode-map - [menu-bar image-dired image-dired-display-thumbs] - '("Display thumbnails" . image-dired-display-thumbs)) - - (define-key dired-mode-map - [menu-bar image-dired image-dired-create-thumbs] - '("Create thumbnails for marked files" . image-dired-create-thumbs)) - - (define-key dired-mode-map - [menu-bar image-dired image-dired-mark-and-display-next] - '("Mark and display next" . image-dired-mark-and-display-next)) - (define-key dired-mode-map - [menu-bar image-dired image-dired-previous-line-and-display] - '("Display thumb for previous file" . image-dired-previous-line-and-display)) - (define-key dired-mode-map - [menu-bar image-dired image-dired-next-line-and-display] - '("Display thumb for next file" . image-dired-next-line-and-display))) +;;;###autoload +(define-obsolete-function-alias 'image-dired-setup-dired-keybindings 'image-dired-minor-mode + "26.1") (declare-function clear-image-cache "image.c" (&optional filter)) @@ -1601,22 +1695,17 @@ Note that n, p and <down> and <up> will be hijacked and bound to With prefix argument ARG, create thumbnails even if they already exist \(i.e. use this to refresh your thumbnails)." (interactive "P") - (let (thumb-name files) - (setq files (dired-get-marked-files)) - (mapcar - (lambda (curr-file) - (setq thumb-name (image-dired-thumb-name curr-file)) - ;; If the user overrides the exist check, we must clear the - ;; image cache so that if the user wants to display the - ;; thumbnail, it is not fetched from cache. - (if arg - (clear-image-cache)) - (if (or (not (file-exists-p thumb-name)) - arg) - (if (not (= 0 (image-dired-create-thumb curr-file - (image-dired-thumb-name curr-file)))) - (error "Thumb could not be created")))) - files))) + (let (thumb-name) + (dolist (curr-file (dired-get-marked-files)) + (setq thumb-name (image-dired-thumb-name curr-file)) + ;; If the user overrides the exist check, we must clear the + ;; image cache so that if the user wants to display the + ;; thumbnail, it is not fetched from cache. + (when arg + (clear-image-cache (expand-file-name thumb-name))) + (when (or (not (file-exists-p thumb-name)) + arg) + (image-dired-create-thumb curr-file thumb-name))))) (defvar image-dired-slideshow-timer nil "Slideshow timer.") @@ -1714,7 +1803,8 @@ Calculate how many thumbnails fit." (/ width (+ (* 2 image-dired-thumb-relief) (* 2 image-dired-thumb-margin) - image-dired-thumb-width char-width)))) + (image-dired-thumb-size 'width) + char-width)))) (image-dired-line-up))) (defun image-dired-line-up-interactive () @@ -1735,16 +1825,16 @@ Ask user how many thumbnails should be displayed per row." (message "No thumbnail at point") (if (not file) (message "No original file name found") - (call-process shell-file-name nil nil nil shell-command-switch - (format "%s \"%s\"" image-dired-external-viewer file)))))) + (start-process "image-dired-thumb-external" nil + image-dired-external-viewer file))))) ;;;###autoload (defun image-dired-dired-display-external () "Display file at point using an external viewer." (interactive) (let ((file (dired-get-filename))) - (call-process shell-file-name nil nil nil shell-command-switch - (format "%s \"%s\"" image-dired-external-viewer file)))) + (start-process "image-dired-external" nil + image-dired-external-viewer file))) (defun image-dired-window-width-pixels (window) "Calculate WINDOW width in pixels." @@ -1780,14 +1870,14 @@ Ask user how many thumbnails should be displayed per row." (equal (window-buffer window) buf)))) (error "No thumbnail image at point")))) -(defun image-dired-display-window-width () - "Return width, in pixels, of image-dired's image display window." - (- (image-dired-window-width-pixels (image-dired-display-window)) +(defun image-dired-display-window-width (window) + "Return width, in pixels, of WINDOW." + (- (image-dired-window-width-pixels window) image-dired-display-window-width-correction)) -(defun image-dired-display-window-height () - "Return height, in pixels, of image-dired's image display window." - (- (image-dired-window-height-pixels (image-dired-display-window)) +(defun image-dired-display-window-height (window) + "Return height, in pixels, of WINDOW." + (- (image-dired-window-height-pixels window) image-dired-display-window-height-correction)) (defun image-dired-display-image (file &optional original-size) @@ -1800,27 +1890,28 @@ should feel snappy enough. If optional argument ORIGINAL-SIZE is non-nil, display image in its original size." + (image-dired--check-executable-exists + 'image-dired-cmd-create-temp-image-program) (let ((new-file (expand-file-name image-dired-temp-image-file)) - width height command ret + (window (image-dired-display-window)) (image-type 'jpeg)) (setq file (expand-file-name file)) (if (not original-size) - (progn - (setq width (image-dired-display-window-width)) - (setq height (image-dired-display-window-height)) - (setq command - (format-spec - image-dired-cmd-create-temp-image-options - (list - (cons ?p image-dired-cmd-create-temp-image-program) - (cons ?w width) - (cons ?h height) - (cons ?f file) - (cons ?t new-file)))) - (setq ret (call-process shell-file-name nil nil nil - shell-command-switch command)) - (if (not (= 0 ret)) - (error "Could not resize image"))) + (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)) (copy-file file new-file t)) (with-current-buffer (image-dired-create-display-image-buffer) @@ -1829,6 +1920,8 @@ original size." (clear-image-cache) (image-dired-insert-image image-dired-temp-image-file image-type 0 0) (goto-char (point-min)) + (set-window-vscroll window 0) + (set-window-hscroll window 0) (image-dired-update-property 'original-file-name file))))) (defun image-dired-display-thumbnail-original-image (&optional arg) @@ -1864,20 +1957,17 @@ With prefix argument ARG, display image in its original size." (defun image-dired-rotate-thumbnail (degrees) "Rotate thumbnail DEGREES degrees." + (image-dired--check-executable-exists + '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) - ;; 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)))) + (let* ((file (image-dired-thumb-name (image-dired-original-file-name))) + (thumb (expand-file-name file)) + (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 () "Rotate thumbnail left (counter clockwise) 90 degrees. @@ -1900,27 +1990,29 @@ overwritten. This confirmation can be turned off using (defun image-dired-refresh-thumb () "Force creation of new image for current thumbnail." (interactive) - (let ((file (image-dired-original-file-name))) - (clear-image-cache) - (image-dired-create-thumb file (image-dired-thumb-name file)))) + (let* ((file (image-dired-original-file-name)) + (thumb (expand-file-name (image-dired-thumb-name file)))) + (clear-image-cache (expand-file-name thumb)) + (image-dired-create-thumb file thumb))) (defun image-dired-rotate-original (degrees) "Rotate original image DEGREES degrees." + (image-dired--check-executable-exists + '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) - (if (not (string-match "\\.[jJ][pP[eE]?[gG]$" 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))) + (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!")) + (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 @@ -1950,15 +2042,14 @@ for traceability. The format of the returned file name is YYYY_MM_DD_HH_MM_DD_ORIG_FILE_NAME.jpg. Used from `image-dired-copy-with-exif-file-name'." (let (data no-exif-data-found) - (if (not (string-match "\\.[Jj][Pp][Ee]?[Gg]$" (expand-file-name file))) - (progn - (setq no-exif-data-found t) - (setq data - (format-time-string - "%Y:%m:%d %H:%M:%S" - (nth 5 (file-attributes (expand-file-name file)))))) + (if (not (eq 'jpeg (image-type (expand-file-name file)))) + (setq no-exif-data-found t + data (format-time-string + "%Y:%m:%d %H:%M:%S" + (file-attribute-modification-time + (file-attributes (expand-file-name file))))) (setq data (image-dired-get-exif-data (expand-file-name file) - "DateTimeOriginal"))) + "DateTimeOriginal"))) (while (string-match "[ :]" data) (setq data (replace-match "_" nil nil data))) (format "%s%s%s" data @@ -1985,30 +2076,32 @@ default value at the prompt." (defun image-dired-set-exif-data (file tag-name tag-value) "In FILE, set EXIF tag TAG-NAME to value TAG-VALUE." - (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))) + (image-dired--check-executable-exists + 'image-dired-cmd-write-exif-data-program) + (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 @@ -2034,7 +2127,7 @@ function. The result is a couple of new files in (interactive) (let (new-name (files (dired-get-marked-files))) - (mapcar + (mapc (lambda (curr-file) (setq new-name (format "%s/%s" @@ -2226,11 +2319,9 @@ non-nil." (let* ((file (dired-get-filename)) (file-name (file-name-nondirectory file)) (dired-buf (buffer-name (current-buffer))) - (props (mapconcat - 'princ - (image-dired-list-tags file) - ", ")) - (comment (image-dired-get-comment file))) + (props (mapconcat #'identity (image-dired-list-tags file) ", ")) + (comment (image-dired-get-comment file)) + (message-log-max nil)) (if file-name (message "%s" (image-dired-format-properties-string @@ -2344,13 +2435,8 @@ image-dired-file-comment-list: (defun image-dired-hidden-p (file) "Return t if image FILE has a \"hidden\" tag." - (let (hidden) - (mapc - (lambda (tag) - (if (member tag image-dired-gallery-hidden-tags) - (setq hidden t))) - (cdr (assoc file image-dired-file-tag-list))) - hidden)) + (cl-loop for tag in (cdr (assoc file image-dired-file-tag-list)) + if (member tag image-dired-gallery-hidden-tags) return t)) (defun image-dired-gallery-generate () "Generate gallery pages. @@ -2442,15 +2528,6 @@ when using per-directory thumbnail file storage")) (insert " </body>\n") (insert "</html>")))) -(defun image-dired-kill-buffer-and-window () - "Kill the current buffer and, if possible, also the window." - (interactive) - (let ((buffer (current-buffer))) - (condition-case nil - (delete-window (selected-window)) - (error nil)) - (kill-buffer buffer))) - (defvar image-dired-widget-list nil "List to keep track of meta data in edit buffer.") @@ -2465,7 +2542,7 @@ easy-to-use form." (setq image-dired-widget-list nil) ;; Setup buffer. (let ((files (dired-get-marked-files))) - (switch-to-buffer "*Image-Dired Edit Meta Data*") + (pop-to-buffer-same-window "*Image-Dired Edit Meta Data*") (kill-all-local-variables) (make-local-variable 'widget-example-repeat) (let ((inhibit-read-only t)) @@ -2500,8 +2577,7 @@ the operation by activating the Cancel button.\n\n") :size 60 :format "%v " :value (or (mapconcat - (lambda (tag) - tag) + #'identity (image-dired-list-tags file) ",") ""))) ;; Save information in all widgets so that we can use it when |