X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/ab67260b084615a1451e263c1c05b2f64230c6e1..169e69a3951d0d86bc2380e0187a01a6d35e3e25:/lisp/dired-aux.el diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index d81d0641ec..878e5c5710 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1,9 +1,8 @@ -;; 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 . -;; Version: 5.234 ;; This file is part of GNU Emacs. @@ -23,12 +22,19 @@ ;;; 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 . ;; 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 @@ -37,34 +43,42 @@ (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 @@ -128,7 +142,7 @@ This calls chmod, thus symbolic modes like `g+w' are allowed." ;; 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)) @@ -138,7 +152,7 @@ This calls chmod, thus symbolic modes like `g+w' are allowed." (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 @@ -150,7 +164,8 @@ Uses the shell command coming from variables `lpr-command' and (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)))) @@ -171,14 +186,101 @@ Uses the shell command coming from variables `lpr-command' and (function read-string) (format prompt (dired-mark-prompt arg files)) initial)) +;;; 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))))) + ;;; 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))) @@ -198,46 +300,47 @@ Uses the shell command coming from variables `lpr-command' and ;; 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 "" @@ -272,12 +375,10 @@ output files usually are created there instead of in a subdir." (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) ;; In Emacs 19 this will return program's exit status. ;; This is a separate function so that ange-ftp can redefine it. @@ -314,17 +415,6 @@ output files usually are created there instead of in a subdir." ;; 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)) @@ -347,31 +437,38 @@ If on a subdir headerline, kill whole subdir." ;;;###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 @@ -382,24 +479,60 @@ With a prefix arg, kill all lines not marked or flagged." ;; 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")))))))) (defun dired-mark-confirm (op-symbol arg) ;; Request confirmation from the user that the operation described @@ -408,9 +541,11 @@ With a prefix arg, kill all lines not marked or flagged." ;; 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) @@ -432,15 +567,16 @@ With a prefix arg, kill all lines not marked or flagged." (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 @@ -455,7 +591,7 @@ With a prefix arg, kill all lines not marked or flagged." ;; 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) @@ -493,15 +629,12 @@ With a prefix arg, kill all lines not marked or flagged." (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) @@ -561,7 +694,8 @@ a prefix arg lets you edit the `ls' switches used for the new listing." ;; 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 @@ -574,7 +708,7 @@ a prefix arg lets you edit the `ls' switches used for the new listing." (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 @@ -588,6 +722,7 @@ a prefix arg lets you edit the `ls' switches used for the new listing." (set-buffer obuf))) success-list)) +;;;###autoload (defun dired-add-file (filename &optional marker-char) (dired-fun-in-all-buffers (file-name-directory filename) @@ -631,19 +766,16 @@ a prefix arg lets you edit the `ls' switches used for the new listing." (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 @@ -656,7 +788,7 @@ a prefix arg lets you edit the `ls' switches used for the new listing." 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) @@ -680,6 +812,7 @@ a prefix arg lets you edit the `ls' switches used for the new listing." (forward-line 1)) (point))) +;;;###autoload (defun dired-remove-file (file) (dired-fun-in-all-buffers (file-name-directory file) (function dired-remove-entry) file)) @@ -691,6 +824,7 @@ a prefix arg lets you edit the `ls' switches used for the new listing." (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)) @@ -717,12 +851,14 @@ a prefix arg lets you edit the `ls' switches used for the new listing." "*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)))) @@ -730,10 +866,12 @@ Special value `always' suppresses confirmation.") (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 @@ -754,12 +892,13 @@ Special value `always' suppresses confirmation.") (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)) @@ -772,12 +911,13 @@ Special value `always' suppresses confirmation.") (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) @@ -929,7 +1069,7 @@ Optional arg GLOBAL means to replace all matches." (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', @@ -946,7 +1086,7 @@ ESC or `q' to not overwrite any of the remaining files, (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 @@ -987,7 +1127,7 @@ ESC or `q' to not overwrite any of the remaining files, ;; 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 @@ -1199,8 +1339,7 @@ Type SPC or `y' to %s one match, DEL or `n' to skip to next, (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: ")))) @@ -1363,7 +1502,7 @@ This function takes some pains to conform to `ls -lR' output." (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) @@ -1394,6 +1533,7 @@ This function takes some pains to conform to `ls -lR' output." ;;"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)) @@ -1449,7 +1589,9 @@ This function takes some pains to conform to `ls -lR' output." (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) @@ -1548,38 +1690,6 @@ is always equal to STRING." ;;; 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. @@ -1624,7 +1734,7 @@ The next char is either \\n, or \\r if DIR is hidden." ;;;###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)))) @@ -1747,4 +1857,28 @@ Use \\[dired-hide-subdir] to (un)hide a particular subdirectory." ;;;###end dired-ins.el + +;; 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))) + + +(provide 'dired-aux) + ;;; dired-aux.el ends here