-;;; dired-aux.el --- less commonly used parts of dired -*-byte-compile-dynamic: t;-*-
+;;; 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 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2011
+;; Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
;; Maintainer: FSF
;; Keywords: files
+;; Package: emacs
;; This file is part of GNU Emacs.
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))
(defun dired-files-attributes (dir)
"Return a list of all file names and attributes from DIR.
-List has a form of (file-name full-file-name (attribute-list))"
+List has a form of (file-name full-file-name (attribute-list))."
(mapcar
(lambda (file-name)
(let ((full-file-name (expand-file-name file-name dir)))
(funcall fun file))))
(forward-line 1)))))
+(defvar backup-extract-version-start) ; used in backup-extract-version
+
(defun dired-collect-file-versions (fn)
(let ((fn (file-name-sans-versions fn)))
;; Only do work if this file is not already in the alist.
(declare-function mailcap-file-default-commands "mailcap" (files))
(defun minibuffer-default-add-dired-shell-commands ()
- "Return a list of all commands associted with current dired files.
-This function is used to add all related commands retieved by `mailcap'
+ "Return a list of all commands associated with current dired files.
+This function is used to add all related commands retrieved by `mailcap'
to the end of the list of defaults just after the default value."
(interactive)
(let ((commands (and (boundp 'files) (require 'mailcap nil t)
;; This is an extra function so that you can redefine it, e.g., to use gmhist.
(defun dired-read-shell-command (prompt arg files)
- "Read a dired shell command prompting with PROMPT (using read-shell-command).
-ARG is the prefix arg and may be used to indicate in the prompt which
-FILES are affected."
+ "Read a dired shell command prompting with PROMPT.
+Passes the prefix argument ARG to `dired-mark-prompt', so that it
+can be used in the prompt to indicate which FILES are affected.
+Normally reads the command with `read-shell-command', but if the
+`dired-x' packages is loaded, uses `dired-guess-shell-command' to offer
+a smarter default choice of shell command."
(minibuffer-with-setup-hook
(lambda ()
(set (make-local-variable 'minibuffer-default-add-function)
'minibuffer-default-add-dired-shell-commands))
- (dired-mark-pop-up
- nil 'shell files
- #'read-shell-command
- (format prompt (dired-mark-prompt arg files))
- nil nil)))
+ (setq prompt (format prompt (dired-mark-prompt arg files)))
+ (if (featurep 'dired-x)
+ (dired-mark-pop-up nil 'shell files
+ #'dired-guess-shell-command prompt files)
+ (dired-mark-pop-up nil 'shell files
+ #'read-shell-command prompt nil nil))))
;;;###autoload
(defun dired-do-async-shell-command (command &optional arg file-list)
there's no telling what files COMMAND may have changed.
Type \\[dired-do-redisplay] to redisplay the marked files.
-When COMMAND runs, its working directory is the top-level directory of
-the Dired buffer, so output files usually are created there instead of
-in a subdir.
+When COMMAND runs, its working directory is the top-level directory
+of the Dired buffer, so output files usually are created there
+instead of in a subdir.
In a noninteractive call (from Lisp code), you must specify
the list of file names explicitly with the FILE-LIST argument, which
(defvar dired-mark-separator " "
"Separates marked files in dired shell commands.")
-(defun dired-shell-stuff-it (command file-list on-each &optional raw-arg)
+(defun dired-shell-stuff-it (command file-list on-each &optional _raw-arg)
;; "Make up a shell command line from COMMAND and FILE-LIST.
;; If ON-EACH is t, COMMAND should be applied to each file, else
;; simply concat all files and apply COMMAND to this.
(save-excursion (and file
(dired-goto-subdir file)
(dired-kill-subdir)))
- (delete-region (progn (beginning-of-line) (point))
+ (delete-region (line-beginning-position)
(progn (forward-line 1) (point)))
(if (> arg 0)
(setq arg (1- arg))
(while (and (not (eobp))
(re-search-forward regexp nil t))
(setq count (1+ count))
- (delete-region (progn (beginning-of-line) (point))
+ (delete-region (line-beginning-position)
(progn (forward-line 1) (point))))
(or (equal "" fmt)
(message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
("\\.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.
(downcase string) count total (dired-plural-s total))
failures)))))
-(defvar dired-query-alist
- '((?\y . y) (?\040 . y) ; `y' or SPC means accept once
- (?n . n) (?\177 . n) ; `n' or DEL skips once
- (?! . yes) ; `!' accepts rest
- (?q . no) (?\e . no) ; `q' or ESC skips rest
- ;; None of these keys quit - use C-g for that.
- ))
-
;;;###autoload
-(defun dired-query (qs-var qs-prompt &rest qs-args)
- ;; Query user and return nil or t.
- ;; Store answer in symbol VAR (which must initially be bound to nil).
- ;; Format PROMPT with ARGS.
- ;; Binding variable help-form will help the user who types the help key.
- (let* ((char (symbol-value qs-var))
- (action (cdr (assoc char dired-query-alist))))
- (cond ((eq 'yes action)
- t) ; accept, and don't ask again
- ((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
- (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)
- (setq char (set qs-var (read-char)))
- (while (not (setq elt (assoc char dired-query-alist)))
- (message "Invalid char - type %c for help." help-char)
- (ding)
- (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)))))))
+(defun dired-query (sym prompt &rest args)
+ "Format PROMPT with ARGS, query user, and store the result in SYM.
+The return value is either nil or t.
+
+The user may type y or SPC to accept once; n or DEL to skip once;
+! to accept this and subsequent queries; or q or ESC to decline
+this and subsequent queries.
+
+If SYM is already bound to a non-nil value, this function may
+return automatically without querying the user. If SYM is !,
+return t; if SYM is q or ESC, return nil."
+ (let* ((char (symbol-value sym))
+ (char-choices '(?y ?\s ?n ?\177 ?! ?q ?\e)))
+ (cond ((eq char ?!)
+ t) ; accept, and don't ask again
+ ((memq char '(?q ?\e))
+ nil) ; skip, and don't ask again
+ (t ; no previous answer - ask now
+ (setq prompt
+ (concat (apply 'format prompt args)
+ (if help-form
+ (format " [Type yn!q or %s] "
+ (key-description
+ (char-to-string help-char)))
+ " [Type y, n, q or !] ")))
+ (set sym (setq char (read-char-choice prompt char-choices)))
+ (if (memq char '(?y ?\s ?!)) t)))))
+
\f
;;;###autoload
(defun dired-do-compress (&optional arg)
;; message much faster than making dired-map-over-marks show progress
(dired-uncache
(if (consp dired-directory) (car dired-directory) dired-directory))
- (dired-map-over-marks (let ((fname (dired-get-filename)))
+ (dired-map-over-marks (let ((fname (dired-get-filename))
+ ;; Postphone readin hook till we map
+ ;; over all marked files (Bug#6810).
+ (dired-after-readin-hook nil))
(message "Redisplaying... %s" fname)
(dired-update-file-line fname))
arg)
+ (run-hooks 'dired-after-readin-hook)
(dired-move-to-filename)
(message "Redisplaying...done")))
;; Keeps any marks that may be present in column one (doing this
;; here is faster than with dired-add-entry's optional arg).
;; Does not update other dired buffers. Use dired-relist-entry for that.
- (beginning-of-line)
- (let ((char (following-char)) (opoint (point))
- (buffer-read-only))
- (delete-region (point) (progn (forward-line 1) (point)))
+ (let* ((opoint (line-beginning-position))
+ (char (char-after opoint))
+ (buffer-read-only))
+ (delete-region opoint (progn (forward-line 1) (point)))
(if file
(progn
(dired-add-entry file nil t)
(file-name-directory filename) (file-name-nondirectory filename)
(function dired-add-entry) filename marker-char))
+(defvar dired-omit-mode)
+(declare-function dired-omit-regexp "dired-x" ())
+(defvar dired-omit-localp)
+
(defun dired-add-entry (filename &optional marker-char relative)
- ;; Add a new entry for FILENAME, optionally marking it
- ;; with MARKER-CHAR (a character, else dired-marker-char is used).
- ;; Note that this adds the entry `out of order' if files sorted by
- ;; time, etc.
- ;; At least this version inserts in the right subdirectory (if present).
- ;; And it skips "." or ".." (see `dired-trivial-filenames').
- ;; Hidden subdirs are exposed if a file is added there.
- (setq filename (directory-file-name filename))
- ;; Entry is always for files, even if they happen to also be directories
- (let* ((opoint (point))
- (cur-dir (dired-current-directory))
- (orig-file-name filename)
- (directory (if relative cur-dir (file-name-directory filename)))
- reason)
- (setq filename
- (if relative
- (file-relative-name filename directory)
- (file-name-nondirectory filename))
- reason
- (catch 'not-found
- (if (string= directory cur-dir)
- (progn
- (skip-chars-forward "^\r\n")
- (if (eq (following-char) ?\r)
- (dired-unhide-subdir))
- ;; We are already where we should be, except when
- ;; point is before the subdir line or its total line.
- (let ((p (dired-after-subdir-garbage cur-dir)))
- (if (< (point) p)
- (goto-char p))))
- ;; else try to find correct place to insert
- (if (dired-goto-subdir directory)
- (progn ;; unhide if necessary
- (if (looking-at "\r") ;; point is at end of subdir line
- (dired-unhide-subdir))
- ;; found - skip subdir and `total' line
- ;; and uninteresting files like . and ..
- ;; This better not moves into the next subdir!
- (dired-goto-next-nontrivial-file))
- ;; not found
- (throw 'not-found "Subdir not found")))
- (let (buffer-read-only opoint)
- (beginning-of-line)
- (setq opoint (point))
- ;; Don't expand `.'. Show just the file name within directory.
- (let ((default-directory directory))
- (dired-insert-directory directory
- (concat dired-actual-switches "d")
- (list filename)))
- (goto-char opoint)
- ;; Put in desired marker char.
- (when marker-char
- (let ((dired-marker-char
- (if (integerp marker-char) marker-char dired-marker-char)))
- (dired-mark nil)))
- ;; Compensate for a bug in ange-ftp.
- ;; It inserts the file's absolute name, rather than
- ;; the relative one. That may be hard to fix since it
- ;; is probably controlled by something in ftp.
- (goto-char opoint)
- (let ((inserted-name (dired-get-filename 'verbatim)))
- (if (file-name-directory inserted-name)
- (let (props)
- (end-of-line)
- (forward-char (- (length inserted-name)))
- (setq props (text-properties-at (point)))
- (delete-char (length inserted-name))
- (let ((pt (point)))
- (insert filename)
- (set-text-properties pt (point) props))
- (forward-char 1))
- (forward-line 1)))
- (forward-line -1)
- (if dired-after-readin-hook ;; the subdir-alist is not affected...
- (save-excursion ;; ...so we can run it right now:
- (save-restriction
- (beginning-of-line)
- (narrow-to-region (point) (save-excursion
- (forward-line 1) (point)))
- (run-hooks 'dired-after-readin-hook))))
- (dired-move-to-filename))
- ;; return nil if all went well
- nil))
- (if reason ; don't move away on failure
- (goto-char opoint))
- (not reason))) ; return t on success, nil else
+ "Add a new dired entry for FILENAME.
+Optionally mark it with MARKER-CHAR (a character, else uses
+`dired-marker-char'). Note that this adds the entry `out of order'
+if files are sorted by time, etc.
+Skips files that match `dired-trivial-filenames'.
+Exposes hidden subdirectories if a file is added there.
+
+If `dired-x' is loaded and `dired-omit-mode' is enabled, skips
+files matching `dired-omit-regexp'."
+ (if (or (not (featurep 'dired-x))
+ (not dired-omit-mode)
+ ;; Avoid calling ls for files that are going to be omitted anyway.
+ (let ((omit-re (dired-omit-regexp)))
+ (or (string= omit-re "")
+ (not (string-match omit-re
+ (cond
+ ((eq 'no-dir dired-omit-localp)
+ filename)
+ ((eq t dired-omit-localp)
+ (dired-make-relative filename))
+ (t
+ (dired-make-absolute
+ filename
+ (file-name-directory filename)))))))))
+ ;; Do it!
+ (progn
+ (setq filename (directory-file-name filename))
+ ;; Entry is always for files, even if they happen to also be directories
+ (let* ((opoint (point))
+ (cur-dir (dired-current-directory))
+ (directory (if relative cur-dir (file-name-directory filename)))
+ reason)
+ (setq filename
+ (if relative
+ (file-relative-name filename directory)
+ (file-name-nondirectory filename))
+ reason
+ (catch 'not-found
+ (if (string= directory cur-dir)
+ (progn
+ (skip-chars-forward "^\r\n")
+ (if (eq (following-char) ?\r)
+ (dired-unhide-subdir))
+ ;; We are already where we should be, except when
+ ;; point is before the subdir line or its total line.
+ (let ((p (dired-after-subdir-garbage cur-dir)))
+ (if (< (point) p)
+ (goto-char p))))
+ ;; else try to find correct place to insert
+ (if (dired-goto-subdir directory)
+ (progn ;; unhide if necessary
+ (if (looking-at "\r")
+ ;; Point is at end of subdir line.
+ (dired-unhide-subdir))
+ ;; found - skip subdir and `total' line
+ ;; and uninteresting files like . and ..
+ ;; This better not move into the next subdir!
+ (dired-goto-next-nontrivial-file))
+ ;; not found
+ (throw 'not-found "Subdir not found")))
+ (let (buffer-read-only opoint)
+ (beginning-of-line)
+ (setq opoint (point))
+ ;; Don't expand `.'.
+ ;; Show just the file name within directory.
+ (let ((default-directory directory))
+ (dired-insert-directory
+ directory
+ (concat dired-actual-switches " -d")
+ (list filename)))
+ (goto-char opoint)
+ ;; Put in desired marker char.
+ (when marker-char
+ (let ((dired-marker-char
+ (if (integerp marker-char) marker-char
+ dired-marker-char)))
+ (dired-mark nil)))
+ ;; Compensate for a bug in ange-ftp.
+ ;; It inserts the file's absolute name, rather than
+ ;; the relative one. That may be hard to fix since it
+ ;; is probably controlled by something in ftp.
+ (goto-char opoint)
+ (let ((inserted-name (dired-get-filename 'verbatim)))
+ (if (file-name-directory inserted-name)
+ (let (props)
+ (end-of-line)
+ (forward-char (- (length inserted-name)))
+ (setq props (text-properties-at (point)))
+ (delete-char (length inserted-name))
+ (let ((pt (point)))
+ (insert filename)
+ (set-text-properties pt (point) props))
+ (forward-char 1))
+ (forward-line 1)))
+ (forward-line -1)
+ (if dired-after-readin-hook
+ ;; The subdir-alist is not affected...
+ (save-excursion ; ...so we can run it right now:
+ (save-restriction
+ (beginning-of-line)
+ (narrow-to-region (point)
+ (line-beginning-position 2))
+ (run-hooks 'dired-after-readin-hook))))
+ (dired-move-to-filename))
+ ;; return nil if all went well
+ nil))
+ (if reason ; don't move away on failure
+ (goto-char opoint))
+ (not reason))) ; return t on success, nil else
+ ;; Don't do it (dired-omit-mode).
+ ;; Return t for success (perhaps we should return file-exists-p).
+ t))
(defun dired-after-subdir-garbage (dir)
;; Return pos of first file line of DIR, skipping header and total
(and (dired-goto-file file)
(let (buffer-read-only)
(delete-region (progn (beginning-of-line) (point))
- (save-excursion (forward-line 1) (point)))))))
+ (line-beginning-position 2))))))
;;;###autoload
(defun dired-relist-file (file)
(delete-region (progn (beginning-of-line)
(setq marker (following-char))
(point))
- (save-excursion (forward-line 1) (point))))
+ (line-beginning-position 2)))
(setq file (directory-file-name file))
(dired-add-entry file (if (eq ?\040 marker) nil marker)))))
\f
;;; Copy, move/rename, making hard and symbolic links
(defcustom dired-backup-overwrite nil
- "*Non-nil if Dired should ask about making backups before overwriting files.
+ "Non-nil if Dired should ask about making backups before overwriting files.
Special value `always' suppresses confirmation."
:type '(choice (const :tag "off" nil)
(const :tag "suppress" always)
(defun dired-copy-file-recursive (from to ok-flag &optional
preserve-time top recursive)
- (let ((attrs (file-attributes from))
- dirfailed)
+ (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 ((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)))
+ (copy-directory from to preserve-time)
;; 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))
+ (copy-file from to ok-flag preserve-time))
(file-date-error
(push (dired-make-relative from)
dired-create-files-failures)
(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))
(setcar elt cur-dir)
(when cons (setcar cons cur-dir))))))
\f
+;; Bound in dired-create-files
+(defvar overwrite-query)
+(defvar overwrite-backup-query)
+
;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
(defun dired-create-files (file-creator operation fn-list name-constructor
&optional marker-char)
+ "Create one or more new files from a list of existing files FN-LIST.
+This function also handles querying the user, updating Dired
+buffers, and displaying a success or failure message.
-;; Create a new file for each from a list of existing files. The user
-;; is queried, dired buffers are updated, and at the end a success or
-;; failure message is displayed
+FILE-CREATOR should be a function. It is called once for each
+file in FN-LIST, and must create a new file, querying the user
+and updating Dired buffers as necessary. It should accept three
+arguments: the old file name, the new name, and an argument
+OK-IF-ALREADY-EXISTS with the same meaning as in `copy-file'.
-;; FILE-CREATOR must accept three args: oldfile newfile ok-if-already-exists
+OPERATION should be a capitalized string describing the operation
+performed (e.g. `Copy'). It is used for error logging.
-;; It is called for each file and must create newfile, the entry of
-;; which will be added. The user will be queried if the file already
-;; exists. If oldfile is removed by FILE-CREATOR (i.e, it is a
-;; rename), it is FILE-CREATOR's responsibility to update dired
-;; buffers. FILE-CREATOR must abort by signaling a file-error if it
-;; could not create newfile. The error is caught and logged.
+FN-LIST is the list of files to copy (full absolute file names).
-;; OPERATION (a capitalized string, e.g. `Copy') describes the
-;; operation performed. It is used for error logging.
-
-;; FN-LIST is the list of files to copy (full absolute file names).
-
-;; NAME-CONSTRUCTOR returns a newfile for every oldfile, or nil to
-;; skip. If it skips files for other reasons than a direct user
-;; query, it is supposed to tell why (using dired-log).
-
-;; Optional MARKER-CHAR is a character with which to mark every
-;; newfile's entry, or t to use the current marker character if the
-;; oldfile was marked.
+NAME-CONSTRUCTOR should be a function accepting a single
+argument, the name of an old file, and returning either the
+corresponding new file name or nil to skip.
+Optional MARKER-CHAR is a character with which to mark every
+newfile's entry, or t to use the current marker character if the
+old file was marked."
(let (dired-create-files-failures failures
skipped (success-count 0) (total (length fn-list)))
(let (to overwrite-query
(cond ((integerp marker-char) marker-char)
(marker-char (dired-file-marker from)) ; slow
(t nil))))
+ (when (and (file-directory-p from)
+ (file-directory-p to)
+ (eq file-creator 'dired-copy-file))
+ (setq to (file-name-directory to)))
(condition-case err
(progn
(funcall file-creator from to dired-overwrite-confirmed)
(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
(function
(lambda (from)
(expand-file-name (file-name-nondirectory from) target)))
- (function (lambda (from) target)))
+ (function (lambda (_from) target)))
marker-char))))
;; Read arguments for a marked-files command that wants a file name,
(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)
- "Create a directory called DIRECTORY."
+ "Create a directory called DIRECTORY.
+If DIRECTORY already exists, signal an error."
(interactive
(list (read-file-name "Create directory: " (dired-current-directory))))
(let* ((expanded (directory-file-name (expand-file-name directory)))
(try expanded) new)
+ (if (file-exists-p expanded)
+ (error "Cannot create directory %s: file exists" expanded))
;; Find the topmost nonexistent parent dir (variable `new')
(while (and try (not (file-exists-p try)) (not (equal new try)))
(setq new try
;; symlinks.
(defvar dired-copy-how-to-fn nil
- "nil or a function used by `dired-do-copy' to determine target.
+ "Either nil or a function used by `dired-do-copy' to determine target.
See HOW-TO argument for `dired-do-create-files'.")
;;;###autoload
\f
;;; 5K
;;;###begin dired-re.el
+(defvar rename-regexp-query)
+
(defun dired-do-create-files-regexp
(file-creator operation arg regexp newname &optional whole-name marker-char)
;; Create a new file for each marked file using regexps.
;; instead of only the non-directory part of the file.
;; Optional arg MARKER-CHAR as in dired-create-files.
(let* ((fn-list (dired-get-marked-files nil arg))
- (fn-count (length fn-list))
(operation-prompt (concat operation " `%s' to `%s'?"))
(rename-regexp-help-form (format "\
Type SPC or `y' to %s one match, DEL or `n' to skip to next,
(function make-symbolic-link)
"SymLink" arg regexp newname whole-name dired-keep-marker-symlink))
+(defvar rename-non-directory-query)
+
(defun dired-create-files-non-directory
(file-creator basename-constructor operation arg)
;; Perform FILE-CREATOR on the non-directory part of marked files
(while alist
(setq elt (car alist)
alist (cdr alist)
- dir (car elt)
- pos (dired-get-subdir-min elt))
+ dir (car elt))
(if (dired-tree-lessp dir new-dir)
;; Insert NEW-DIR after DIR
(setq new-pos (dired-get-subdir-max elt)
(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."
;; Search only in file names in the Dired buffer.
(defcustom dired-isearch-filenames nil
- "*Non-nil to Isearch in file names only.
+ "Non-nil to Isearch in file names only.
If t, Isearch in Dired always matches only file names.
If `dwim', Isearch matches file names when initial point position is on
a file name. Otherwise, it searches the whole buffer without restrictions."
"Toggle file names searching on or off.
When on, Isearch skips matches outside file names using the predicate
`dired-isearch-filter-filenames' that matches only at file names.
-When off, it uses the default predicate `isearch-filter-invisible'."
+When off, it uses the original predicate."
(interactive)
(setq isearch-filter-predicate
(if (eq isearch-filter-predicate 'dired-isearch-filter-filenames)
- 'isearch-filter-invisible
+ dired-isearch-filter-predicate-orig
'dired-isearch-filter-filenames))
(setq isearch-success t isearch-adjusted t)
(isearch-update))
(remove-hook 'isearch-mode-end-hook 'dired-isearch-filenames-end t))
(defun dired-isearch-filter-filenames (beg end)
- "Match only at visible regions with the text property `dired-filename'."
- (and (isearch-filter-invisible beg end)
+ "Test whether the current search hit is a visible file name.
+Return non-nil if the text from BEG to END is part of a file
+name (has the text property `dired-filename') and is visible."
+ (and (isearch-filter-visible beg end)
(if dired-isearch-filenames
(text-property-not-all (min beg end) (max beg end)
'dired-filename nil)
If FILE is a symbolic link and the optional argument DEREF-SYMLINKS is
true then the type of the file linked to by FILE is printed instead."
(interactive (list (dired-get-filename t) current-prefix-arg))
- (with-temp-buffer
- (if deref-symlinks
- (call-process "file" nil t t "-L" "--" file)
- (call-process "file" nil t t "--" file))
- (when (bolp)
- (backward-delete-char 1))
- (message "%s" (buffer-string))))
+ (let (process-file-side-effects)
+ (with-temp-buffer
+ (if deref-symlinks
+ (process-file "file" nil t t "-L" "--" file)
+ (process-file "file" nil t t "--" file))
+ (when (bolp)
+ (backward-delete-char 1))
+ (message "%s" (buffer-string)))))
(provide 'dired-aux)
-;; arch-tag: 4b508de9-a153-423d-8d3f-a1bbd86f4f60
+;; Local Variables:
+;; byte-compile-dynamic: t
+;; generated-autoload-file: "dired.el"
+;; End:
+
;;; dired-aux.el ends here