bug#50000: 27.2; tagging marked thumbnails

["Peter Münster" <pm@a16n.net>]

[-- Attachment #1.1: Type: text/plain, Size: 200 bytes --]

On Mon, Aug 16 2021, Lars Ingebrigtsen wrote:

> I don't think the renames bring a lot of value here, so I'd rather avoid
> them.

Ok. Please find attached a new patch.

-- 
           Peter

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-Add-menu-bindings-to-new-functions-in-image-dired.el.patch --]
[-- Type: text/x-patch, Size: 5771 bytes --]

From 2bee2a5a92a4d3593a60ded577731966c09c68cb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Peter=20M=C3=BCnster?= <pm@a16n.net>
Date: Fri, 13 Aug 2021 15:02:03 +0200
Subject: [PATCH] Add menu bindings to new functions in image-dired.el

* lisp/image-dired.el (image-dired--with-marked): New macro for
cycling over marked thumbnails.
(image-dired-tag-thumbnail, image-dired-tag-thumbnail-remove): Can handle
now also all marked thumbnails.
(image-dired-tag-marked-thumbnails): Remove it, because it's obsoleted by
`image-dired-tag-thumbnail' now.
(image-dired-delete-marked): Use new macro `image-dired--with-marked', and
add command to menu.
---
 etc/NEWS            |  7 +++--
 lisp/image-dired.el | 70 ++++++++++++++++++++++++++-------------------
 2 files changed, 45 insertions(+), 32 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 26ede71523..6aa574eda3 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2415,10 +2415,8 @@ This command, called interactively, toggles the local value of
 If non-nil (the default), use 'image-dired-thumb-mark' to say what
 images are marked.
 
-*** New command 'image-dired-tag-marked-thumbnails'.
-
 *** New command 'image-dired-delete-marked'.
 
 ** Miscellaneous
 
 ---
diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index 7092f758db..520d8cdb34 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -797,6 +797,21 @@ Queued items live in `image-dired-queue'."
                (list (list original-file thumbnail-file))))
   (run-at-time 0 nil #'image-dired-thumb-queue-run))
 
+(defmacro image-dired--with-marked (&rest body)
+  "Eval BODY with point on each marked thumbnail. If no marked file could
+be found, execute BODY on the current thumbnail."
+  `(with-current-buffer image-dired-thumbnail-buffer
+     (let (found)
+       (save-mark-and-excursion
+         (goto-char (point-min))
+         (while (not (eobp))
+           (when (image-dired-thumb-file-marked-p)
+             (setq found t)
+             ,@body)
+           (forward-char)))
+       (unless found
+         ,@body))))
+
 ;;;###autoload
 (defun image-dired-dired-toggle-marked-thumbs (&optional arg)
   "Toggle thumbnails in front of file names in the dired buffer.
@@ -1145,20 +1160,15 @@ FILE-TAGS is an alist in the following form:
         (cons x tag))
       files))))
 
-(defun image-dired-tag-marked-thumbnails ()
-  "Tag marked thumbnails."
-  (interactive)
-  (when-let ((dired-buf (image-dired-associated-dired-buffer)))
-    (with-current-buffer dired-buf
-      (image-dired-tag-files nil))))
-
-(defun image-dired-tag-thumbnail ()
-  "Tag current thumbnail."
+(defun image-dired-tag-thumbnail ()
+  "Tag current or marked thumbnails."
   (interactive)
   (let ((tag (read-string "Tags to add (separate tags with a semicolon): ")))
-    (image-dired-write-tags (list (cons (image-dired-original-file-name) tag))))
-  (image-dired-update-property
-   'tags (image-dired-list-tags (image-dired-original-file-name))))
+    (image-dired--with-marked
+     (image-dired-write-tags
+      (list (cons (image-dired-original-file-name) tag)))
+     (image-dired-update-property
+      'tags (image-dired-list-tags (image-dired-original-file-name))))))
 
 ;;;###autoload
 (defun image-dired-delete-tag (arg)
@@ -1172,13 +1182,14 @@ With prefix argument ARG, remove tag from file at point."
       (setq files (dired-get-marked-files)))
     (image-dired-remove-tag files tag)))
 
-(defun image-dired-tag-thumbnail-remove ()
-  "Remove tag from thumbnail."
+(defun image-dired-tag-thumbnail-remove ()
+  "Remove tag from current or marked thumbnails."
   (interactive)
   (let ((tag (read-string "Tag to remove: ")))
-    (image-dired-remove-tag (image-dired-original-file-name) tag))
-  (image-dired-update-property
-   'tags (image-dired-list-tags (image-dired-original-file-name))))
+    (image-dired--with-marked
+     (image-dired-remove-tag (image-dired-original-file-name) tag)
+     (image-dired-update-property
+      'tags (image-dired-list-tags (image-dired-original-file-name))))))
 
 (defun image-dired-original-file-name ()
   "Get original file name for thumbnail or display image at point."
@@ -1518,8 +1529,10 @@ You probably want to use this together with
       '("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]
+        ["Delete marked images" image-dired-delete-marked]
+        ["Remove tag from current or marked thumbnails"
+         image-dired-tag-thumbnail-remove]
+        ["Tag current or marked thumbnails" image-dired-tag-thumbnail]
         ["Comment thumbnail" image-dired-comment-thumbnail]
         ["Refresh thumb" image-dired-refresh-thumb]
         ["Dynamic line up" image-dired-line-up-dynamic]
@@ -2301,15 +2314,12 @@ non-nil."
 (defun image-dired-delete-marked ()
   "Delete marked thumbnails and associated images."
   (interactive)
-  (goto-char (point-min))
-  (let ((dired-buf (image-dired-associated-dired-buffer)))
-    (while (not (eobp))
-      (if (image-dired-thumb-file-marked-p)
-          (image-dired-delete-char)
-        (forward-char)))
-    (image-dired--line-up-with-method)
-    (with-current-buffer dired-buf
-      (dired-do-delete))))
+  (image-dired--with-marked
+   (image-dired-delete-char)
+   (backward-char))
+  (image-dired--line-up-with-method)
+  (with-current-buffer (image-dired-associated-dired-buffer)
+    (dired-do-delete)))
 
 (defun image-dired-thumb-update-marks ()
   "Update the marks in the thumbnail buffer."
-- 
2.26.2


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 211 bytes --]