-;; dired-aux.el --- directory browsing command support
+;;; dired-aux.el --- all of dired except what people usually use
-;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1992, 1994 Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
-;; Version: 5.234
;; This file is part of GNU Emacs.
;;; Commentary:
+;; The parts of dired mode not normally used. This is a space-saving hack
+;; to avoid having to load a large mode when all that's wanted are a few
+;; functions.
+
;; Rewritten in 1990/1991 to add tree features, file marking and
;; sorting by Sebastian Kremer <sk@thp.uni-koeln.de>.
;; Finished up by rms in 1992.
;;; Code:
+;; We need macros in dired.el to compile properly.
+(eval-when-compile (require 'dired))
+
;;; 15K
;;;###begin dired-cmd.el
;; Diffing and compressing
(defun dired-diff (file &optional switches)
"Compare file at point with file FILE using `diff'.
FILE defaults to the file at the mark.
-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'."
(interactive
- (let ((default (if (mark)
- (save-excursion (goto-char (mark))
+ (let ((default (if (mark t)
+ (save-excursion (goto-char (mark t))
(dired-get-filename t t)))))
+ (require 'diff)
(list (read-file-name (format "Diff %s with: %s"
(dired-get-filename t)
(if default
(concat "(default " default ") ")
""))
(dired-current-directory) default t)
- (if (fboundp 'diff-read-switches)
- (diff-read-switches "Options for diff: ")))))
- (if switches ; Emacs 19's diff has but two
- (diff file (dired-get-filename t) switches) ; args (yet ;-)
- (diff file (dired-get-filename t))))
+ (if current-prefix-arg
+ (read-string "Options for diff: "
+ (if (stringp diff-switches)
+ diff-switches
+ (mapconcat 'identity diff-switches " ")))))))
+ (diff file (dired-get-filename t) switches))
;;;###autoload
(defun dired-backup-diff (&optional switches)
"Diff this file with its backup file or vice versa.
Uses the latest backup, if there are several numerical backups.
If this file is a backup, diff it with its original.
-The backup file is the first file given to `diff'."
- (interactive (list (if (fboundp 'diff-read-switches)
- (diff-read-switches "Diff with switches: "))))
- (if switches
- (diff-backup (dired-get-filename) switches)
- (diff-backup (dired-get-filename))))
+The backup file is the first file given to `diff'.
+With prefix arg, prompt for argument SWITCHES which is options for `diff'."
+ (interactive
+ (if current-prefix-arg
+ (list (read-string "Options for diff: "
+ (if (stringp diff-switches)
+ diff-switches
+ (mapconcat 'identity diff-switches " "))))
+ nil))
+ (diff-backup (dired-get-filename) switches))
(defun dired-do-chxxx (attribute-name program op-symbol arg)
;; Change file attributes (mode, group, owner) of marked files and
;; and this file won't fit in the length limit, process now.
(if (and pending (> (+ thislength pending-length) max))
(setq failures
- (nconc (apply function (append args pending) pending)
+ (nconc (apply function (append args pending))
failures)
pending nil
pending-length 0))
(setq pending files)
(setq pending-length (+ thislength pending-length))
(setq files rest)))
- (nconc (apply function (append args pending) pending)
+ (nconc (apply function (append args pending))
failures)))
;;;###autoload
(let* ((file-list (dired-get-marked-files t arg))
(command (dired-mark-read-string
"Print %s with: "
- (apply 'concat lpr-command " " lpr-switches)
+ (mapconcat 'concat (append (list lpr-command)
+ lpr-switches) " ")
'print arg file-list)))
(dired-run-shell-command (dired-shell-stuff-it command file-list nil))))
(function read-string)
(format prompt (dired-mark-prompt arg files)) initial))
\f
+;;; Cleaning a directory: flagging some backups for deletion.
+
+(defvar dired-file-version-alist)
+
+(defun dired-clean-directory (keep)
+ "Flag numerical backups for deletion.
+Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
+Positive prefix arg KEEP overrides `dired-kept-versions';
+Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive.
+
+To clear the flags on these files, you can use \\[dired-flag-backup-files]
+with a prefix argument."
+ (interactive "P")
+ (setq keep (if keep (prefix-numeric-value keep) dired-kept-versions))
+ (let ((early-retention (if (< keep 0) (- keep) kept-old-versions))
+ (late-retention (if (<= keep 0) dired-kept-versions keep))
+ (dired-file-version-alist ()))
+ (message "Cleaning numerical backups (keeping %d late, %d old)..."
+ late-retention early-retention)
+ ;; Look at each file.
+ ;; If the file has numeric backup versions,
+ ;; put on dired-file-version-alist an element of the form
+ ;; (FILENAME . VERSION-NUMBER-LIST)
+ (dired-map-dired-file-lines (function dired-collect-file-versions))
+ ;; Sort each VERSION-NUMBER-LIST,
+ ;; and remove the versions not to be deleted.
+ (let ((fval dired-file-version-alist))
+ (while fval
+ (let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
+ (v-count (length sorted-v-list)))
+ (if (> v-count (+ early-retention late-retention))
+ (rplacd (nthcdr early-retention sorted-v-list)
+ (nthcdr (- v-count late-retention)
+ sorted-v-list)))
+ (rplacd (car fval)
+ (cdr sorted-v-list)))
+ (setq fval (cdr fval))))
+ ;; Look at each file. If it is a numeric backup file,
+ ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
+ (dired-map-dired-file-lines (function dired-trample-file-versions))
+ (message "Cleaning numerical backups...done")))
+
+;;; Subroutines of dired-clean-directory.
+
+(defun dired-map-dired-file-lines (fun)
+ ;; Perform FUN with point at the end of each non-directory line.
+ ;; FUN takes one argument, the filename (complete pathname).
+ (save-excursion
+ (let (file buffer-read-only)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (save-excursion
+ (and (not (looking-at 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)))))
+
+(defun dired-collect-file-versions (fn)
+ ;; "If it looks like file FN has versions, return a list of the versions.
+ ;;That is a list of strings which are file names.
+ ;;The caller may want to flag some of these files for deletion."
+ (let* ((base-versions
+ (concat (file-name-nondirectory fn) ".~"))
+ (bv-length (length base-versions))
+ (possibilities (file-name-all-completions
+ base-versions
+ (file-name-directory fn)))
+ (versions (mapcar 'backup-extract-version possibilities)))
+ (if versions
+ (setq dired-file-version-alist (cons (cons fn versions)
+ dired-file-version-alist)))))
+
+(defun dired-trample-file-versions (fn)
+ (let* ((start-vn (string-match "\\.~[0-9]+~$" fn))
+ base-version-list)
+ (and start-vn
+ (setq base-version-list ; there was a base version to which
+ (assoc (substring fn 0 start-vn) ; this looks like a
+ dired-file-version-alist)) ; subversion
+ (not (memq (string-to-int (substring fn (+ 2 start-vn)))
+ base-version-list)) ; this one doesn't make the cut
+ (progn (beginning-of-line)
+ (delete-char 1)
+ (insert dired-del-marker)))))
+\f
;;; Shell commands
;;>>> install (move this function into simple.el)
(defun dired-shell-quote (filename)
"Quote a file name for inferior shell (see variable `shell-file-name')."
;; Quote everything except POSIX filename characters.
- ;; This should be safe enough even for really wierd shells.
+ ;; This should be safe enough even for really weird shells.
(let ((result "") (start 0) end)
- (while (string-match "[^---0-9a-zA-Z_./]" filename start)
+ (while (string-match "[^-0-9a-zA-Z_./]" filename start)
(setq end (match-beginning 0)
result (concat result (substring filename start end)
"\\" (substring filename end (1+ end)))
;; 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 (&optional arg in-background)
- "Run a shell command on the marked files.
+(defun dired-do-shell-command (command &optional arg)
+ "Run a shell command COMMAND on the marked files.
+If no files are marked or a specific 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.
+
If there is output, it goes to a separate buffer.
+
Normally the command is run on each file individually.
However, if there is a `*' in the command then it is run
just once with the entire file list substituted there.
-If no files are marked or a specific 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.
-
-No automatic redisplay is attempted, as the file names may have
-changed. Type \\[dired-do-redisplay] to redisplay the marked files.
+No automatic redisplay of dired buffers is attempted, as there's no
+telling what files the command may have changed. Type
+\\[dired-do-redisplay] to redisplay the marked files.
The shell command has the top level directory as working directory, so
output files usually are created there instead of in a subdir."
;;Functions dired-run-shell-command and dired-shell-stuff-it do the
;;actual work and can be redefined for customization.
- (interactive "P")
+ (interactive (list
+ ;; Want to give feedback whether this file or marked files are used:
+ (dired-read-shell-command (concat "! on "
+ "%s: ")
+ current-prefix-arg
+ (dired-get-marked-files
+ t current-prefix-arg))
+ current-prefix-arg))
(let* ((on-each (not (string-match "\\*" command)))
- (prompt (concat (if in-background "& on " "! on ")
- (if on-each "each " "")
- "%s: "))
- (file-list (dired-get-marked-files t arg))
- ;; Want to give feedback whether this file or marked files are used:
- (command (dired-read-shell-command
- prompt arg file-list)))
+ (file-list (dired-get-marked-files t arg)))
(if on-each
(dired-bunch-files
(- 10000 (length command))
(function (lambda (&rest files)
(dired-run-shell-command
- (dired-shell-stuff-it command files t arg))
- in-background))
+ (dired-shell-stuff-it command files t arg))))
nil
file-list)
;; execute the shell command
(dired-run-shell-command
- (dired-shell-stuff-it command file-list nil arg)
- in-background))))
+ (dired-shell-stuff-it command file-list nil arg)))))
;; Might use {,} for bash or csh:
(defvar dired-mark-prefix ""
(funcall stuff-it fns)))))
;; This is an extra function so that it can be redefined by ange-ftp.
-(defun dired-run-shell-command (command &optional in-background)
- (if (not in-background)
- (shell-command command)
- ;; We need this only in Emacs 18 (19's shell command has `&').
- ;; comint::background is defined in emacs-19.el.
- (comint::background command)))
+(defun dired-run-shell-command (command)
+ (shell-command command)
+ ;; Return nil for sake of nconc in dired-bunch-files.
+ nil)
\f
;; In Emacs 19 this will return program's exit status.
;; This is a separate function so that ange-ftp can redefine it.
\f
;; Commands that delete or redisplay part of the dired buffer.
-;;;###autoload
-(defun dired-kill-line-or-subdir (&optional arg)
- "Kill this line (but don't delete its file).
-Optional prefix argument is a repeat factor.
-If file is displayed as in situ subdir, kill that as well.
-If on a subdir headerline, kill whole subdir."
- (interactive "p")
- (if (dired-get-subdir)
- (dired-kill-subdir)
- (dired-kill-line arg)))
-
(defun dired-kill-line (&optional arg)
(interactive "P")
(setq arg (prefix-numeric-value arg))
;;;###autoload
(defun dired-do-kill-lines (&optional arg fmt)
"Kill all marked lines (not the files).
-With a prefix arg, kill all lines not marked or flagged."
+With a prefix argument, kill that many lines starting with the current line.
+\(A negative argument kills lines before the current line.)
+To kill an entire subdirectory, go to its directory header line
+and use this command with a prefix argument (the value does not matter)."
;; Returns count of killed lines. FMT="" suppresses message.
(interactive "P")
- (save-excursion
- (goto-char (point-min))
- (let (buffer-read-only (count 0))
- (if (not arg) ; kill marked lines
- (let ((regexp (dired-marker-regexp)))
- (while (and (not (eobp))
- (re-search-forward regexp nil t))
+ (if arg
+ (if (dired-get-subdir)
+ (dired-kill-subdir)
+ (dired-kill-line arg))
+ (save-excursion
+ (goto-char (point-min))
+ (let (buffer-read-only (count 0))
+ (if (not arg) ; kill marked lines
+ (let ((regexp (dired-marker-regexp)))
+ (while (and (not (eobp))
+ (re-search-forward regexp nil t))
+ (setq count (1+ count))
+ (delete-region (progn (beginning-of-line) (point))
+ (progn (forward-line 1) (point)))))
+ ;; else kill unmarked lines
+ (while (not (eobp))
+ (if (or (dired-between-files)
+ (not (looking-at "^ ")))
+ (forward-line 1)
(setq count (1+ count))
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point)))))
- ;; else kill unmarked lines
- (while (not (eobp))
- (if (or (dired-between-files)
- (not (looking-at "^ ")))
- (forward-line 1)
- (setq count (1+ count))
- (delete-region (point) (save-excursion
- (forward-line 1)
- (point))))))
- (or (equal "" fmt)
- (message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
- count)))
+ (delete-region (point) (save-excursion
+ (forward-line 1)
+ (point))))))
+ (or (equal "" fmt)
+ (message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
+ count))))
;;;###end dired-cmd.el
\f
;; Compress or uncompress the current file.
;; Return nil for success, offending filename else.
(let* (buffer-read-only
- (from-file (dired-get-filename)))
- (cond ((save-excursion (beginning-of-line)
- (looking-at dired-re-sym))
- (dired-log (concat "Attempt to compress a symbolic link:\n"
- from-file))
- (dired-make-relative from-file))
- ((string-match "\\.Z$" from-file)
- (if (dired-check-process (concat "Uncompressing " from-file)
- "uncompress" from-file)
- (dired-make-relative from-file)
- (dired-update-file-line (substring from-file 0 -2))))
+ (from-file (dired-get-filename))
+ (new-file (dired-compress-file from-file)))
+ (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))
+ (goto-char start)
+ ;; Now replace the current line with an entry for NEW-FILE.
+ (dired-update-file-line new-file) nil)
+ (dired-log (concat "Failed to compress" from-file))
+ from-file)))
+
+;;;###autoload
+(defun dired-compress-file (file)
+ ;; Compress or uncompress FILE.
+ ;; Return the name of the compressed or uncompressed file.
+ ;; Return nil if no change in files.
+ (let ((handler (find-file-name-handler file 'dired-compress-file)))
+ (cond (handler
+ (funcall handler 'dired-compress-file file))
+ ((file-symlink-p file)
+ nil)
+ ((let (case-fold-search)
+ (string-match "\\.Z$" file))
+ (if (not (dired-check-process (concat "Uncompressing " file)
+ "uncompress" file))
+ (substring file 0 -2)))
+ ((let (case-fold-search)
+ (string-match "\\.gz$" file))
+ (if (not (dired-check-process (concat "Uncompressing " file)
+ "gunzip" file))
+ (substring file 0 -3)))
+ ;; For .z, try gunzip. It might be an old gzip file,
+ ;; or it might be from compact? pack? (which?) but gunzip handles
+ ;; both.
+ ((let (case-fold-search)
+ (string-match "\\.z$" file))
+ (if (not (dired-check-process (concat "Uncompressing " file)
+ "gunzip" file))
+ (substring file 0 -2)))
(t
- (if (dired-check-process (concat "Compressing " from-file)
- "compress" "-f" from-file)
- ;; Errors from the process are already logged.
- (dired-make-relative from-file)
- (dired-update-file-line (concat from-file ".Z")))))
- nil))
+ ;;; Try gzip; if we don't have that, use compress.
+ (condition-case nil
+ (if (not (dired-check-process (concat "Compressing " file)
+ "gzip" "-f" file))
+ (cond ((file-exists-p (concat file ".gz"))
+ (concat file ".gz"))
+ (t (concat file ".z"))))
+ (file-error
+ (if (not (dired-check-process (concat "Compressing " file)
+ "compress" "-f" file))
+ (concat file ".Z"))))))))
\f
(defun dired-mark-confirm (op-symbol arg)
;; Request confirmation from the user that the operation described
;; pop-up unless OP-SYMBOL is a member of `dired-no-confirm'.
;; The files used are determined by ARG (as in dired-get-marked-files).
(or (memq op-symbol dired-no-confirm)
- (let ((files (dired-get-marked-files t arg)))
+ (let ((files (dired-get-marked-files t arg))
+ (string (if (eq op-symbol 'compress) "Compress or uncompress"
+ (capitalize (symbol-name op-symbol)))))
(dired-mark-pop-up nil op-symbol files (function y-or-n-p)
- (concat (capitalize (symbol-name op-symbol)) " "
+ (concat string " "
(dired-mark-prompt arg files) "? ")))))
(defun dired-map-over-marks-check (fun arg op-symbol &optional show-progress)
(dired-map-over-marks (funcall fun) arg show-progress))
(total (length total-list))
(failures (delq nil total-list))
- (count (length failures)))
+ (count (length failures))
+ (string (if (eq op-symbol 'compress) "Compress or uncompress"
+ (capitalize (symbol-name op-symbol)))))
(if (not failures)
(message "%s: %d file%s."
- (capitalize (symbol-name op-symbol))
- total (dired-plural-s total))
+ string total (dired-plural-s total))
;; end this bunch of errors:
(dired-log-summary
(format "Failed to %s %d of %d file%s"
- (symbol-name op-symbol) count total (dired-plural-s total))
+ (downcase string) count total (dired-plural-s total))
failures)))))
(defvar dired-query-alist
;; 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 C-h.
+ ;; 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)
(defun dired-byte-compile ()
;; Return nil for success, offending file name else.
(let* ((filename (dired-get-filename))
- (elc-file
- (if (eq system-type 'vax-vms)
- (concat (substring filename 0 (string-match ";" filename)) "c")
- (concat filename "c")))
- buffer-read-only failure)
+ elc-file buffer-read-only failure)
(condition-case err
(save-excursion (byte-compile-file filename))
(error
(setq failure err)))
+ (setq elc-file (byte-compile-dest-file filename))
(if failure
(progn
(dired-log "Byte compile error for %s:\n%s\n" filename failure)
;; 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)))
+ (let ((char (following-char)) (opoint (point))
+ (buffer-read-only))
(delete-region (point) (progn (forward-line 1) (point)))
(if file
(progn
(defun dired-fun-in-all-buffers (directory fun &rest args)
;; In all buffers dired'ing DIRECTORY, run FUN with ARGS.
;; Return list of buffers where FUN succeeded (i.e., returned non-nil).
- (let ((buf-list (dired-buffers-for-dir directory))
+ (let ((buf-list (dired-buffers-for-dir (expand-file-name directory)))
(obuf (current-buffer))
buf success-list)
(while buf-list
(set-buffer obuf)))
success-list))
+;;;###autoload
(defun dired-add-file (filename &optional marker-char)
(dired-fun-in-all-buffers
(file-name-directory filename)
(dired-goto-next-nontrivial-file))
;; not found
(throw 'not-found "Subdir not found")))
- ;; found and point is at The Right Place:
- (let (buffer-read-only)
+ (let (buffer-read-only opoint)
(beginning-of-line)
+ (setq opoint (point))
(dired-add-entry-do-indentation marker-char)
- (dired-ls (dired-make-absolute filename directory);; don't expand `.' !
- (concat dired-actual-switches "d"))
+ ;; don't expand `.'. Show just the file name within directory.
+ (let ((default-directory directory))
+ (insert-directory filename
+ (concat dired-actual-switches "d")))
+ (dired-insert-set-properties opoint (point))
(forward-line -1)
- ;; We want to have the non-directory part, only:
- (let* ((beg (dired-move-to-filename t)) ; error for strange output
- (end (dired-move-to-end-of-filename)))
- (setq filename (buffer-substring beg end))
- (delete-region beg end)
- (insert (file-name-nondirectory filename)))
(if dired-after-readin-hook;; the subdir-alist is not affected...
(save-excursion;; ...so we can run it right now:
(save-restriction
nil))
(if reason ; don't move away on failure
(goto-char opoint))
- (not reason))) ; return t on succes, nil else
+ (not reason))) ; return t on success, nil else
;; This is a separate function for the sake of nested dired format.
(defun dired-add-entry-do-indentation (marker-char)
(forward-line 1))
(point)))
+;;;###autoload
(defun dired-remove-file (file)
(dired-fun-in-all-buffers
(file-name-directory file) (function dired-remove-entry) file))
(delete-region (progn (beginning-of-line) (point))
(save-excursion (forward-line 1) (point)))))))
+;;;###autoload
(defun dired-relist-file (file)
(dired-fun-in-all-buffers (file-name-directory file)
(function dired-relist-entry) file))
"*Non-nil if Dired should ask about making backups before overwriting files.
Special value `always' suppresses confirmation.")
+(defvar dired-overwrite-confirmed)
+
(defun dired-handle-overwrite (to)
;; Save old version of a to be overwritten file TO.
- ;; `overwrite-confirmed' and `overwrite-backup-query' are fluid vars
+ ;; `dired-overwrite-confirmed' and `overwrite-backup-query' are fluid vars
;; from dired-create-files.
(if (and dired-backup-overwrite
- overwrite-confirmed
+ dired-overwrite-confirmed
(or (eq 'always dired-backup-overwrite)
(dired-query 'overwrite-backup-query
(format "Make backup for existing file `%s'? " to))))
(rename-file to backup 0) ; confirm overwrite of old backup
(dired-relist-entry backup))))
+;;;###autoload
(defun dired-copy-file (from to ok-flag)
(dired-handle-overwrite to)
(copy-file from to ok-flag dired-copy-preserve-time))
+;;;###autoload
(defun dired-rename-file (from to ok-flag)
(dired-handle-overwrite to)
(rename-file from to ok-flag) ; error is caught in -create-files
(dired-fun-in-all-buffers from-dir
(function dired-rename-subdir-1) from-dir to-dir)
;; Update visited file name of all affected buffers
- (let ((blist (buffer-list)))
+ (let ((expanded-from-dir (expand-file-name from-dir))
+ (blist (buffer-list)))
(while blist
(save-excursion
- (set-buffer (car blist))
+ (set-buffer (car blist))
(if (and buffer-file-name
- (dired-in-this-tree buffer-file-name from-dir))
+ (dired-in-this-tree buffer-file-name expanded-from-dir))
(let ((modflag (buffer-modified-p))
(to-file (dired-replace-in-string
(concat "^" (regexp-quote from-dir))
(defun dired-rename-subdir-1 (dir to)
;; Rename DIR to TO in headerlines and dired-subdir-alist, if DIR or
;; one of its subdirectories is expanded in this buffer.
- (let ((alist dired-subdir-alist)
+ (let ((expanded-dir (expand-file-name dir))
+ (alist dired-subdir-alist)
(elt nil))
(while alist
(setq elt (car alist)
alist (cdr alist))
- (if (dired-in-this-tree (car elt) dir)
+ (if (dired-in-this-tree (car elt) expanded-dir)
;; ELT's subdir is affected by the rename
(dired-rename-subdir-2 elt dir to)))
(if (equal dir default-directory)
(if (not to)
(setq skipped (cons (dired-make-relative from) skipped))
(let* ((overwrite (file-exists-p to))
- (overwrite-confirmed ; for dired-handle-overwrite
+ (dired-overwrite-confirmed ; for dired-handle-overwrite
(and overwrite
(let ((help-form '(format "\
Type SPC or `y' to overwrite file `%s',
(t nil))))
(condition-case err
(progn
- (funcall file-creator from to overwrite-confirmed)
+ (funcall file-creator from to dired-overwrite-confirmed)
(if overwrite
;; If we get here, file-creator hasn't been aborted
;; and the old entry (if any) has to be deleted
;; the new files. Target may be a plain file if only one marked
;; file exists.
;; OP-SYMBOL is the symbol for the operation. Function `dired-mark-pop-up'
- ;; will determine wether pop-ups are appropriate for this OP-SYMBOL.
+ ;; will determine whether pop-ups are appropriate for this OP-SYMBOL.
;; FILE-CREATOR and OPERATION as in dired-create-files.
;; ARG as in dired-get-marked-files.
;; Optional arg OP1 is an alternate form for OPERATION if there is
(if whole-path nil current-prefix-arg))
(regexp
(dired-read-regexp
- (concat (if whole-path "Path " "") operation " from (regexp): ")
- dired-flagging-regexp))
+ (concat (if whole-path "Path " "") operation " from (regexp): ")))
(newname
(read-string
(concat (if whole-path "Path " "") operation " " regexp " to: "))))
(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 `..').
- (or (dired-in-this-tree dirname default-directory)
+ (or (dired-in-this-tree dirname (expand-file-name default-directory))
(error "%s: not in this directory tree" dirname))
(if switches
(let (case-fold-search)
;;"Kill all proper subdirs of DIRNAME, excluding DIRNAME itself.
;; With optional arg REMEMBER-MARKS, return an alist of marked files."
(interactive "DKill tree below directory: ")
+ (setq dirname (expand-file-name dirname))
(let ((s-alist dired-subdir-alist) dir m-alist)
(while s-alist
(setq dir (car (car s-alist))
(if (equal dirname (car (car (reverse dired-subdir-alist))))
;; top level directory may contain wildcards:
(dired-readin-insert dired-directory)
- (dired-ls dirname dired-actual-switches nil t)))
+ (let ((opoint (point)))
+ (insert-directory dirname dired-actual-switches nil t)
+ (dired-insert-set-properties opoint (point)))))
(message "Reading directory %s...done" dirname)
(setq end (point-marker))
(indent-rigidly begin end 2)
\f
;;; moving by subdirectories
-(defun dired-subdir-index (dir)
- ;; Return an index into alist for use with nth
- ;; for the sake of subdir moving commands.
- (let (found (index 0) (alist dired-subdir-alist))
- (while alist
- (if (string= dir (car (car alist)))
- (setq alist nil found t)
- (setq alist (cdr alist) index (1+ index))))
- (if found index nil)))
-
-;;;###autoload
-(defun dired-next-subdir (arg &optional no-error-if-not-found no-skip)
- "Go to next subdirectory, regardless of level."
- ;; Use 0 arg to go to this directory's header line.
- ;; NO-SKIP prevents moving to end of header line, returning whatever
- ;; position was found in dired-subdir-alist.
- (interactive "p")
- (let ((this-dir (dired-current-directory))
- pos index)
- ;; nth with negative arg does not return nil but the first element
- (setq index (- (dired-subdir-index this-dir) arg))
- (setq pos (if (>= index 0)
- (dired-get-subdir-min (nth index dired-subdir-alist))))
- (if pos
- (progn
- (goto-char pos)
- (or no-skip (skip-chars-forward "^\n\r"))
- (point))
- (if no-error-if-not-found
- nil ; return nil if not found
- (error "%s directory" (if (> arg 0) "Last" "First"))))))
-
;;;###autoload
(defun dired-prev-subdir (arg &optional no-error-if-not-found no-skip)
"Go to previous subdirectory, regardless of level.
;;;###autoload
(defun dired-mark-subdir-files ()
"Mark all files except `.' and `..'."
- (interactive "P")
+ (interactive)
(let ((p-min (dired-subdir-min)))
(dired-mark-files-in-region p-min (dired-subdir-max))))
;;;###end dired-ins.el
+\f
+;; Functions for searching in tags style among marked files.
+
+;;;###autoload
+(defun dired-do-tags-search (regexp)
+ "Search through all marked files for a match for REGEXP.
+Stops when a match is found.
+To continue searching for next match, use command \\[tags-loop-continue]."
+ (interactive "sSearch marked files (regexp): ")
+ (tags-search regexp '(dired-get-marked-files)))
+
+;;;###autoload
+(defun dired-do-tags-query-replace (from to &optional delimited)
+ "Query-replace-regexp FROM with TO through all marked files.
+Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
+If you exit (\\[keyboard-quit] or ESC), you can resume the query-replace
+with the command \\[tags-loop-continue]."
+ (interactive
+ "sQuery replace in marked files (regexp): \nsQuery replace %s by: \nP")
+ (tags-query-replace from to delimited '(dired-get-marked-files)))
+\f
+
+(provide 'dired-aux)
+
;;; dired-aux.el ends here
HCoop / bpt / emacs.git / blobdiff