;;; 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)
(defun dired-shell-command (cmd)
"Run CMD, and check for output.
-On error, pop up the log buffer."
- (let ((out-buffer " *dired-check-process 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 ((res (process-file
- shell-file-name
- nil
- t
- nil
- shell-command-switch
- cmd)))
+ (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))))))
+ (pop-to-buffer out-buffer))
+ res))))
\f
;; Commands that delete or redisplay part of the dired buffer.
from-file)))
(defvar dired-compress-file-suffixes
- '(("\\.tar\\.gz\\'" "" "gzip -dc %i | tar -xv")
+ '(
+ ;; "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")
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)
"Compress or uncompress FILE.
(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 (cl-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