From: Eshel Yaron Date: Thu, 24 Oct 2024 18:59:01 +0000 (+0200) Subject: Improve filet.el X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=c7d99d581dd8da7fd143645a95ac6caf1db604d5;p=emacs.git Improve filet.el --- diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index e75704e6626..703ab553c68 100644 --- 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))))) ;;;###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 9df053ba531..d1a22e35c6d 100644 --- 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