X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/430d2ee2919b2d4693780f2474ba40148442d206..96ae4c8fa704b0385d6f2cf10b69bf289e2fb7ef:/lisp/dired-aux.el diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 11cf1e184d..f4b79414c6 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1,18 +1,19 @@ -;;; 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 . ;; Maintainer: FSF ;; Keywords: files +;; Package: emacs ;; 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 @@ -20,9 +21,7 @@ ;; 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 . ;;; Commentary: @@ -61,31 +60,45 @@ The prompted-for file is the first file given to `diff'. 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) @@ -130,11 +143,17 @@ Examples of PREDICATE: (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)) @@ -198,7 +217,7 @@ condition. Two file items are considered to match if they are equal (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))) @@ -257,9 +276,20 @@ List has a form of (file-name full-file-name (attribute-list))" 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) @@ -360,14 +390,14 @@ Uses the shell command coming from variables `lpr-command' and ;; 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)) ;;; Cleaning a directory: flagging some backups for deletion. @@ -464,67 +494,53 @@ with a prefix argument." ;;; 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 `&'. @@ -556,9 +572,9 @@ This feature does not try to redisplay Dired buffers afterward, as 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 @@ -757,6 +773,7 @@ command with a prefix argument (the value does not matter)." ("\\.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. @@ -872,7 +889,7 @@ Otherwise, the rule is a compression rule, and compression is done with gzip.") 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 @@ -881,10 +898,10 @@ Otherwise, the rule is a compression rule, and compression is done with gzip.") ;;;###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) @@ -892,26 +909,33 @@ Otherwise, the rule is a compression rule, and compression is done with gzip.") ((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))))))) ;;;###autoload @@ -1079,7 +1103,7 @@ See Info node `(emacs)Subdir switches' for more details." ;; 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. @@ -1124,7 +1148,6 @@ See Info node `(emacs)Subdir switches' for more details." ;; 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) @@ -1172,13 +1195,16 @@ See Info node `(emacs)Subdir switches' for more details." ;;; 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) @@ -1186,16 +1212,15 @@ Special value `always' suppresses confirmation." ;; `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) @@ -1214,45 +1239,7 @@ Special value `always' suppresses confirmation." (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 @@ -1286,8 +1273,7 @@ Special value `always' suppresses confirmation." (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)) @@ -1389,51 +1375,48 @@ Special value `always' suppresses confirmation." 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)) @@ -1465,7 +1448,7 @@ ESC or `q' to not overwrite any of the remaining files, 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' @@ -1475,30 +1458,23 @@ ARG as in `dired-get-marked-files'. 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)) @@ -1508,10 +1484,15 @@ Optional arg HOW-TO is used to set the value of the into-dir variable (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 @@ -1568,19 +1549,69 @@ Optional arg HOW-TO is used to set the value of the into-dir variable (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))) + ;;;###autoload (defun dired-create-directory (directory) @@ -1615,7 +1646,7 @@ Optional arg HOW-TO is used to set the value of the into-dir variable ;; 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 @@ -1947,7 +1978,6 @@ This function takes some pains to conform to `ls -lR' output." (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 `..'). @@ -2279,7 +2309,7 @@ Use \\[dired-hide-all] to (un)hide all directories." (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." @@ -2309,9 +2339,97 @@ Use \\[dired-hide-subdir] to (un)hide a particular subdirectory." ;;;###end dired-ins.el + +;; 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))) + ;; 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. @@ -2348,15 +2466,21 @@ with the command \\[tags-loop-continue]." 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