;;; dired-aux.el --- less commonly used parts of dired
-;; Copyright (C) 1985, 1986, 1992, 1994, 1998, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2014 Free Software
+;; Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: files
+;; Package: emacs
;; This file is part of GNU Emacs.
;;;###autoload
(defun dired-diff (file &optional switches)
"Compare file at point with file FILE using `diff'.
-FILE defaults to the file at the mark. (That's the mark set by
-\\[set-mark-command], not by Dired's \\[dired-mark] command.)
-The prompted-for file is the first file given to `diff'.
-With prefix arg, prompt for second argument SWITCHES,
-which is options for `diff'."
+If called interactively, prompt for FILE. If the file at point
+has a backup file, use that as the default. If the file at point
+is a backup file, use its original. If the mark is active
+in Transient Mark mode, use the file at the mark as the default.
+\(That's the mark set by \\[set-mark-command], not by Dired's
+\\[dired-mark] command.)
+
+FILE is the first file given to `diff'. The file at point
+is the second file given to `diff'.
+
+With prefix arg, prompt for second argument SWITCHES, which is
+the string of command switches for the third argument of `diff'."
(interactive
(let* ((current (dired-get-filename t))
+ ;; Get the latest existing backup file or its original.
+ (oldf (if (backup-file-name-p current)
+ (file-name-sans-versions current)
+ (diff-latest-backup-file current)))
;; Get the file at the mark.
- (file-at-mark (if (mark t)
+ (file-at-mark (if (and transient-mark-mode mark-active)
(save-excursion (goto-char (mark t))
(dired-get-filename t t))))
+ (default-file (or file-at-mark
+ (and oldf (file-name-nondirectory oldf))))
;; 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))
+ ;; and the target dir is current or there is a default file.
+ (default (if (and (not (equal default-file current))
(or (equal (dired-dwim-target-directory)
(dired-current-directory))
- mark-active))
- file-at-mark))
+ default-file))
+ default-file))
(target-dir (if default
(dired-current-directory)
(dired-dwim-target-directory)))
(defaults (dired-dwim-target-defaults (list current) target-dir)))
- (require 'diff)
(list
(minibuffer-with-setup-hook
(lambda ()
(equal (expand-file-name current file)
(expand-file-name current))))
(error "Attempt to compare the file to itself"))
- (diff file current switches)))
+ (if (and (backup-file-name-p current)
+ (equal file (file-name-sans-versions current)))
+ (diff current file switches)
+ (diff file current switches))))
;;;###autoload
(defun dired-backup-diff (&optional switches)
(file-attributes full-file-name))))
(directory-files dir)))
\f
-
-(defun dired-touch-initial (files)
- "Create initial input value for `touch' command."
- (let (initial)
- (while files
- (let ((current (nth 5 (file-attributes (car files)))))
- (if (and initial (not (equal initial current)))
- (setq initial (current-time) files nil)
- (setq initial current))
- (setq files (cdr files))))
- (format-time-string "%Y%m%d%H%M.%S" initial)))
+;;; Change file attributes
(defun dired-do-chxxx (attribute-name program op-symbol arg)
- ;; Change file attributes (mode, group, owner, timestamp) of marked files and
+ ;; Change file attributes (group, owner, timestamp) of marked files and
;; refresh their file lines.
;; ATTRIBUTE-NAME is a string describing the attribute to the user.
;; PROGRAM is the program used to change the attribute.
- ;; OP-SYMBOL is the type of operation (for use in dired-mark-pop-up).
- ;; ARG describes which files to use, as in dired-get-marked-files.
+ ;; OP-SYMBOL is the type of operation (for use in `dired-mark-pop-up').
+ ;; ARG describes which files to use, as in `dired-get-marked-files'.
(let* ((files (dired-get-marked-files t arg))
- (new-attribute
- (dired-mark-read-string
- (concat "Change " attribute-name " of %s to: ")
- (if (eq op-symbol 'touch) (dired-touch-initial files))
- op-symbol arg files))
+ ;; The source of default file attributes is the file at point.
+ (default-file (dired-get-filename t t))
+ (default (when default-file
+ (cond ((eq op-symbol 'touch)
+ (format-time-string
+ "%Y%m%d%H%M.%S"
+ (nth 5 (file-attributes default-file))))
+ ((eq op-symbol 'chown)
+ (nth 2 (file-attributes default-file 'string)))
+ ((eq op-symbol 'chgrp)
+ (nth 3 (file-attributes default-file 'string))))))
+ (prompt (concat "Change " attribute-name " of %s to"
+ (if (eq op-symbol 'touch)
+ " (default now): "
+ ": ")))
+ (new-attribute (dired-mark-read-string prompt nil op-symbol
+ arg files default
+ (cond ((eq op-symbol 'chown)
+ (system-users))
+ ((eq op-symbol 'chgrp)
+ (system-groups)))))
(operation (concat program " " new-attribute))
failures)
(setq failures
(function dired-check-process)
(append
(list operation program)
- (if (eq op-symbol 'touch)
- '("-t") nil)
- (list new-attribute)
- (if (string-match "gnu" system-configuration)
+ (unless (or (string-equal new-attribute "")
+ ;; Use `eq' instead of `equal'
+ ;; to detect empty input (bug#12399).
+ (eq new-attribute default))
+ (if (eq op-symbol 'touch)
+ (list "-t" new-attribute)
+ (list new-attribute)))
+ (if (string-match-p "gnu" system-configuration)
'("--") nil))
files))
(dired-do-redisplay arg);; moves point if ARG is an integer
;;;###autoload
(defun dired-do-chmod (&optional arg)
"Change the mode of the marked (or next ARG) files.
-Symbolic modes like `g+w' are allowed."
+Symbolic modes like `g+w' are allowed.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer."
(interactive "P")
(let* ((files (dired-get-marked-files t arg))
- (modestr (and (stringp (car files))
- (nth 8 (file-attributes (car files)))))
+ ;; The source of default file attributes is the file at point.
+ (default-file (dired-get-filename t t))
+ (modestr (when default-file
+ (nth 8 (file-attributes default-file))))
(default
(and (stringp modestr)
(string-match "^.\\(...\\)\\(...\\)\\(...\\)$" modestr)
(match-string 2 modestr)
(match-string 3 modestr)))))
(modes (dired-mark-read-string
- "Change mode of %s to: " nil
- 'chmod arg files default))
- (num-modes (if (string-match "^[0-7]+" modes)
- (string-to-number modes 8))))
+ "Change mode of %s to: "
+ nil 'chmod arg files default))
+ num-modes)
+ (cond ((or (equal modes "")
+ ;; Use `eq' instead of `equal'
+ ;; to detect empty input (bug#12399).
+ (eq modes default))
+ ;; We used to treat empty input as DEFAULT, but that is not
+ ;; such a good idea (Bug#9361).
+ (error "No file mode specified"))
+ ((string-match-p "^[0-7]+" modes)
+ (setq num-modes (string-to-number modes 8))))
+
(dolist (file files)
(set-file-modes
file
;;;###autoload
(defun dired-do-chgrp (&optional arg)
- "Change the group of the marked (or next ARG) files."
+ "Change the group of the marked (or next ARG) files.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer."
(interactive "P")
(if (memq system-type '(ms-dos windows-nt))
(error "chgrp not supported on this system"))
;;;###autoload
(defun dired-do-chown (&optional arg)
- "Change the owner of the marked (or next ARG) files."
+ "Change the owner of the marked (or next ARG) files.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer."
(interactive "P")
(if (memq system-type '(ms-dos windows-nt))
(error "chown not supported on this system"))
;;;###autoload
(defun dired-do-touch (&optional arg)
"Change the timestamp of the marked (or next ARG) files.
-This calls touch."
+This calls touch.
+Type M-n to pull the file attributes of the file at point
+into the minibuffer."
(interactive "P")
(dired-do-chxxx "Timestamp" dired-touch-program 'touch arg))
;; Do the operation and record failures.
failures (nconc (apply function (append args pending))
failures)
- ;; Transfer the elemens of PENDING onto PAST
+ ;; Transfer the elements of PENDING onto PAST
;; and clear it out. Now PAST contains the first N files
;; specified (for some N), and FILES contains the rest.
past (nconc past pending)
`lpr-switches' as default."
(interactive "P")
(let* ((file-list (dired-get-marked-files t arg))
+ (lpr-switches
+ (if (and (stringp printer-name)
+ (string< "" printer-name))
+ (cons (concat lpr-printer-switch printer-name)
+ lpr-switches)
+ lpr-switches))
(command (dired-mark-read-string
"Print %s with: "
(mapconcat 'identity
'print arg file-list)))
(dired-run-shell-command (dired-shell-stuff-it command file-list nil))))
-;; Read arguments for a marked-files command that wants a string
-;; that is not a file name,
-;; perhaps popping up the list of marked files.
-;; ARG is the prefix arg and indicates whether the files came from
-;; marks (ARG=nil) or a repeat factor (integerp ARG).
-;; 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 &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 nil default))
+(defun dired-mark-read-string (prompt initial op-symbol arg files
+ &optional default-value collection)
+ "Read args for a Dired marked-files command, prompting with PROMPT.
+Return the user input (a string).
+
+INITIAL, if non-nil, is the initial minibuffer input.
+OP-SYMBOL is an operation symbol (see `dired-no-confirm').
+ARG is normally the prefix argument for the calling command;
+it is passed as the first argument to `dired-mark-prompt'.
+FILES should be a list of marked files' names.
+
+Optional arg DEFAULT-VALUE is a default value or list of default
+values, passed as the seventh arg to `completing-read'.
+
+Optional arg COLLECTION is a collection of possible completions,
+passed as the second arg to `completing-read'."
+ (dired-mark-pop-up nil op-symbol files
+ 'completing-read
+ (format prompt (dired-mark-prompt arg files))
+ collection nil nil initial nil default-value nil))
\f
;;; Cleaning a directory: flagging some backups for deletion.
(goto-char (point-min))
(while (not (eobp))
(save-excursion
- (and (not (looking-at dired-re-dir))
+ (and (not (looking-at-p dired-re-dir))
(not (eolp))
(setq file (dired-get-filename nil t)) ; nil on non-file
(progn (end-of-line)
(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.
dired-file-version-alist)))))))
(defun dired-trample-file-versions (fn)
- (let* ((start-vn (string-match "\\.~[0-9]+~$" fn))
+ (let* ((start-vn (string-match-p "\\.~[0-9]+~$" fn))
base-version-list)
(and start-vn
(setq base-version-list ; there was a base version to which
;; 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.
+PROMPT should be a format string with one \"%s\" format sequence,
+which is replaced by the value returned by `dired-mark-prompt',
+with ARG and FILES as its arguments. FILES should be a list of
+file names. The result is used as the prompt.
+
+This normally reads using `read-shell-command', but if the
+`dired-x' package is loaded, use `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 (functionp 'dired-guess-shell-command)
+ (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)
"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.
+Like `dired-do-shell-command', but adds `&' at the end of COMMAND
+to execute it asynchronously.
+
+When operating on multiple files, asynchronous commands
+are executed in the background on each file in parallel.
+In shell syntax this means separating the individual commands
+with `&'. However, when COMMAND ends in `;' or `;&' then commands
+are executed in the background on each file sequentially waiting
+for each command to terminate before running the next command.
+In shell syntax this means separating the individual commands with `;'.
+
The output appears in the buffer `*Async Shell Command*'."
(interactive
(let ((files (dired-get-marked-files t current-prefix-arg)))
(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)
+ (unless (string-match-p "&[ \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 `&'.
;;;###autoload
(defun dired-do-shell-command (command &optional arg file-list)
"Run a shell command COMMAND on the marked files.
-If no files are marked or a specific numeric prefix arg is given,
+If no files are marked or a numeric prefix arg is given,
the next ARG files are used. Just \\[universal-argument] means the current file.
The prompt mentions the file(s) or the marker, as appropriate.
`*' and `?' when not surrounded by whitespace have no special
significance for `dired-do-shell-command', and are passed through
-normally to the shell, but you must confirm first. To pass `*' by
-itself to the shell as a wildcard, type `*\"\"'.
+normally to the shell, but you must confirm first.
+
+If you want to use `*' as a shell wildcard with whitespace around
+it, write `*\"\"' in place of just `*'. This is equivalent to just
+`*' in the shell, but avoids Dired's special handling.
-If COMMAND produces output, it goes to a separate buffer.
+If COMMAND ends in `&', `;', or `;&', it is executed in the
+background asynchronously, and the output appears in the buffer
+`*Async Shell Command*'. When operating on multiple files and COMMAND
+ends in `&', the shell command is executed on each file in parallel.
+However, when COMMAND ends in `;' or `;&' then commands are executed
+in the background on each file sequentially waiting for each command
+to terminate before running the next command. You can also use
+`dired-do-async-shell-command' that automatically adds `&'.
+
+Otherwise, COMMAND is executed synchronously, and the output
+appears in the buffer `*Shell Command Output*'.
This feature does not try to redisplay Dired buffers afterward, as
there's no telling what files COMMAND may have changed.
(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 (concat "! on "
- "%s: ")
- current-prefix-arg
- files)
+ (dired-read-shell-command "! on %s: " current-prefix-arg files)
current-prefix-arg
files)))
- (let* ((on-each (not (string-match dired-star-subst-regexp command)))
- (subst (not (string-match dired-quark-subst-regexp command)))
- (star (not (string-match "\\*" command)))
- (qmark (not (string-match "\\?" command))))
+ (let* ((on-each (not (string-match-p dired-star-subst-regexp command)))
+ (no-subst (not (string-match-p dired-quark-subst-regexp command)))
+ (star (string-match-p "\\*" command))
+ (qmark (string-match-p "\\?" command)))
;; Get confirmation for wildcards that may have been meant
;; to control substitution of a file name or the file name list.
- (if (cond ((not (or on-each subst))
+ (if (cond ((not (or on-each no-subst))
(error "You can not combine `*' and `?' substitution marks"))
- ((and star (not on-each))
+ ((and star on-each)
(y-or-n-p "Confirm--do you mean to use `*' as a wildcard? "))
- ((and qmark (not subst))
+ ((and qmark no-subst)
(y-or-n-p "Confirm--do you mean to use `?' as a wildcard? "))
(t))
(if on-each
(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.
;; Might be redefined for smarter things and could then use RAW-ARG
;; (coming from interactive P and currently ignored) to decide what to do.
;; Smart would be a way to access basename or extension of file names.
- (let ((stuff-it
- (if (or (string-match dired-star-subst-regexp command)
- (string-match dired-quark-subst-regexp command))
- (lambda (x)
- (let ((retval command))
- (while (string-match
- "\\(^\\|[ \t]\\)\\([*?]\\)\\([ \t]\\|$\\)" retval)
- (setq retval (replace-match x t t retval 2)))
- retval))
- (lambda (x) (concat command dired-mark-separator x)))))
- (if on-each
- (mapconcat stuff-it (mapcar 'shell-quote-argument file-list) ";")
- (let ((files (mapconcat 'shell-quote-argument
- file-list dired-mark-separator)))
- (if (> (length file-list) 1)
- (setq files (concat dired-mark-prefix files dired-mark-postfix)))
- (funcall stuff-it files)))))
+ (let* ((in-background (string-match "[ \t]*&[ \t]*\\'" command))
+ (command (if in-background
+ (substring command 0 (match-beginning 0))
+ command))
+ (sequentially (string-match "[ \t]*;[ \t]*\\'" command))
+ (command (if sequentially
+ (substring command 0 (match-beginning 0))
+ command))
+ (stuff-it
+ (if (or (string-match-p dired-star-subst-regexp command)
+ (string-match-p dired-quark-subst-regexp command))
+ (lambda (x)
+ (let ((retval command))
+ (while (string-match
+ "\\(^\\|[ \t]\\)\\([*?]\\)\\([ \t]\\|$\\)" retval)
+ (setq retval (replace-match x t t retval 2)))
+ retval))
+ (lambda (x) (concat command dired-mark-separator x)))))
+ (concat
+ (if on-each
+ (mapconcat stuff-it (mapcar 'shell-quote-argument file-list)
+ (if (and in-background (not sequentially)) "&" ";"))
+ (let ((files (mapconcat 'shell-quote-argument
+ file-list dired-mark-separator)))
+ (if (> (length file-list) 1)
+ (setq files (concat dired-mark-prefix files dired-mark-postfix)))
+ (funcall stuff-it files)))
+ (if in-background "&" ""))))
;; This is an extra function so that it can be redefined by ange-ftp.
;;;###autoload
;; Commands that delete or redisplay part of the dired buffer.
(defun dired-kill-line (&optional arg)
+ "Kill the current line (not the files).
+With a prefix argument, kill that many lines starting with the current line.
+\(A negative argument kills backward.)"
(interactive "P")
(setq arg (prefix-numeric-value arg))
(let (buffer-read-only file)
(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)))
(if new-file
(let ((start (point)))
;; Remove any preexisting entry for the name NEW-FILE.
- (condition-case nil
- (dired-remove-entry new-file)
- (error nil))
+ (ignore-errors (dired-remove-entry new-file))
(goto-char start)
;; Now replace the current line with an entry for NEW-FILE.
(dired-update-file-line new-file) nil)
;; See if any suffix rule matches this file name.
(while suffixes
(let (case-fold-search)
- (if (string-match (car (car suffixes)) file)
+ (if (string-match-p (car (car suffixes)) file)
(setq suffix (car suffixes) suffixes nil))
(setq suffixes (cdr suffixes))))
;; If so, compute desired new name.
(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 ((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 !] ")))
- done result elt)
- (while (not done)
- (apply 'message qprompt qs-args)
- (setq char (set qs-var (read-event)))
- (if (numberp char)
- (cond ((and executing-kbd-macro (= char -1))
- ;; read-event returns -1 if we are in a kbd
- ;; macro and there are no more events in the
- ;; macro. Attempt to get an event
- ;; interactively.
- (setq executing-kbd-macro nil))
- ((eq (key-binding (vector char)) 'keyboard-quit)
- (keyboard-quit))
- (t
- (setq done (setq elt (assoc char
- dired-query-alist)))))))
- ;; Display the question with the answer.
- (message "%s" (concat (apply 'format qprompt qs-args)
- (char-to-string char)))
- (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 (vector 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)
(dired-uncache
(if (consp dired-directory) (car dired-directory) dired-directory))
(dired-map-over-marks (let ((fname (dired-get-filename))
- ;; Postphone readin hook till we map
+ ;; Postpone readin hook till we map
;; over all marked files (Bug#6810).
(dired-after-readin-hook nil))
(message "Redisplaying... %s" fname)
;; 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-p 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-p "\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
(defun dired-copy-file-recursive (from to ok-flag &optional
preserve-time top recursive)
- (let ((attrs (file-attributes from))
- dirfailed)
+ (when (and (eq t (car (file-attributes from)))
+ (file-in-directory-p to from))
+ (error "Cannot copy `%s' into its subdirectory `%s'" from to))
+ (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.
- (copy-directory from to dired-copy-preserve-time)
- ;; Not a directory.
+ (copy-directory from to preserve-time)
(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)
(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 must accept three args: oldfile newfile ok-if-already-exists
-
-;; 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.
+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'.
-;; OPERATION (a capitalized string, e.g. `Copy') describes the
-;; operation performed. It is used for error logging.
+OPERATION should be a capitalized string describing the operation
+performed (e.g. `Copy'). It is used for error logging.
-;; FN-LIST is the list of files to copy (full absolute file names).
+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.
+If optional argument MARKER-CHAR is non-nil, mark each
+newly-created file's Dired entry with the character MARKER-CHAR,
+or with the current marker character if MARKER-CHAR is t."
(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))))
+ ;; Handle the `dired-copy-file' file-creator specially
+ ;; When copying a directory to another directory or
+ ;; possibly to itself or one of its subdirectories.
+ ;; e.g "~/foo/" => "~/test/"
+ ;; or "~/foo/" =>"~/foo/"
+ ;; or "~/foo/ => ~/foo/bar/")
+ ;; In this case the 'name-constructor' have set the destination
+ ;; TO to "~/test/foo" because the old emacs23 behavior
+ ;; of `copy-directory' was to not create the subdirectory
+ ;; and instead copy the contents.
+ ;; With the new behavior of `copy-directory'
+ ;; (similar to the `cp' shell command) we don't
+ ;; need such a construction of the target directory,
+ ;; so modify the destination TO to "~/test/" instead of "~/test/foo/".
+ (let ((destname (file-name-directory to)))
+ (when (and (file-directory-p from)
+ (file-directory-p to)
+ (eq file-creator 'dired-copy-file))
+ (setq to destname))
+ ;; If DESTNAME is a subdirectory of FROM, not a symlink,
+ ;; and the method in use is copying, signal an error.
+ (and (eq t (car (file-attributes destname)))
+ (eq file-creator 'dired-copy-file)
+ (file-in-directory-p destname from)
+ (error "Cannot copy `%s' into its subdirectory `%s'"
+ from to)))
(condition-case err
(progn
(funcall file-creator from to dired-overwrite-confirmed)
&optional marker-char op1
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 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'.
+Prompt user for a target directory in which to create the new
+ files. The target may also be a non-directory file, if only
+ one file is marked. The initial suggestion for target is the
+ Dired buffer's current directory (or, if `dired-dwim-target' is
+ non-nil, the current directory of a neighboring Dired window).
OP-SYMBOL is the symbol for the operation. Function `dired-mark-pop-up'
will determine whether pop-ups are appropriate for this OP-SYMBOL.
FILE-CREATOR and OPERATION as in `dired-create-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 determiness how to treat the target.
+Optional arg HOW-TO determines 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;
(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,
\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
;;;###autoload
(defun dired-do-copy (&optional arg)
"Copy all marked (or next ARG) files, or copy the current file.
-This normally preserves the last-modified date when copying.
-When operating on just the current file, you specify the new name.
-When operating on multiple or marked files, you specify a directory,
-and new copies of these files are made in that directory
-with the same names that the files currently have. The default
-suggested for the target directory depends on the value of
-`dired-dwim-target', which see.
+When operating on just the current file, prompt for the new name.
+
+When operating on multiple or marked files, prompt for a target
+directory, and make the new copies in that directory, with the
+same names as the original files. The initial suggestion for the
+target directory is the Dired buffer's current directory (or, if
+`dired-dwim-target' is non-nil, the current directory of a
+neighboring Dired window).
+
+If `dired-copy-preserve-time' is non-nil, this command preserves
+the modification time of each old file in the copy, similar to
+the \"-p\" option for the \"cp\" shell command.
-This command copies symbolic links by creating new ones,
-like `cp -d'."
+This command copies symbolic links by creating new ones, similar
+to the \"-d\" option for the \"cp\" shell command."
(interactive "P")
(let ((dired-recursive-copies dired-recursive-copies))
(dired-do-create-files 'copy (function dired-copy-file)
\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
;;;###autoload
(defun dired-insert-subdir (dirname &optional switches no-error-if-not-dir-p)
- "Insert this subdirectory into the same dired buffer.
-If it is already present, overwrites previous entry,
- else inserts it at its natural place (as `ls -lR' would have done).
+ "Insert this subdirectory into the same Dired buffer.
+If it is already present, overwrite the previous entry;
+ otherwise, insert it at its natural place (as `ls -lR' would
+ have done).
With a prefix arg, you may edit the `ls' switches used for this listing.
You can add `R' to the switches to expand the whole tree starting at
this subdirectory.
(and (not switches) cons (setq switches (cdr cons)))
(dired-insert-subdir-validate dirname switches)
;; case-fold-search is nil now, so we can test for capital `R':
- (if (setq switches-have-R (and switches (string-match "R" switches)))
+ (if (setq switches-have-R (and switches (string-match-p "R" switches)))
;; avoid duplicated subdirs
(setq mark-alist (dired-kill-tree dirname t)))
(if elt
(mapcar
(function
(lambda (x)
- (or (eq (null (string-match x real-switches))
- (null (string-match x dired-actual-switches)))
+ (or (eq (null (string-match-p x real-switches))
+ (null (string-match-p x dired-actual-switches)))
(error
"Can't have dirs with and without -%s switches together" x))))
;; all switches that make a difference to dired-get-filename:
(defun dired-insert-subdir-newpos (new-dir)
;; Find pos for new subdir, according to tree order.
;;(goto-char (point-max))
- (let ((alist dired-subdir-alist) elt dir pos new-pos)
+ (let ((alist dired-subdir-alist) elt dir new-pos)
(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)
(and selective-display
(save-excursion
(dired-goto-subdir dir)
- (looking-at "\r"))))
+ (looking-at-p "\r"))))
;;;###autoload
(defun dired-hide-subdir (arg)
:group 'dired
:version "23.1")
-(defvar dired-isearch-filter-predicate-orig nil)
-
-(defun dired-isearch-filenames-toggle ()
+(define-minor-mode dired-isearch-filenames-mode
"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))
+ nil nil nil
+ (if dired-isearch-filenames-mode
+ (add-function :before-while (local 'isearch-filter-predicate)
+ #'dired-isearch-filter-filenames
+ '((isearch-message-prefix . "filename ")))
+ (remove-function (local 'isearch-filter-predicate)
+ #'dired-isearch-filter-filenames))
+ (when isearch-mode
+ (setq isearch-success t isearch-adjusted t)
+ (isearch-update)))
;;;###autoload
(defun dired-isearch-filenames-setup ()
(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)
+ (define-key isearch-mode-map "\M-sff" 'dired-isearch-filenames-mode)
+ (dired-isearch-filenames-mode 1)
(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)
+ (define-key isearch-mode-map "\M-sff" nil)
+ (dired-isearch-filenames-mode -1)
(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.
+ "Test whether the current search hit is a 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)))
+name (has the text property `dired-filename')."
+ (text-property-not-all (min beg end) (max beg end)
+ 'dired-filename nil))
;;;###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)))
+ (isearch-forward nil t)))
;;;###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)))
+ (isearch-forward-regexp nil t)))
\f
;; Functions for searching in tags style among marked files.
;;;###autoload
(defun dired-show-file-type (file &optional deref-symlinks)
"Print the type of FILE, according to the `file' command.
-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."
+If you give a prefix to this command, and FILE is a symbolic
+link, then the type of the file linked to by FILE is printed
+instead."
(interactive (list (dired-get-filename t) current-prefix-arg))
(let (process-file-side-effects)
(with-temp-buffer
;; generated-autoload-file: "dired.el"
;; End:
-;; arch-tag: 4b508de9-a153-423d-8d3f-a1bbd86f4f60
;;; dired-aux.el ends here
HCoop / bpt / emacs.git / blobdiff