;;; 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)
Uses the shell command coming from variables `lpr-command' and
`lpr-switches' as default."
(interactive "P")
+ (require 'lpr)
(let* ((file-list (dired-get-marked-files t arg))
(lpr-switches
(if (and (stringp printer-name)
(if (cond ((not (or on-each no-subst))
(error "You can not combine `*' and `?' substitution marks"))
((and star on-each)
- (y-or-n-p "Confirm--do you mean to use `*' as a wildcard? "))
+ (y-or-n-p (format-message
+ "Confirm--do you mean to use `*' as a wildcard? ")))
((and qmark no-subst)
- (y-or-n-p "Confirm--do you mean to use `?' as a wildcard? "))
+ (y-or-n-p (format-message
+ "Confirm--do you mean to use `?' as a wildcard? ")))
(t))
(if on-each
(dired-bunch-files
\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")
;; 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)
- ;; Compress or uncompress FILE.
- ;; Return the name of the compressed or uncompressed file.
- ;; Return nil if no change in files.
+ "Compress or uncompress FILE.
+Return the name of the compressed or uncompressed 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))
+ suffix newname
+ (suffixes dired-compress-file-suffixes)
+ command)
;; See if any suffix rule matches this file name.
(while suffixes
(let (case-fold-search)
- (if (string-match (car (car suffixes)) file)
- (setq suffix (car suffixes) suffixes nil))
- (setq suffixes (cdr suffixes))))
+ (if (string-match (car (car suffixes)) file)
+ (setq suffix (car suffixes) suffixes nil))
+ (setq suffixes (cdr suffixes))))
;; If so, compute desired new name.
(if suffix
- (setq newname (concat (substring file 0 (match-beginning 0))
- (nth 1 suffix))))
+ (setq newname (concat (substring file 0 (match-beginning 0))
+ (nth 1 suffix))))
(cond (handler
- (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))
- (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 ".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)))
- (file-error
- (if (not (dired-check-process (concat "Compressing " file)
- "compress" "-f" file))
- ;; Don't use NEWNAME with `compress'.
- (concat file ".Z"))))))))
+ (funcall handler 'dired-compress-file file))
+ ((file-symlink-p file)
+ nil)
+ ((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
+ (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))))
+ (file-error
+ (if (not (dired-check-process (concat "Compressing " file)
+ "compress" "-f" file))
+ ;; Don't use NEWNAME with `compress'.
+ (concat file ".Z"))))))))
\f
(defun dired-mark-confirm (op-symbol arg)
;; Request confirmation from the user that the operation described
nil) ; skip, and don't ask again
(t ; no previous answer - ask now
(setq prompt
- (concat (apply 'format prompt args)
+ (concat (apply #'format-message prompt args)
(if help-form
(format " [Type yn!q or %s] "
(key-description (vector help-char)))
;; 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
(let* ((overwrite (file-exists-p to))
(dired-overwrite-confirmed ; for dired-handle-overwrite
(and overwrite
- (let ((help-form '(format "\
+ (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,
;; 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 "\
+ (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)))
+ (downcase operation)
+ (downcase operation)))
(regexp-name-constructor
;; Function to construct new filename using REGEXP and NEWNAME:
(if whole-name ; easy (but rare) case
(let ((to (concat (file-name-directory from)
(funcall basename-constructor
(file-name-nondirectory from)))))
- (and (let ((help-form (format "\
+ (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))))
+ (downcase operation)
+ (downcase operation))))
(dired-query 'rename-non-directory-query
(concat operation " `%s' to `%s'")
(dired-make-relative from)
;; components are string-lessp.
;; Thus ("/usr/" "/usr/bin") and ("/usr/a/" "/usr/b/") are tree-lessp.
;; string-lessp could arguably be replaced by file-newer-than-file-p
- ;; if dired-actual-switches contained `t'.
+ ;; 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))
(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