;;; dired-aux.el --- less commonly used parts of dired -*-byte-compile-dynamic: t;-*-
-;; Copyright (C) 1985, 1986, 1992, 1994, 1998, 2000, 2001, 2004
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1992, 1994, 1998, 2000, 2001, 2002, 2003,
+;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
;; Maintainer: FSF
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Code:
;; We need macros in dired.el to compile properly.
-(eval-when-compile (require 'dired))
+(require 'dired)
+
+(defvar dired-create-files-failures nil
+ "Variable where `dired-create-files' records failing file names.
+Functions that operate recursively can store additional names
+into this list; they also should call `dired-log' to log the errors.")
;;; 15K
;;;###begin dired-cmd.el
\\[set-mark-command], not by Dired's \\[dired-mark] command.)
The prompted-for file is the first file given to `diff'.
With prefix arg, prompt for second argument SWITCHES,
- which is options for `diff'."
+which is options for `diff'."
(interactive
- (let ((default (if (mark t)
+ (let ((current (dired-get-filename t))
+ (default (if (mark t)
(save-excursion (goto-char (mark t))
(dired-get-filename t t)))))
+ (if (or (equal default current)
+ (and (not (equal (dired-dwim-target-directory)
+ (dired-current-directory)))
+ (not mark-active)))
+ (setq default nil))
(require 'diff)
- (list (read-file-name (format "Diff %s with: %s"
- (dired-get-filename t)
+ (list (read-file-name (format "Diff %s with%s: "
+ current
(if default
- (concat "(default " default ") ")
+ (concat " (default " default ")")
""))
(if default
(dired-current-directory)
nil))
(diff-backup (dired-get-filename) switches))
+;;;###autoload
(defun dired-compare-directories (dir2 predicate)
"Mark files with different file attributes in two dired buffers.
Compare file attributes of files in the current directory
with file attributes in directory DIR2 using PREDICATE on pairs of files
with the same name. Mark files for which PREDICATE returns non-nil.
Mark files with different names if PREDICATE is nil (or interactively
-when the user enters empty input at the predicate prompt).
+with empty input at the predicate prompt).
PREDICATE is a Lisp expression that can refer to the following variables:
(not (and (= (nth 2 fa1) (nth 2 fa2)) - mark files with different UID
(= (nth 3 fa1) (nth 3 fa2)))) and GID."
(interactive
- (list (read-file-name (format "Compare %s with: "
- (dired-current-directory))
- (dired-dwim-target-directory))
+ (list (read-directory-name (format "Compare %s with: "
+ (dired-current-directory))
+ (dired-dwim-target-directory)
+ (dired-dwim-target-directory))
(read-from-minibuffer "Mark if (lisp expr or RET): " nil nil t nil "nil")))
(let* ((dir1 (dired-current-directory))
(file-alist1 (dired-files-attributes dir1))
(file-alist2 (dired-files-attributes dir2))
- (file-list1 (mapcar
+ file-list1 file-list2)
+ (setq file-alist1 (delq (assoc "." file-alist1) file-alist1))
+ (setq file-alist1 (delq (assoc ".." file-alist1) file-alist1))
+ (setq file-alist2 (delq (assoc "." file-alist2) file-alist2))
+ (setq file-alist2 (delq (assoc ".." file-alist2) file-alist2))
+ (setq file-list1 (mapcar
'cadr
(dired-file-set-difference
file-alist1 file-alist2
- predicate)))
- (file-list2 (mapcar
+ predicate))
+ file-list2 (mapcar
'cadr
(dired-file-set-difference
file-alist2 file-alist1
- predicate))))
+ predicate)))
(dired-fun-in-all-buffers
dir1 nil
(lambda ()
(unless (let ((list list2))
(while (and list
(not (let* ((file2 (car list))
- (fa1 (caddr file1))
- (fa2 (caddr file2))
+ (fa1 (car (cddr file1)))
+ (fa2 (car (cddr file2)))
(size1 (nth 7 fa1))
(size2 (nth 7 fa2))
(mtime1 (float-time (nth 5 fa1)))
(setq base-version-list ; there was a base version to which
(assoc (substring fn 0 start-vn) ; this looks like a
dired-file-version-alist)) ; subversion
- (not (memq (string-to-int (substring fn (+ 2 start-vn)))
+ (not (memq (string-to-number (substring fn (+ 2 start-vn)))
base-version-list)) ; this one doesn't make the cut
(progn (beginning-of-line)
(delete-char 1)
in a subdir.
In a noninteractive call (from Lisp code), you must specify
-the list of file names explicitly with the FILE-LIST argument."
+the list of file names explicitly with the FILE-LIST argument, which
+can be produced by `dired-get-marked-files', for example."
;;Functions dired-run-shell-command and dired-shell-stuff-it do the
;;actual work and can be redefined for customization.
(interactive
(defun dired-do-kill-lines (&optional arg fmt)
"Kill all marked lines (not the files).
With a prefix argument, kill that many lines starting with the current line.
-\(A negative argument kills lines before the current line.)
-To kill an entire subdirectory, go to its directory header line
-and use this command with a prefix argument (the value does not matter)."
+\(A negative argument kills backward.)
+If you use this command with a prefix argument to kill the line
+for a file that is a directory, which you have inserted in the
+Dired buffer as a subdirectory, then it deletes that subdirectory
+from the buffer as well.
+To kill an entire subdirectory \(without killing its line in the
+parent directory), go to its directory header line and use this
+command with a prefix argument (the value does not matter)."
;; Returns count of killed lines. FMT="" suppresses message.
(interactive "P")
(if arg
(dired-kill-line arg))
(save-excursion
(goto-char (point-min))
- (let (buffer-read-only (count 0))
- (if (not arg) ; kill marked lines
- (let ((regexp (dired-marker-regexp)))
- (while (and (not (eobp))
- (re-search-forward regexp nil t))
- (setq count (1+ count))
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point)))))
- ;; else kill unmarked lines
- (while (not (eobp))
- (if (or (dired-between-files)
- (not (looking-at "^ ")))
- (forward-line 1)
- (setq count (1+ count))
- (delete-region (point) (save-excursion
- (forward-line 1)
- (point))))))
+ (let (buffer-read-only
+ (count 0)
+ (regexp (dired-marker-regexp)))
+ (while (and (not (eobp))
+ (re-search-forward regexp nil t))
+ (setq count (1+ count))
+ (delete-region (progn (beginning-of-line) (point))
+ (progn (forward-line 1) (point))))
(or (equal "" fmt)
(message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
count))))
;;; 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 (not (dired-check-process (concat "Compressing " file)
- "gzip" "-f" file))
- (let ((out-name
- (if (file-exists-p (concat file ".gz"))
- (concat file ".gz")
- (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)))
+ (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))
;; The files used are determined by ARG (as in dired-get-marked-files).
(or (eq dired-no-confirm t)
(memq op-symbol dired-no-confirm)
- (let ((files (dired-get-marked-files t arg))
+ ;; Pass t for DISTINGUISH-ONE-MARKED so that a single file which
+ ;; is marked pops up a window. That will help the user see
+ ;; it isn't the current line file.
+ (let ((files (dired-get-marked-files t arg nil t))
(string (if (eq op-symbol 'compress) "Compress or uncompress"
(capitalize (symbol-name op-symbol)))))
(dired-mark-pop-up nil op-symbol files (function y-or-n-p)
(sit-for 1)
(apply 'message qprompt qs-args)
(setq char (set qs-var (read-char))))
+ ;; Display the question with the answer.
+ (message "%s" (concat (apply 'format qprompt qs-args)
+ (char-to-string char)))
(memq (cdr elt) '(t y yes)))))))
\f
;;;###autoload
or delete subdirectories can bypass this machinery. Hence, you sometimes
may have to reset some subdirectory switches after a `dired-undo'.
You can reset all subdirectory switches to the default using
-\\<dired-mode-map>\\[dired-reset-subdir-switches]."
+\\<dired-mode-map>\\[dired-reset-subdir-switches].
+See Info node `(emacs)Subdir switches' for more details."
;; Moves point if the next ARG files are redisplayed.
(interactive "P\np")
(if (and test-for-subdir (dired-get-subdir))
\f
;;; Copy, move/rename, making hard and symbolic links
-(defcustom dired-recursive-copies nil
- "*Decide whether recursive copies are allowed.
-nil means no recursive copies.
-`always' means copy recursively without asking.
-`top' means ask for each directory at top level.
-Anything else means ask for each directory."
- :type '(choice :tag "Copy directories"
- (const :tag "No recursive copies" nil)
- (const :tag "Ask for each directory" t)
- (const :tag "Ask for each top directory only" top)
- (const :tag "Copy directories without asking" always))
- :group 'dired)
-
(defcustom dired-backup-overwrite nil
"*Non-nil if Dired should ask about making backups before overwriting files.
Special value `always' suppresses confirmation."
(other :tag "ask" t))
:group 'dired)
+;; This is a fluid var used in dired-handle-overwrite. It should be
+;; let-bound whenever dired-copy-file etc are called. See
+;; dired-create-files for an example.
(defvar dired-overwrite-confirmed)
(defun dired-handle-overwrite (to)
(setq backup (car (find-backup-file-name to)))
(or (eq 'always dired-backup-overwrite)
(dired-query 'overwrite-backup-query
- (format "Make backup for existing file `%s'? "
- to))))
+ "Make backup for existing file `%s'? "
+ to)))
(progn
(rename-file to backup 0) ; confirm overwrite of old backup
(dired-relist-entry backup)))))
;;;###autoload
(defun dired-copy-file (from to ok-flag)
(dired-handle-overwrite to)
- (condition-case ()
- (dired-copy-file-recursive from to ok-flag dired-copy-preserve-time t
- dired-recursive-copies)
- (file-date-error (message "Can't set date")
- (sit-for 1))))
+ (dired-copy-file-recursive from to ok-flag dired-copy-preserve-time t
+ dired-recursive-copies))
(defun dired-copy-file-recursive (from to ok-flag &optional
preserve-time top recursive)
- (if (and recursive
- (eq t (car (file-attributes from))) ; A directory, no symbolic link.
- (or (eq recursive 'always)
- (yes-or-no-p (format "Recursive copies of %s " from))))
- (let ((files (directory-files from nil dired-re-no-dot)))
- (if (eq recursive 'top) (setq recursive 'always)) ; Don't ask any more.
- (if (file-exists-p to)
- (or top (dired-handle-overwrite to))
- (make-directory to))
- (while files
- (dired-copy-file-recursive
- (expand-file-name (car files) from)
- (expand-file-name (car files) to)
- ok-flag preserve-time nil recursive)
- (setq files (cdr files))))
- (or top (dired-handle-overwrite to)) ; Just a file.
- (copy-file from to ok-flag dired-copy-preserve-time)))
+ (let ((attrs (file-attributes from))
+ dirfailed)
+ (if (and recursive
+ (eq t (car attrs))
+ (or (eq recursive 'always)
+ (yes-or-no-p (format "Recursive copies of %s? " from))))
+ ;; This is a directory.
+ (let ((mode (file-modes from))
+ (files
+ (condition-case err
+ (directory-files from nil dired-re-no-dot)
+ (file-error
+ (push (dired-make-relative from)
+ dired-create-files-failures)
+ (dired-log "Copying error for %s:\n%s\n" from err)
+ (setq dirfailed t)
+ nil))))
+ (if (eq recursive 'top) (setq recursive 'always)) ; Don't ask any more.
+ (unless dirfailed
+ (if (file-exists-p to)
+ (or top (dired-handle-overwrite to))
+ (condition-case err
+ ;; We used to call set-file-modes here, but on some
+ ;; Linux kernels, that returns an error on vfat
+ ;; filesystems
+ (let ((default-mode (default-file-modes)))
+ (unwind-protect
+ (progn
+ (set-default-file-modes #o700)
+ (make-directory to))
+ (set-default-file-modes default-mode)))
+ (file-error
+ (push (dired-make-relative from)
+ dired-create-files-failures)
+ (setq files nil)
+ (dired-log "Copying error for %s:\n%s\n" from err)))))
+ (dolist (file files)
+ (let ((thisfrom (expand-file-name file from))
+ (thisto (expand-file-name file to)))
+ ;; Catch errors copying within a directory,
+ ;; and report them through the dired log mechanism
+ ;; just as our caller will do for the top level files.
+ (condition-case err
+ (dired-copy-file-recursive
+ thisfrom thisto
+ ok-flag preserve-time nil recursive)
+ (file-error
+ (push (dired-make-relative thisfrom)
+ dired-create-files-failures)
+ (dired-log "Copying error for %s:\n%s\n" thisfrom err)))))
+ (when (file-directory-p to)
+ (set-file-modes to mode)))
+ ;; Not a directory.
+ (or top (dired-handle-overwrite to))
+ (condition-case err
+ (if (stringp (car attrs))
+ ;; It is a symlink
+ (make-symbolic-link (car attrs) to ok-flag)
+ (copy-file from to ok-flag dired-copy-preserve-time))
+ (file-date-error
+ (push (dired-make-relative from)
+ dired-create-files-failures)
+ (dired-log "Can't set date on %s:\n%s\n" from err))))))
;;;###autoload
(defun dired-rename-file (file newname ok-if-already-exists)
;; newfile's entry, or t to use the current marker character if the
;; oldfile was marked.
- (let (failures skipped (success-count 0) (total (length fn-list)))
+ (let (dired-create-files-failures failures
+ skipped (success-count 0) (total (length fn-list)))
(let (to overwrite-query
overwrite-backup-query) ; for dired-handle-overwrite
(mapcar
(dired-add-file to actual-marker-char))
(file-error ; FILE-CREATOR aborted
(progn
- (setq failures (cons (dired-make-relative from) failures))
+ (push (dired-make-relative from)
+ failures)
(dired-log "%s `%s' to `%s' failed:\n%s\n"
operation from to err))))))))
fn-list))
(cond
+ (dired-create-files-failures
+ (setq failures (nconc failures dired-create-files-failures))
+ (dired-log-summary
+ (format "%s failed for %d file%s in %d requests"
+ operation (length failures)
+ (dired-plural-s (length failures))
+ total)
+ failures))
(failures
(dired-log-summary
(format "%s failed for %d of %d file%s"
- operation (length failures) total
- (dired-plural-s total))
+ operation (length failures)
+ total (dired-plural-s total))
failures))
(skipped
(dired-log-summary
and new copies of these files are made in that directory
with the same names that the files currently have. The default
suggested for the target directory depends on the value of
-`dired-dwim-target', which see."
+`dired-dwim-target', which see.
+
+This command copies symbolic links by creating new ones,
+like `cp -d'."
(interactive "P")
(let ((dired-recursive-copies dired-recursive-copies))
(dired-do-create-files 'copy (function dired-copy-file)
- (if dired-copy-preserve-time "Copy [-p]" "Copy")
+ "Copy"
arg dired-keep-marker-copy
nil dired-copy-how-to-fn)))
and new symbolic links are made in that directory
with the same names that the files currently have. The default
suggested for the target directory depends on the value of
-`dired-dwim-target', which see."
+`dired-dwim-target', which see.
+
+For relative symlinks, use \\[dired-do-relsymlink]."
(interactive "P")
(dired-do-create-files 'symlink (function make-symbolic-link)
"Symlink" arg dired-keep-marker-symlink))
or delete subdirectories can bypass this machinery. Hence, you sometimes
may have to reset some subdirectory switches after a `dired-undo'.
You can reset all subdirectory switches to the default using
-\\<dired-mode-map>\\[dired-reset-subdir-switches]."
+\\<dired-mode-map>\\[dired-reset-subdir-switches].
+See Info node `(emacs)Subdir switches' for more details."
(interactive
(list (dired-get-filename)
(if current-prefix-arg
(defun dired-tree-lessp (dir1 dir2)
;; Lexicographic order on file name components, like `ls -lR':
- ;; DIR1 < DIR2 iff DIR1 comes *before* DIR2 in an `ls -lR' listing,
- ;; i.e., iff DIR1 is a (grand)parent dir of DIR2,
+ ;; DIR1 < DIR2 if DIR1 comes *before* DIR2 in an `ls -lR' listing,
+ ;; i.e., if DIR1 is a (grand)parent dir of DIR2,
;; or DIR1 and DIR2 are in the same parentdir and their last
;; components are string-lessp.
;; Thus ("/usr/" "/usr/bin") and ("/usr/a/" "/usr/b/") are tree-lessp.
If you exit (\\[keyboard-quit], RET or q), you can resume the query replace
with the command \\[tags-loop-continue]."
(interactive
- "sQuery replace in marked files (regexp): \nsQuery replace %s by: \nP")
+ (let ((common
+ (query-replace-read-args
+ "Query replace regexp in marked files" t t)))
+ (list (nth 0 common) (nth 1 common) (nth 2 common))))
(dolist (file (dired-get-marked-files nil nil 'dired-nondirectory-p))
(let ((buffer (get-file-buffer file)))
(if (and buffer (with-current-buffer buffer