(if default
(concat "(default " default ") ")
""))
- (dired-current-directory) default t)
+ (if default
+ (dired-current-directory)
+ (dired-dwim-target-directory))
+ default t)
(if current-prefix-arg
(read-string "Options for diff: "
(if (stringp diff-switches)
(unless (let ((list list2))
(while (and list
(not (let* ((file2 (car list))
- (fa1 (caddr file1))
- (fa2 (caddr file2))
+ (fa1 (car (cddr file1)))
+ (fa2 (car (cddr file2)))
(size1 (nth 7 fa1))
(size2 (nth 7 fa2))
(mtime1 (float-time (nth 5 fa1)))
(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)))
+
(defun dired-do-chxxx (attribute-name program op-symbol arg)
;; Change file attributes (mode, group, owner, timestamp) of marked files and
;; refresh their file lines.
(new-attribute
(dired-mark-read-string
(concat "Change " attribute-name " of %s to: ")
- nil op-symbol arg files))
+ (if (eq op-symbol 'touch) (dired-touch-initial files))
+ op-symbol arg files))
(operation (concat program " " new-attribute))
failures)
(setq failures
(error "chown not supported on this system"))
(dired-do-chxxx "Owner" dired-chown-program 'chown arg))
+;;;###autoload
(defun dired-do-touch (&optional arg)
"Change the timestamp of the marked (or next ARG) files.
This calls touch."
(defvar dired-file-version-alist)
+;;;###autoload
(defun dired-clean-directory (keep)
"Flag numerical backups for deletion.
Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
(funcall stuff-it files)))))
;; This is an extra function so that it can be redefined by ange-ftp.
+;;;###autoload
(defun dired-run-shell-command (command)
(let ((handler
(find-file-name-handler (directory-file-name default-directory)
(defun dired-do-kill-lines (&optional arg fmt)
"Kill all marked lines (not the files).
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)."
+\(A negative argument kills backward.)
+If you use this command with a prefix argument to kill the line
+for a file that is a directory, which you have inserted in the
+Dired buffer as a subdirectory, then it deletes that subdirectory
+from the buffer as well.
+To kill an entire subdirectory \(without killing its line in the
+parent directory), 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")
(if arg
(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 (point) (save-excursion
- (forward-line 1)
- (point))))))
+ (let (buffer-read-only
+ (count 0)
+ (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))))
(or (equal "" fmt)
(message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
count))))
;; None of these keys quit - use C-g for that.
))
+;;;###autoload
(defun dired-query (qs-var qs-prompt &rest qs-args)
;; Query user and return nil or t.
;; Store answer in symbol VAR (which must initially be bound to nil).
(defun dired-do-redisplay (&optional arg test-for-subdir)
"Redisplay all marked (or next ARG) files.
If on a subdir line, redisplay that subdirectory. In that case,
-a prefix arg lets you edit the `ls' switches used for the new listing."
+a prefix arg lets you edit the `ls' switches used for the new listing.
+
+Dired remembers switches specified with a prefix arg, so that reverting
+the buffer will not reset them. However, using `dired-undo' to re-insert
+or delete subdirectories can bypass this machinery. Hence, you sometimes
+may have to reset some subdirectory switches after a `dired-undo'.
+You can reset all subdirectory switches to the default using
+\\<dired-mode-map>\\[dired-reset-subdir-switches].
+See Info node `(emacs-xtra)Subdir switches' for more details."
;; Moves point if the next ARG files are redisplayed.
(interactive "P\np")
(if (and test-for-subdir (dired-get-subdir))
- (dired-insert-subdir
- (dired-get-subdir)
- (if arg (read-string "Switches for listing: " dired-actual-switches)))
+ (let* ((dir (dired-get-subdir))
+ (switches (cdr (assoc-string dir dired-switches-alist))))
+ (dired-insert-subdir
+ dir
+ (when arg
+ (read-string "Switches for listing: "
+ (or switches
+ dired-subdir-switches
+ dired-actual-switches)))))
(message "Redisplaying...")
;; message much faster than making dired-map-over-marks show progress
(dired-uncache
arg)
(dired-move-to-filename)
(message "Redisplaying...done")))
+
+(defun dired-reset-subdir-switches ()
+ "Set `dired-switches-alist' to nil and revert dired buffer."
+ (interactive)
+ (setq dired-switches-alist nil)
+ (revert-buffer))
\f
(defun dired-update-file-line (file)
;; Delete the current line, and insert an entry for FILE.
\f
;;; Copy, move/rename, making hard and symbolic links
-(defcustom dired-recursive-copies nil
- "*Decide whether recursive copies are allowed.
-nil means no recursive copies.
-`always' means copy recursively without asking.
-`top' means ask for each directory at top level.
-Anything else means ask for each directory."
- :type '(choice :tag "Copy directories"
- (const :tag "No recursive copies" nil)
- (const :tag "Ask for each directory" t)
- (const :tag "Ask for each top directory only" top)
- (const :tag "Copy directories without asking" always))
- :group 'dired)
-
(defcustom dired-backup-overwrite nil
"*Non-nil if Dired should ask about making backups before overwriting files.
Special value `always' suppresses confirmation."
(dired-advertise)))))
(defun dired-rename-subdir-2 (elt dir to)
- ;; Update the headerline and dired-subdir-alist element of directory
- ;; described by alist-element ELT to reflect the moving of DIR to TO.
- ;; Thus, ELT describes either DIR itself or a subdir of DIR.
+ ;; Update the headerline and dired-subdir-alist element, as well as
+ ;; dired-switches-alist element, of directory described by
+ ;; alist-element ELT to reflect the moving of DIR to TO. Thus, ELT
+ ;; describes either DIR itself or a subdir of DIR.
(save-excursion
(let ((regexp (regexp-quote (directory-file-name dir)))
(newtext (directory-file-name to))
(if (re-search-forward regexp (match-end 1) t)
(replace-match newtext t t)
(error "Expected to find `%s' in headerline of %s" dir (car elt))))
- ;; Update buffer-local dired-subdir-alist
- (setcar elt
- (dired-normalize-subdir
- (dired-replace-in-string regexp newtext (car elt)))))))
+ ;; Update buffer-local dired-subdir-alist and dired-switches-alist
+ (let ((cons (assoc-string (car elt) dired-switches-alist))
+ (cur-dir (dired-normalize-subdir
+ (dired-replace-in-string regexp newtext (car elt)))))
+ (setcar elt cur-dir)
+ (when cons (setcar cons cur-dir))))))
\f
;; 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
With a prefix arg, you may edit the ls switches used for this listing.
You can add `R' to the switches to expand the whole tree starting at
this subdirectory.
-This function takes some pains to conform to `ls -lR' output."
+This function takes some pains to conform to `ls -lR' output.
+
+Dired remembers switches specified with a prefix arg, so that reverting
+the buffer will not reset them. However, using `dired-undo' to re-insert
+or delete subdirectories can bypass this machinery. Hence, you sometimes
+may have to reset some subdirectory switches after a `dired-undo'.
+You can reset all subdirectory switches to the default using
+\\<dired-mode-map>\\[dired-reset-subdir-switches].
+See Info node `(emacs-xtra)Subdir switches' for more details."
(interactive
(list (dired-get-filename)
(if current-prefix-arg
- (read-string "Switches for listing: " dired-actual-switches))))
+ (read-string "Switches for listing: "
+ (or dired-subdir-switches dired-actual-switches)))))
(let ((opoint (point)))
;; We don't need a marker for opoint as the subdir is always
;; inserted *after* opoint.
(interactive
(list (dired-get-filename)
(if current-prefix-arg
- (read-string "Switches for listing: " dired-actual-switches))))
+ (read-string "Switches for listing: "
+ (or dired-subdir-switches dired-actual-switches)))))
(setq dirname (file-name-as-directory (expand-file-name dirname)))
- (dired-insert-subdir-validate dirname switches)
(or no-error-if-not-dir-p
(file-directory-p dirname)
(error "Attempt to insert a non-directory: %s" dirname))
(let ((elt (assoc dirname dired-subdir-alist))
- switches-have-R mark-alist case-fold-search buffer-read-only)
+ (cons (assoc-string dirname dired-switches-alist))
+ (modflag (buffer-modified-p))
+ (old-switches switches)
+ switches-have-R mark-alist case-fold-search buffer-read-only)
+ (and (not switches) cons (setq switches (cdr cons)))
+ (dired-insert-subdir-validate dirname switches)
;; case-fold-search is nil now, so we can test for capital `R':
(if (setq switches-have-R (and switches (string-match "R" switches)))
;; avoid duplicated subdirs
(dired-insert-subdir-newpos dirname)) ; else compute new position
(dired-insert-subdir-doupdate
dirname elt (dired-insert-subdir-doinsert dirname switches))
- (if switches-have-R (dired-build-subdir-alist switches))
+ (when old-switches
+ (if cons
+ (setcdr cons switches)
+ (push (cons dirname switches) dired-switches-alist)))
+ (when switches-have-R
+ (dired-build-subdir-alist switches)
+ (setq switches (dired-replace-in-string "R" "" switches))
+ (dolist (cur-ass dired-subdir-alist)
+ (let ((cur-dir (car cur-ass)))
+ (and (dired-in-this-tree cur-dir dirname)
+ (let ((cur-cons (assoc-string cur-dir dired-switches-alist)))
+ (if cur-cons
+ (setcdr cur-cons switches)
+ (push (cons cur-dir switches) dired-switches-alist)))))))
(dired-initial-position dirname)
- (save-excursion (dired-mark-remembered mark-alist))))
+ (save-excursion (dired-mark-remembered mark-alist))
+ (restore-buffer-modified-p modflag)))
;; This is a separate function for dired-vms.
(defun dired-insert-subdir-validate (dirname &optional switches)
;; Signal an error if invalid (e.g. user typed `i' on `..').
(or (dired-in-this-tree dirname (expand-file-name default-directory))
(error "%s: not in this directory tree" dirname))
- (if switches
+ (let ((real-switches (or switches dired-subdir-switches)))
+ (when real-switches
(let (case-fold-search)
(mapcar
(function
(lambda (x)
- (or (eq (null (string-match x switches))
+ (or (eq (null (string-match x real-switches))
(null (string-match x dired-actual-switches)))
- (error "Can't have dirs with and without -%s switches together"
- x))))
+ (error
+ "Can't have dirs with and without -%s switches together" x))))
;; all switches that make a difference to dired-get-filename:
- '("F" "b")))))
+ '("F" "b"))))))
(defun dired-alist-add (dir new-marker)
;; Add new DIR at NEW-MARKER. Sort alist.
(> (dired-get-subdir-min elt1)
(dired-get-subdir-min elt2)))))))
-(defun dired-kill-tree (dirname &optional remember-marks)
+(defun dired-kill-tree (dirname &optional remember-marks kill-root)
"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))
+Interactively, you can kill DIRNAME as well by using a prefix argument.
+In interactive use, the command prompts for DIRNAME.
+
+When called from Lisp, if REMEMBER-MARKS is non-nil, return an alist
+of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well."
+ (interactive "DKill tree below directory: \ni\nP")
+ (setq dirname (file-name-as-directory (expand-file-name dirname)))
(let ((s-alist dired-subdir-alist) dir m-alist)
(while s-alist
(setq dir (car (car s-alist))
s-alist (cdr s-alist))
- (if (and (not (string-equal dir dirname))
- (dired-in-this-tree dir dirname)
- (dired-goto-subdir dir))
- (setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist))))
+ (and (or kill-root (not (string-equal dir dirname)))
+ (dired-in-this-tree dir dirname)
+ (dired-goto-subdir dir)
+ (setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist))))
m-alist))
(defun dired-insert-subdir-newpos (new-dir)
;; Return the boundary of the inserted text (as list of BEG and END).
(save-excursion
(let ((begin (point)))
- (message "Reading directory %s..." dirname)
(let ((dired-actual-switches
(or switches
+ dired-subdir-switches
(dired-replace-in-string "R" "" dired-actual-switches))))
(if (equal dirname (car (car (last dired-subdir-alist))))
;; If doing the top level directory of the buffer,
;; redo it as specified in dired-directory.
(dired-readin-insert)
(dired-insert-directory dirname dired-actual-switches nil nil t)))
- (message "Reading directory %s...done" dirname)
(list begin (point)))))
(defun dired-insert-subdir-doupdate (dirname elt beg-end)
Lower levels are unaffected."
;; With optional REMEMBER-MARKS, return a mark-alist.
(interactive)
- (let ((beg (dired-subdir-min))
- (end (dired-subdir-max))
- buffer-read-only cur-dir)
- (setq cur-dir (dired-current-directory))
+ (let* ((beg (dired-subdir-min))
+ (end (dired-subdir-max))
+ (modflag (buffer-modified-p))
+ (cur-dir (dired-current-directory))
+ (cons (assoc-string cur-dir dired-switches-alist))
+ buffer-read-only)
(if (equal cur-dir default-directory)
(error "Attempt to kill top level directory"))
(prog1
(delete-region beg end)
(if (eobp) ; don't leave final blank line
(delete-char -1))
- (dired-unsubdir cur-dir))))
+ (dired-unsubdir cur-dir)
+ (when cons
+ (setq dired-switches-alist (delete cons dired-switches-alist)))
+ (restore-buffer-modified-p modflag))))
(defun dired-unsubdir (dir)
;; Remove DIR from the alist
Use \\[dired-hide-all] to (un)hide all directories."
(interactive "p")
(dired-hide-check)
- (while (>= (setq arg (1- arg)) 0)
- (let* ((cur-dir (dired-current-directory))
- (hidden-p (dired-subdir-hidden-p cur-dir))
- (elt (assoc cur-dir dired-subdir-alist))
- (end-pos (1- (dired-get-subdir-max elt)))
- buffer-read-only)
- ;; keep header line visible, hide rest
- (goto-char (dired-get-subdir-min elt))
- (skip-chars-forward "^\n\r")
- (if hidden-p
- (subst-char-in-region (point) end-pos ?\r ?\n)
- (subst-char-in-region (point) end-pos ?\n ?\r)))
- (dired-next-subdir 1 t)))
+ (let ((modflag (buffer-modified-p)))
+ (while (>= (setq arg (1- arg)) 0)
+ (let* ((cur-dir (dired-current-directory))
+ (hidden-p (dired-subdir-hidden-p cur-dir))
+ (elt (assoc cur-dir dired-subdir-alist))
+ (end-pos (1- (dired-get-subdir-max elt)))
+ buffer-read-only)
+ ;; keep header line visible, hide rest
+ (goto-char (dired-get-subdir-min elt))
+ (skip-chars-forward "^\n\r")
+ (if hidden-p
+ (subst-char-in-region (point) end-pos ?\r ?\n)
+ (subst-char-in-region (point) end-pos ?\n ?\r)))
+ (dired-next-subdir 1 t))
+ (restore-buffer-modified-p modflag)))
;;;###autoload
(defun dired-hide-all (arg)
Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
(interactive "P")
(dired-hide-check)
- (let (buffer-read-only)
+ (let ((modflag (buffer-modified-p))
+ buffer-read-only)
(if (save-excursion
(goto-char (point-min))
(search-forward "\r" nil t))
;; hide
(let ((pos (point-max)) ; pos of end of last directory
(alist dired-subdir-alist))
- (while alist ; while there are dirs before pos
+ (while alist ; while there are dirs before pos
(subst-char-in-region (dired-get-subdir-min (car alist)) ; pos of prev dir
(save-excursion
(goto-char pos) ; current dir
(point))
?\n ?\r)
(setq pos (dired-get-subdir-min (car alist))) ; prev dir gets current dir
- (setq alist (cdr alist)))))))
+ (setq alist (cdr alist)))))
+ (restore-buffer-modified-p modflag)))
;;;###end dired-ins.el