;; 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:
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 associted with current dired files.
+This function is used to add all related commands retieved 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 `&'.
;; 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)
(other :tag "ask" t))
:group 'dired)
-(defvar dired-overwrite-confirmed nil)
+;; 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)
;; Save old version of file TO that is to be overwritten.
(if (file-exists-p to)
(or top (dired-handle-overwrite to))
(condition-case err
- (progn
- (make-directory to)
- (set-file-modes to #o700))
+ ;; 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)
(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 `..').
;;;###end dired-ins.el
\f
+;; Search only in file names in the Dired buffer.
+
+(defcustom dired-isearch-filenames nil
+ "*If non-nil, Isearch in Dired matches only file names."
+ :type '(choice (const :tag "No restrictions" nil)
+ (const :tag "Isearch only in file names" dired-filename))
+ :group 'dired
+ :version "23.1")
+
+(defvar dired-isearch-orig-success-function nil)
+
+(defun dired-isearch-filenames-toggle ()
+ "Toggle file names searching on or off.
+When on, Isearch checks the success of the current matching point
+using the function `dired-isearch-success-function' that matches only
+at file names. When off, it uses the default function
+`isearch-success-function-default'."
+ (interactive)
+ (setq isearch-success-function
+ (if (eq isearch-success-function 'dired-isearch-success-function)
+ 'isearch-success-function-default
+ 'dired-isearch-success-function))
+ (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 dired-isearch-filenames
+ (define-key isearch-mode-map "\M-sf" 'dired-isearch-filenames-toggle)
+ (setq dired-isearch-orig-success-function
+ (default-value 'isearch-success-function))
+ (setq-default isearch-success-function 'dired-isearch-success-function)
+ (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."
+ (define-key isearch-mode-map "\M-sf" nil)
+ (setq-default isearch-success-function dired-isearch-orig-success-function)
+ (remove-hook 'isearch-mode-end-hook 'dired-isearch-filenames-end t))
+
+(defun dired-isearch-success-function (beg end)
+ "Match only at visible regions with the text property `dired-filename'."
+ (and (isearch-success-function-default 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.
(provide 'dired-aux)
-;;; arch-tag: 4b508de9-a153-423d-8d3f-a1bbd86f4f60
+;; arch-tag: 4b508de9-a153-423d-8d3f-a1bbd86f4f60
;;; dired-aux.el ends here
HCoop / bpt / emacs.git / blobdiff