;;; dired-aux.el --- less commonly used parts of dired
;; Copyright (C) 1985, 1986, 1992, 1994, 1998, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
;; Maintainer: FSF
With prefix arg, prompt for second argument SWITCHES,
which is options for `diff'."
(interactive
- (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))
+ (let* ((current (dired-get-filename t))
+ ;; Get the file at the mark.
+ (file-at-mark (if (mark t)
+ (save-excursion (goto-char (mark t))
+ (dired-get-filename t t))))
+ ;; Use it as default if it's not the same as the current file,
+ ;; and the target dir is the current dir or the mark is active.
+ (default (if (and (not (equal file-at-mark current))
+ (or (equal (dired-dwim-target-directory)
+ (dired-current-directory))
+ mark-active))
+ file-at-mark))
+ (target-dir (if default
+ (dired-current-directory)
+ (dired-dwim-target-directory)))
+ (defaults (dired-dwim-target-defaults (list current) target-dir)))
(require 'diff)
- (list (read-file-name (format "Diff %s with%s: "
- current
- (if default
- (concat " (default " default ")")
- ""))
- (if default
- (dired-current-directory)
- (dired-dwim-target-directory))
- default t)
- (if current-prefix-arg
- (read-string "Options for diff: "
- (if (stringp diff-switches)
- diff-switches
- (mapconcat 'identity diff-switches " ")))))))
- (diff file (dired-get-filename t) switches))
+ (list
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (set (make-local-variable 'minibuffer-default-add-function) nil)
+ (setq minibuffer-default defaults))
+ (read-file-name
+ (format "Diff %s with%s: " current
+ (if default (format " (default %s)" default) ""))
+ target-dir default t))
+ (if current-prefix-arg
+ (read-string "Options for diff: "
+ (if (stringp diff-switches)
+ diff-switches
+ (mapconcat 'identity diff-switches " ")))))))
+ (let ((current (dired-get-filename t)))
+ (when (or (equal (expand-file-name file)
+ (expand-file-name current))
+ (and (file-directory-p file)
+ (equal (expand-file-name current file)
+ (expand-file-name current))))
+ (error "Attempt to compare the file to itself"))
+ (diff file current switches)))
;;;###autoload
(defun dired-backup-diff (&optional switches)
(not (and (= (nth 2 fa1) (nth 2 fa2)) - mark files with different UID
(= (nth 3 fa1) (nth 3 fa2)))) and GID."
(interactive
- (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")))
+ (list
+ (let* ((target-dir (dired-dwim-target-directory))
+ (defaults (dired-dwim-target-defaults nil target-dir)))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (set (make-local-variable 'minibuffer-default-add-function) nil)
+ (setq minibuffer-default defaults))
+ (read-directory-name (format "Compare %s with: "
+ (dired-current-directory))
+ target-dir target-dir t)))
+ (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))
("\\.dz\\'" "" "dictunzip")
("\\.tbz\\'" ".tar" "bunzip2")
("\\.bz2\\'" "" "bunzip2")
+ ("\\.xz\\'" "" "unxz")
;; This item controls naming for compression.
("\\.tar\\'" ".tgz" nil))
"Control changes in file name suffixes for compression and uncompression.
((eq 'no action)
nil) ; skip, and don't ask again
(t;; no lasting effects from last time we asked - ask now
- (let ((qprompt (concat qs-prompt
+ (let ((cursor-in-echo-area t)
+ (executing-kbd-macro executing-kbd-macro)
+ (qprompt (concat qs-prompt
(if help-form
(format " [Type yn!q or %s] "
(key-description
(char-to-string help-char)))
" [Type y, n, q or !] ")))
- result elt)
- ;; Actually it looks nicer without cursor-in-echo-area - you can
- ;; look at the dired buffer instead of at the prompt to decide.
- (apply 'message qprompt qs-args)
- (while (progn (setq char (set qs-var (read-key)))
- (not (setq elt (assoc char dired-query-alist))))
- (message "Invalid key - type %c for help." help-char)
- (ding)
- (sit-for 1)
- (apply 'message qprompt qs-args))
+ done result elt)
+ (while (not done)
+ (apply 'message qprompt qs-args)
+ (setq char (set qs-var (read-event)))
+ (if (numberp char)
+ (cond ((and executing-kbd-macro (= char -1))
+ ;; read-event returns -1 if we are in a kbd
+ ;; macro and there are no more events in the
+ ;; macro. Attempt to get an event
+ ;; interactively.
+ (setq executing-kbd-macro nil))
+ ((eq (key-binding (vector char)) 'keyboard-quit)
+ (keyboard-quit))
+ (t
+ (setq done (setq elt (assoc char
+ dired-query-alist)))))))
;; Display the question with the answer.
(message "%s" (concat (apply 'format qprompt qs-args)
- (char-to-string char)))
+ (char-to-string char)))
(memq (cdr elt) '(t y yes)))))))
\f
;;;###autoload
(or (eq recursive 'always)
(yes-or-no-p (format "Recursive copies of %s? " from))))
;; This is a directory.
- (let ((mode (or (file-modes from) #o700))
- (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)))
+ (copy-directory from to dired-copy-preserve-time)
;; Not a directory.
(or top (dired-handle-overwrite to))
(condition-case err
(let ((expanded-from-dir (expand-file-name from-dir))
(blist (buffer-list)))
(while blist
- (save-excursion
- (set-buffer (car blist))
+ (with-current-buffer (car blist)
(if (and buffer-file-name
(dired-in-this-tree buffer-file-name expanded-from-dir))
(let ((modflag (buffer-modified-p))
(default (and dired-one-file
(expand-file-name (file-name-nondirectory (car fn-list))
target-dir)))
+ (defaults (dired-dwim-target-defaults fn-list target-dir))
(target (expand-file-name ; fluid variable inside dired-create-files
- (dired-mark-read-file-name
- (concat (if dired-one-file op1 operation) " %s to: ")
- target-dir op-symbol arg rfn-list default)))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (set (make-local-variable 'minibuffer-default-add-function) nil)
+ (setq minibuffer-default defaults))
+ (dired-mark-read-file-name
+ (concat (if dired-one-file op1 operation) " %s to: ")
+ target-dir op-symbol arg rfn-list default))))
(into-dir (cond ((null how-to)
;; Allow DOS/Windows users to change the letter
;; case of a directory. If we don't test these
(defun dired-dwim-target-directory ()
;; Try to guess which target directory the user may want.
- ;; If there is a dired buffer displayed in the next window, use
- ;; its current subdir, else use current subdir of this dired buffer.
+ ;; If there is a dired buffer displayed in one of the next windows,
+ ;; use its current subdir, else use current subdir of this dired buffer.
(let ((this-dir (and (eq major-mode 'dired-mode)
(dired-current-directory))))
;; non-dired buffer may want to profit from this function, e.g. vm-uudecode
(if dired-dwim-target
- (let* ((other-buf (window-buffer (next-window)))
- (other-dir (save-excursion
- (set-buffer other-buf)
- (and (eq major-mode 'dired-mode)
- (dired-current-directory)))))
+ (let* ((other-win (get-window-with-predicate
+ (lambda (window)
+ (with-current-buffer (window-buffer window)
+ (eq major-mode 'dired-mode)))))
+ (other-dir (and other-win
+ (with-current-buffer (window-buffer other-win)
+ (and (eq major-mode 'dired-mode)
+ (dired-current-directory))))))
(or other-dir this-dir))
this-dir)))
+
+(defun dired-dwim-target-defaults (fn-list target-dir)
+ ;; Return a list of default values for file-reading functions in Dired.
+ ;; This list may contain directories from Dired buffers in other windows.
+ ;; `fn-list' is a list of file names used to build a list of defaults.
+ ;; When nil or more than one element, a list of defaults will
+ ;; contain only directory names. `target-dir' is a directory name
+ ;; to exclude from the returned list, for the case when this
+ ;; directory name is already presented in initial input.
+ ;; For Dired operations that support `dired-dwim-target',
+ ;; the argument `target-dir' should have the value returned
+ ;; from `dired-dwim-target-directory'.
+ (let ((dired-one-file
+ (and (consp fn-list) (null (cdr fn-list)) (car fn-list)))
+ (current-dir (and (eq major-mode 'dired-mode)
+ (dired-current-directory)))
+ dired-dirs)
+ ;; Get a list of directories of visible buffers in dired-mode.
+ (walk-windows (lambda (w)
+ (with-current-buffer (window-buffer w)
+ (and (eq major-mode 'dired-mode)
+ (push (dired-current-directory) dired-dirs)))))
+ ;; Force the current dir to be the first in the list.
+ (setq dired-dirs
+ (delete-dups (delq nil (cons current-dir (nreverse dired-dirs)))))
+ ;; Remove the target dir (if specified) or the current dir from
+ ;; default values, because it should be already in initial input.
+ (setq dired-dirs (delete (or target-dir current-dir) dired-dirs))
+ ;; Return a list of default values.
+ (if dired-one-file
+ ;; For one file operation, provide a list that contains
+ ;; other directories, other directories with the appended filename
+ ;; and the current directory with the appended filename, e.g.
+ ;; 1. /TARGET-DIR/
+ ;; 2. /TARGET-DIR/FILENAME
+ ;; 3. /CURRENT-DIR/FILENAME
+ (append dired-dirs
+ (mapcar (lambda (dir)
+ (expand-file-name
+ (file-name-nondirectory (car fn-list)) dir))
+ (reverse dired-dirs))
+ (list (expand-file-name
+ (file-name-nondirectory (car fn-list))
+ (or target-dir current-dir))))
+ ;; For multi-file operation, return only a list of other directories.
+ dired-dirs)))
+
\f
;;;###autoload
(defun dired-create-directory (directory)
(restore-buffer-modified-p modflag)))
;;;###autoload
-(defun dired-hide-all (arg)
+(defun dired-hide-all (&optional ignored)
"Hide all subdirectories, leaving only their header lines.
If there is already something hidden, make everything visible again.
Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."