diff options
Diffstat (limited to 'lisp/dired-aux.el')
| -rw-r--r-- | lisp/dired-aux.el | 237 |
1 files changed, 181 insertions, 56 deletions
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index d47bcf04279..4faf9431aa3 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -444,10 +444,10 @@ List has a form of (file-name full-file-name (attribute-list))." ((eq op-symbol 'chgrp) (file-attribute-group-id (file-attributes default-file 'string)))))) - (prompt (concat "Change " attribute-name " of %s to" - (if (eq op-symbol 'touch) - " (default now): " - ": "))) + (prompt (format-prompt "Change %s of %%s to" + (when (eq op-symbol 'touch) + "now") + attribute-name)) (new-attribute (dired-mark-read-string prompt nil op-symbol arg files default (cond ((eq op-symbol 'chown) @@ -796,6 +796,15 @@ offer a smarter default choice of shell command." 'read-shell-command prompt nil nil)))) ;;;###autoload +(defcustom dired-confirm-shell-command t + "Whether to prompt for confirmation for `dired-do-shell-command'. +If non-nil, prompt for confirmation if the command contains potentially +dangerous characters. If nil, never prompt for confirmation." + :type 'boolean + :group 'dired + :version "29.1") + +;;;###autoload (defun dired-do-async-shell-command (command &optional arg file-list) "Run a shell command COMMAND on the marked files asynchronously. @@ -810,7 +819,9 @@ are executed in the background on each file sequentially waiting for each command to terminate before running the next command. In shell syntax this means separating the individual commands with `;'. -The output appears in the buffer named by `shell-command-buffer-name-async'." +The output appears in the buffer named by `shell-command-buffer-name-async'. + +Commands that are run asynchronously do not accept user input." (interactive (let ((files (dired-get-marked-files t current-prefix-arg nil nil t))) (list @@ -873,7 +884,9 @@ can be produced by `dired-get-marked-files', for example. `dired-guess-shell-alist-default' and `dired-guess-shell-alist-user' are consulted when the user is -prompted for the shell command to use interactively." +prompted for the shell command to use interactively. + +Also see the `dired-confirm-shell-command' variable." ;; Functions dired-run-shell-command and dired-shell-stuff-it do the ;; actual work and can be redefined for customization. (interactive @@ -891,6 +904,8 @@ prompted for the shell command to use interactively." (ok (cond ((not (or on-each no-subst)) (error "You can not combine `*' and `?' substitution marks")) + ((not dired-confirm-shell-command) + t) ((setq confirmations (dired--need-confirm-positions command "*")) (dired--no-subst-confirm confirmations command)) ((setq confirmations (dired--need-confirm-positions command "?")) @@ -954,6 +969,13 @@ prompted for the shell command to use interactively." (setq retval (replace-match x t t retval 2))) retval)) (lambda (x) (concat cmd-prefix command dired-mark-separator x))))) + ;; If a file name starts with "-", add a "./" to avoid the command + ;; interpreting it as a command line switch. + (setq file-list (mapcar (lambda (file) + (if (string-match "\\`-" file) + (concat "./" file) + file)) + file-list)) (concat (cond (on-each @@ -976,8 +998,15 @@ prompted for the shell command to use interactively." file-list dired-mark-separator))) (when (cdr file-list) (setq files (concat dired-mark-prefix files dired-mark-postfix))) - (funcall stuff-it files)))) - (or (and in-background "&") "")))) + (concat + (funcall stuff-it files) + ;; Be consistent in how we treat inputs to commands -- do + ;; the same here as in the `on-each' case. + (if (and in-background (not w32-shell)) + "&wait" + ""))))) + (or (and in-background "&") + "")))) ;; This is an extra function so that it can be redefined by ange-ftp. ;;;###autoload @@ -1009,6 +1038,7 @@ the offending ARGUMENTS or PROGRAM if no ARGUMENTS were provided." (erase-buffer) (setq default-directory dir ; caller's default-directory err (not (eq 0 (apply #'process-file program nil t nil arguments)))) + (dired-uncache dir) (if err (progn (dired-log (concat program " " (prin1-to-string arguments) "\n")) @@ -1034,6 +1064,7 @@ Return the result of `process-file' - zero for success." nil shell-command-switch cmd))) + (dired-uncache dir) (unless (zerop res) (pop-to-buffer out-buffer)) res)))) @@ -1283,9 +1314,9 @@ Return nil if no change in files." (prog1 (setq newname (file-name-as-directory newname)) (dired-shell-command (replace-regexp-in-string - "%o" (shell-quote-argument newname) + "%o" (shell-quote-argument (file-local-name newname)) (replace-regexp-in-string - "%i" (shell-quote-argument file) + "%i" (shell-quote-argument (file-local-name file)) command nil t) nil t))) @@ -1296,10 +1327,10 @@ Return nil if no change in files." (dired-check-process msg (substring command 0 match) (substring command (1+ match)) - file) + (file-local-name file)) (dired-check-process msg command - file)) + (file-local-name file))) newname)))) (t ;; We don't recognize the file as compressed, so compress it. @@ -1317,7 +1348,8 @@ Return nil if no change in files." (default-directory (file-name-directory file))) (dired-shell-command (replace-regexp-in-string - "%o" (shell-quote-argument out-name) + "%o" (shell-quote-argument + (file-local-name out-name)) (replace-regexp-in-string "%i" (shell-quote-argument (file-name-nondirectory file)) @@ -1347,9 +1379,10 @@ see `dired-compress-file-alist' for the supported suffixes list" out-name))) (dired-shell-command (replace-regexp-in-string - "%o" (shell-quote-argument out-name) + "%o" (shell-quote-argument + (file-local-name out-name)) (replace-regexp-in-string - "%i" (shell-quote-argument file) + "%i" (shell-quote-argument (file-local-name file)) (cdr rule) nil t) nil t)) @@ -1364,7 +1397,8 @@ see `dired-compress-file-alist' for the supported suffixes list" out-name))))) (file-error (if (not (dired-check-process (concat "Compressing " file) - "compress" "-f" file)) + "compress" "-f" + (file-local-name file))) ;; Don't use NEWNAME with `compress'. (concat file ".Z")))))))) @@ -1785,13 +1819,46 @@ Special value `always' suppresses confirmation." "Whether Dired should create destination dirs when copying/removing files. If nil, don't create them. If `always', create them without asking. -If `ask', ask for user confirmation." +If `ask', ask for user confirmation. + +Also see `dired-create-destination-dirs-on-trailing-dirsep'." :type '(choice (const :tag "Never create non-existent dirs" nil) (const :tag "Always create non-existent dirs" always) (const :tag "Ask for user confirmation" ask)) :group 'dired :version "27.1") +(defcustom dired-create-destination-dirs-on-trailing-dirsep nil + "If non-nil, treat a trailing slash at queried destination dir specially. + +If this variable is non-nil and a single destination filename is +queried which ends in a directory separator (/), it will be +treated as a non-existent directory and acted on according to +`dired-create-destination-dirs'. + +This option is only relevant if `dired-create-destination-dirs' +is non-nil, too. + +For example, if both `dired-create-destination-dirs' and this +option are non-nil, renaming a directory named `old_name' to +`new_name/' (note the trailing directory separator) where +`new_name' does not exists already, it will be created and +`old_name' be moved into it. If only `new_name' (without the +trailing /) is given or this option or +`dired-create-destination-dirs' is `nil', `old_name' will be +renamed to `new_name'." + :type '(choice + (const :tag + (concat "Do not treat destination dirs with a " + "trailing directory separator specially") + nil) + (const :tag + (concat "Treat destination dirs with trailing " + "directory separator specially") + t)) + :group 'dired + :version "29.1") + (defun dired-maybe-create-dirs (dir) "Create DIR if doesn't exist according to `dired-create-destination-dirs'." (when (and dired-create-destination-dirs (not (file-exists-p dir))) @@ -1988,11 +2055,12 @@ 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 "\ -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))) + (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)))) ;; must determine if FROM is marked before file-creator @@ -2108,18 +2176,23 @@ Prompt user for a target directory in which to create the new one file is marked. The initial suggestion for target is the Dired buffer's current directory (or, if `dired-dwim-target' is non-nil, the current directory of a neighboring Dired window). + OP-SYMBOL is the symbol for the operation. Function `dired-mark-pop-up' will determine whether pop-ups are appropriate for this OP-SYMBOL. + FILE-CREATOR and OPERATION as in `dired-create-files'. + ARG as in `dired-get-marked-files'. + Optional arg MARKER-CHAR as in `dired-create-files'. + Optional arg OP1 is an alternate form for OPERATION if there is only one file. + Optional arg HOW-TO determines how to treat the target. If HOW-TO is nil, use `file-directory-p' to determine if the target is a directory. If so, the marked file(s) are created - inside that directory. Otherwise, the target is a plain file; - an error is raised unless there is exactly one marked file. + inside that directory. If HOW-TO is t, target is always treated as a plain file. Otherwise, HOW-TO should be a function of one argument, TARGET. If its return value is nil, TARGET is regarded as a plain file. @@ -2132,6 +2205,11 @@ Optional arg HOW-TO determines how to treat the target. target - the name of the target itself. The rest of elements of the list returned by HOW-TO are optional arguments for the function that is the first element of the list. + + This can be useful because by default, copying a single file + would replace the tar file. But this could be overridden to + add or replace entries in the tar file. + For any other return value, TARGET is treated as a directory." (or op1 (setq op1 operation)) (let* ((fn-list (dired-get-marked-files nil arg nil nil t)) @@ -2161,7 +2239,12 @@ Optional arg HOW-TO determines how to treat the target. target-dir op-symbol arg rfn-list default)))) (into-dir (progn - (unless dired-one-file (dired-maybe-create-dirs target)) + (when + (or + (not dired-one-file) + (and dired-create-destination-dirs-on-trailing-dirsep + (directory-name-p target))) + (dired-maybe-create-dirs target)) (cond ((null how-to) ;; Allow users to change the letter case of ;; a directory on a case-insensitive @@ -2375,7 +2458,7 @@ If FILE already exists, signal an error." (defvar dired-copy-how-to-fn nil "Either nil or a function used by `dired-do-copy' to determine target. -See HOW-TO argument for `dired-do-create-files'.") +See HOW-TO argument for `dired-do-create-files' for an explanation.") ;;;###autoload (defun dired-do-copy (&optional arg) @@ -2396,6 +2479,10 @@ If `dired-copy-preserve-time' is non-nil, this command preserves the modification time of each old file in the copy, similar to the \"-p\" option for the \"cp\" shell command. +The `dired-keep-marker-copy' user option controls how this +command handles file marking. The default is to mark all new +copies of files with a \"C\" mark. + This command copies symbolic links by creating new ones, similar to the \"-d\" option for the \"cp\" shell command. But if `dired-copy-dereference' is non-nil, the symbolic @@ -2485,11 +2572,12 @@ Also see `dired-do-revert-buffer'." ;; Optional arg MARKER-CHAR as in dired-create-files. (let* ((fn-list (dired-get-marked-files nil arg)) (operation-prompt (concat operation " `%s' to `%s'?")) - (rename-regexp-help-form (format-message "\ -Type SPC or `y' to %s one match, DEL or `n' to skip to next, -`!' to %s all remaining matches with no more questions." - (downcase operation) - (downcase operation))) + (rename-regexp-help-form (format-message + (substitute-command-keys "\ +Type \\`SPC' or \\`y' to %s one match, \\`DEL' or \\`n' to skip to next, +\\`!' to %s all remaining matches with no more questions.") + (downcase operation) + (downcase operation))) (regexp-name-constructor ;; Function to construct new filename using REGEXP and NEWNAME: (if whole-name ; easy (but rare) case @@ -2610,11 +2698,12 @@ See function `dired-do-rename-regexp' for more info." (let ((to (concat (file-name-directory from) (funcall basename-constructor (file-name-nondirectory from))))) - (and (let ((help-form (format-message "\ -Type SPC or `y' to %s one file, DEL or `n' to skip to next, -`!' to %s all remaining matches with no more questions." - (downcase operation) - (downcase operation)))) + (and (let ((help-form (format-message + (substitute-command-keys "\ +Type \\`SPC' or \\`y' to %s one file, \\`DEL' or \\`n' to skip to next, +\\`!' to %s all remaining matches with no more questions.") + (downcase operation) + (downcase operation)))) (dired-query 'rename-non-directory-query (concat operation " `%s' to `%s'") (dired-make-relative from) @@ -2864,8 +2953,8 @@ of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well." ;; if dired-actual-switches contained t. (setq dir1 (file-name-as-directory dir1) dir2 (file-name-as-directory dir2)) - (let ((components-1 (dired-split "/" dir1)) - (components-2 (dired-split "/" dir2))) + (let ((components-1 (split-string dir1 "/")) + (components-2 (split-string dir2 "/"))) (while (and components-1 components-2 (equal (car components-1) (car components-2))) @@ -2884,7 +2973,6 @@ of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well." nil) (t (error "This can't happen")))))) -;; There should be a builtin split function - inverse to mapconcat. (defun dired-split (pat str &optional limit) "Splitting on regexp PAT, turn string STR into a list of substrings. Optional third arg LIMIT (>= 1) is a limit to the length of the @@ -2894,6 +2982,7 @@ Thus, if SEP is a regexp that only matches itself, (mapconcat #'identity (dired-split SEP STRING) SEP) is always equal to STRING." + (declare (obsolete split-string "29.1")) (let* ((start (string-match pat str)) (result (list (substring str 0 start))) (count 1) @@ -3081,16 +3170,16 @@ a file name. Otherwise, it searches the whole buffer without restrictions." (define-minor-mode dired-isearch-filenames-mode "Toggle file names searching on or off. -When on, Isearch skips matches outside file names using the predicate -`dired-isearch-filter-filenames' that matches only at file names. -When off, it uses the original predicate." +When on, Isearch skips matches outside file names using the search function +`dired-isearch-search-filenames' that matches only at file names. +When off, it uses the default search function." :lighter nil (if dired-isearch-filenames-mode - (add-function :before-while (local 'isearch-filter-predicate) - #'dired-isearch-filter-filenames + (add-function :around (local 'isearch-search-fun-function) + #'dired-isearch-search-filenames '((isearch-message-prefix . "filename "))) - (remove-function (local 'isearch-filter-predicate) - #'dired-isearch-filter-filenames)) + (remove-function (local 'isearch-search-fun-function) + #'dired-isearch-search-filenames)) (when isearch-mode (setq isearch-success t isearch-adjusted t) (isearch-update))) @@ -3114,12 +3203,46 @@ Intended to be added to `isearch-mode-hook'." (unless isearch-suspended (kill-local-variable 'dired-isearch-filenames))) -(defun dired-isearch-filter-filenames (beg end) - "Test whether some part of the current search match is inside a file name. -This function returns non-nil if some part of the text between BEG and END -is part of a file name (i.e., has the text property `dired-filename')." - (text-property-not-all (min beg end) (max beg end) - 'dired-filename nil)) +(defun dired-isearch-search-filenames (orig-fun) + "Return the function that searches inside file names. +The returned function narrows the search to match the search string +only as part of a file name enclosed by the text property `dired-filename'. +It's intended to override the default search function." + (let ((search-fun (funcall orig-fun)) + (property 'dired-filename)) + (lambda (string &optional bound noerror count) + (let* ((old (point)) + ;; Check if point is already on the property. + (beg (when (get-text-property + (if isearch-forward old (max (1- old) (point-min))) + property) + old)) + end found) + ;; Otherwise, try to search for the next property. + (unless beg + (setq beg (if isearch-forward + (next-single-property-change old property) + (previous-single-property-change old property))) + (when beg (goto-char beg))) + ;; Non-nil `beg' means there are more properties. + (while (and beg (not found)) + ;; Search for the end of the current property. + (setq end (if isearch-forward + (next-single-property-change beg property) + (previous-single-property-change beg property))) + (setq found (funcall + search-fun string (if bound (if isearch-forward + (min bound end) + (max bound end)) + end) + noerror count)) + (unless found + (setq beg (if isearch-forward + (next-single-property-change end property) + (previous-single-property-change end property))) + (when beg (goto-char beg)))) + (unless found (goto-char old)) + found)))) ;;;###autoload (defun dired-isearch-filenames () @@ -3196,7 +3319,6 @@ resume the query replace with the command \\[fileloop-continue]." delimited) (fileloop-continue)) -(declare-function xref--show-xrefs "xref") (declare-function xref-query-replace-in-results "xref") (declare-function project--files-in-directory "project") @@ -3232,7 +3354,7 @@ REGEXP should use constructs supported by your local `grep' command." (project--files-in-directory mark ignores "*") files)) (push mark files))) - (nreverse marks)) + (reverse marks)) (message "Searching...") (setq xrefs (xref-matches-in-files regexp files)) @@ -3240,7 +3362,7 @@ REGEXP should use constructs supported by your local `grep' command." (user-error "No matches for: %s" regexp)) (message "Searching...done") xrefs)))) - (xref--show-xrefs fetcher nil))) + (xref-show-xrefs fetcher nil))) ;;;###autoload (defun dired-do-find-regexp-and-replace (from to) @@ -3258,7 +3380,10 @@ recursively. However, files matching `grep-find-ignored-files' and subdirectories matching `grep-find-ignored-directories' are skipped in the marked directories. -REGEXP should use constructs supported by your local `grep' command." +REGEXP should use constructs supported by your local `grep' command. + +Also see `query-replace' for user options that affect how this +function works." (interactive (let ((common (query-replace-read-args |