1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411
|
;;; image-dired-dired.el --- Dired specific commands for Image-Dired -*- lexical-binding: t -*-
;; Copyright (C) 2005-2025 Free Software Foundation, Inc.
;; Author: Mathias Dahl <mathias.rem0veth1s.dahl@gmail.com>
;; Maintainer: Stefan Kangas <stefankangas@gmail.com>
;; Keywords: multimedia
;; Package: image-dired
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; See the description of the `image-dired' package.
;;; Code:
(require 'image-dired)
(defgroup image-dired-dired nil
"Dired specific commands for Image-Dired."
:prefix "image-dired-dired-"
:link '(info-link "(emacs) Image-Dired")
:group 'image-dired)
(define-obsolete-variable-alias 'image-dired-append-when-browsing
'image-dired-dired-append-when-browsing "29.1")
(defcustom image-dired-dired-append-when-browsing nil
"Append thumbnails in thumbnail buffer when browsing.
If non-nil, using `image-dired-next-line-and-display' and
`image-dired-previous-line-and-display' will leave a trail of thumbnail
images in the thumbnail buffer. If you enable this and want to clean
the thumbnail buffer because it is filled with too many thumbnails,
just call `image-dired-display-thumb' to display only the image at point.
This value can be toggled using `image-dired-toggle-append-browsing'."
:type 'boolean)
(defcustom image-dired-dired-disp-props t
"If non-nil, display properties for Dired file when browsing.
Used by `image-dired-next-line-and-display',
`image-dired-previous-line-and-display' and `image-dired-mark-and-display-next'.
If the database file is large, this can slow down image browsing in
Dired and you might want to turn it off."
:type 'boolean)
;;;###autoload
(defun image-dired-dired-toggle-marked-thumbs (&optional arg)
"Toggle thumbnails in front of marked file names in the Dired buffer.
If no file is marked, toggle display of thumbnail on the current file's line.
ARG, if non-nil (interactively, the prefix argument), specifies the files
whose thumbnail display to toggle instead of the marked files: if ARG is an
integer, use the next ARG (or previous -ARG, if ARG<0) files; any other
value of ARG means toggle thumbnail display of the current line's file."
(interactive "P" dired-mode)
(setq image-dired--generate-thumbs-start (current-time))
(dired-map-over-marks
(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-dired--file-name-regexp) image-file))
(setq thumb-file (create-image
(image-dired--get-create-thumbnail-file image-file)))
;; If image is not already added, then add it.
(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 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)))))
;; Show or hide thumbnail on ARG next files.
arg)
(add-hook 'dired-after-readin-hook
'image-dired-dired-after-readin-hook nil t))
(defun image-dired-dired-after-readin-hook ()
"Relocate existing thumbnail overlays in Dired buffer after reverting.
Move each overlay to its corresponding file if it still exists.
Otherwise, delete the overlay.
Used by `image-dired-dired-toggle-marked-thumbs'."
(mapc (lambda (overlay)
(when (overlay-get overlay 'put-image)
(let* ((image-file (overlay-get overlay 'image-file))
(image-pos (dired-goto-file image-file)))
(if image-pos
(move-overlay overlay image-pos image-pos)
(delete-overlay overlay)))))
(overlays-in (point-min) (point-max))))
(defun image-dired-next-line-and-display ()
"Move to next Dired line and display its thumbnail image."
(interactive nil dired-mode)
(dired-next-line 1)
(image-dired-display-thumbs t image-dired-dired-append-when-browsing t)
(if image-dired-dired-disp-props
(image-dired-dired-display-properties)))
(defun image-dired-previous-line-and-display ()
"Move to previous Dired line and display its thumbnail image."
(interactive nil dired-mode)
(dired-previous-line 1)
(image-dired-display-thumbs t image-dired-dired-append-when-browsing t)
(if image-dired-dired-disp-props
(image-dired-dired-display-properties)))
(defun image-dired-toggle-append-browsing ()
"Toggle `image-dired-dired-append-when-browsing'."
(interactive nil dired-mode)
(setq image-dired-dired-append-when-browsing
(not image-dired-dired-append-when-browsing))
(message "Append browsing %s"
(if image-dired-dired-append-when-browsing
"on"
"off")))
(defun image-dired-mark-and-display-next ()
"Mark current file in Dired and display the next thumbnail image."
(interactive nil dired-mode)
(dired-mark 1)
(image-dired-display-thumbs t image-dired-dired-append-when-browsing t)
(if image-dired-dired-disp-props
(image-dired-dired-display-properties)))
(defun image-dired-toggle-dired-display-properties ()
"Toggle `image-dired-dired-disp-props'."
(interactive nil dired-mode)
(setq image-dired-dired-disp-props
(not image-dired-dired-disp-props))
(message "Dired display properties %s"
(if image-dired-dired-disp-props
"on"
"off")))
(defun image-dired-track-thumbnail ()
"Move to thumbnail of the current Dired file in `image-dired-thumbnail-buffer'.
This is almost the same as what `image-dired-track-original-file' does,
but the other way around."
(let ((file (dired-get-filename))
prop-val found window)
(when (get-buffer image-dired-thumbnail-buffer)
(with-current-buffer image-dired-thumbnail-buffer
(goto-char (point-min))
(while (and (not (eobp))
(not found))
(if (and (setq prop-val
(get-text-property (point) 'original-file-name))
(string= prop-val file))
(setq found t))
(if (not found)
(forward-char 1)))
(when found
(if (setq window (image-dired-thumbnail-window))
(set-window-point window (point)))
(image-dired--update-header-line))))))
(defun image-dired-dired-next-line (&optional arg)
"Call `dired-next-line', while tracking the file's thumbnail.
This can safely replace `dired-next-line'.
With prefix argument ARG, move that many lines."
(interactive "P" dired-mode)
(dired-next-line (or arg 1))
(if image-dired-track-movement
(image-dired-track-thumbnail)))
(defun image-dired-dired-previous-line (&optional arg)
"Call `dired-previous-line', while tracking the file's thumbnail.
This can safely replace `dired-previous-line'.
With prefix argument ARG, move that many lines."
(interactive "P" dired-mode)
(dired-previous-line (or arg 1))
(if image-dired-track-movement
(image-dired-track-thumbnail)))
;;;###autoload
(defun image-dired-jump-thumbnail-buffer ()
"Jump to thumbnail buffer."
(interactive nil dired-mode)
(let ((window (image-dired-thumbnail-window))
frame)
(if window
(progn
(if (not (equal (selected-frame) (setq frame (window-frame window))))
(select-frame-set-input-focus frame))
(select-window window))
(message "Thumbnail buffer not visible"))))
(defvar-keymap image-dired-minor-mode-map
:doc "Keymap for `image-dired-minor-mode'."
"<remap> <dired-previous-line>" #'image-dired-dired-previous-line
"<remap> <dired-next-line>" #'image-dired-dired-next-line
"C-S-n" #'image-dired-next-line-and-display
"C-S-p" #'image-dired-previous-line-and-display
"C-S-m" #'image-dired-mark-and-display-next
"<tab>" #'image-dired-jump-thumbnail-buffer
:menu
'("Image-Dired"
["Display thumb for next file" image-dired-next-line-and-display]
["Display thumb for previous file" image-dired-previous-line-and-display]
["Mark and display next" image-dired-mark-and-display-next]
"---"
["Create thumbnails for marked files" image-dired-create-thumbs]
"---"
["Display thumbnails append" image-dired-display-thumbs-append]
["Display this thumbnail" image-dired-display-thumb]
["Display image" image-dired-dired-display-image]
["Display in external viewer" image-dired-dired-display-external]
"---"
["Toggle display properties" image-dired-toggle-dired-display-properties
:style toggle
:selected image-dired-dired-disp-props]
["Toggle append browsing" image-dired-toggle-append-browsing
:style toggle
:selected image-dired-dired-append-when-browsing]
["Toggle movement tracking" image-dired-toggle-movement-tracking
:style toggle
:selected image-dired-track-movement]
"---"
["Jump to thumbnail buffer" image-dired-jump-thumbnail-buffer]
["Mark tagged files" image-dired-mark-tagged-files]
["Comment files" image-dired-dired-comment-files]
["Copy with EXIF file name" image-dired-copy-with-exif-file-name]))
;;;###autoload
(define-minor-mode image-dired-minor-mode
"Setup easy-to-use keybindings for Image-Dired in Dired mode.
This minor mode adds these additional bindings:
\\<image-dired-minor-mode-map>
\\[image-dired-next-line-and-display] Move to next line and display \
thumbnail image.
\\[image-dired-previous-line-and-display] Move to previous line \
and display thumbnail image.
\\[image-dired-mark-and-display-next] Mark current file and display \
next thumbnail image.
\\[image-dired-jump-thumbnail-buffer] Jump to thumbnail buffer.
For reference, these are the default Image-Dired bindings that
are always available in Dired:
\\<dired-mode-map>
\\[image-dired-display-thumbs] Display thumbnails of all marked files.
\\[image-dired-tag-files] Tag marked file(s).
\\[image-dired-delete-tag] Remove tag for selected file(s).
\\[image-dired-jump-thumbnail-buffer] Jump to thumbnail buffer.
\\[image-dired-dired-display-image] Display current image file.
\\[image-dired-dired-display-external] Display file at point \
using an external viewer.
\\[image-dired-display-thumbs-append] Append thumbnails to \
thumbnail buffer.
\\[image-dired-display-thumb] Display thumbnails of all marked files.
\\[image-dired-dired-comment-files] Add comment to current or \
marked files in Dired.
\\[image-dired-mark-tagged-files] Use REGEXP to mark files with \
matching tag.
\\[image-dired-dired-toggle-marked-thumbs] Toggle thumbnails in \
front of file names.
\\[image-dired-dired-edit-comment-and-tags] Edit comment and tags \
of marked images."
:keymap image-dired-minor-mode-map)
(declare-function clear-image-cache "image.c" (&optional filter))
(defun image-dired-create-thumbs (&optional arg)
"Create thumbnail images for all marked files in Dired.
With prefix argument ARG, create thumbnails even if they already exist
\(i.e. use this to refresh your thumbnails)."
(interactive "P" dired-mode)
(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)))))
;;;###autoload
(defun image-dired-display-thumbs-append ()
"Append thumbnails to `image-dired-thumbnail-buffer'."
(interactive nil dired-mode)
(image-dired-display-thumbs nil t t))
;;;###autoload
(defun image-dired-display-thumb ()
"Shorthand for `image-dired-display-thumbs' with prefix argument."
(interactive nil dired-mode)
(image-dired-display-thumbs t nil t))
;;;###autoload
(defun image-dired-dired-display-external ()
"Display file at point using an external viewer.
The viewer is specified by the value of `image-dired-external-viewer'."
(interactive nil dired-mode)
(let ((file (dired-get-filename)))
(start-process "image-dired-external" nil
image-dired-external-viewer file)))
;;;###autoload
(defun image-dired-dired-display-image (&optional _)
"Display current image file.
See documentation for `image-dired-display-image' for more information."
(declare (advertised-calling-convention () "29.1"))
(interactive nil dired-mode)
(image-dired-display-image (dired-get-filename)))
(defun image-dired-copy-with-exif-file-name ()
"Copy file with unique name to main image directory.
Copy current or all files marked in Dired to new file(s) in your
main image directory, using file name(s) generated by
`image-dired-get-exif-file-name'. A typical usage for this if when
copying images from a digital camera into the image directory.
Typically, you would open up the folder with the incoming
digital images, mark the files to be copied, and execute this
command. The result is one or more new files in
`image-dired-main-image-directory', named like
2005_05_08_12_52_00_dscn0319.jpg,
2005_05_08_14_27_45_dscn0320.jpg etc."
(interactive nil dired-mode)
(let (new-name
(files (dired-get-marked-files)))
(mapc
(lambda (curr-file)
(setq new-name
(format "%s/%s"
(file-name-as-directory
(expand-file-name image-dired-main-image-directory))
(image-dired-get-exif-file-name curr-file)))
(message "Copying %s to %s" curr-file new-name)
(copy-file curr-file new-name))
files)))
;;;###autoload
(defun image-dired-mark-tagged-files (regexp)
"Mark files whose tag matches REGEXP.
A `tag' is a keyword, a piece of meta data, associated with an
image file and stored in image-dired's database file. This command
prompts for a regexp, and then matches it against all the tags
of all the image files in the database file. The files that have a
matching tag will be marked in the Dired buffer."
(interactive "sMark tagged files (regexp): " dired-mode)
(image-dired-sane-db-file)
(let ((hits 0)
files)
(image-dired--with-db-file
;; Collect matches
(while (search-forward-regexp "\\(^[^;\n]+\\);\\(.*\\)" nil t)
(let ((file (match-string 1))
(tags (split-string (match-string 2) ";")))
(when (seq-find (lambda (tag)
(string-match-p regexp tag))
tags)
(push file files)))))
;; Mark files
(dolist (curr-file files)
;; I tried using `dired-mark-files-regexp' but it was waaaay to
;; slow. Don't bother about hits found in other directories
;; than the current one.
(when (string= (file-name-as-directory
(expand-file-name default-directory))
(file-name-as-directory
(file-name-directory curr-file)))
(setq curr-file (file-name-nondirectory curr-file))
(goto-char (point-min))
(when (search-forward-regexp (format "\\s %s[*@]?$" curr-file) nil t)
(setq hits (+ hits 1))
(dired-mark 1))))
(message "%d files with matching tag marked" hits)))
(defun image-dired-dired-display-properties ()
"Show in the echo area the image-related properties of a file in Dired buffer."
(interactive nil dired-mode)
(let* ((file-name (dired-get-filename))
(dired-buf (buffer-name (current-buffer)))
(image-count "") ; TODO
(props (string-join (image-dired-list-tags file-name) ", "))
(comment (image-dired-get-comment file-name))
(message-log-max nil))
(if file-name
(message "%s"
(image-dired-format-properties-string
dired-buf
file-name
image-count
props
comment)))))
(provide 'image-dired-dired)
;;; image-dired-dired.el ends here
|