-;; dired.el --- directory-browsing commands
+;;; dired.el --- directory-browsing commands
-;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 1997 Free Software Foundation, Inc.
-;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
-;; Version: 5.234
+;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
+;; Maintainer: FSF
;; This file is part of GNU Emacs.
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
+;; This is a major mode for directory browsing and editing. It is
+;; documented in the Emacs manual.
+
;; 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.
;;; Customizable variables
-;;; The funny comments are for autoload.el, to automagically update
-;;; loaddefs.
+(defgroup dired nil
+ "Directory editing."
+ :group 'environment)
+
+(defgroup dired-mark nil
+ "Handling marks in dired."
+ :prefix "dired-"
+ :group 'dired)
+
;;;###autoload
-(defvar dired-listing-switches "-al"
+(defcustom dired-listing-switches "-al"
"*Switches passed to `ls' for dired. MUST contain the `l' option.
May contain all other options that don't contradict `-l';
-may contain even `F', `b', `i' and `s'.")
+may contain even `F', `b', `i' and `s'. See also the variable
+`dired-ls-F-marks-symlinks' concerning the `F' switch."
+ :type 'string
+ :group 'dired)
; Don't use absolute paths as /bin should be in any PATH and people
; may prefer /usr/local/gnu/bin or whatever. However, chown is
;;;###autoload
(defvar dired-chown-program
- (if (memq system-type '(hpux dgux usg-unix-v)) "chown" "/etc/chown")
- "Name of chown command (usully `chown' or `/etc/chown').")
+ (if (memq system-type '(hpux dgux usg-unix-v irix linux gnu/linux))
+ "chown"
+ (if (file-exists-p "/usr/sbin/chown")
+ "/usr/sbin/chown"
+ "/etc/chown"))
+ "Name of chown command (usually `chown' or `/etc/chown').")
+
+(defvar dired-chmod-program
+ (if (eq system-type 'windows-nt)
+ "chmode" "chmod")
+ "Name of chmod command (usually `chmod' or `chmode').")
;;;###autoload
-(defvar dired-ls-program "ls"
- "Absolute or relative name of the `ls' program used by dired.")
-
-;;;###autoload
-(defvar dired-ls-F-marks-symlinks nil
+(defcustom dired-ls-F-marks-symlinks nil
"*Informs dired about how `ls -lF' marks symbolic links.
-Set this to t if `dired-ls-program' with `-lF' marks the symbolic link
+Set this to t if `ls' (or whatever program is specified by
+`insert-directory-program') with `-lF' marks the symbolic link
itself with a trailing @ (usually the case under Ultrix).
Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to
Dired checks if there is really a @ appended. Thus, if you have a
marking `ls' program on one host and a non-marking on another host, and
don't care about symbolic links which really end in a @, you can
-always set this variable to t.")
+always set this variable to t."
+ :type 'boolean
+ :group 'dired-mark)
;;;###autoload
-(defvar dired-trivial-filenames "^\\.\\.?$\\|^#"
+(defcustom dired-trivial-filenames "^\\.\\.?$\\|^#"
"*Regexp of files to skip when finding first file of a directory.
A value of nil means move to the subdir line.
-A value of t means move to first file.")
+A value of t means move to first file."
+ :type '(choice (const :tag "Move to subdir" nil)
+ (const :tag "Move to first" t)
+ regexp)
+ :group 'dired)
;;;###autoload
-(defvar dired-keep-marker-rename t
+(defcustom dired-keep-marker-rename t
;; Use t as default so that moved files "take their markers with them".
"*Controls marking of renamed files.
If t, files keep their previous marks when they are renamed.
If a character, renamed files (whether previously marked or not)
-are afterward marked with that character.")
+are afterward marked with that character."
+ :type '(choice (const :tag "Keep" t)
+ (character :tag "Mark"))
+ :group 'dired-mark)
;;;###autoload
-(defvar dired-keep-marker-copy ?C
+(defcustom dired-keep-marker-copy ?C
"*Controls marking of copied files.
If t, copied files are marked if and as the corresponding original files were.
-If a character, copied files are unconditionally marked with that character.")
+If a character, copied files are unconditionally marked with that character."
+ :type '(choice (const :tag "Keep" t)
+ (character :tag "Mark"))
+ :group 'dired-mark)
;;;###autoload
-(defvar dired-keep-marker-hardlink ?H
+(defcustom dired-keep-marker-hardlink ?H
"*Controls marking of newly made hard links.
If t, they are marked if and as the files linked to were marked.
-If a character, new links are unconditionally marked with that character.")
+If a character, new links are unconditionally marked with that character."
+ :type '(choice (const :tag "Keep" t)
+ (character :tag "Mark"))
+ :group 'dired-mark)
;;;###autoload
-(defvar dired-keep-marker-symlink ?Y
+(defcustom dired-keep-marker-symlink ?Y
"*Controls marking of newly made symbolic links.
If t, they are marked if and as the files linked to were marked.
-If a character, new links are unconditionally marked with that character.")
+If a character, new links are unconditionally marked with that character."
+ :type '(choice (const :tag "Keep" t)
+ (character :tag "Mark"))
+ :group 'dired-mark)
;;;###autoload
-(defvar dired-dwim-target nil
+(defcustom dired-dwim-target nil
"*If non-nil, dired tries to guess a default target directory.
This means: if there is a dired buffer displayed in the next window,
use its current subdir, instead of the current subdir of this dired buffer.
-The target is used in the prompt for file copy, rename etc.")
+The target is used in the prompt for file copy, rename etc."
+ :type 'boolean
+ :group 'dired)
;;;###autoload
-(defvar dired-copy-preserve-time t
+(defcustom dired-copy-preserve-time t
"*If non-nil, Dired preserves the last-modified time in a file copy.
-\(This works on only some systems.)")
+\(This works on only some systems.)"
+ :type 'boolean
+ :group 'dired)
;;; Hook variables
(defvar dired-directory nil
"The directory name or shell wildcard that was used as argument to `ls'.
-Local to each dired buffer.")
+Local to each dired buffer. May be a list, in which case the car is the
+directory name and the cdr is the actual files to list.")
(defvar dired-actual-switches nil
"The value of `dired-listing-switches' used to make this buffer's text.")
"-[-r][-w].[-r][-w][xs][-r][-w]."
"-[-r][-w].[-r][-w].[-r][-w][xst]")
"\\|"))
+(defvar dired-re-perms "[-bcdlps][-r][-w].[-r][-w].[-r][-w].")
(defvar dired-re-dot "^.* \\.\\.?$")
+;; The subdirectory names in this list are expanded.
(defvar dired-subdir-alist nil
"Association list of subdirectories and their buffer positions.
Each subdirectory has an element: (DIRNAME . STARTMARKER).
-The order of elements is the reverse of the order in the buffer.")
+The order of elements is the reverse of the order in the buffer.
+In simple cases, this list contains one element.")
-(defvar dired-subdir-regexp "^. \\([^ \n\r]+\\)\\(:\\)[\n\r]"
+(defvar dired-subdir-regexp "^. \\([^\n\r]+\\)\\(:\\)[\n\r]"
"Regexp matching a maybe hidden subdirectory line in `ls -lR' output.
Subexpression 1 is the subdirectory proper, no trailing colon.
The match starts at the beginning of the line and ends after the end
of the line (\\n or \\r).
Subexpression 2 must end right before the \\n or \\r.")
+(defvar dired-font-lock-keywords
+ (list
+ ;;
+ ;; Directory headers.
+ (list dired-subdir-regexp '(1 font-lock-type-face))
+ ;;
+ ;; We make heavy use of MATCH-ANCHORED, since the regexps don't identify the
+ ;; file name itself. We search for Dired defined regexps, and then use the
+ ;; Dired defined function `dired-move-to-filename' before searching for the
+ ;; simple regexp ".+". It is that regexp which matches the file name.
+ ;;
+ ;; Dired marks.
+ (list dired-re-mark
+ '(0 font-lock-reference-face)
+ '(".+" (dired-move-to-filename) nil (0 font-lock-warning-face)))
+ ;;
+ ;; Files that are group or world writable.
+ (list (concat dired-re-maybe-mark dired-re-inode-size
+ "\\([-d]\\(....w....\\|.......w.\\)\\)")
+ '(1 font-lock-comment-face)
+ '(".+" (dired-move-to-filename) nil (0 font-lock-comment-face)))
+ ;;
+ ;; Subdirectories.
+ (list dired-re-dir
+ '(".+" (dired-move-to-filename) nil (0 font-lock-function-name-face)))
+ ;;
+ ;; Symbolic links.
+ (list dired-re-sym
+ '(".+" (dired-move-to-filename) nil (0 font-lock-keyword-face)))
+ ;;
+ ;; Files suffixed with `completion-ignored-extensions'.
+ '(eval .
+ (let ((extensions (mapcar 'regexp-quote completion-ignored-extensions)))
+ ;; It is quicker to first find just an extension, then go back to the
+ ;; start of that file name. So we do this complex MATCH-ANCHORED form.
+ (list (concat "\\(" (mapconcat 'identity extensions "\\|") "\\|#\\)$")
+ '(".+" (dired-move-to-filename) nil (0 font-lock-string-face))))))
+ "Additional expressions to highlight in Dired mode.")
\f
;;; Macros must be defined before they are used, for the byte compiler.
\f
;; Function dired-ls is redefinable for VMS, ange-ftp, Prospero or
;; other special applications.
-
-;; dired-ls
-;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
-;; FULL-DIRECTORY-P is nil.
-;; The single line of output must display FILE's name as it was
-;; given, namely, an absolute path name.
-;; - must insert exactly one line for each file if WILDCARD or
-;; FULL-DIRECTORY-P is t, plus one optional "total" line
-;; before the file lines, plus optional text after the file lines.
-;; Lines are delimited by "\n", so filenames containing "\n" are not
-;; allowed.
-;; File lines should display the basename, not a path name.
-;; - must drag point after inserted text
-;; - must be consistent with
-;; - functions dired-move-to-filename, (these two define what a file line is)
-;; dired-move-to-end-of-filename,
-;; dired-between-files, (shortcut for (not (dired-move-to-filename)))
-;; dired-insert-headerline
-;; dired-after-subdir-garbage (defines what a "total" line is)
-;; - variables dired-subdir-regexp
-(defun dired-ls (file switches &optional wildcard full-directory-p)
-; "Insert `ls' output of FILE, formatted according to SWITCHES.
-;Optional third arg WILDCARD means treat FILE as shell wildcard.
-;Optional fourth arg FULL-DIRECTORY-P means file is a directory and
-;switches do not contain `d', so that a full listing is expected.
-;
-;Uses dired-ls-program (and shell-file-name if WILDCARD) to do the work."
- (if wildcard
- (let ((default-directory (file-name-directory file)))
- (call-process shell-file-name nil t nil
- "-c" (concat dired-ls-program " -d " switches " "
- (file-name-nondirectory file))))
- (call-process dired-ls-program nil t nil switches file)))
\f
;; The dired command
Optional second argument SWITCHES specifies the `ls' options used.
\(Interactively, use a prefix argument to be able to specify SWITCHES.)
Dired displays a list of files in DIRNAME (which may also have
- shell wildcards appended to select certain files).
+shell wildcards appended to select certain files). If DIRNAME is a cons,
+its first element is taken as the directory name and the rest as an explicit
+list of files to make directory entries for.
\\<dired-mode-map>\
You can move around in it with the usual commands.
-You can flag files for deletion with \\[dired-flag-file-deletion] and then delete them by
- typing \\[dired-do-flagged-delete].
+You can flag files for deletion with \\[dired-flag-file-deletion] and then
+delete them by typing \\[dired-do-flagged-delete].
Type \\[describe-mode] after entering dired for more info.
If DIRNAME is already in a dired buffer, that buffer is used without refresh."
(interactive (dired-read-dir-and-switches "in other window "))
(switch-to-buffer-other-window (dired-noselect dirname switches)))
+;;;###autoload (define-key ctl-x-5-map "d" 'dired-other-frame)
+;;;###autoload
+(defun dired-other-frame (dirname &optional switches)
+ "\"Edit\" directory DIRNAME. Like `dired' but makes a new frame."
+ (interactive (dired-read-dir-and-switches "in other frame "))
+ (switch-to-buffer-other-frame (dired-noselect dirname switches)))
+
;;;###autoload
-(defun dired-noselect (dirname &optional switches)
+(defun dired-noselect (dir-or-list &optional switches)
"Like `dired' but returns the dired buffer as value, does not select it."
- (or dirname (setq dirname default-directory))
+ (or dir-or-list (setq dir-or-list default-directory))
;; This loses the distinction between "/foo/*/" and "/foo/*" that
;; some shells make:
- (setq dirname (expand-file-name (directory-file-name dirname)))
- (if (file-directory-p dirname)
- (setq dirname (file-name-as-directory dirname)))
- (dired-internal-noselect dirname switches))
+ (let (dirname initially-was-dirname)
+ (if (consp dir-or-list)
+ (setq dirname (car dir-or-list))
+ (setq dirname dir-or-list))
+ (setq initially-was-dirname
+ (string= (file-name-as-directory dirname) dirname))
+ (setq dirname (abbreviate-file-name
+ (expand-file-name (directory-file-name dirname))))
+ (if find-file-visit-truename
+ (setq dirname (file-truename dirname)))
+ ;; If the argument was syntactically a directory name not a file name,
+ ;; or if it happens to name a file that is a directory,
+ ;; convert it syntactically to a directory name.
+ ;; The reason for checking initially-was-dirname
+ ;; and not just file-directory-p
+ ;; is that file-directory-p is slow over ftp.
+ (if (or initially-was-dirname (file-directory-p dirname))
+ (setq dirname (file-name-as-directory dirname)))
+ (if (consp dir-or-list)
+ (setq dir-or-list (cons dirname (cdr dir-or-list)))
+ (setq dir-or-list dirname))
+ (dired-internal-noselect dir-or-list switches)))
;; Separate function from dired-noselect for the sake of dired-vms.el.
-(defun dired-internal-noselect (dirname &optional switches)
+(defun dired-internal-noselect (dir-or-list &optional switches mode)
;; If there is an existing dired buffer for DIRNAME, just leave
;; buffer as it is (don't even call dired-revert).
;; This saves time especially for deep trees or with ange-ftp.
;; revert the buffer.
;; A pity we can't possibly do "Directory has changed - refresh? "
;; like find-file does.
- (let* ((buffer (dired-find-buffer-nocreate dirname))
+ ;; Optional argument MODE is passed to dired-find-buffer-nocreate,
+ ;; see there.
+ (let* ((dirname (if (consp dir-or-list) (car dir-or-list) dir-or-list))
+ ;; The following line used to use dir-or-list.
+ ;; That never found an existing buffer, in the case
+ ;; where it is a list.
+ (buffer (dired-find-buffer-nocreate dirname mode))
;; note that buffer already is in dired-mode, if found
(new-buffer-p (not buffer))
(old-buf (current-buffer)))
;; kill-all-local-variables any longer.
(setq buffer (create-file-buffer (directory-file-name dirname)))))
(set-buffer buffer)
- (if (not new-buffer-p) ; existing buffer ...
- (if switches ; ... but new switches
- (dired-sort-other switches)) ; this calls dired-revert
+ (if (not new-buffer-p) ; existing buffer ...
+ (cond (switches ; ... but new switches
+ ;; file list may have changed
+ (if (consp dir-or-list)
+ (setq dired-directory dir-or-list))
+ ;; this calls dired-revert
+ (dired-sort-other switches))
+ ;; If directory has changed on disk, offer to revert.
+ ((if (let ((attributes (file-attributes dirname))
+ (modtime (visited-file-modtime)))
+ (or (eq modtime 0)
+ (not (eq (car attributes) t))
+ (and (= (car (nth 5 attributes)) (car modtime))
+ (= (nth 1 (nth 5 attributes)) (cdr modtime)))))
+ nil
+ (message "%s"
+ (substitute-command-keys
+ "Directory has changed on disk; type \\[revert-buffer] to update Dired")))))
;; Else a new buffer
- (setq default-directory (if (file-directory-p dirname)
- dirname
- (file-name-directory dirname)))
+ (setq default-directory
+ ;; We can do this unconditionally
+ ;; because dired-noselect ensures that the name
+ ;; is passed in directory name syntax
+ ;; if it was the name of a directory at all.
+ (file-name-directory dirname))
(or switches (setq switches dired-listing-switches))
(dired-mode dirname switches)
+ (if mode (funcall mode))
;; default-directory and dired-actual-switches are set now
;; (buffer-local), so we can call dired-readin:
(let ((failed t))
(unwind-protect
- (progn (dired-readin dirname buffer)
+ (progn (dired-readin dir-or-list buffer)
(setq failed nil))
;; dired-readin can fail if parent directories are inaccessible.
;; Don't leave an empty buffer around in that case.
(set-buffer old-buf)
buffer))
-;; This differs from dired-buffers-for-dir in that it does not consider
-;; subdirs of default-directory and searches for the first match only
-(defun dired-find-buffer-nocreate (dirname)
- (let (found (blist (buffer-list)))
+(defun dired-find-buffer-nocreate (dirname &optional mode)
+ ;; This differs from dired-buffers-for-dir in that it does not consider
+ ;; subdirs of default-directory and searches for the first match only.
+ ;; Also, the major mode must be MODE.
+ (let (found (blist dired-buffers)) ; was (buffer-list)
+ (or mode (setq mode 'dired-mode))
(while blist
- (save-excursion
- (set-buffer (car blist))
- (if (and (eq major-mode 'dired-mode)
- (equal dired-directory dirname))
- (setq found (car blist)
- blist nil)
- (setq blist (cdr blist)))))
+ (if (null (buffer-name (cdr (car blist))))
+ (setq blist (cdr blist))
+ (save-excursion
+ (set-buffer (cdr (car blist)))
+ (if (and (eq major-mode mode)
+ (if (consp dired-directory)
+ (equal (car dired-directory) dirname)
+ (equal dired-directory dirname)))
+ (setq found (cdr (car blist))
+ blist nil)
+ (setq blist (cdr blist))))))
found))
\f
;; dired-readin differs from dired-insert-subdir in that it accepts
;; wildcards, erases the buffer, and builds the subdir-alist anew
;; (including making it buffer-local and clearing it first).
-(defun dired-readin (dirname buffer)
+(defun dired-readin (dir-or-list buffer)
;; default-directory and dired-actual-switches must be buffer-local
;; and initialized by now.
;; Thus we can test (equal default-directory dirname) instead of
;; Also, we can run this hook which may want to modify the switches
;; based on default-directory, e.g. with ange-ftp to a SysV host
;; where ls won't understand -Al switches.
- (setq dirname (expand-file-name dirname))
- (run-hooks 'dired-before-readin-hook)
- (save-excursion
- (message "Reading directory %s..." dirname)
- (set-buffer buffer)
- (let (buffer-read-only (failed t))
- (widen)
- (erase-buffer)
- (dired-readin-insert dirname)
- (indent-rigidly (point-min) (point-max) 2)
- ;; We need this to make the root dir have a header line as all
- ;; other subdirs have:
- (goto-char (point-min))
- (dired-insert-headerline default-directory)
- ;; can't run dired-after-readin-hook here, it may depend on the subdir
- ;; alist to be OK.
- )
- (message "Reading directory %s...done" dirname)
- (set-buffer-modified-p nil)
- ;; Must first make alist buffer local and set it to nil because
- ;; dired-build-subdir-alist will call dired-clear-alist first
- (set (make-local-variable 'dired-subdir-alist) nil)
- (dired-build-subdir-alist)))
+ (let (dirname)
+ (if (consp dir-or-list)
+ (setq dirname (car dir-or-list))
+ (setq dirname dir-or-list))
+ (setq dirname (expand-file-name dirname))
+ (if (consp dir-or-list)
+ (setq dir-or-list (cons dirname (cdr dir-or-list))))
+ (run-hooks 'dired-before-readin-hook)
+ (save-excursion
+ (message "Reading directory %s..." dirname)
+ (set-buffer buffer)
+ (let (buffer-read-only (failed t))
+ (widen)
+ (erase-buffer)
+ (dired-readin-insert dir-or-list)
+ (indent-rigidly (point-min) (point-max) 2)
+ ;; We need this to make the root dir have a header line as all
+ ;; other subdirs have:
+ (goto-char (point-min))
+ (dired-insert-headerline default-directory)
+ ;; can't run dired-after-readin-hook here, it may depend on the subdir
+ ;; alist to be OK.
+ )
+ (message "Reading directory %s...done" dirname)
+ ;; Must first make alist buffer local and set it to nil because
+ ;; dired-build-subdir-alist will call dired-clear-alist first
+ (set (make-local-variable 'dired-subdir-alist) nil)
+ (dired-build-subdir-alist)
+ (let ((attributes (file-attributes dirname)))
+ (if (eq (car attributes) t)
+ (set-visited-file-modtime (nth 5 attributes))))
+ (set-buffer-modified-p nil))))
;; Subroutines of dired-readin
-(defun dired-readin-insert (dirname)
- ;; Just insert listing for DIRNAME, assuming a clean buffer.
- (if (equal default-directory dirname);; i.e., (file-directory-p dirname)
- (dired-ls dirname dired-actual-switches nil t)
- (if (not (file-readable-p
- (directory-file-name (file-name-directory dirname))))
- (error "Directory %s inaccessible or nonexistent" dirname)
- ;; else assume it contains wildcards:
- (dired-ls dirname dired-actual-switches t)
- (save-excursion;; insert wildcard instead of total line:
- (goto-char (point-min))
- (insert "wildcard " (file-name-nondirectory dirname) "\n")))))
+(defun dired-readin-insert (dir-or-list)
+ ;; Just insert listing for the passed-in directory or
+ ;; directory-and-file list, assuming a clean buffer.
+ (let (dirname)
+ (if (consp dir-or-list)
+ (setq dirname (car dir-or-list))
+ (setq dirname dir-or-list))
+ ;; Expand before comparing in case one or both have been abbreviated.
+ (if (and (equal (expand-file-name default-directory)
+ (expand-file-name dirname))
+ (not (consp dir-or-list)))
+ ;; If we are reading a whole single directory...
+ (dired-insert-directory dir-or-list dired-actual-switches nil t)
+ (if (not (file-readable-p
+ (directory-file-name (file-name-directory dirname))))
+ (error "Directory %s inaccessible or nonexistent" dirname)
+ ;; Else assume it contains wildcards,
+ ;; unless it is an explicit list of files.
+ (dired-insert-directory dir-or-list dired-actual-switches
+ (not (listp dir-or-list)))
+ (save-excursion ;; insert wildcard instead of total line:
+ (goto-char (point-min))
+ (insert "wildcard " (file-name-nondirectory dirname) "\n"))))))
+
+(defun dired-insert-directory (dir-or-list switches &optional wildcard full-p)
+ ;; Do the right thing whether dir-or-list is atomic or not. If it is,
+ ;; inset all files listed in the cdr (the car is the passed-in directory
+ ;; list).
+ (let ((opoint (point))
+ (process-environment (copy-sequence process-environment))
+ end)
+ ;; We used to specify the C locale here, to force English month names;
+ ;; but this should not be necessary any more,
+ ;; with the new value of dired-move-to-filename-regexp.
+ (if (consp dir-or-list)
+ ;; In this case, use the file names in the cdr
+ ;; exactly as originally given to dired-noselect.
+ (mapcar
+ (function (lambda (x) (insert-directory x switches wildcard full-p)))
+ (cdr dir-or-list))
+ ;; Expand the file name here because it may have been abbreviated
+ ;; in dired-noselect.
+ (insert-directory (expand-file-name dir-or-list) switches wildcard full-p))
+ ;; Quote certain characters, unless ls quoted them for us.
+ (if (not (string-match "b" dired-actual-switches))
+ (save-excursion
+ (setq end (point-marker))
+ (goto-char opoint)
+ (while (search-forward "\\" end t)
+ (replace-match "\\\\" nil t))
+ (goto-char opoint)
+ (while (search-forward "\^m" end t)
+ (replace-match "\\015" nil t))
+ (set-marker end nil)))
+ (dired-insert-set-properties opoint (point)))
+ (setq dired-directory dir-or-list))
+
+;; Make the file names highlight when the mouse is on them.
+(defun dired-insert-set-properties (beg end)
+ (save-excursion
+ (goto-char beg)
+ (while (< (point) end)
+ (condition-case nil
+ (if (dired-move-to-filename)
+ (put-text-property (point)
+ (save-excursion
+ (dired-move-to-end-of-filename)
+ (point))
+ 'mouse-face 'highlight))
+ (error nil))
+ (forward-line 1))))
(defun dired-insert-headerline (dir);; also used by dired-insert-subdir
;; Insert DIR's headerline with no trailing slash, exactly like ls
(setq mark-alist;; only after dired-remember-hidden since this unhides:
(dired-remember-marks (point-min) (point-max)))
;; treat top level dir extra (it may contain wildcards)
+ (dired-uncache
+ (if (consp dired-directory) (car dired-directory) dired-directory))
(dired-readin dired-directory (current-buffer))
(let ((dired-after-readin-hook nil))
;; don't run that hook for each subdir...
old-subdir-alist (cdr old-subdir-alist)
dir (car elt))
(condition-case ()
- (dired-insert-subdir dir)
+ (progn
+ (dired-uncache dir)
+ (dired-insert-subdir dir))
(error nil))))))
+
+;; Remove directory DIR from any directory cache.
+(defun dired-uncache (dir)
+ (let ((handler (find-file-name-handler dir 'dired-uncache)))
+ (if handler
+ (funcall handler 'dired-uncache dir))))
\f
;; dired mode key bindings and initialization
(defvar dired-mode-map nil "Local keymap for dired-mode buffers.")
(if dired-mode-map
nil
- ;; Force `f' rather than `e' in the mode doc:
- (fset 'dired-advertised-find-file 'dired-find-file)
;; This looks ugly when substitute-command-keys uses C-d instead d:
;; (define-key dired-mode-map "\C-d" 'dired-flag-file-deletion)
- (setq dired-mode-map (make-keymap))
- (suppress-keymap dired-mode-map)
- ;; Commands to mark or flag certain categories of files
- (define-key dired-mode-map "#" 'dired-flag-auto-save-files)
- (define-key dired-mode-map "*" 'dired-mark-executables)
- (define-key dired-mode-map "." 'dired-clean-directory)
- (define-key dired-mode-map "/" 'dired-mark-directories)
- (define-key dired-mode-map "@" 'dired-mark-symlinks)
- (define-key dired-mode-map "~" 'dired-flag-backup-files)
- ;; Upper case keys (except !, c) for operating on the marked files
- (define-key dired-mode-map "C" 'dired-do-copy)
- (define-key dired-mode-map "B" 'dired-do-byte-compile)
- (define-key dired-mode-map "D" 'dired-do-delete)
- (define-key dired-mode-map "G" 'dired-do-chgrp)
- (define-key dired-mode-map "H" 'dired-do-hardlink)
- (define-key dired-mode-map "L" 'dired-do-load)
- (define-key dired-mode-map "M" 'dired-do-chmod)
- (define-key dired-mode-map "O" 'dired-do-chown)
- (define-key dired-mode-map "P" 'dired-do-print)
- (define-key dired-mode-map "R" 'dired-do-rename)
- (define-key dired-mode-map "S" 'dired-do-symlink)
- (define-key dired-mode-map "X" 'dired-do-shell-command)
- (define-key dired-mode-map "Z" 'dired-do-compress)
- (define-key dired-mode-map "!" 'dired-do-shell-command)
- ;; Comparison commands
- (define-key dired-mode-map "=" 'dired-diff)
- (define-key dired-mode-map "\M-=" 'dired-backup-diff)
- ;; Tree Dired commands
- (define-key dired-mode-map "\M-\C-?" 'dired-unmark-all-files)
- (define-key dired-mode-map "\M-\C-d" 'dired-tree-down)
- (define-key dired-mode-map "\M-\C-u" 'dired-tree-up)
- (define-key dired-mode-map "\M-\C-n" 'dired-next-subdir)
- (define-key dired-mode-map "\M-\C-p" 'dired-prev-subdir)
- ;; move to marked files
- (define-key dired-mode-map "\M-{" 'dired-prev-marked-file)
- (define-key dired-mode-map "\M-}" 'dired-next-marked-file)
- ;; kill marked files
- (define-key dired-mode-map "\M-k" 'dired-do-kill-lines)
- ;; Make all regexp commands share a `%' prefix:
- (fset 'dired-regexp-prefix (make-sparse-keymap))
- (define-key dired-mode-map "%" 'dired-regexp-prefix)
- (define-key dired-mode-map "%u" 'dired-upcase)
- (define-key dired-mode-map "%l" 'dired-downcase)
- (define-key dired-mode-map "%d" 'dired-flag-files-regexp)
- (define-key dired-mode-map "%m" 'dired-mark-files-regexp)
- (define-key dired-mode-map "%r" 'dired-do-rename-regexp)
- (define-key dired-mode-map "%C" 'dired-do-copy-regexp)
- (define-key dired-mode-map "%H" 'dired-do-hardlink-regexp)
- (define-key dired-mode-map "%R" 'dired-do-rename-regexp)
- (define-key dired-mode-map "%S" 'dired-do-symlink-regexp)
- ;; Lower keys for commands not operating on all the marked files
- (define-key dired-mode-map "d" 'dired-flag-file-deletion)
- (define-key dired-mode-map "e" 'dired-find-file)
- (define-key dired-mode-map "f" 'dired-advertised-find-file)
- (define-key dired-mode-map "g" 'revert-buffer)
- (define-key dired-mode-map "h" 'describe-mode)
- (define-key dired-mode-map "i" 'dired-maybe-insert-subdir)
- (define-key dired-mode-map "k" 'dired-kill-line-or-subdir)
- (define-key dired-mode-map "l" 'dired-do-redisplay)
- (define-key dired-mode-map "m" 'dired-mark)
- (define-key dired-mode-map "n" 'dired-next-line)
- (define-key dired-mode-map "o" 'dired-find-file-other-window)
- (define-key dired-mode-map "\C-o" 'dired-display-file)
- (define-key dired-mode-map "p" 'dired-previous-line)
- (define-key dired-mode-map "q" 'dired-quit)
- (define-key dired-mode-map "s" 'dired-sort-toggle-or-edit)
- (define-key dired-mode-map "u" 'dired-unmark)
- (define-key dired-mode-map "v" 'dired-view-file)
- (define-key dired-mode-map "x" 'dired-do-flagged-delete)
- (define-key dired-mode-map "+" 'dired-create-directory)
- ;; moving
- (define-key dired-mode-map "<" 'dired-prev-dirline)
- (define-key dired-mode-map ">" 'dired-next-dirline)
- (define-key dired-mode-map "^" 'dired-up-directory)
- (define-key dired-mode-map " " 'dired-next-line)
- (define-key dired-mode-map "\C-n" 'dired-next-line)
- (define-key dired-mode-map "\C-p" 'dired-previous-line)
- ;; hiding
- (define-key dired-mode-map "$" 'dired-hide-subdir)
- (define-key dired-mode-map "\M-$" 'dired-hide-all)
- ;; misc
- (define-key dired-mode-map "?" 'dired-summary)
- (define-key dired-mode-map "\177" 'dired-unmark-backward)
- (define-key dired-mode-map "\C-_" 'dired-undo)
- (define-key dired-mode-map "\C-xu" 'dired-undo)
- )
-
-(or (member '(dired-sort-mode dired-sort-mode) minor-mode-alist)
- ;; Test whether this has already been done in case dired is reloaded
- ;; There may be several elements with dired-sort-mode as car.
- (setq minor-mode-alist
- (cons '(dired-sort-mode dired-sort-mode)
- ;; dired-sort-mode is nil outside dired
- minor-mode-alist)))
+ (let ((map (make-keymap)))
+ (suppress-keymap map)
+ (define-key map [mouse-2] 'dired-mouse-find-file-other-window)
+ ;; Commands to mark or flag certain categories of files
+ (define-key map "#" 'dired-flag-auto-save-files)
+ (define-key map "." 'dired-clean-directory)
+ (define-key map "~" 'dired-flag-backup-files)
+ (define-key map "&" 'dired-flag-garbage-files)
+ ;; Upper case keys (except !) for operating on the marked files
+ (define-key map "A" 'dired-do-search)
+ (define-key map "C" 'dired-do-copy)
+ (define-key map "B" 'dired-do-byte-compile)
+ (define-key map "D" 'dired-do-delete)
+ (define-key map "G" 'dired-do-chgrp)
+ (define-key map "H" 'dired-do-hardlink)
+ (define-key map "L" 'dired-do-load)
+ (define-key map "M" 'dired-do-chmod)
+ (define-key map "O" 'dired-do-chown)
+ (define-key map "P" 'dired-do-print)
+ (define-key map "Q" 'dired-do-query-replace)
+ (define-key map "R" 'dired-do-rename)
+ (define-key map "S" 'dired-do-symlink)
+ (define-key map "X" 'dired-do-shell-command)
+ (define-key map "Z" 'dired-do-compress)
+ (define-key map "!" 'dired-do-shell-command)
+ ;; Comparison commands
+ (define-key map "=" 'dired-diff)
+ (define-key map "\M-=" 'dired-backup-diff)
+ ;; Tree Dired commands
+ (define-key map "\M-\C-?" 'dired-unmark-all-files)
+ (define-key map "\M-\C-d" 'dired-tree-down)
+ (define-key map "\M-\C-u" 'dired-tree-up)
+ (define-key map "\M-\C-n" 'dired-next-subdir)
+ (define-key map "\M-\C-p" 'dired-prev-subdir)
+ ;; move to marked files
+ (define-key map "\M-{" 'dired-prev-marked-file)
+ (define-key map "\M-}" 'dired-next-marked-file)
+ ;; Make all regexp commands share a `%' prefix:
+ ;; We used to get to the submap via a symbol dired-regexp-prefix,
+ ;; but that seems to serve little purpose, and copy-keymap
+ ;; does a better job without it.
+ (define-key map "%" nil)
+ (define-key map "%u" 'dired-upcase)
+ (define-key map "%l" 'dired-downcase)
+ (define-key map "%d" 'dired-flag-files-regexp)
+ (define-key map "%m" 'dired-mark-files-regexp)
+ (define-key map "%r" 'dired-do-rename-regexp)
+ (define-key map "%C" 'dired-do-copy-regexp)
+ (define-key map "%H" 'dired-do-hardlink-regexp)
+ (define-key map "%R" 'dired-do-rename-regexp)
+ (define-key map "%S" 'dired-do-symlink-regexp)
+ ;; Commands for marking and unmarking.
+ (define-key map "*" nil)
+ (define-key map "**" 'dired-mark-executables)
+ (define-key map "*/" 'dired-mark-directories)
+ (define-key map "*@" 'dired-mark-symlinks)
+ (define-key map "*%" 'dired-mark-files-regexp)
+ (define-key map "*c" 'dired-change-marks)
+ (define-key map "*s" 'dired-mark-subdir-files)
+ (define-key map "*m" 'dired-mark)
+ (define-key map "*u" 'dired-unmark)
+ (define-key map "*?" 'dired-unmark-all-files)
+ (define-key map "*!" 'dired-unmark-all-marks)
+ (define-key map "*\177" 'dired-unmark-backward)
+ (define-key map "*\C-n" 'dired-next-marked-file)
+ (define-key map "*\C-p" 'dired-prev-marked-file)
+ ;; Lower keys for commands not operating on all the marked files
+ (define-key map "d" 'dired-flag-file-deletion)
+ (define-key map "e" 'dired-find-file)
+ (define-key map "f" 'dired-find-file)
+ (define-key map "\C-m" 'dired-advertised-find-file)
+ (define-key map "g" 'revert-buffer)
+ (define-key map "h" 'describe-mode)
+ (define-key map "i" 'dired-maybe-insert-subdir)
+ (define-key map "k" 'dired-do-kill-lines)
+ (define-key map "l" 'dired-do-redisplay)
+ (define-key map "m" 'dired-mark)
+ (define-key map "n" 'dired-next-line)
+ (define-key map "o" 'dired-find-file-other-window)
+ (define-key map "\C-o" 'dired-display-file)
+ (define-key map "p" 'dired-previous-line)
+ (define-key map "q" 'dired-quit)
+ (define-key map "s" 'dired-sort-toggle-or-edit)
+ (define-key map "u" 'dired-unmark)
+ (define-key map "v" 'dired-view-file)
+ (define-key map "x" 'dired-do-flagged-delete)
+ (define-key map "+" 'dired-create-directory)
+ ;; moving
+ (define-key map "<" 'dired-prev-dirline)
+ (define-key map ">" 'dired-next-dirline)
+ (define-key map "^" 'dired-up-directory)
+ (define-key map " " 'dired-next-line)
+ (define-key map "\C-n" 'dired-next-line)
+ (define-key map "\C-p" 'dired-previous-line)
+ (define-key map [down] 'dired-next-line)
+ (define-key map [up] 'dired-previous-line)
+ ;; hiding
+ (define-key map "$" 'dired-hide-subdir)
+ (define-key map "\M-$" 'dired-hide-all)
+ ;; misc
+ (define-key map "?" 'dired-summary)
+ (define-key map "\177" 'dired-unmark-backward)
+ (define-key map "\C-_" 'dired-undo)
+ (define-key map "\C-xu" 'dired-undo)
+
+ ;; Make menu bar items.
+
+ ;; Get rid of the Edit menu bar item to save space.
+ (define-key map [menu-bar edit] 'undefined)
+
+ (define-key map [menu-bar subdir]
+ (cons "Subdir" (make-sparse-keymap "Subdir")))
+
+ (define-key map [menu-bar subdir hide-all]
+ '("Hide All" . dired-hide-all))
+ (define-key map [menu-bar subdir hide-subdir]
+ '("Hide Subdir" . dired-hide-subdir))
+ (define-key map [menu-bar subdir tree-down]
+ '("Tree Down" . dired-tree-down))
+ (define-key map [menu-bar subdir tree-up]
+ '("Tree Up" . dired-tree-up))
+ (define-key map [menu-bar subdir up]
+ '("Up Directory" . dired-up-directory))
+ (define-key map [menu-bar subdir prev-subdir]
+ '("Prev Subdir" . dired-prev-subdir))
+ (define-key map [menu-bar subdir next-subdir]
+ '("Next Subdir" . dired-next-subdir))
+ (define-key map [menu-bar subdir prev-dirline]
+ '("Prev Dirline" . dired-prev-dirline))
+ (define-key map [menu-bar subdir next-dirline]
+ '("Next Dirline" . dired-next-dirline))
+ (define-key map [menu-bar subdir insert]
+ '("Insert This Subdir" . dired-maybe-insert-subdir))
+
+ (define-key map [menu-bar immediate]
+ (cons "Immediate" (make-sparse-keymap "Immediate")))
+
+ (define-key map [menu-bar immediate revert-buffer]
+ '("Update Buffer" . revert-buffer))
+
+ (define-key map [menu-bar immediate dashes]
+ '("--"))
+
+ (define-key map [menu-bar immediate backup-diff]
+ '("Compare with Backup" . dired-backup-diff))
+ (define-key map [menu-bar immediate diff]
+ '("Diff" . dired-diff))
+ (define-key map [menu-bar immediate view]
+ '("View This File" . dired-view-file))
+ (define-key map [menu-bar immediate display]
+ '("Display in Other Window" . dired-display-file))
+ (define-key map [menu-bar immediate find-file-other-window]
+ '("Find in Other Window" . dired-find-file-other-window))
+ (define-key map [menu-bar immediate find-file]
+ '("Find This File" . dired-find-file))
+ (define-key map [menu-bar immediate create-directory]
+ '("Create Directory..." . dired-create-directory))
+
+ (define-key map [menu-bar regexp]
+ (cons "Regexp" (make-sparse-keymap "Regexp")))
+
+ (define-key map [menu-bar regexp downcase]
+ '("Downcase" . dired-downcase))
+ (define-key map [menu-bar regexp upcase]
+ '("Upcase" . dired-upcase))
+ (define-key map [menu-bar regexp hardlink]
+ '("Hardlink..." . dired-do-hardlink-regexp))
+ (define-key map [menu-bar regexp symlink]
+ '("Symlink..." . dired-do-symlink-regexp))
+ (define-key map [menu-bar regexp rename]
+ '("Rename..." . dired-do-rename-regexp))
+ (define-key map [menu-bar regexp copy]
+ '("Copy..." . dired-do-copy-regexp))
+ (define-key map [menu-bar regexp flag]
+ '("Flag..." . dired-flag-files-regexp))
+ (define-key map [menu-bar regexp mark]
+ '("Mark..." . dired-mark-files-regexp))
+
+ (define-key map [menu-bar mark]
+ (cons "Mark" (make-sparse-keymap "Mark")))
+
+ (define-key map [menu-bar mark prev]
+ '("Previous Marked" . dired-prev-marked-file))
+ (define-key map [menu-bar mark next]
+ '("Next Marked" . dired-next-marked-file))
+ (define-key map [menu-bar mark marks]
+ '("Change Marks..." . dired-change-marks))
+ (define-key map [menu-bar mark unmark-all]
+ '("Unmark All" . dired-unmark-all-marks))
+ (define-key map [menu-bar mark symlinks]
+ '("Mark Symlinks" . dired-mark-symlinks))
+ (define-key map [menu-bar mark directories]
+ '("Mark Directories" . dired-mark-directories))
+ (define-key map [menu-bar mark directory]
+ '("Mark Old Backups" . dired-clean-directory))
+ (define-key map [menu-bar mark executables]
+ '("Mark Executables" . dired-mark-executables))
+ (define-key map [menu-bar mark garbage-files]
+ '("Flag Garbage Files" . dired-flag-garbage-files))
+ (define-key map [menu-bar mark backup-files]
+ '("Flag Backup Files" . dired-flag-backup-files))
+ (define-key map [menu-bar mark auto-save-files]
+ '("Flag Auto-save Files" . dired-flag-auto-save-files))
+ (define-key map [menu-bar mark deletion]
+ '("Flag" . dired-flag-file-deletion))
+ (define-key map [menu-bar mark unmark]
+ '("Unmark" . dired-unmark))
+ (define-key map [menu-bar mark mark]
+ '("Mark" . dired-mark))
+
+ (define-key map [menu-bar operate]
+ (cons "Operate" (make-sparse-keymap "Operate")))
+
+ (define-key map [menu-bar operate query-replace]
+ '("Query Replace in Files..." . dired-do-query-replace))
+ (define-key map [menu-bar operate search]
+ '("Search Files..." . dired-do-search))
+ (define-key map [menu-bar operate chown]
+ '("Change Owner..." . dired-do-chown))
+ (define-key map [menu-bar operate chgrp]
+ '("Change Group..." . dired-do-chgrp))
+ (define-key map [menu-bar operate chmod]
+ '("Change Mode..." . dired-do-chmod))
+ (define-key map [menu-bar operate load]
+ '("Load" . dired-do-load))
+ (define-key map [menu-bar operate compile]
+ '("Byte-compile" . dired-do-byte-compile))
+ (define-key map [menu-bar operate compress]
+ '("Compress" . dired-do-compress))
+ (define-key map [menu-bar operate print]
+ '("Print" . dired-do-print))
+ (define-key map [menu-bar operate hardlink]
+ '("Hardlink to..." . dired-do-hardlink))
+ (define-key map [menu-bar operate symlink]
+ '("Symlink to..." . dired-do-symlink))
+ (define-key map [menu-bar operate command]
+ '("Shell Command..." . dired-do-shell-command))
+ (define-key map [menu-bar operate delete]
+ '("Delete" . dired-do-delete))
+ (define-key map [menu-bar operate rename]
+ '("Rename to..." . dired-do-rename))
+ (define-key map [menu-bar operate copy]
+ '("Copy to..." . dired-do-copy))
+
+ (setq dired-mode-map map)))
\f
;; Dired mode is suitable only for specially formatted data.
(put 'dired-mode 'mode-class 'special)
(dired-advertise) ; default-directory is already set
(setq major-mode 'dired-mode
mode-name "Dired"
- case-fold-search nil
+;; case-fold-search nil
buffer-read-only t
selective-display t ; for subdirectory hiding
- mode-line-buffer-identification '("Dired: %17b"))
+ mode-line-buffer-identification '("%17b"))
(set (make-local-variable 'revert-buffer-function)
(function dired-revert))
(set (make-local-variable 'page-delimiter)
(or dirname default-directory))
;; list-buffers uses this to display the dir being edited in this buffer.
(set (make-local-variable 'list-buffers-directory)
- dired-directory)
+ (expand-file-name dired-directory))
(set (make-local-variable 'dired-actual-switches)
(or switches dired-listing-switches))
- (make-local-variable 'dired-sort-mode)
+ (set (make-local-variable 'font-lock-defaults) '(dired-font-lock-keywords t))
(dired-sort-other dired-actual-switches t)
(run-hooks 'dired-mode-hook))
\f
-;; Ideosyncratic dired commands that don't deal with marks.
+;; Idiosyncratic dired commands that don't deal with marks.
(defun dired-quit ()
"Bury the current dired buffer."
(dired-why)
;>> this should check the key-bindings and use substitute-command-keys if non-standard
(message
- "d-elete, u-ndelete, x-punge, f-ind, o-ther window, r-ename, C-opy, h-elp"))
+ "d-elete, u-ndelete, x-punge, f-ind, o-ther window, R-ename, C-opy, h-elp"))
(defun dired-undo ()
"Undo in a dired buffer.
(interactive "p")
(dired-next-dirline (- arg)))
-(defun dired-up-directory ()
+(defun dired-up-directory (&optional other-window)
"Run dired on parent directory of current directory.
Find the parent directory either in this buffer or another buffer.
Creates a buffer if necessary."
- (interactive)
+ (interactive "P")
(let* ((dir (dired-current-directory))
(up (file-name-directory (directory-file-name dir))))
(or (dired-goto-file (directory-file-name dir))
- (and dired-subdir-alist
+ ;; Only try dired-goto-subdir if buffer has more than one dir.
+ (and (cdr dired-subdir-alist)
(dired-goto-subdir up))
(progn
- (dired up)
+ (if other-window
+ (dired-other-window up)
+ (dired up))
(dired-goto-file dir)))))
+;; Force `f' rather than `e' in the mode doc:
+(defalias 'dired-advertised-find-file 'dired-find-file)
(defun dired-find-file ()
"In dired, visit the file or directory named on this line."
(interactive)
- (find-file (dired-get-filename)))
+ (let ((file-name (file-name-sans-versions (dired-get-filename) t)))
+ (if (file-exists-p file-name)
+ (find-file file-name)
+ (if (file-symlink-p file-name)
+ (error "File is a symlink to a nonexistent target")
+ (error "File no longer exists; type `g' to update Dired buffer")))))
+
+(defun dired-mouse-find-file-other-window (event)
+ "In dired, visit the file or directory name you click on."
+ (interactive "e")
+ (let (file)
+ (save-excursion
+ (set-buffer (window-buffer (posn-window (event-end event))))
+ (save-excursion
+ (goto-char (posn-point (event-end event)))
+ (setq file (dired-get-filename))))
+ (select-window (posn-window (event-end event)))
+ (find-file-other-window (file-name-sans-versions file t))))
(defun dired-view-file ()
"In dired, examine a file in view mode, returning to dired when done.
otherwise, display it in another buffer."
(interactive)
(if (file-directory-p (dired-get-filename))
- (or (and dired-subdir-alist (dired-goto-subdir (dired-get-filename)))
+ (or (and (cdr dired-subdir-alist)
+ (dired-goto-subdir (dired-get-filename)))
(dired (dired-get-filename)))
(view-file (dired-get-filename))))
(defun dired-find-file-other-window ()
"In dired, visit this file or directory in another window."
(interactive)
- (find-file-other-window (dired-get-filename)))
+ (find-file-other-window (file-name-sans-versions (dired-get-filename) t)))
(defun dired-display-file ()
"In dired, display this file or directory in another window."
(interactive)
- (display-buffer (find-file-noselect (dired-get-filename))))
+ (let ((file (file-name-sans-versions (dired-get-filename) t)))
+ (display-buffer (find-file-noselect file))))
\f
;;; Functions for extracting and manipulating file names in dired buffers.
(setq p2 (dired-move-to-end-of-filename no-error-if-not-filep))))
;; nil if no file on this line, but no-error-if-not-filep is t:
(if (setq file (and p1 p2 (buffer-substring p1 p2)))
- ;; Check if ls quoted the names, and unquote them.
- ;; Using read to unquote is much faster than substituting
- ;; \007 (4 chars) -> ^G (1 char) etc. in a lisp loop.
- (cond ((string-match "b" dired-actual-switches) ; System V ls
- ;; This case is about 20% slower than without -b.
- (setq file
- (read
- (concat "\""
- ;; some ls -b don't escape quotes, argh!
- ;; This is not needed for GNU ls, though.
- (or (dired-string-replace-match
- "\\([^\\]\\)\"" file "\\1\\\\\"")
- file)
- "\""))))
- ;; If you do this, update dired-insert-subdir-validate too
- ;; ((string-match "Q" dired-actual-switches) ; GNU ls
- ;; (setq file (read file)))
- ))
+ (progn
+ ;; Get rid of the mouse-face property that file names have.
+ (set-text-properties 0 (length file) nil file)
+ ;; Unquote names quoted by ls or by dired-insert-directory.
+ ;; Using read to unquote is much faster than substituting
+ ;; \007 (4 chars) -> ^G (1 char) etc. in a lisp loop.
+ (setq file
+ (read
+ (concat "\""
+ ;; some ls -b don't escape quotes, argh!
+ ;; This is not needed for GNU ls, though.
+ (or (dired-string-replace-match
+ "\\([^\\]\\|\\`\\)\"" file "\\1\\\\\"" nil t)
+ file)
+ "\"")))))
(if (eq localp 'no-dir)
file
(and file (concat (dired-current-directory localp) file)))))
+(defun dired-string-replace-match (regexp string newtext
+ &optional literal global)
+ "Replace first match of REGEXP in STRING with NEWTEXT.
+If it does not match, nil is returned instead of the new string.
+Optional arg LITERAL means to take NEWTEXT literally.
+Optional arg GLOBAL means to replace all matches."
+ (if global
+ (let ((start 0))
+ (while (string-match regexp string start)
+ (let ((from-end (- (length string) (match-end 0))))
+ (setq string (replace-match newtext t literal string))
+ (setq start (- (length string) from-end))))
+ string)
+ (if (not (string-match regexp string 0))
+ nil
+ (replace-match newtext t literal string))))
+
(defun dired-make-absolute (file &optional dir)
;;"Convert FILE (a pathname relative to DIR) to an absolute pathname."
;; We can't always use expand-file-name as this would get rid of `.'
;; dired-get-filename.
(concat (or dir default-directory) file))
-(defun dired-make-relative (file &optional dir no-error)
- ;;"Convert FILE (an absolute pathname) to a pathname relative to DIR.
- ;; Else error (unless NO-ERROR is non-nil, then FILE is returned unchanged)
- ;;DIR defaults to default-directory."
- ;; DIR must be file-name-as-directory, as with all directory args in
- ;; Emacs Lisp code.
+(defun dired-make-relative (file &optional dir ignore)
+ "Convert FILE (an absolute file name) to a name relative to DIR.
+If this is impossible, return FILE unchanged.
+DIR must be a directory name, not a file name."
(or dir (setq dir default-directory))
+ ;; This case comes into play if default-directory is set to
+ ;; use ~.
+ (if (and (> (length dir) 0) (= (aref dir 0) ?~))
+ (setq dir (expand-file-name dir)))
(if (string-match (concat "^" (regexp-quote dir)) file)
(substring file (match-end 0))
- (if no-error
- file
- (error "%s: not in directory tree growing at %s" file dir))))
+;;; (or no-error
+;;; (error "%s: not in directory tree growing at %s" file dir))
+ file))
\f
;;; Functions for finding the file name in a dired buffer line.
+(defvar dired-move-to-filename-regexp
+ " [A-Za-z\xa0-\xff][A-Za-z\xa0-\xff][A-Za-z\xa0-\xff] [0-3 ][0-9]\
+ [ 0-9][0-9][:0-9][0-9][ 0-9] "
+ "Regular expression to match a month abbreviation followed date/time.")
+
+(defvar dired-permission-flags-regexp
+ "\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"
+ "Regular expression to match the permission flags in `ls -l'.")
+
;; Move to first char of filename on this line.
;; Returns position (point) or nil if no filename on this line."
(defun dired-move-to-filename (&optional raise-error eol)
;; This is the UNIX version.
(or eol (setq eol (progn (end-of-line) (point))))
(beginning-of-line)
- (if (re-search-forward
- "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+"
- eol t)
- (progn
- (skip-chars-forward " ") ; there is one SPC after day of month
- (skip-chars-forward "^ " eol) ; move after time of day (or year)
- (skip-chars-forward " " eol) ; there is space before the file name
- ;; Actually, if the year instead of clock time is displayed,
- ;; there are (only for some ls programs?) two spaces instead
- ;; of one before the name.
- ;; If we could depend on ls inserting exactly one SPC we
- ;; would not bomb on names _starting_ with SPC.
- (point))
+ (if (re-search-forward dired-move-to-filename-regexp eol t)
+ (goto-char (match-end 0))
(if raise-error
- (error "No file on this line")
- nil)))
+ (error "No file on this line"))))
(defun dired-move-to-end-of-filename (&optional no-error)
;; Assumes point is at beginning of filename,
;; "l---------" (some systems make symlinks that way)
;; "----------" (plain file with zero perms)
(if (re-search-backward
- "\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"
- nil t)
+ dired-permission-flags-regexp nil t)
(setq file-type (char-after (match-beginning 1))
symlink (eq file-type ?l)
;; Only with -F we need to know whether it's an executable
;; Enlarged by dired-advertise
;; Queried by function dired-buffers-for-dir. When this detects a
;; killed buffer, it is removed from this list.
- "Alist of directories and their associated dired buffers.")
+ "Alist of expanded directories and their associated dired buffers.")
-(defun dired-buffers-for-dir (dir)
+(defun dired-buffers-for-dir (dir &optional file)
;; Return a list of buffers that dired DIR (top level or in-situ subdir).
+;; If FILE is non-nil, include only those whose wildcard pattern (if any)
+;; matches FILE.
;; The list is in reverse order of buffer creation, most recent last.
;; As a side effect, killed dired buffers for DIR are removed from
;; dired-buffers.
(setq dir (file-name-as-directory dir))
- (let ((alist dired-buffers) result elt)
+ (let ((alist dired-buffers) result elt buf pattern)
(while alist
- (setq elt (car alist))
- (if (dired-in-this-tree dir (car elt))
- (let ((buf (cdr elt)))
- (if (buffer-name buf)
- (if (assoc dir (save-excursion
- (set-buffer buf)
- dired-subdir-alist))
- (setq result (cons buf result)))
- ;; else buffer is killed - clean up:
- (setq dired-buffers (delq elt dired-buffers)))))
+ (setq elt (car alist)
+ buf (cdr elt))
+ (if (buffer-name buf)
+ (if (dired-in-this-tree dir (car elt))
+ (with-current-buffer buf
+ (and (assoc dir dired-subdir-alist)
+ (or (null file)
+ (let ((wildcards
+ (file-name-nondirectory dired-directory)))
+ (or (= 0 (length wildcards))
+ (string-match (dired-glob-regexp wildcards)
+ file))))
+ (setq result (cons buf result)))))
+ ;; else buffer is killed - clean up:
+ (setq dired-buffers (delq elt dired-buffers)))
(setq alist (cdr alist)))
result))
+(defun dired-glob-regexp (pattern)
+ "Convert glob-pattern PATTERN to a regular expression."
+ (let ((matched-in-pattern 0) ;; How many chars of PATTERN we've handled.
+ regexp)
+ (while (string-match "[[?*]" pattern matched-in-pattern)
+ (let ((op-end (match-end 0))
+ (next-op (aref pattern (match-beginning 0))))
+ (setq regexp (concat regexp
+ (regexp-quote
+ (substring pattern matched-in-pattern
+ (match-beginning 0)))))
+ (cond ((= next-op ??)
+ (setq regexp (concat regexp "."))
+ (setq matched-in-pattern op-end))
+ ((= next-op ?\[)
+ ;; Fails to handle ^ yet ????
+ (let* ((set-start (match-beginning 0))
+ (set-cont
+ (if (= (aref pattern (1+ set-start)) ?^)
+ (+ 3 set-start)
+ (+ 2 set-start)))
+ (set-end (string-match "]" pattern set-cont))
+ (set (substring pattern set-start (1+ set-end))))
+ (setq regexp (concat regexp set))
+ (setq matched-in-pattern (1+ set-end))))
+ ((= next-op ?*)
+ (setq regexp (concat regexp ".*"))
+ (setq matched-in-pattern op-end)))))
+ (concat "\\`"
+ regexp
+ (regexp-quote
+ (substring pattern matched-in-pattern))
+ "\\'")))
+
+
+
(defun dired-advertise ()
;;"Advertise in variable `dired-buffers' that we dired `default-directory'."
;; With wildcards we actually advertise too much.
- (if (memq (current-buffer) (dired-buffers-for-dir default-directory))
- t ; we have already advertised ourselves
- (setq dired-buffers
- (cons (cons default-directory (current-buffer))
- dired-buffers))))
+ (let ((expanded-default (expand-file-name default-directory)))
+ (if (memq (current-buffer) (dired-buffers-for-dir expanded-default))
+ t ; we have already advertised ourselves
+ (setq dired-buffers
+ (cons (cons expanded-default (current-buffer))
+ dired-buffers)))))
(defun dired-unadvertise (dir)
;; Remove DIR from the buffer alist in variable dired-buffers.
;; It does not affect buffers in which DIR is a subdir.
;; Removing is also done as a side-effect in dired-buffer-for-dir.
(setq dired-buffers
- (delq (assoc dir dired-buffers) dired-buffers)))
+ (delq (assoc (expand-file-name dir) dired-buffers) dired-buffers)))
\f
;; Tree Dired
;(defun dired-get-subdir-min (elt)
; (cdr elt))
;; can't use macro, must be redefinable for other alist format in dired-nstd.
-(fset 'dired-get-subdir-min 'cdr)
+(defalias 'dired-get-subdir-min 'cdr)
(defun dired-get-subdir-max (elt)
(save-excursion
(set-marker (dired-get-subdir-min (car dired-subdir-alist)) nil)
(setq dired-subdir-alist (cdr dired-subdir-alist))))
+(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)))
+
+(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"))))))
+
(defun dired-build-subdir-alist ()
"Build `dired-subdir-alist' by parsing the buffer.
Returns the new value of the alist."
(interactive)
(dired-clear-alist)
(save-excursion
- (let ((count 0))
+ (let ((count 0)
+ (buffer-read-only nil)
+ new-dir-name)
(goto-char (point-min))
(setq dired-subdir-alist nil)
- (while (re-search-forward dired-subdir-regexp nil t)
+ (while (and (re-search-forward dired-subdir-regexp nil t)
+ ;; Avoid taking a file name ending in a colon
+ ;; as a subdir name.
+ (not (save-excursion
+ (goto-char (match-beginning 0))
+ (beginning-of-line)
+ (forward-char 2)
+ (save-match-data (looking-at dired-re-perms)))))
+ (save-excursion
+ (goto-char (match-beginning 1))
+ (setq new-dir-name
+ (expand-file-name (buffer-substring (point) (match-end 1))))
+ (delete-region (point) (match-end 1))
+ (insert new-dir-name))
(setq count (1+ count))
- (dired-alist-add-1 (buffer-substring (match-beginning 1)
- (match-end 1))
- ;; Put subdir boundary between lines:
- (save-excursion
- (goto-char (match-beginning 0))
- (beginning-of-line)
- (point-marker)))
- (message "%d" count))
- (message "%d director%s" count (if (= 1 count) "y" "ies"))
+ (dired-alist-add-1 new-dir-name
+ ;; Place a sub directory boundary between lines.
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (beginning-of-line)
+ (point-marker))))
+ (if (> count 1)
+ (message "Buffer includes %d directories" count))
;; We don't need to sort it because it is in buffer order per
;; constructionem. Return new alist:
dired-subdir-alist)))
(save-excursion
;; The hair here is to get the result of dired-goto-subdir
;; without really calling it if we don't have any subdirs.
- (if (if (string= dir default-directory)
+ (if (if (string= dir (expand-file-name default-directory))
(goto-char (point-min))
- (and dired-subdir-alist
+ (and (cdr dired-subdir-alist)
(dired-goto-subdir dir)))
(let ((base (file-name-nondirectory file))
(boundary (dired-subdir-max)))
;; correct) match could have been elsewhere on the
;; ;; line (e.g. "-" would match somewhere in the
;; permission bits).
- (setq found (dired-move-to-filename)))))))
+ (setq found (dired-move-to-filename))
+ ;; If this isn't the right line, move forward to avoid
+ ;; trying this line again.
+ (forward-line 1))))))
(and found
;; return value of point (i.e., FOUND):
(goto-char found))))
(defun dired-subdir-max ()
(save-excursion
- (if (or (null dired-subdir-alist) (not (dired-next-subdir 1 t t)))
+ (if (or (null (cdr dired-subdir-alist)) (not (dired-next-subdir 1 t t)))
(point-max)
(point))))
\f
;; Deleting files
-(defun dired-do-flagged-delete ()
- "In dired, delete the files flagged for deletion."
+(defun dired-do-flagged-delete (&optional nomessage)
+ "In dired, delete the files flagged for deletion.
+If NOMESSAGE is non-nil, we don't display any message
+if there are no flagged files."
(interactive)
(let* ((dired-marker-char dired-del-marker)
(regexp (dired-marker-regexp))
(dired-map-over-marks (cons (dired-get-filename) (point))
nil)
nil)
- (message "(No deletions requested)"))))
+ (or nomessage
+ (message "(No deletions requested)")))))
(defun dired-do-delete (&optional arg)
"Delete all marked (or next ARG) files."
;; This is a separate function for the sake of dired-x.el.
(defun dired-clean-up-after-deletion (fn)
;; Clean up after a deleted file or directory FN.
- (save-excursion (and (dired-goto-subdir fn)
+ (save-excursion (and (cdr dired-subdir-alist)
+ (dired-goto-subdir fn)
(dired-kill-subdir))))
\f
;; Confirmation
(set-buffer buf)
(goto-char (point-max))
(skip-chars-backward "\n\r\t ")
- (setq target-lines (count-lines (point-min) (point))))
+ (setq target-lines (count-lines (point-min) (point)))
+ ;; Don't forget to count the last line.
+ (if (not (bolp))
+ (setq target-lines (1+ target-lines))))
(if (<= (window-height window) (* 2 window-min-height))
;; At this point, every window on the frame is too small to split.
(setq w2 (display-buffer buf))
)))
(defvar dired-no-confirm nil
-;; "If non-nil, list of symbols for commands dired should not confirm.
-;;It can be a sublist of
-;;
-;; '(byte-compile chgrp chmod chown compress copy delete hardlink load
-;; move print shell symlink uncompress)"
- )
+ "A list of symbols for commands dired should not confirm.
+Command symbols are `byte-compile', `chgrp', `chmod', `chown', `compress',
+`copy', `delete', `hardlink', `load', `move', `print', `shell', `symlink' and
+`uncompress'.")
(defun dired-mark-pop-up (bufname op-symbol files function &rest args)
;;"Args BUFNAME OP-SYMBOL FILES FUNCTION &rest ARGS.
;; OP-SYMBOL is a member of the list in `dired-no-confirm'.
;;FILES is the list of marked files."
(or bufname (setq bufname " *Marked Files*"))
- (if (or (memq op-symbol dired-no-confirm)
+ (if (or (eq dired-no-confirm t)
+ (memq op-symbol dired-no-confirm)
(= (length files) 1))
(apply function args)
(save-excursion
(set-buffer (get-buffer-create bufname))
(erase-buffer)
- (dired-format-columns-of-files files))
+ (dired-format-columns-of-files files)
+ (remove-text-properties (point-min) (point-max) '(mouse-face)))
(save-window-excursion
(dired-pop-to-buffer bufname)
(apply function args))))
(defun dired-repeat-over-lines (arg function)
;; This version skips non-file lines.
- (beginning-of-line)
- (while (and (> arg 0) (not (eobp)))
- (setq arg (1- arg))
- (beginning-of-line)
- (while (and (not (eobp)) (dired-between-files)) (forward-line 1))
- (save-excursion (funcall function))
- (forward-line 1))
- (while (and (< arg 0) (not (bobp)))
- (setq arg (1+ arg))
- (forward-line -1)
- (while (and (not (bobp)) (dired-between-files)) (forward-line -1))
+ (let ((pos (make-marker)))
(beginning-of-line)
- (save-excursion (funcall function))
- (dired-move-to-filename))
- (dired-move-to-filename))
+ (while (and (> arg 0) (not (eobp)))
+ (setq arg (1- arg))
+ (beginning-of-line)
+ (while (and (not (eobp)) (dired-between-files)) (forward-line 1))
+ (save-excursion
+ (forward-line 1)
+ (move-marker pos (1+ (point))))
+ (save-excursion (funcall function))
+ ;; Advance to the next line--actually, to the line that *was* next.
+ ;; (If FUNCTION inserted some new lines in between, skip them.)
+ (goto-char pos))
+ (while (and (< arg 0) (not (bobp)))
+ (setq arg (1+ arg))
+ (forward-line -1)
+ (while (and (not (bobp)) (dired-between-files)) (forward-line -1))
+ (beginning-of-line)
+ (save-excursion (funcall function)))
+ (move-marker pos nil)
+ (dired-move-to-filename)))
(defun dired-between-files ()
;; Point must be at beginning of line
;; Should be equivalent to (save-excursion (not (dired-move-to-filename)))
;; but is about 1.5..2.0 times as fast. (Actually that's not worth it)
(or (looking-at "^$\\|^. *$\\|^. total\\|^. wildcard")
- (looking-at dired-subdir-regexp)))
+ (and (looking-at dired-subdir-regexp)
+ (save-excursion (not (dired-move-to-filename))))))
(defun dired-next-marked-file (arg &optional wrap opoint)
"Move to the next marked file, wrapping around the end of the buffer."
and \\[dired-unmark] on a subdir to remove the marks in
this subdir."
(interactive "P")
- (if (and dired-subdir-alist (dired-get-subdir))
+ (if (dired-get-subdir)
(save-excursion (dired-mark-subdir-files))
(let (buffer-read-only)
(dired-repeat-over-lines
\f
;;; Commands to mark or flag files based on their characteristics or names.
-(defun dired-read-regexp (prompt &optional initial)
-;; This is an extra function so that gmhist can redefine it.
- (setq dired-flagging-regexp
- (read-string prompt (or initial dired-flagging-regexp))))
+(defvar dired-regexp-history nil
+ "History list of regular expressions used in Dired commands.")
+
+(defun dired-read-regexp (prompt)
+ (read-from-minibuffer prompt nil nil nil 'dired-regexp-history))
(defun dired-mark-files-regexp (regexp &optional marker-char)
"Mark all files matching REGEXP for use in later commands.
(interactive "P")
(let ((dired-marker-char (if unflag-p ?\040 dired-del-marker)))
(dired-mark-if
- (and (not (looking-at dired-re-dir))
- (let ((fn (dired-get-filename t t)))
- (if fn (auto-save-file-name-p
- (file-name-nondirectory fn)))))
- "auto save file")))
+ ;; It is less than general to check for # here,
+ ;; but it's the only way this runs fast enough.
+ (and (save-excursion (end-of-line)
+ (or
+ (eq (preceding-char) ?#)
+ ;; Handle executables in case of -F option.
+ ;; We need not worry about the other kinds
+ ;; of markings that -F makes, since they won't
+ ;; appear on real auto-save files.
+ (if (eq (preceding-char) ?*)
+ (progn
+ (forward-char -1)
+ (eq (preceding-char) ?#)))))
+ (not (looking-at dired-re-dir))
+ (let ((fn (dired-get-filename t t)))
+ (if fn (auto-save-file-name-p
+ (file-name-nondirectory fn)))))
+ "auto save file")))
+
+(defvar dired-garbage-files-regexp
+ "\\.log$\\|\\.toc$\\|.dvi$|\\.bak$\\|\\.orig$\\|\\.rej$"
+ "*Regular expression to match \"garbage\" files for `dired-flag-garbage-files'.")
+
+(defun dired-flag-garbage-files ()
+ (interactive)
+ "Flag for deletion all files that match `dired-garbage-files-regexp'."
+ (dired-flag-files-regexp dired-garbage-files-regexp))
(defun dired-flag-backup-files (&optional unflag-p)
"Flag all backup files (names ending with `~') for deletion.
With prefix argument, unflag these files."
(interactive "P")
- (let ((dired-marker-char (if unflag-p ?\040 dired-del-marker)))
+ (let ((dired-marker-char (if unflag-p ?\ dired-del-marker)))
(dired-mark-if
- (and (not (looking-at dired-re-dir))
+ ;; Don't call backup-file-name-p unless the last character looks like
+ ;; it might be the end of a backup file name. This isn't very general,
+ ;; but it's the only way this runs fast enough.
+ (and (save-excursion (end-of-line)
+ ;; Handle executables in case of -F option.
+ ;; We need not worry about the other kinds
+ ;; of markings that -F makes, since they won't
+ ;; appear on real backup files.
+ (if (eq (preceding-char) ?*)
+ (forward-char -1))
+ (eq (preceding-char) ?~))
+ (not (looking-at dired-re-dir))
(let ((fn (dired-get-filename t t)))
(if fn (backup-file-name-p fn))))
"backup file")))
-(defun dired-unmark-all-files (flag &optional arg)
- "Remove a specific mark or any mark from every file.
-With an arg, queries for each marked file.
-Type \\[help-command] at that time for help."
- (interactive "sRemove mark: (default: all marks) \nP")
- (let ((count 0)
- (re (if (zerop (length flag)) dired-re-mark
- (concat "^" (regexp-quote flag)))))
- (save-excursion
- (let (buffer-read-only case-fold-search query
- (help-form "\
-Type SPC or `y' to unflag one file, DEL or `n' to skip to next,
-`!' to unflag all remaining files with no more questions."))
+(defun dired-change-marks (&optional old new)
+ "Change all OLD marks to NEW marks.
+OLD and NEW are both characters used to mark files."
+ (interactive
+ (let* ((cursor-in-echo-area t)
+ (old (progn (message "Change (old mark): ") (read-char)))
+ (new (progn (message "Change %c marks to (new mark): " old)
+ (read-char))))
+ (list old new)))
+ (if (or (eq old ?\r) (eq new ?\r))
+ (ding)
+ (let ((string (format "\n%c" old))
+ (buffer-read-only))
+ (save-excursion
(goto-char (point-min))
- (while (re-search-forward re nil t)
- (if (or (not arg)
- (dired-query 'query "Unmark file `%s'? "
- (dired-get-filename t)))
- (progn (delete-char -1) (insert " ") (setq count (1+ count))))
- (forward-line 1))))
- (message "%s" (format "Flags removed: %d %s" count flag) )))
-\f
-;;; Cleaning a directory: flagging some backups for deletion.
-
-(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.
+ (while (search-forward string nil t)
+ (if (if (= old ?\ )
+ (save-match-data
+ (dired-get-filename 'no-dir t))
+ t)
+ (subst-char-in-region (match-beginning 0)
+ (match-end 0) old new)))))))
+
+(defun dired-unmark-all-marks ()
+ "Remove all marks from all files in the Dired buffer."
+ (interactive)
+ (dired-unmark-all-files ?\r))
-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).
+(defun dired-unmark-all-files (mark &optional arg)
+ "Remove a specific mark (or any mark) from every file.
+After this command, type the mark character to remove,
+or type RET to remove all marks.
+With prefix arg, query for each marked file.
+Type \\[help-command] at that time for help."
+ (interactive "cRemove marks (RET means all): \nP")
(save-excursion
- (let (file buffer-read-only)
+ (let* ((count 0)
+ buffer-read-only case-fold-search query
+ (string (format "\n%c" mark))
+ (help-form "\
+Type SPC or `y' to unmark one file, DEL or `n' to skip to next,
+`!' to unmark all remaining files with no more questions."))
(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)))))
+ (while (if (eq mark ?\r)
+ (re-search-forward dired-re-mark nil t)
+ (search-forward string nil t))
+ (if (or (not arg)
+ (dired-query 'query "Unmark file `%s'? "
+ (dired-get-filename t)))
+ (progn (subst-char-in-region (1- (point)) (point)
+ (preceding-char) ?\ )
+ (setq count (1+ count)))))
+ (message (if (= count 1) "1 mark removed"
+ "%d marks removed")
+ count))))
\f
;; Logging failures operating on files, and showing the results.
(let ((owindow (selected-window))
(window (display-buffer (get-buffer dired-log-buffer))))
(unwind-protect
- (save-excursion
+ (progn
(select-window window)
(goto-char (point-max))
(recenter -1))
(concat "^-[^t" dired-ls-sorting-switches "]+$")
"Regexp recognized by dired to set `by name' mode.")
-(defvar dired-sort-mode nil
- "Whether Dired sorts by name, date etc. (buffer-local).")
-;; This is nil outside dired buffers so it can be used in the modeline
-
(defun dired-sort-set-modeline ()
;; Set modeline display according to dired-actual-switches.
;; Modeline display of "by name" or "by date" guarantees the user a
;; match with the corresponding regexps. Non-matching switches are
;; shown literally.
- (setq dired-sort-mode
+ (setq mode-name
(let (case-fold-search)
(cond ((string-match dired-sort-by-name-regexp dired-actual-switches)
- " by name")
+ "Dired by name")
((string-match dired-sort-by-date-regexp dired-actual-switches)
- " by date")
+ "Dired by date")
(t
- (concat " " dired-actual-switches)))))
- ;; update mode line:
- (set-buffer-modified-p (buffer-modified-p)))
+ (concat "Dired " dired-actual-switches)))))
+ (force-mode-line-update))
(defun dired-sort-toggle-or-edit (&optional arg)
"Toggle between sort by date/name and refresh the dired buffer.
(let (case-fold-search)
(concat
"-l"
- (dired-replace-in-string (concat "[---lt"
+ (dired-replace-in-string (concat "[-lt"
dired-ls-sorting-switches "]")
""
dired-actual-switches)
;; minor mode accordingly, others appear literally in the mode line.
;; With optional second arg NO-REVERT, don't refresh the listing afterwards.
(setq dired-actual-switches switches)
- (dired-sort-set-modeline)
+ (if (eq major-mode 'dired-mode) (dired-sort-set-modeline))
(or no-revert (revert-buffer)))
\f
;; To make this file smaller, the less common commands
The backup file is the first file given to `diff'."
t)
+(autoload 'dired-clean-directory "dired-aux"
+ "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."
+ t)
+
(autoload 'dired-do-chmod "dired-aux"
"Change the mode of the marked (or next ARG) files.
This calls chmod, thus symbolic modes like `g+w' are allowed."
t)
(autoload 'dired-do-shell-command "dired-aux"
- "Run a shell command on the marked files.
+ "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."
t)
-(autoload 'dired-kill-line-or-subdir "dired-aux"
- "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."
- t)
-
(autoload 'dired-do-kill-lines "dired-aux"
"Kill all marked lines (not the files).
With a prefix arg, kill all lines not marked or flagged."
a prefix arg lets you edit the `ls' switches used for the new listing."
t)
-(autoload 'dired-string-replace-match "dired-aux"
- "Replace first match of REGEXP in STRING with NEWTEXT.
-If it does not match, nil is returned instead of the new string.
-Optional arg LITERAL means to take NEWTEXT literally.
-Optional arg GLOBAL means to replace all matches."
- t)
-
(autoload 'dired-create-directory "dired-aux"
"Create a directory called DIRECTORY."
t)
(if (eq system-type 'vax-vms)
(load "dired-vms"))
-(run-hooks 'dired-load-hook) ; for your customizations
-
(provide 'dired)
+(run-hooks 'dired-load-hook) ; for your customizations
+
;;; dired.el ends here
HCoop / bpt / emacs.git / blobdiff