;;; dired-aux.el --- less commonly used parts of dired
-;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2015 Free Software
+;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2016 Free Software
;; Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
;;; Code:
+(require 'cl-lib)
;; We need macros in dired.el to compile properly,
;; and we call subroutines in it too.
(require 'dired)
(command (if sequentially
(substring command 0 (match-beginning 0))
command))
+ (parallel-in-background
+ (and in-background (not sequentially) (not (eq system-type 'ms-dos))))
+ (w32-shell (and (fboundp 'w32-shell-dos-semantics)
+ (w32-shell-dos-semantics)))
+ ;; The way to run a command in background in Windows shells
+ ;; is to use the START command. The /B switch means not to
+ ;; create a new window for the command.
+ (cmd-prefix (if w32-shell "start /b " ""))
+ ;; Windows shells don't support chaining with ";", they use
+ ;; "&" instead.
+ (cmd-sep (if (and (not w32-shell) (not parallel-in-background))
+ ";"
+ "&"))
(stuff-it
(if (or (string-match-p dired-star-subst-regexp command)
(string-match-p dired-quark-subst-regexp command))
(lambda (x)
- (let ((retval command))
+ (let ((retval (concat cmd-prefix command)))
(while (string-match
"\\(^\\|[ \t]\\)\\([*?]\\)\\([ \t]\\|$\\)" retval)
(setq retval (replace-match x t t retval 2)))
retval))
- (lambda (x) (concat command dired-mark-separator x)))))
+ (lambda (x) (concat cmd-prefix command dired-mark-separator x)))))
(concat
- (if on-each
- (mapconcat stuff-it (mapcar 'shell-quote-argument file-list)
- (if (and in-background (not sequentially)) "&" ";"))
- (let ((files (mapconcat 'shell-quote-argument
- file-list dired-mark-separator)))
- (if (> (length file-list) 1)
- (setq files (concat dired-mark-prefix files dired-mark-postfix)))
- (funcall stuff-it files)))
- (if in-background "&" ""))))
+ (cond (on-each
+ (format "%s%s"
+ (mapconcat stuff-it (mapcar 'shell-quote-argument file-list)
+ cmd-sep)
+ ;; POSIX shells running a list of commands in the background
+ ;; (LIST = cmd_1 & [cmd_2 & ... cmd_i & ... cmd_N &])
+ ;; return once cmd_N ends, i.e., the shell does not
+ ;; wait for cmd_i to finish before executing cmd_i+1.
+ ;; That means, running (shell-command LIST) may not show
+ ;; the output of all the commands (Bug#23206).
+ ;; Add 'wait' to force those POSIX shells to wait until
+ ;; all commands finish.
+ (or (and parallel-in-background (not w32-shell)
+ "&wait")
+ "")))
+ (t
+ (let ((files (mapconcat 'shell-quote-argument
+ 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 "&") ""))))
;; This is an extra function so that it can be redefined by ange-ftp.
;;;###autoload
\f
(defun dired-check-process (msg program &rest arguments)
-; "Display MSG while running PROGRAM, and check for output.
-;Remaining arguments are strings passed as command arguments to PROGRAM.
-; On error, insert output
-; in a log buffer and return the offending ARGUMENTS or PROGRAM.
-; Caller can cons up a list of failed args.
-;Else returns nil for success."
+ "Display MSG while running PROGRAM, and check for output.
+Remaining arguments are strings passed as command arguments to PROGRAM.
+On error, insert output
+in a log buffer and return the offending ARGUMENTS or PROGRAM.
+Caller can cons up a list of failed args.
+Else returns nil for success."
(let (err-buffer err (dir default-directory))
(message "%s..." msg)
(save-excursion
(kill-buffer err-buffer)
(message "%s...done" msg)
nil))))
+
+(defun dired-shell-command (cmd)
+ "Run CMD, and check for output.
+On error, pop up the log buffer.
+Return the result of `process-file' - zero for success."
+ (let ((out-buffer " *dired-check-process output*")
+ (dir default-directory))
+ (with-current-buffer (get-buffer-create out-buffer)
+ (erase-buffer)
+ (let* ((default-directory dir)
+ (res (process-file
+ shell-file-name
+ nil
+ t
+ nil
+ shell-command-switch
+ cmd)))
+ (unless (zerop res)
+ (pop-to-buffer out-buffer))
+ res))))
\f
;; Commands that delete or redisplay part of the dired buffer.
from-file)))
(defvar dired-compress-file-suffixes
- '(("\\.gz\\'" "" "gunzip")
+ '(
+ ;; "tar -zxf" isn't used because it's not available on the
+ ;; Solaris10 version of tar. Solaris10 becomes obsolete in 2021.
+ ;; Same thing on AIX 7.1.
+ ("\\.tar\\.gz\\'" "" "gzip -dc %i | tar -xv")
+ ("\\.gz\\'" "" "gunzip")
("\\.tgz\\'" ".tar" "gunzip")
("\\.Z\\'" "" "uncompress")
;; For .z, try gunzip. It might be an old gzip file,
("\\.tbz\\'" ".tar" "bunzip2")
("\\.bz2\\'" "" "bunzip2")
("\\.xz\\'" "" "unxz")
+ ("\\.zip\\'" "" "unzip -o -d %o %i")
+ ("\\.7z\\'" "" "7z x -aoa -o%o %i")
;; This item controls naming for compression.
- ("\\.tar\\'" ".tgz" nil))
+ ("\\.tar\\'" ".tgz" nil)
+ ;; This item controls the compression of directories
+ (":" ".tar.gz" "tar -c %i | gzip -c9 > %o"))
"Control changes in file name suffixes for compression and uncompression.
Each element specifies one transformation rule, and has the form:
(REGEXP NEW-SUFFIX PROGRAM)
(as well as anything after that), then adding NEW-SUFFIX in its place.
If PROGRAM is non-nil, the rule is an uncompression rule,
and uncompression is done by running PROGRAM.
-Otherwise, the rule is a compression rule, and compression is done with gzip.")
+
+Within PROGRAM, %i denotes the input file, and %o denotes the
+output file.
+
+Otherwise, the rule is a compression rule, and compression is done with gzip.
+ARGS are command switches passed to PROGRAM.")
+
+(defvar dired-compress-files-alist
+ '(("\\.tar\\.gz\\'" . "tar -c %i | gzip -c9 > %o")
+ ("\\.tar\\.bz2\\'" . "tar -c %i | bzip2 -c9 > %o")
+ ("\\.tar\\.xz\\'" . "tar -c %i | xz -c9 > %o")
+ ("\\.zip\\'" . "zip %o -r --filesync %i"))
+ "Control the compression shell command for `dired-do-compress-to'.
+
+Each element is (REGEXP . CMD), where REGEXP is the name of the
+archive to which you want to compress, and CMD the the
+corresponding command.
+
+Within CMD, %i denotes the input file(s), and %o denotes the
+output file. %i path(s) are relative, while %o is absolute.")
+
+;;;###autoload
+(defun dired-do-compress-to ()
+ "Compress selected files and directories to an archive.
+You are prompted for the archive name.
+The archiving command is chosen based on the archive name extension and
+`dired-compress-files-alist'."
+ (interactive)
+ (let* ((in-files (dired-get-marked-files))
+ (out-file (read-file-name "Compress to: "))
+ (rule (cl-find-if
+ (lambda (x)
+ (string-match (car x) out-file))
+ dired-compress-files-alist)))
+ (cond ((not rule)
+ (error
+ "No compression rule found for %s, see `dired-compress-files-alist'"
+ out-file))
+ ((and (file-exists-p out-file)
+ (not (y-or-n-p
+ (format "%s exists, overwrite?"
+ (abbreviate-file-name out-file)))))
+ (message "Compression aborted"))
+ (t
+ (when (zerop
+ (dired-shell-command
+ (replace-regexp-in-string
+ "%o" out-file
+ (replace-regexp-in-string
+ "%i" (mapconcat #'file-name-nondirectory in-files " ")
+ (cdr rule)))))
+ (message "Compressed %d file(s) to %s"
+ (length in-files)
+ (file-name-nondirectory out-file)))))))
;;;###autoload
(defun dired-compress-file (file)
Return nil if no change in files."
(let ((handler (find-file-name-handler file 'dired-compress-file))
suffix newname
- (suffixes dired-compress-file-suffixes))
+ (suffixes dired-compress-file-suffixes)
+ command)
;; See if any suffix rule matches this file name.
(while suffixes
(let (case-fold-search)
(funcall handler 'dired-compress-file file))
((file-symlink-p file)
nil)
- ((and suffix (nth 2 suffix))
- ;; We found an uncompression rule.
- (if (not (dired-check-process (concat "Uncompressing " file)
- (nth 2 suffix) file))
- newname))
+ ((and suffix (setq command (nth 2 suffix)))
+ (if (string-match "%[io]" command)
+ (prog1 (setq newname (file-name-as-directory newname))
+ (dired-shell-command
+ (replace-regexp-in-string
+ "%o" newname
+ (replace-regexp-in-string
+ "%i" file
+ command))))
+ ;; We found an uncompression rule.
+ (when (not
+ (dired-check-process
+ (concat "Uncompressing " file)
+ command
+ file))
+ newname)))
(t
;; We don't recognize the file as compressed, so compress it.
;; Try gzip; if we don't have that, use compress.
(condition-case nil
- (let ((out-name (concat file (if (file-directory-p file)
- ".tar.gz"
- ".gz"))))
- (and (or (not (file-exists-p out-name))
- (y-or-n-p
- (format "File %s already exists. Really compress? "
- out-name)))
- (not
- (if (file-directory-p file)
- (let ((default-directory (file-name-directory file)))
- (dired-check-process (concat "Compressing " file)
- "tar" "-czf" out-name (file-name-nondirectory file)))
+ (if (file-directory-p file)
+ (progn
+ (setq suffix (cdr (assoc ":" dired-compress-file-suffixes)))
+ (when suffix
+ (let ((out-name (concat file (car suffix)))
+ (default-directory (file-name-directory file)))
+ (dired-shell-command
+ (replace-regexp-in-string
+ "%o" out-name
+ (replace-regexp-in-string
+ "%i" (file-name-nondirectory file)
+ (cadr suffix))))
+ out-name)))
+ (let ((out-name (concat file ".gz")))
+ (and (or (not (file-exists-p out-name))
+ (y-or-n-p
+ (format "File %s already exists. Really compress? "
+ out-name)))
+ (not
(dired-check-process (concat "Compressing " file)
- "gzip" "-f" file)))
- (or (file-exists-p out-name)
- (setq out-name (concat file ".z")))
- ;; Rename the compressed file to NEWNAME
- ;; if it hasn't got that name already.
- (if (and newname (not (equal newname out-name)))
- (progn
- (rename-file out-name newname t)
- newname)
- out-name)))
+ "gzip" "-f" file))
+ (or (file-exists-p out-name)
+ (setq out-name (concat file ".z")))
+ ;; Rename the compressed file to NEWNAME
+ ;; if it hasn't got that name already.
+ (if (and newname (not (equal newname out-name)))
+ (progn
+ (rename-file out-name newname t)
+ newname)
+ out-name))))
(file-error
(if (not (dired-check-process (concat "Compressing " file)
"compress" "-f" file))
;; here is faster than with dired-add-entry's optional arg).
;; Does not update other dired buffers. Use dired-relist-entry for that.
(let* ((opoint (line-beginning-position))
- (char (char-after opoint))
- (buffer-read-only))
+ (char (char-after opoint))
+ (buffer-read-only))
(delete-region opoint (progn (forward-line 1) (point)))
(if file
- (progn
- (dired-add-entry file nil t)
- ;; Replace space by old marker without moving point.
- ;; Faster than goto+insdel inside a save-excursion?
- (subst-char-in-region opoint (1+ opoint) ?\040 char))))
+ (progn
+ (dired-add-entry file nil t)
+ ;; Replace space by old marker without moving point.
+ ;; Faster than goto+insdel inside a save-excursion?
+ (when char
+ (subst-char-in-region opoint (1+ opoint) ?\040 char)))))
(dired-move-to-filename))
;;;###autoload
(cur-dir (dired-current-directory))
(cons (assoc-string cur-dir dired-switches-alist))
buffer-read-only)
- (if (equal cur-dir default-directory)
- (error "Attempt to kill top level directory"))
+ (when (equal cur-dir (expand-file-name default-directory))
+ (error "Attempt to kill top level directory"))
(prog1
(if remember-marks (dired-remember-marks beg end))
(delete-region beg end)
(tags-query-replace from to delimited
'(dired-get-marked-files nil nil 'dired-nondirectory-p)))
+(declare-function xref--show-xrefs "xref")
+(declare-function xref-query-replace-in-results "xref")
+
+;;;###autoload
+(defun dired-do-find-regexp (regexp)
+ "Find all matches for REGEXP in all marked files.
+For any marked directory, all of its files are searched 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."
+ (interactive "sSearch marked files (regexp): ")
+ (require 'grep)
+ (defvar grep-find-ignored-files)
+ (defvar grep-find-ignored-directories)
+ (let* ((files (dired-get-marked-files))
+ (ignores (nconc (mapcar
+ (lambda (s) (concat s "/"))
+ grep-find-ignored-directories)
+ grep-find-ignored-files))
+ (xrefs (mapcan
+ (lambda (file)
+ (xref-collect-matches regexp "*" file
+ (and (file-directory-p file)
+ ignores)))
+ files)))
+ (unless xrefs
+ (user-error "No matches for: %s" regexp))
+ (xref--show-xrefs xrefs nil t)))
+
+;;;###autoload
+(defun dired-do-find-regexp-and-replace (from to)
+ "Replace matches of FROM with TO, in all marked files.
+For any marked directory, matches in all of its files are replaced,
+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."
+ (interactive
+ (let ((common
+ (query-replace-read-args
+ "Query replace regexp in marked files" t t)))
+ (list (nth 0 common) (nth 1 common))))
+ (with-current-buffer (dired-do-find-regexp from)
+ (xref-query-replace-in-results from to)))
+
(defun dired-nondirectory-p (file)
(not (file-directory-p file)))
\f
;; Local Variables:
;; byte-compile-dynamic: t
-;; generated-autoload-file: "dired.el"
+;; generated-autoload-file: "dired-loaddefs.el"
;; End:
;;; dired-aux.el ends here