;;; dired-aux.el --- less commonly used parts of dired
-;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2011
+;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2012
;; Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
"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'.
+The prompted-for FILE is the first file given to `diff'.
With prefix arg, prompt for second argument SWITCHES,
-which is options for `diff'."
+which is the string of command switches for `diff'."
(interactive
(let* ((current (dired-get-filename t))
;; Get the file at the mark.
(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))
+ (default (and (eq op-symbol 'touch)
+ (stringp (car files))
+ (format-time-string "%Y%m%d%H%M.%S"
+ (nth 5 (file-attributes (car files))))))
+ (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))
(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)
+ (unless (string-equal new-attribute "")
+ (if (eq op-symbol 'touch)
+ (list "-t" new-attribute)
+ (list new-attribute)))
(if (string-match "gnu" system-configuration)
'("--") nil))
files))
(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 ((equal modes "")
+ ;; 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 "^[0-7]+" modes)
+ (setq num-modes (string-to-number modes 8))))
+
(dolist (file files)
(set-file-modes
file
;; 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)
'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)
+ "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.
+FILES should be a list of file names.
+
+DEFAULT-VALUE, if non-nil, should be a \"standard\" value or list
+of such values, available via history commands. Note that if the
+user enters empty input, this function returns the empty string,
+not DEFAULT-VALUE."
+ (dired-mark-pop-up nil op-symbol files
+ 'read-from-minibuffer
+ (format prompt (dired-mark-prompt arg files))
+ initial nil nil nil default-value))
\f
;;; Cleaning a directory: flagging some backups for deletion.
(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.
;; 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.
-Passes the prefix argument ARG to `dired-mark-prompt', so that it
-can be used in the prompt to indicate which FILES are affected.
-Normally reads the command with `read-shell-command', but if the
-`dired-x' packages is loaded, uses `dired-guess-shell-command' to offer
-a smarter default choice of shell command."
+ "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))
(setq prompt (format prompt (dired-mark-prompt arg files)))
- (if (featurep 'dired-x)
+ (if (functionp 'dired-guess-shell-command)
(dired-mark-pop-up nil 'shell files
- #'dired-guess-shell-command prompt files)
+ 'dired-guess-shell-command prompt files)
(dired-mark-pop-up nil 'shell files
- #'read-shell-command prompt nil nil))))
+ 'read-shell-command prompt nil nil))))
;;;###autoload
(defun dired-do-async-shell-command (command &optional arg file-list)
(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.
;; 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)
(concat (apply 'format prompt args)
(if help-form
(format " [Type yn!q or %s] "
- (key-description
- (char-to-string help-char)))
+ (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)))))
(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.
- (let ((char (following-char))
- (opoint (line-beginning-position))
- (buffer-read-only))
+ (let* ((opoint (line-beginning-position))
+ (char (char-after opoint))
+ (buffer-read-only))
(delete-region opoint (progn (forward-line 1) (point)))
(if file
(progn
;; 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
(defun dired-copy-file-recursive (from to ok-flag &optional
preserve-time top recursive)
- (let ((attrs (file-attributes from))
- dirfailed)
+ (let ((attrs (file-attributes from)))
(if (and recursive
(eq t (car attrs))
(or (eq recursive 'always)
(yes-or-no-p (format "Recursive copies of %s? " from))))
;; This is a directory.
- (copy-directory from to dired-copy-preserve-time)
+ (copy-directory from to preserve-time)
;; Not a directory.
(or top (dired-handle-overwrite to))
(condition-case err
(if (stringp (car attrs))
;; It is a symlink
(make-symbolic-link (car attrs) to ok-flag)
- (copy-file from to ok-flag dired-copy-preserve-time))
+ (copy-file from to ok-flag preserve-time))
(file-date-error
(push (dired-make-relative from)
dired-create-files-failures)
(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
+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'.
-;; 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.
+OPERATION should be a capitalized string describing the operation
+performed (e.g. `Copy'). It is used for error logging.
-;; OPERATION (a capitalized string, e.g. `Copy') describes the
-;; operation performed. It is used for error logging.
+FN-LIST is the list of files to copy (full absolute file names).
-;; FN-LIST is the list of files to copy (full absolute file names).
-
-;; NAME-CONSTRUCTOR returns a newfile for every oldfile, or nil to
-;; skip. If it skips files for other reasons than a direct user
-;; query, it is supposed to tell why (using dired-log).
-
-;; Optional MARKER-CHAR is a character with which to mark every
-;; newfile's entry, or t to use the current marker character if the
-;; oldfile was marked.
+NAME-CONSTRUCTOR should be a function accepting a single
+argument, the name of an old file, and returning either the
+corresponding new file name or nil to skip.
+Optional MARKER-CHAR is a character with which to mark every
+newfile's entry, or t to use the current marker character if the
+old file was marked."
(let (dired-create-files-failures failures
skipped (success-count 0) (total (length fn-list)))
(let (to overwrite-query
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
\f
;;; 5K
;;;###begin dired-re.el
+(defvar rename-regexp-query)
+
(defun dired-do-create-files-regexp
(file-creator operation arg regexp newname &optional whole-name marker-char)
;; Create a new file for each marked file using regexps.
;; instead of only the non-directory part of the file.
;; Optional arg MARKER-CHAR as in dired-create-files.
(let* ((fn-list (dired-get-marked-files nil arg))
- (fn-count (length fn-list))
(operation-prompt (concat operation " `%s' to `%s'?"))
(rename-regexp-help-form (format "\
Type SPC or `y' to %s one match, DEL or `n' to skip to next,
(function make-symbolic-link)
"SymLink" arg regexp newname whole-name dired-keep-marker-symlink))
+(defvar rename-non-directory-query)
+
(defun dired-create-files-non-directory
(file-creator basename-constructor operation arg)
;; Perform FILE-CREATOR on the non-directory part of marked files
(while alist
(setq elt (car alist)
alist (cdr alist)
- dir (car elt)
- pos (dired-get-subdir-min elt))
+ dir (car elt))
(if (dired-tree-lessp dir new-dir)
;; Insert NEW-DIR after DIR
(setq new-pos (dired-get-subdir-max elt)
;;;###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
HCoop / bpt / emacs.git / blobdiff