;;; Customizable variables
+(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'. See also the variable
-`dired-ls-F-marks-symlinks' concerning the `F' switch.")
+`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
"/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').")
+(defvar dired-chmod-program "chmod"
+ "Name of chmod command (usually `chmod').")
;;;###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 `ls' (or whatever program is specified by
`insert-directory-program') with `-lF' marks the symbolic link
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)
+
+(defcustom dired-free-space-program "df"
+ "*Program to get the amount of free space on a file system.
+We assume the output has the format of `df'.
+The value of this variable must be just a command name or file name;
+if you want to specify options, use `dired-free-space-args'.
+
+A value of nil disables this feature."
+ :type '(choice (string :tag "Program") (const :tag "None" nil))
+ :group 'dired)
+
+(defcustom dired-free-space-args "-Pk"
+ "*Options to use when running `dired-free-space-program'."
+ :type 'string
+ :group 'dired)
;;; Hook variables
;; "Regexp matching a marked line.
;; Important: the match ends just after the marker."
(defvar dired-re-maybe-mark "^. ")
-(defvar dired-re-dir (concat dired-re-maybe-mark dired-re-inode-size "d"))
-(defvar dired-re-sym (concat dired-re-maybe-mark dired-re-inode-size "l"))
+;; The [^:] part after "d" and "l" is to avoid confusion with the
+;; DOS/Windows-style drive letters in directory names, like in "d:/foo".
+(defvar dired-re-dir (concat dired-re-maybe-mark dired-re-inode-size "d[^:]"))
+(defvar dired-re-sym (concat dired-re-maybe-mark dired-re-inode-size "l[^:]"))
(defvar dired-re-exe;; match ls permission string of an executable file
(mapconcat (function
(lambda (x)
;;
;; Dired marks.
(list dired-re-mark
- '(0 font-lock-reference-face)
+ '(0 font-lock-constant-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)))
+ ;; People who are paranoid about security would consider this more
+ ;; important than other things such as whether it is a directory.
+ ;; But we don't want to encourage paranoia, so our default
+ ;; should be what's most useful for non-paranoids. -- rms.
+;;; ;;
+;;; ;; 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
;; 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))
+ (if mode (funcall mode)
+ (dired-mode dirname switches))
;; default-directory and dired-actual-switches are set now
;; (buffer-local), so we can call dired-readin:
(let ((failed t))
;; 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)
+ (if (not (looking-at "^ /.*:$"))
+ (dired-insert-headerline default-directory))
;; can't run dired-after-readin-hook here, it may depend on the subdir
;; alist to be OK.
)
(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))
+ (insert-directory (expand-file-name dir-or-list) switches wildcard full-p)
+ (when (and full-p dired-free-space-program)
+ (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward "total [0-9]+$" nil t)
+ (insert " free ")
+ (let ((beg (point)))
+ (call-process dired-free-space-program nil t nil
+ dired-free-space-args
+ (expand-file-name dir-or-list))
+ (goto-char beg)
+ (forward-line 1)
+ (skip-chars-forward "^ \t")
+ (forward-word 2)
+ (skip-chars-forward " \t")
+ (delete-region beg (point))
+ (forward-word 1)
+ (delete-region (point)
+ (progn (forward-line 1) (point))))))))
;; Quote certain characters, unless ls quoted them for us.
(if (not (string-match "b" dired-actual-switches))
(save-excursion
(define-key map "%u" 'dired-upcase)
(define-key map "%l" 'dired-downcase)
(define-key map "%d" 'dired-flag-files-regexp)
+ (define-key map "%g" 'dired-mark-files-containing-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 "*m" 'dired-mark)
(define-key map "*u" 'dired-unmark)
(define-key map "*?" 'dired-unmark-all-files)
- (define-key map "*!" 'dired-unmark-all-files-no-query)
+ (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)
+ (define-key map "*t" 'dired-do-toggle)
;; 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 "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 "q" 'quit-window)
(define-key map "s" 'dired-sort-toggle-or-edit)
+ (define-key map "t" 'dired-do-toggle)
(define-key map "u" 'dired-unmark)
(define-key map "v" 'dired-view-file)
(define-key map "x" 'dired-do-flagged-delete)
'("Flag..." . dired-flag-files-regexp))
(define-key map [menu-bar regexp mark]
'("Mark..." . dired-mark-files-regexp))
+ (define-key map [menu-bar regexp mark-cont]
+ '("Mark Containing..." . dired-mark-files-containing-regexp))
(define-key map [menu-bar mark]
(cons "Mark" (make-sparse-keymap "Mark")))
(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-files-no-query))
+ '("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]
'("Unmark" . dired-unmark))
(define-key map [menu-bar mark mark]
'("Mark" . dired-mark))
+ (define-key map [menu-bar mark toggle-marks]
+ '("Toggle Marks" . dired-do-toggle))
(define-key map [menu-bar operate]
(cons "Operate" (make-sparse-keymap "Operate")))
;; case-fold-search nil
buffer-read-only t
selective-display t ; for subdirectory hiding
- mode-line-buffer-identification '(" %17b"))
+ mode-line-buffer-identification '("%17b"))
(set (make-local-variable 'revert-buffer-function)
(function dired-revert))
(set (make-local-variable 'page-delimiter)
\f
;; Idiosyncratic dired commands that don't deal with marks.
-(defun dired-quit ()
- "Bury the current dired buffer."
- (interactive)
- (bury-buffer))
-
(defun dired-summary ()
"Summarize basic Dired commands and show recent Dired errors."
(interactive)
;; Force `f' rather than `e' in the mode doc:
(defalias 'dired-advertised-find-file 'dired-find-file)
-(defun dired-find-file (&optional coding-system)
+(defun dired-find-file ()
"In dired, visit the file or directory named on this line."
- (interactive "ZCoding-system: ")
+ (interactive)
(let ((file-name (file-name-sans-versions (dired-get-filename) t)))
(if (file-exists-p file-name)
- (find-file file-name coding-system)
- (error "File no longer exists; type `g' to update Dired buffer"))))
+ (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."
"\\([^\\]\\|\\`\\)\"" file "\\1\\\\\"" nil t)
file)
"\"")))))
+ (and file buffer-file-coding-system
+ (not file-name-coding-system)
+ (not default-file-name-coding-system)
+ (setq file (encode-coding-string file buffer-file-coding-system)))
(if (eq localp 'no-dir)
file
(and file (concat (dired-current-directory localp) file)))))
Optional arg LITERAL means to take NEWTEXT literally.
Optional arg GLOBAL means to replace all matches."
(if global
- (let ((start 0))
+ (let ((start 0) ret)
(while (string-match regexp string start)
(let ((from-end (- (length string) (match-end 0))))
- (setq string (replace-match newtext t literal string))
+ (setq ret (setq string (replace-match newtext t literal string)))
(setq start (- (length string) from-end))))
- string)
+ ret)
(if (not (string-match regexp string 0))
nil
(replace-match newtext t literal string))))
;;; 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.")
+ (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
+ ;; In some locales, month abbreviations are as short as 2 letters,
+ ;; and they can be padded on the right with spaces.
+ ;; weiand: changed: month ends potentially with . or , or .,
+;;old (month (concat l l "+ *"))
+ (month (concat l l "+[.]?,? *"))
+ ;; Recognize any non-ASCII character.
+ ;; The purpose is to match a Kanji character.
+ (k "[^\0-\177]")
+ ;; (k "[^\x00-\x7f\x80-\xff]")
+ (s " ")
+ (yyyy "[0-9][0-9][0-9][0-9]")
+ (mm "[ 0-1][0-9]")
+;;old (dd "[ 0-3][0-9]")
+ (dd "[ 0-3][0-9][.]?")
+ (HH:MM "[ 0-2][0-9]:[0-5][0-9]")
+ (western (concat "\\(" month s dd "\\|" dd s month "\\)"
+ ;; weiand: changed: year potentially unaligned
+;;old s "\\(" HH:MM "\\|" s yyyy "\\|" yyyy s "\\)"))
+ s "\\(" HH:MM "\\|" s "?" yyyy "\\|" yyyy s
+"\\)"))
+ (japanese (concat mm k s dd k s "\\(" s HH:MM "\\|" yyyy k "\\)")))
+ ;; The "[0-9]" below requires the previous column to end in a digit.
+ ;; This avoids recognizing `1 may 1997' as a date in the line:
+ ;; -r--r--r-- 1 may 1997 1168 Oct 19 16:49 README
+ ;; The ".*" below finds the last match if there are multiple matches.
+ ;; This avoids recognizing `jservice 10 1024' as a date in the line:
+ ;; drwxr-xr-x 3 jservice 10 1024 Jul 2 1997 esg-host
+ (concat ".*[0-9]" s "\\(" western "\\|" japanese "\\)" s))
+ "Regular expression to match up to the file name in a directory listing.
+The default value is designed to recognize dates and times
+regardless of the language.")
(defvar dired-permission-flags-regexp
"\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"
\f
;; Deleting files
+(defcustom dired-recursive-deletes nil ; Default only delete empty directories.
+ "*Decide whether recursive deletes are allowed.
+Nil means no recursive deletes.
+`always' means delete recursively without asking. This is DANGEROUS!
+`top' means ask for each directory at top level, but delete its subdirectories
+without asking.
+Anything else means ask for each directory."
+ :type '(choice :tag "Delete not empty directory"
+ (const :tag "No. Only empty directories" nil)
+ (const :tag "Ask for each directory" t)
+ (const :tag "Ask for each top directory only" top))
+ :group 'dired)
+
+;; Match anything but `.' and `..'.
+(defvar dired-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")
+
+;; Delete file, possibly delete a directory and all its files.
+;; This function is usefull outside of dired. One could change it's name
+;; to e.g. recursive-delete-file and put it somewhere else.
+(defun dired-delete-file (file &optional recursive) "\
+Delete FILE or directory (possibly recursively if optional RECURSIVE is true.)
+RECURSIVE determines what to do with a non-empty directory. If RECURSIVE is:
+Nil, do not delete.
+`always', delete recursively without asking.
+`top', ask for each directory at top level.
+Anything else, ask for each sub-directory."
+ (let (files)
+ ;; This test is equivalent to
+ ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
+ ;; but more efficient
+ (if (not (eq t (car (file-attributes file))))
+ (delete-file file)
+ (when (and recursive
+ (setq files
+ (directory-files file t dired-re-no-dot)) ; Not empty.
+ (or (eq recursive 'always)
+ (yes-or-no-p (format "Recursive delete of %s "
+ (dired-make-relative file)))))
+ (if (eq recursive 'top) (setq recursive 'always)) ; Don't ask again.
+ (while files ; Recursively delete (possibly asking).
+ (dired-delete-file (car files) recursive)
+ (setq files (cdr files))))
+ (delete-directory file))))
+
(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
(let (buffer-read-only)
(condition-case err
(let ((fn (car (car l))))
- ;; This test is equivalent to
- ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
- ;; but more efficient
- (if (eq t (car (file-attributes fn)))
- (delete-directory fn)
- (delete-file fn))
+ (dired-delete-file fn dired-recursive-deletes)
;; if we get here, removing worked
(setq succ (1+ succ))
(message "%s of %s deletions" succ count)
Optional prefix ARG says how many lines to unflag; default is one line."
(interactive "p")
(dired-unmark (- arg)))
+
+(defun dired-do-toggle ()
+ "Toggle marks.
+That is, currently marked files become unmarked and vice versa.
+Files marked with other flags (such as `D') are not affected.
+`.' and `..' are never toggled.
+As always, hidden subdirs are not affected."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (let (buffer-read-only)
+ (while (not (eobp))
+ (or (dired-between-files)
+ (looking-at dired-re-dot)
+ ;; use subst instead of insdel because it does not move
+ ;; the gap and thus should be faster and because
+ ;; other characters are left alone automatically
+ (apply 'subst-char-in-region
+ (point) (1+ (point))
+ (if (eq ?\040 (following-char)) ; SPC
+ (list ?\040 dired-marker-char)
+ (list dired-marker-char ?\040))))
+ (forward-line 1)))))
\f
;;; Commands to mark or flag files based on their characteristics or names.
(and fn (string-match regexp (file-name-nondirectory fn)))))
"matching file")))
+(defun dired-mark-files-containing-regexp (regexp &optional marker-char)
+ "Mark all files with contents containing REGEXP for use in later commands.
+A prefix argument means to unmark them instead.
+`.' and `..' are never marked."
+ (interactive
+ (list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
+ " files containing (regexp): "))
+ (if current-prefix-arg ?\040)))
+ (let ((dired-marker-char (or marker-char dired-marker-char)))
+ (dired-mark-if
+ (and (not (looking-at dired-re-dot))
+ (not (eolp)) ; empty line
+ (let ((fn (dired-get-filename nil t)))
+ (when (and fn (file-readable-p fn)
+ (not (file-directory-p fn)))
+ (let ((prebuf (get-file-buffer fn)))
+ (message "Checking %s" fn)
+ ;; For now we do it inside emacs
+ ;; Grep might be better if there are a lot of files
+ (if prebuf
+ (with-current-buffer prebuf
+ (save-excursion
+ (goto-char (point-min))
+ (re-search-forward regexp nil t)))
+ (with-temp-buffer
+ (insert-file-contents fn)
+ (goto-char (point-min))
+ (re-search-forward regexp nil t))))
+ )))
+ "matching file")))
+
(defun dired-flag-files-regexp (regexp)
"In dired, flag all files containing the specified REGEXP for deletion.
The match is against the non-directory part of the filename. Use `^'
"auto save file")))
(defvar dired-garbage-files-regexp
- "\\.log$\\|\\.toc$\\|.dvi$|\\.bak$\\|\\.orig$\\|\\.rej$"
+ "\\.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'."
+ (interactive)
(dired-flag-files-regexp dired-garbage-files-regexp))
(defun dired-flag-backup-files (&optional unflag-p)
(subst-char-in-region (match-beginning 0)
(match-end 0) old new)))))))
-(defun dired-unmark-all-files-no-query ()
+(defun dired-unmark-all-marks ()
"Remove all marks from all files in the Dired buffer."
(interactive)
(dired-unmark-all-files ?\r))
;; Toggle between sort by date/name. Reverts the buffer.
(setq dired-actual-switches
(let (case-fold-search)
- (concat
- "-l"
- (dired-replace-in-string (concat "[-lt"
- dired-ls-sorting-switches "]")
- ""
- dired-actual-switches)
- (if (string-match (concat "[t" dired-ls-sorting-switches "]")
- dired-actual-switches)
- ""
- "t"))))
+ (if (string-match " " dired-actual-switches)
+ ;; New toggle scheme: add/remove a trailing " -t"
+ (if (string-match " -t\\'" dired-actual-switches)
+ (dired-replace-in-string " -t\\'" "" dired-actual-switches)
+ (concat dired-actual-switches " -t"))
+ ;; old toggle scheme: look for some 't' switch and add/remove it
+ (concat
+ "-l"
+ (dired-replace-in-string (concat "[-lt"
+ dired-ls-sorting-switches "]")
+ ""
+ dired-actual-switches)
+ (if (string-match (concat "[t" dired-ls-sorting-switches "]")
+ dired-actual-switches)
+ ""
+ "t")))))
(dired-sort-set-modeline)
(revert-buffer))
(autoload 'dired-do-copy-regexp "dired-aux"
"Copy all marked files containing REGEXP to NEWNAME.
-See function `dired-rename-regexp' for more info."
+See function `dired-do-rename-regexp' for more info."
t)
(autoload 'dired-do-hardlink-regexp "dired-aux"
"Hardlink all marked files containing REGEXP to NEWNAME.
-See function `dired-rename-regexp' for more info."
+See function `dired-do-rename-regexp' for more info."
t)
(autoload 'dired-do-symlink-regexp "dired-aux"
"Symlink all marked files containing REGEXP to NEWNAME.
-See function `dired-rename-regexp' for more info."
+See function `dired-do-rename-regexp' for more info."
t)
(autoload 'dired-upcase "dired-aux"