-;;; 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.
+;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
;; Maintainer: FSF
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
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)))
Symbolic modes like `g+w' are allowed."
(interactive "P")
(let* ((files (dired-get-marked-files t arg))
+ (modestr (and (stringp (car files))
+ (nth 8 (file-attributes (car files)))))
+ (default
+ (and (stringp modestr)
+ (string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr)
+ (replace-regexp-in-string
+ "-" ""
+ (format "u=%s,g=%s,o=%s"
+ (match-string 1 modestr)
+ (match-string 2 modestr)
+ (match-string 3 modestr)))))
(modes (dired-mark-read-string
"Change mode of %s to: " nil
- 'chmod arg files))
+ 'chmod arg files default))
(num-modes (if (string-match "^[0-7]+" modes)
(string-to-number modes 8))))
(dolist (file files)
;; If the current file was used, the list has but one element and ARG
;; does not matter. (It is non-nil, non-integer in that case, namely '(4)).
-(defun dired-mark-read-string (prompt initial op-symbol arg files)
- ;; PROMPT for a string, with INITIAL input.
+(defun dired-mark-read-string (prompt initial op-symbol arg files &optional default)
+ ;; PROMPT for a string, with INITIAL input and DEFAULT value.
;; Other args are used to give user feedback and pop-up:
;; OP-SYMBOL of command, prefix ARG, marked FILES.
(dired-mark-pop-up
nil op-symbol files
(function read-string)
- (format prompt (dired-mark-prompt arg files)) initial))
+ (format prompt (dired-mark-prompt arg files)) initial nil default))
\f
;;; Cleaning a directory: flagging some backups for deletion.
\f
;;; Shell commands
-(declare-function mailcap-parse-mailcaps "mailcap" (&optional path force))
-(declare-function mailcap-parse-mimetypes "mailcap" (&optional path force))
-(declare-function mailcap-extension-to-mime "mailcap" (extn))
-(declare-function mailcap-mime-info "mailcap"
- (string &optional request no-decode))
-
-(defun dired-read-shell-command-default (files)
- "Return a list of default commands for `dired-read-shell-command'."
- (require 'mailcap)
- (mailcap-parse-mailcaps)
- (mailcap-parse-mimetypes)
- (let* ((all-mime-type
- ;; All unique MIME types from file extensions
- (delete-dups (mapcar (lambda (file)
- (mailcap-extension-to-mime
- (file-name-extension file t)))
- files)))
- (all-mime-info
- ;; All MIME info lists
- (delete-dups (mapcar (lambda (mime-type)
- (mailcap-mime-info mime-type 'all))
- all-mime-type)))
- (common-mime-info
- ;; Intersection of mime-infos from different mime-types;
- ;; or just the first MIME info for a single MIME type
- (if (cdr all-mime-info)
- (delq nil (mapcar (lambda (mi1)
- (unless (memq nil (mapcar
- (lambda (mi2)
- (member mi1 mi2))
- (cdr all-mime-info)))
- mi1))
- (car all-mime-info)))
- (car all-mime-info)))
- (commands
- ;; Command strings from `viewer' field of the MIME info
- (delq nil (mapcar (lambda (mime-info)
- (let ((command (cdr (assoc 'viewer mime-info))))
- (if (stringp command)
- (replace-regexp-in-string
- ;; Replace mailcap's `%s' placeholder
- ;; with dired's `?' placeholder
- "%s" "?"
- (replace-regexp-in-string
- ;; Remove the final filename placeholder
- "\s*\\('\\)?%s\\1?\s*\\'" "" command nil t)
- nil t))))
- common-mime-info))))
- commands))
+(declare-function mailcap-file-default-commands "mailcap" (files))
+
+(defun minibuffer-default-add-dired-shell-commands ()
+ "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)
+ (mailcap-file-default-commands files))))
+ (if (listp minibuffer-default)
+ (append minibuffer-default commands)
+ (cons minibuffer-default commands))))
+;; 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-string).
-;;ARG is the prefix arg and may be used to indicate in the prompt which
-;; files are affected.
-;;This is an extra function so that you can redefine it, e.g., to use gmhist."
- (dired-mark-pop-up
- nil 'shell files
- (function read-string)
- (format prompt (dired-mark-prompt arg files))
- nil 'shell-command-history
- (dired-read-shell-command-default 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."
+ (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)))
+
+;;;###autoload
+(defun dired-do-async-shell-command (command &optional arg file-list)
+ "Run a shell command COMMAND on the marked files asynchronously.
+
+Like `dired-do-shell-command' but if COMMAND doesn't end in ampersand,
+adds `* &' surrounded by whitespace and executes the command asynchronously.
+The output appears in the buffer `*Async Shell Command*'."
+ (interactive
+ (let ((files (dired-get-marked-files t current-prefix-arg)))
+ (list
+ ;; Want to give feedback whether this file or marked files are used:
+ (dired-read-shell-command "& on %s: " current-prefix-arg files)
+ current-prefix-arg
+ files)))
+ (unless (string-match "[*?][ \t]*\\'" command)
+ (setq command (concat command " *")))
+ (unless (string-match "&[ \t]*\\'" command)
+ (setq command (concat command " &")))
+ (dired-do-shell-command command arg file-list))
;; The in-background argument is only needed in Emacs 18 where
;; shell-command doesn't understand an appended ampersand `&'.
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
("\\.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.
failures)))))
(defvar dired-query-alist
- '((?\y . y) (?\040 . y) ; `y' or SPC means accept once
+ '((?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
;;;###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.
+ "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)
((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)
- (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)
+ done result elt)
+ (while (not done)
(apply 'message qprompt qs-args)
- (setq char (set qs-var (read-char))))
+ (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
;; Don't expand `.'. Show just the file name within directory.
(let ((default-directory directory))
(dired-insert-directory directory
- (concat dired-actual-switches "d")
+ (concat dired-actual-switches " -d")
(list filename)))
(goto-char opoint)
;; Put in desired marker char.
;; or wildcard lines.
;; Important: never moves into the next subdir.
;; DIR is assumed to be unhidden.
- ;; Will probably be redefined for VMS etc.
(save-excursion
(or (dired-goto-subdir dir) (error "This cannot happen"))
(forward-line 1)
;;; 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)
(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)
;; `dired-overwrite-confirmed' and `overwrite-backup-query' are fluid vars
;; from dired-create-files.
(let (backup)
- (if (and dired-backup-overwrite
- dired-overwrite-confirmed
- (setq backup (car (find-backup-file-name to)))
- (or (eq 'always dired-backup-overwrite)
- (dired-query 'overwrite-backup-query
- "Make backup for existing file `%s'? "
- to)))
- (progn
- (rename-file to backup 0) ; confirm overwrite of old backup
- (dired-relist-entry backup)))))
+ (when (and dired-backup-overwrite
+ dired-overwrite-confirmed
+ (setq backup (car (find-backup-file-name to)))
+ (or (eq 'always dired-backup-overwrite)
+ (dired-query 'overwrite-backup-query
+ "Make backup for existing file `%s'? "
+ to)))
+ (rename-file to backup 0) ; confirm overwrite of old backup
+ (dired-relist-entry backup))))
;;;###autoload
(defun dired-copy-file (from to ok-flag)
(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
- (progn
- (make-directory to)
- (set-file-modes to #o700))
- (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))
skipped (success-count 0) (total (length fn-list)))
(let (to overwrite-query
overwrite-backup-query) ; for dired-handle-overwrite
- (mapc
- (function
- (lambda (from)
- (setq to (funcall name-constructor from))
- (if (equal to from)
- (progn
- (setq to nil)
- (dired-log "Cannot %s to same file: %s\n"
- (downcase operation) from)))
- (if (not to)
- (setq skipped (cons (dired-make-relative from) skipped))
- (let* ((overwrite (file-exists-p to))
- (dired-overwrite-confirmed ; for dired-handle-overwrite
- (and overwrite
- (let ((help-form '(format "\
+ (dolist (from fn-list)
+ (setq to (funcall name-constructor from))
+ (if (equal to from)
+ (progn
+ (setq to nil)
+ (dired-log "Cannot %s to same file: %s\n"
+ (downcase operation) from)))
+ (if (not to)
+ (setq skipped (cons (dired-make-relative from) skipped))
+ (let* ((overwrite (file-exists-p to))
+ (dired-overwrite-confirmed ; for dired-handle-overwrite
+ (and overwrite
+ (let ((help-form '(format "\
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,
`!' to overwrite all remaining files with no more questions." to)))
- (dired-query 'overwrite-query
- "Overwrite `%s'?" to))))
- ;; must determine if FROM is marked before file-creator
- ;; gets a chance to delete it (in case of a move).
- (actual-marker-char
- (cond ((integerp marker-char) marker-char)
- (marker-char (dired-file-marker from)) ; slow
- (t nil))))
- (condition-case err
- (progn
- (funcall file-creator from to dired-overwrite-confirmed)
- (if overwrite
- ;; If we get here, file-creator hasn't been aborted
- ;; and the old entry (if any) has to be deleted
- ;; before adding the new entry.
- (dired-remove-file to))
- (setq success-count (1+ success-count))
- (message "%s: %d of %d" operation success-count total)
- (dired-add-file to actual-marker-char))
- (file-error ; FILE-CREATOR aborted
- (progn
- (push (dired-make-relative from)
- failures)
- (dired-log "%s `%s' to `%s' failed:\n%s\n"
- operation from to err))))))))
- fn-list))
+ (dired-query 'overwrite-query
+ "Overwrite `%s'?" to))))
+ ;; must determine if FROM is marked before file-creator
+ ;; gets a chance to delete it (in case of a move).
+ (actual-marker-char
+ (cond ((integerp marker-char) marker-char)
+ (marker-char (dired-file-marker from)) ; slow
+ (t nil))))
+ (condition-case err
+ (progn
+ (funcall file-creator from to dired-overwrite-confirmed)
+ (if overwrite
+ ;; If we get here, file-creator hasn't been aborted
+ ;; and the old entry (if any) has to be deleted
+ ;; before adding the new entry.
+ (dired-remove-file to))
+ (setq success-count (1+ success-count))
+ (message "%s: %d of %d" operation success-count total)
+ (dired-add-file to actual-marker-char))
+ (file-error ; FILE-CREATOR aborted
+ (progn
+ (push (dired-make-relative from)
+ failures)
+ (dired-log "%s `%s' to `%s' failed:\n%s\n"
+ operation from to err))))))))
(cond
(dired-create-files-failures
(setq failures (nconc failures dired-create-files-failures))
how-to)
"Create a new file for each marked file.
Prompts user for target, which is a directory in which to create
- the new files. Target may be a plain file if only one marked
+ the new files. Target may also be a plain file if only one marked
file exists. The way the default for the target directory is
computed depends on the value of `dired-dwim-target-directory'.
OP-SYMBOL is the symbol for the operation. Function `dired-mark-pop-up'
Optional arg MARKER-CHAR as in `dired-create-files'.
Optional arg OP1 is an alternate form for OPERATION if there is
only one file.
-Optional arg HOW-TO is used to set the value of the into-dir variable
- which determines how to treat target.
- If into-dir is set to nil then target is not regarded as a directory,
- there must be exactly one marked file, else error.
- Else if into-dir is set to a list, then target is a generalized
- directory (e.g. some sort of archive). The first element of into-dir
- must be a function with at least four arguments:
- operation as OPERATION above.
- rfn-list a list of the relative names for the marked files.
- fn-list a list of the absolute names for the marked files.
- target.
+Optional arg HOW-TO determiness how to treat the target.
+ If HOW-TO is nil, use `file-directory-p' to determine if the
+ target is a directory. If so, the marked file(s) are created
+ inside that directory. Otherwise, the target is a plain file;
+ an error is raised unless there is exactly one marked file.
+ If HOW-TO is t, target is always treated as a plain file.
+ Otherwise, HOW-TO should be a function of one argument, TARGET.
+ If its return value is nil, TARGET is regarded as a plain file.
+ If it return value is a list, TARGET is a generalized
+ directory (e.g. some sort of archive). The first element of
+ this list must be a function with at least four arguments:
+ operation - as OPERATION above.
+ rfn-list - list of the relative names for the marked files.
+ fn-list - list of the absolute names for the marked files.
+ target - the name of the target itself.
The rest of into-dir are optional arguments.
- Else into-dir is not a list. Target is a directory.
- The marked file(s) are created inside the target directory.
-
- If HOW-TO is not given (or nil), then into-dir is set to true if
- target is a directory and otherwise to nil.
- Else if HOW-TO is t, then into-dir is set to nil.
- Else HOW-TO is assumed to be a function of one argument, target,
- that looks at target and returns a value for the into-dir
- variable. The function `dired-into-dir-with-symlinks' is provided
- for the case (common when creating symlinks) that symbolic
- links to directories are not to be considered as directories
- (as `file-directory-p' would if HOW-TO had been nil)."
+ For any other return value, TARGET is treated as a directory."
(or op1 (setq op1 operation))
(let* ((fn-list (dired-get-marked-files nil arg))
(rfn-list (mapcar (function dired-make-relative) fn-list))
(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)
;; 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
(save-excursion (dired-mark-remembered mark-alist))
(restore-buffer-modified-p modflag)))
-;; This is a separate function for dired-vms.
(defun dired-insert-subdir-validate (dirname &optional switches)
;; Check that it is valid to insert DIRNAME with SWITCHES.
;; Signal an error if invalid (e.g. user typed `i' on `..').
(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."
;;;###end dired-ins.el
+\f
+;; Search only in file names in the Dired buffer.
+
+(defcustom dired-isearch-filenames nil
+ "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."
+ :type '(choice (const :tag "No restrictions" nil)
+ (const :tag "When point is on a file name initially, search file names" dwim)
+ (const :tag "Always search in file names" t))
+ :group 'dired
+ :version "23.1")
+
+(defvar dired-isearch-filter-predicate-orig nil)
+
+(defun dired-isearch-filenames-toggle ()
+ "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 original predicate."
+ (interactive)
+ (setq isearch-filter-predicate
+ (if (eq isearch-filter-predicate 'dired-isearch-filter-filenames)
+ dired-isearch-filter-predicate-orig
+ 'dired-isearch-filter-filenames))
+ (setq isearch-success t isearch-adjusted t)
+ (isearch-update))
+
+;;;###autoload
+(defun dired-isearch-filenames-setup ()
+ "Set up isearch to search in Dired file names.
+Intended to be added to `isearch-mode-hook'."
+ (when (or (eq dired-isearch-filenames t)
+ (and (eq dired-isearch-filenames 'dwim)
+ (get-text-property (point) 'dired-filename)))
+ (setq isearch-message-prefix-add "filename ")
+ (define-key isearch-mode-map "\M-sf" 'dired-isearch-filenames-toggle)
+ (setq dired-isearch-filter-predicate-orig
+ (default-value 'isearch-filter-predicate))
+ (setq-default isearch-filter-predicate 'dired-isearch-filter-filenames)
+ (add-hook 'isearch-mode-end-hook 'dired-isearch-filenames-end nil t)))
+
+(defun dired-isearch-filenames-end ()
+ "Clean up the Dired file name search after terminating isearch."
+ (setq isearch-message-prefix-add nil)
+ (define-key isearch-mode-map "\M-sf" nil)
+ (setq-default isearch-filter-predicate dired-isearch-filter-predicate-orig)
+ (remove-hook 'isearch-mode-end-hook 'dired-isearch-filenames-end t))
+
+(defun dired-isearch-filter-filenames (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)
+ t)))
+
+;;;###autoload
+(defun dired-isearch-filenames ()
+ "Search for a string using Isearch only in file names in the Dired buffer."
+ (interactive)
+ (let ((dired-isearch-filenames t))
+ (isearch-forward)))
+
+;;;###autoload
+(defun dired-isearch-filenames-regexp ()
+ "Search for a regexp using Isearch only in file names in the Dired buffer."
+ (interactive)
+ (let ((dired-isearch-filenames t))
+ (isearch-forward-regexp)))
+
\f
;; Functions for searching in tags style among marked files.
+;;;###autoload
+(defun dired-do-isearch ()
+ "Search for a string through all marked files using Isearch."
+ (interactive)
+ (multi-isearch-files
+ (dired-get-marked-files nil nil 'dired-nondirectory-p)))
+
+;;;###autoload
+(defun dired-do-isearch-regexp ()
+ "Search for a regexp through all marked files using Isearch."
+ (interactive)
+ (multi-isearch-files-regexp
+ (dired-get-marked-files nil nil 'dired-nondirectory-p)))
+
;;;###autoload
(defun dired-do-search (regexp)
"Search through all marked files for a match for REGEXP.
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:
+
+;; arch-tag: 4b508de9-a153-423d-8d3f-a1bbd86f4f60
;;; dired-aux.el ends here