From: Eshel Yaron <me@eshelyaron.com>
Date: Thu, 24 Oct 2024 12:11:17 +0000 (+0200)
Subject: * filet.el: New file
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=9a4e8ce2d94ad11bd56b300257df60c441b0c445;p=emacs.git

* filet.el: New file
---

diff --git a/lisp/dired.el b/lisp/dired.el
index 8db1c0b5b72..bf19f247c81 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -2421,7 +2421,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
   "<remap> <undo>"             #'dired-undo
   "<remap> <advertised-undo>"  #'dired-undo
   "<remap> <vc-next-action>"   #'dired-vc-next-action
-  "<remap> <yank>"             #'dired-yank
+  "<remap> <yank>"             #'filet
   ;; thumbnail manipulation (image-dired)
   "C-t d"   #'image-dired-display-thumbs
   "C-t t"   #'image-dired-tag-files
diff --git a/lisp/filet.el b/lisp/filet.el
new file mode 100644
index 00000000000..9df053ba531
--- /dev/null
+++ b/lisp/filet.el
@@ -0,0 +1,140 @@
+;;; filet.el --- Do things with copied file names   -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024  Eshel Yaron
+
+;; Author: Eshel Yaron <me@eshelyaron.com>
+;; Keywords:
+
+;; This program 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.
+
+;; This program 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 this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'transient)
+(require 'dired-aux)
+
+;;;###autoload
+(transient-define-prefix filet ()
+  "Operate on copied file names."
+  [ :description (lambda () (concat "In directory "
+                                    (abbreviate-file-name
+                                     (expand-file-name default-directory))))
+    ("-f" "Files" "--files"
+     :class transient-option
+     :multi-value rest)
+    ("-d" "Directory" "--directory=")
+    ("c" "Copy" filet-copy)
+    ("m" "Move" filet-move)
+    ("l" "Link" filet-link)]
+  (interactive)
+  (transient-setup 'filet nil nil
+                   :value (append
+                           (let ((files (split-string-and-unquote (current-kill 0))))
+                             (when (seq-every-p #'file-name-absolute-p files)
+                               (list (cons "--files" (mapcar #'file-relative-name files)))))
+                           (when (derived-mode-p 'dired-mode)
+                             (list (concat "--directory="
+                                           (file-relative-name (dired-current-directory))))))))
+
+(defun filet-args (op-name)
+  (let ((files nil) (directory nil))
+    (dolist (arg (transient-args 'filet))
+      (cond
+       ((and (consp arg) (equal (car arg) "--files"))
+        (setq files (mapcar #'expand-file-name (cdr arg))))
+       ((string-match "--directory=\\(.+\\)" arg)
+        (setq directory (match-string 1 arg)))))
+    (unless files
+      (setq files
+            (mapcar #'abbreviate-file-name
+                    (mapcar #'expand-file-name
+                            (completing-read-multiple
+                             (format "%s files: " op-name)
+                             #'completion-file-name-table
+                             nil t nil 'file-name-history)))))
+    (unless directory
+      (setq directory
+            (abbreviate-file-name
+             (expand-file-name
+              (read-directory-name (format "%s files to: " op-name))))))
+    (list files directory)))
+
+(defun filet-copy (files directory)
+  (interactive (filet-args "Copy"))
+  (dired-create-files #'copy-file "Copy" files
+                      (lambda (file)
+                        (expand-file-name (file-name-nondirectory file) directory))
+                      dired-keep-marker-copy))
+
+(defun filet-move (files directory)
+  (interactive
+   (let ((files nil) (directory nil))
+     (dolist (arg (transient-args 'filet))
+       (cond
+        ((and (consp arg) (equal (car arg) "--files"))
+         (setq files (cdr arg)))
+        ((string-match "--directory=\\(.+\\)" arg)
+         (setq directory (match-string 1 arg)))))
+     (unless files
+       (setq files
+             (mapcar #'abbreviate-file-name
+                     (mapcar #'expand-file-name
+                             (completing-read-multiple
+                              "Move files: "
+                              #'completion-file-name-table
+                              nil t nil 'file-name-history)))))
+     (unless directory
+       (setq directory
+             (abbreviate-file-name
+              (expand-file-name
+               (read-directory-name "Move files to directory: ")))))
+     (list files directory)))
+  (dired-create-files #'rename-file "Move" files
+                      (lambda (file)
+                        (expand-file-name (file-name-nondirectory file) directory))
+                      dired-keep-marker-rename))
+
+(defun filet-link (files directory)
+  (interactive
+   (let ((files nil) (directory nil))
+     (dolist (arg (transient-args 'filet))
+       (cond
+        ((and (consp arg) (equal (car arg) "--files"))
+         (setq files (cdr arg)))
+        ((string-match "--directory=\\(.+\\)" arg)
+         (setq directory (match-string 1 arg)))))
+     (unless files
+       (setq files
+             (mapcar #'abbreviate-file-name
+                     (mapcar #'expand-file-name
+                             (completing-read-multiple
+                              "Link files: "
+                              #'completion-file-name-table
+                              nil t nil 'file-name-history)))))
+     (unless directory
+       (setq directory
+             (abbreviate-file-name
+              (expand-file-name
+               (read-directory-name "Link files to directory: ")))))
+     (list files directory)))
+  (dired-create-files #'rename-file "Link" files
+                      (lambda (file)
+                        (expand-file-name (file-name-nondirectory file) directory))
+                      dired-keep-marker-symlink))
+
+(provide 'filet)
+;;; filet.el ends here