Improve filet.el

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index e75704e66264705e61f8ec6b1d6d4e13ce812118..703ab553c687fe23c120a28c6ac42d440e6423e2 100644 (file)
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1890,16 +1890,20 @@ this and subsequent queries.
 If SYM is already bound to a non-nil value, this function may
 return automatically without querying the user.  If SYM is !,
 return t; if SYM is q or ESC, return nil."
-  (let* ((char (symbol-value sym))
-        (char-choices '(?y ?\s ?n ?\177 ?! ?q ?\e)))
+  (let ((char (symbol-value sym)))
     (cond ((eq char ?!)
-          t)       ; accept, and don't ask again
-         ((memq char '(?q ?\e))
-          nil)     ; skip, and don't ask again
-         (t        ; no previous answer - ask now
+          t)                           ; accept, and don't ask again
+         ((eq char ?q)
+          nil)                         ; skip, and don't ask again
+         (t                            ; no previous answer - ask now
           (setq prompt (apply #'format-message prompt args))
-          (set sym (setq char (read-char-choice prompt char-choices)))
-          (if (memq char '(?y ?\s ?!)) t)))))
+          (set sym
+                (setq char (car (read-multiple-choice
+                                 prompt '((?y "yes")
+                                          (?n "no")
+                                          (?! "all" "Overwrite all remaining files")
+                                          (?q "quit"))))))
+          (if (eq char ?y) t)))))
 
 \f
 ;;;###autoload
@@ -2470,14 +2474,8 @@ or with the current marker character if MARKER-CHAR is t."
           (let* ((overwrite (file-exists-p to))
                  (dired-overwrite-confirmed ; for dired-handle-overwrite
                   (and overwrite
-                       (let ((help-form (format-message
-                                         (substitute-command-keys "\
-Type \\`SPC' or \\`y' to overwrite file `%s',
-\\`DEL' or \\`n' to skip to next,
-\\`ESC' or \\`q' to not overwrite any of the remaining files,
-\\`!' to overwrite all remaining files with no more questions.") to)))
-                         (dired-query 'overwrite-query
-                                      "Overwrite `%s'?" to))))
+                       (dired-query 'overwrite-query "Overwrite `%s'?"
+                                    (abbreviate-file-name to))))
                  ;; must determine if FROM is marked before file-creator
                  ;; gets a chance to delete it (in case of a move).
                  (actual-marker-char

diff --git a/lisp/filet.el b/lisp/filet.el
index 9df053ba531dd54b1edc0b4bd8733776f7988b5b..d1a22e35c6d432dc8bd327ace081c206926c024a 100644 (file)
--- a/lisp/filet.el
+++ b/lisp/filet.el
@@ -27,114 +27,122 @@
 (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-short-name (file)
+  "Return a short name for FILE."
+  (let ((rel (file-relative-name file))
+        (abr (abbreviate-file-name (expand-file-name file))))
+    (if (< (string-width rel) (string-width abr)) rel abr)))
+
+(defun filet-read-files (prompt initial-input history)
+  "Prompt with PROMPT for multiple file names.
+
+INITIAL-INPUT is the minibuffer initial input, and HISTORY is the
+minibuffer history variable to use."
+  (mapcar #'filet-short-name
+          (completing-read-multiple
+           prompt #'completion-file-name-table nil t initial-input history)))
+
+(defun filet-create-files (file-creator op-name files directory marker-char)
+  "Call FILE-CREATOR for each file in FILES to create files in DIRECTORY.
+
+OP-NAME is a string describing the operation, such as \"Copy\".
+MARKER-CHAR is a character to mark created files with."
+  (dired-create-files
+   file-creator op-name files
+   (lambda (file) (expand-file-name (file-name-nondirectory file) directory))
+   marker-char))
 
 (defun filet-args (op-name)
+  "Return (FILES DIRECTORY) argument list for `filet' commands.
+
+OP-NAME is a string describing the current operation, such as \"Copy\"."
   (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)))))
+        (setq directory (expand-file-name (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)))))
+            (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))))))
+            (expand-file-name
+             (read-directory-name (format "%s files to: " op-name)))))
     (list files directory)))
 
 (defun filet-copy (files directory)
+  "Copy FILES to 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))
+  (filet-create-files #'copy-file
+                      "Copy" files 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))
+  "Move FILES to DIRECTORY."
+  (interactive (filet-args "Move"))
+  (filet-create-files #'rename-file
+                      "Move" files 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))
+  "Create symlinks to FILES in DIRECTORY."
+  (interactive (filet-args "Link"))
+  (filet-create-files #'make-symbolic-link
+                      "Link" files directory dired-keep-marker-symlink))
+
+(defun filet-make-relative-symbolic-link (file new ok-flag)
+  "Create a relative symbolic link to FILE at NEW.
+
+OK-FLAG says whether it is OK to override an existing NEW file."
+  (make-symbolic-link
+   (file-relative-name file (file-name-directory new)) new ok-flag))
+
+(defun filet-relk (files directory)
+  "Create relative symlinks to FILES in DIRECTORY."
+  (interactive (filet-args "Relk"))
+  (filet-create-files #'filet-make-relative-symbolic-link
+                      "Relk" files directory dired-keep-marker-relsymlink))
+
+;;;###autoload
+(transient-define-prefix filet ()
+  "Operate on file names in your `kill-ring'.
+
+Use `0 w' in a Dired buffer to grab some absolute file names, then later
+invoke this command in another Dired buffer to copy/move/link those
+files to that directory."
+  [ :description (lambda () (concat "In directory "
+                                    (abbreviate-file-name
+                                     (expand-file-name default-directory))))
+    ("-f" "Files" "--files"
+     :class transient-option
+     :multi-value rest
+     :reader filet-read-files)
+    ("-d" "Directory" "--directory=")]
+  ["Actions"
+   [("c" "Copy" filet-copy)]
+   [("m" "Move" filet-move)]
+   [("l" "Link" filet-link)]
+   [("r" "Relk" filet-relk)]]
+  (interactive)
+  (transient-setup
+   'filet nil nil :value
+   (append
+    (let ((files nil) (ring kill-ring))
+      (while (and ring (not files))
+        (setq files (ignore-errors (split-string-and-unquote (car ring)))
+              ring  (cdr ring))
+        (unless (seq-every-p #'file-name-absolute-p files)
+          (setq files nil)))
+      (when files
+        (list (cons "--files" (mapcar #'filet-short-name files)))))
+    (list (concat "--directory="
+                  (filet-short-name (if (derived-mode-p 'dired-mode)
+                                        (dired-current-directory)
+                                      default-directory)))))))
 
 (provide 'filet)
 ;;; filet.el ends here