;;; 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 Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
;; Maintainer: FSF
;; 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:
\\[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
;;; 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
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].
-See Info node `(emacs-xtra)Subdir switches' for more details."
+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."
(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)))))
(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)))
+ (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 ((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))))
+ ;; Not a directory.
+ (or top (dired-handle-overwrite to))
+ (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)))))
;;;###autoload
(defun dired-rename-file (file newname ok-if-already-exists)
(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)))
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].
-See Info node `(emacs-xtra)Subdir switches' for more details."
+See Info node `(emacs)Subdir switches' for more details."
(interactive
(list (dired-get-filename)
(if current-prefix-arg
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
HCoop / bpt / emacs.git / blobdiff