X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/67ab0163d67fbfeb41c37c8a259f27eeef965520..acaf905b1130aae80fa59d2c861ffd4c8eb75486:/lisp/dired-aux.el diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 986c9edfd2..31d8afc4fc 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1,6 +1,6 @@ ;;; 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 . @@ -56,9 +56,9 @@ into this list; they also should call `dired-log' to log the errors.") "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. @@ -226,31 +226,26 @@ List has a form of (file-name full-file-name (attribute-list))." (file-attributes full-file-name)))) (directory-files dir))) - -(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 @@ -258,9 +253,10 @@ List has a form of (file-name full-file-name (attribute-list))." (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)) @@ -288,10 +284,16 @@ Symbolic modes like `g+w' are allowed." (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 @@ -345,7 +347,7 @@ This calls touch." ;; 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) @@ -382,22 +384,24 @@ Uses the shell command coming from variables `lpr-command' and '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)) ;;; Cleaning a directory: flagging some backups for deletion. @@ -459,6 +463,8 @@ with a prefix argument." (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. @@ -509,22 +515,25 @@ to the end of the list of defaults just after the default value." ;; 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) @@ -628,7 +637,7 @@ can be produced by `dired-get-marked-files', for example." (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. @@ -694,6 +703,9 @@ can be produced by `dired-get-marked-files', for example." ;; 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) @@ -915,8 +927,7 @@ return t; if SYM is q or ESC, return nil." (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))))) @@ -1003,7 +1014,7 @@ See Info node `(emacs)Subdir switches' for more details." (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) @@ -1025,9 +1036,9 @@ See Info node `(emacs)Subdir switches' for more details." ;; 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 @@ -1078,7 +1089,6 @@ files matching `dired-omit-regexp'." ;; 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 @@ -1251,21 +1261,20 @@ Special value `always' suppresses confirmation." (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) @@ -1360,36 +1369,35 @@ Special value `always' suppresses confirmation." (setcar elt cur-dir) (when cons (setcar cons cur-dir)))))) +;; 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 @@ -1481,7 +1489,7 @@ 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 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; @@ -1551,7 +1559,7 @@ Optional arg HOW-TO determiness how to treat the target. (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, @@ -1638,11 +1646,14 @@ Optional arg HOW-TO determiness how to treat the target. ;;;###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 @@ -1742,6 +1753,8 @@ of `dired-dwim-target', which see." ;;; 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. @@ -1753,7 +1766,6 @@ of `dired-dwim-target', which see." ;; 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, @@ -1862,6 +1874,8 @@ See function `dired-do-rename-regexp' for more info." (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 @@ -2058,8 +2072,7 @@ of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well." (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) @@ -2486,8 +2499,9 @@ with the command \\[tags-loop-continue]." ;;;###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