;;; dired.el --- directory-browsing commands
-;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 1997, 2000 Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
;; Maintainer: FSF
"/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
(defcustom dired-ls-F-marks-symlinks nil
: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
(defvar dired-load-hook nil
;; "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)
;; 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))
(set-buffer old-buf)
buffer))
+(defvar dired-buffers nil
+ ;; 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 expanded directories and their associated dired buffers.")
+
(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.
;; 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.
)
;; 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"))))))
+ (or (consp 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,
(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)))
+ (if (zerop (call-process dired-free-space-program nil t nil
+ dired-free-space-args
+ (expand-file-name dir-or-list)))
+ (progn
+ (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))))
+ ;; The dired-free-space-program failed; delete its output
+ (delete-region (- beg 7) (point))))))))
;; Quote certain characters, unless ls quoted them for us.
(if (not (string-match "b" dired-actual-switches))
(save-excursion
(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 "Q" 'dired-do-query-replace-regexp)
(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 "%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 "*\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 "a" 'dired-find-alternate-file)
(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 "w" 'dired-show-file-type)
(define-key map "\C-m" 'dired-advertised-find-file)
(define-key map "g" 'revert-buffer)
(define-key map "h" 'describe-mode)
;; Make menu bar items.
+ ;; No need to fo this, now that top-level items are fewer.
+ ;;;;
;; Get rid of the Edit menu bar item to save space.
- (define-key map [menu-bar edit] 'undefined)
+ ;(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))
+ '(menu-item "Hide All" dired-hide-all
+ :help "Hide all subdirectories, leave only header lines"))
(define-key map [menu-bar subdir hide-subdir]
- '("Hide Subdir" . dired-hide-subdir))
+ '(menu-item "Hide/UnHide Subdir" dired-hide-subdir
+ :help "Hide or unhide current directory listing"))
(define-key map [menu-bar subdir tree-down]
- '("Tree Down" . dired-tree-down))
+ '(menu-item "Tree Down" dired-tree-down
+ :help "Go to first subdirectory header down the tree"))
(define-key map [menu-bar subdir tree-up]
- '("Tree Up" . dired-tree-up))
+ '(menu-item "Tree Up" dired-tree-up
+ :help "Go to first subdirectory header up the tree"))
(define-key map [menu-bar subdir up]
- '("Up Directory" . dired-up-directory))
+ '(menu-item "Up Directory" dired-up-directory
+ :help "Edit the parent directory"))
(define-key map [menu-bar subdir prev-subdir]
- '("Prev Subdir" . dired-prev-subdir))
+ '(menu-item "Prev Subdir" dired-prev-subdir
+ :help "Go to previous subdirectory header line"))
(define-key map [menu-bar subdir next-subdir]
- '("Next Subdir" . dired-next-subdir))
+ '(menu-item "Next Subdir" dired-next-subdir
+ :help "Go to next subdirectory header line"))
(define-key map [menu-bar subdir prev-dirline]
- '("Prev Dirline" . dired-prev-dirline))
+ '(menu-item "Prev Dirline" dired-prev-dirline
+ :help "Move to next directory-file line"))
(define-key map [menu-bar subdir next-dirline]
- '("Next Dirline" . dired-next-dirline))
+ '(menu-item "Next Dirline" dired-next-dirline
+ :help "Move to previous directory-file line"))
(define-key map [menu-bar subdir insert]
- '("Insert This Subdir" . dired-maybe-insert-subdir))
+ '(menu-item "Insert This Subdir" dired-maybe-insert-subdir
+ :help "Insert contents of subdirectory"))
(define-key map [menu-bar immediate]
(cons "Immediate" (make-sparse-keymap "Immediate")))
(define-key map [menu-bar immediate revert-buffer]
- '("Update Buffer" . revert-buffer))
+ '(menu-item "Refresh" revert-buffer
+ :help "Update contents of shown directories"))
(define-key map [menu-bar immediate dashes]
'("--"))
(define-key map [menu-bar immediate backup-diff]
- '("Compare with Backup" . dired-backup-diff))
+ '(menu-item "Compare with Backup" dired-backup-diff
+ :help "Diff file at cursor with its latest backup"))
(define-key map [menu-bar immediate diff]
- '("Diff" . dired-diff))
+ '(menu-item "Diff..." dired-diff
+ :help "Compare file at cursor with another file"))
(define-key map [menu-bar immediate view]
- '("View This File" . dired-view-file))
+ '(menu-item "View This File" dired-view-file
+ :help "Examine file at cursor in read-only mode"))
(define-key map [menu-bar immediate display]
- '("Display in Other Window" . dired-display-file))
+ '(menu-item "Display in Other Window" dired-display-file
+ :help "Display file at cursor in other window"))
(define-key map [menu-bar immediate find-file-other-window]
- '("Find in Other Window" . dired-find-file-other-window))
+ '(menu-item "Find in Other Window" dired-find-file-other-window
+ :help "Edit file at cursor in other window"))
(define-key map [menu-bar immediate find-file]
- '("Find This File" . dired-find-file))
+ '(menu-item "Find This File" dired-find-file
+ :help "Edit file at cursor"))
(define-key map [menu-bar immediate create-directory]
- '("Create Directory..." . dired-create-directory))
+ '(menu-item "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))
+ '(menu-item "Downcase" dired-downcase
+ ;; When running on plain MS-DOS, there's only one
+ ;; letter-case for file names.
+ :enable (or (not (fboundp 'msdos-long-file-names))
+ (msdos-long-file-names))
+ :help "Rename marked files to lower-case name"))
(define-key map [menu-bar regexp upcase]
- '("Upcase" . dired-upcase))
+ '(menu-item "Upcase" dired-upcase
+ :enable (or (not (fboundp 'msdos-long-file-names))
+ (msdos-long-file-names))
+ :help "Rename marked files to upper-case name"))
(define-key map [menu-bar regexp hardlink]
- '("Hardlink..." . dired-do-hardlink-regexp))
+ '(menu-item "Hardlink..." dired-do-hardlink-regexp
+ :help "Make hard links for files matching regexp"))
(define-key map [menu-bar regexp symlink]
- '("Symlink..." . dired-do-symlink-regexp))
+ '(menu-item "Symlink..." dired-do-symlink-regexp
+ :visible (fboundp 'make-symbolic-link)
+ :help "Make symbolic links for files matching regexp"))
(define-key map [menu-bar regexp rename]
- '("Rename..." . dired-do-rename-regexp))
+ '(menu-item "Rename..." dired-do-rename-regexp
+ :help "Rename marked files matching regexp"))
(define-key map [menu-bar regexp copy]
- '("Copy..." . dired-do-copy-regexp))
+ '(menu-item "Copy..." dired-do-copy-regexp
+ :help "Copy marked files matching regexp"))
(define-key map [menu-bar regexp flag]
- '("Flag..." . dired-flag-files-regexp))
+ '(menu-item "Flag..." dired-flag-files-regexp
+ :help "Flag files matching regexp for deletion"))
(define-key map [menu-bar regexp mark]
- '("Mark..." . dired-mark-files-regexp))
+ '(menu-item "Mark..." dired-mark-files-regexp
+ :help "Mark files matching regexp for future operations"))
+ (define-key map [menu-bar regexp mark-cont]
+ '(menu-item "Mark Containing..." dired-mark-files-containing-regexp
+ :help "Mark files whose contents matches 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))
+ '(menu-item "Previous Marked" dired-prev-marked-file
+ :help "Move to previous marked file"))
(define-key map [menu-bar mark next]
- '("Next Marked" . dired-next-marked-file))
+ '(menu-item "Next Marked" dired-next-marked-file
+ :help "Move to next marked file"))
(define-key map [menu-bar mark marks]
- '("Change Marks..." . dired-change-marks))
+ '(menu-item "Change Marks..." dired-change-marks
+ :help "Replace marker with another character"))
(define-key map [menu-bar mark unmark-all]
- '("Unmark All" . dired-unmark-all-marks))
+ '(menu-item "Unmark All" dired-unmark-all-marks))
(define-key map [menu-bar mark symlinks]
- '("Mark Symlinks" . dired-mark-symlinks))
+ '(menu-item "Mark Symlinks" dired-mark-symlinks
+ :visible (fboundp 'make-symbolic-link)
+ :help "Mark all symbolic links"))
(define-key map [menu-bar mark directories]
- '("Mark Directories" . dired-mark-directories))
+ '(menu-item "Mark Directories" dired-mark-directories
+ :help "Mark all directories except `.' and `..'"))
(define-key map [menu-bar mark directory]
- '("Mark Old Backups" . dired-clean-directory))
+ '(menu-item "Mark Old Backups" dired-clean-directory
+ :help "Flag old numbered backups for deletion"))
(define-key map [menu-bar mark executables]
- '("Mark Executables" . dired-mark-executables))
+ '(menu-item "Mark Executables" dired-mark-executables
+ :help "Mark all executable files"))
(define-key map [menu-bar mark garbage-files]
- '("Flag Garbage Files" . dired-flag-garbage-files))
+ '(menu-item "Flag Garbage Files" dired-flag-garbage-files
+ :help "Flag unneeded files for deletion"))
(define-key map [menu-bar mark backup-files]
- '("Flag Backup Files" . dired-flag-backup-files))
+ '(menu-item "Flag Backup Files" dired-flag-backup-files
+ :help "Flag all backup files for deletion"))
(define-key map [menu-bar mark auto-save-files]
- '("Flag Auto-save Files" . dired-flag-auto-save-files))
+ '(menu-item "Flag Auto-save Files" dired-flag-auto-save-files
+ :help "Flag auto-save files for deletion"))
(define-key map [menu-bar mark deletion]
- '("Flag" . dired-flag-file-deletion))
+ '(menu-item "Flag" dired-flag-file-deletion
+ :help "Flag current line's file for deletion"))
(define-key map [menu-bar mark unmark]
- '("Unmark" . dired-unmark))
+ '(menu-item "Unmark" dired-unmark
+ :help "Unmark or unflag current line's file"))
(define-key map [menu-bar mark mark]
- '("Mark" . dired-mark))
+ '(menu-item "Mark" dired-mark
+ :help "Mark current line's file for future operations"))
(define-key map [menu-bar mark toggle-marks]
- '("Toggle Marks" . dired-do-toggle))
+ '(menu-item "Toggle Marks" dired-do-toggle
+ :help "Mark unmarked files, unmark marked ones"))
(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))
+ '(menu-item "Query Replace in Files..." dired-do-query-replace-regexp
+ :help "Replace regexp in marked files"))
(define-key map [menu-bar operate search]
- '("Search Files..." . dired-do-search))
+ '(menu-item "Search Files..." dired-do-search
+ :help "Search marked files for regexp"))
(define-key map [menu-bar operate chown]
- '("Change Owner..." . dired-do-chown))
+ '(menu-item "Change Owner..." dired-do-chown
+ :visible (not (memq system-type '(ms-dos windows-nt)))
+ :help "Change the owner of marked files"))
(define-key map [menu-bar operate chgrp]
- '("Change Group..." . dired-do-chgrp))
+ '(menu-item "Change Group..." dired-do-chgrp
+ :visible (not (memq system-type '(ms-dos windows-nt)))
+ :help "Change the group of marked files"))
(define-key map [menu-bar operate chmod]
- '("Change Mode..." . dired-do-chmod))
+ '(menu-item "Change Mode..." dired-do-chmod
+ :help "Change mode (attributes) of marked files"))
(define-key map [menu-bar operate load]
- '("Load" . dired-do-load))
+ '(menu-item "Load" dired-do-load
+ :help "Load marked Emacs Lisp files"))
(define-key map [menu-bar operate compile]
- '("Byte-compile" . dired-do-byte-compile))
+ '(menu-item "Byte-compile" dired-do-byte-compile
+ :help "Byte-compile marked Emacs Lisp files"))
(define-key map [menu-bar operate compress]
- '("Compress" . dired-do-compress))
+ '(menu-item "Compress" dired-do-compress
+ :help "Compress/uncompress marked files"))
(define-key map [menu-bar operate print]
- '("Print" . dired-do-print))
+ '(menu-item "Print..." dired-do-print
+ :help "Ask for print command and print marked files"))
(define-key map [menu-bar operate hardlink]
- '("Hardlink to..." . dired-do-hardlink))
+ '(menu-item "Hardlink to..." dired-do-hardlink
+ :help "Make hard links for current or marked files"))
(define-key map [menu-bar operate symlink]
- '("Symlink to..." . dired-do-symlink))
+ '(menu-item "Symlink to..." dired-do-symlink
+ :visible (fboundp 'make-symbolic-link)
+ :help "Make symbolic links for current or marked files"))
(define-key map [menu-bar operate command]
- '("Shell Command..." . dired-do-shell-command))
+ '(menu-item "Shell Command..." dired-do-shell-command
+ :help "Run a shell command on each of marked files"))
(define-key map [menu-bar operate delete]
- '("Delete" . dired-do-delete))
+ '(menu-item "Delete" dired-do-delete
+ :help "Delete current file or all marked files"))
(define-key map [menu-bar operate rename]
- '("Rename to..." . dired-do-rename))
+ '(menu-item "Rename to..." dired-do-rename
+ :help "Rename current file or move marked files"))
(define-key map [menu-bar operate copy]
- '("Copy to..." . dired-do-copy))
+ '(menu-item "Copy to..." dired-do-copy
+ :help "Copy current file or all marked files"))
(setq dired-mode-map map)))
\f
;; case-fold-search nil
buffer-read-only t
selective-display t ; for subdirectory hiding
- mode-line-buffer-identification '("%17b"))
+ mode-line-buffer-identification
+ (propertized-buffer-identification "%17b"))
(set (make-local-variable 'revert-buffer-function)
(function dired-revert))
(set (make-local-variable 'page-delimiter)
(error "File is a symlink to a nonexistent target")
(error "File no longer exists; type `g' to update Dired buffer")))))
+(defun dired-find-alternate-file ()
+ "In dired, visit this file or directory instead of the dired buffer."
+ (interactive)
+ (set-buffer-modified-p nil)
+ (find-alternate-file (dired-get-filename)))
+
(defun dired-mouse-find-file-other-window (event)
"In dired, visit the file or directory name you click on."
(interactive "e")
`default-directory', which still may contain slashes if in a subdirectory.
Optional arg NO-ERROR-IF-NOT-FILEP means return nil if no filename on
this line, otherwise an error occurs."
- (let (case-fold-search file p1 p2)
+ (let (case-fold-search file p1 p2 already-absolute)
(save-excursion
(if (setq p1 (dired-move-to-filename (not no-error-if-not-filep)))
(setq p2 (dired-move-to-end-of-filename no-error-if-not-filep))))
"\\([^\\]\\|\\`\\)\"" file "\\1\\\\\"" nil t)
file)
"\"")))))
+ (and file (file-name-absolute-p file)
+ (setq already-absolute t))
(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)))))
+ (cond
+ ((and (eq localp 'no-dir) already-absolute)
+ (file-name-nondirectory file))
+ ((or already-absolute (eq localp 'no-dir))
+ file)
+ (t
+ (and file (concat (dired-current-directory localp) file))))))
(defun dired-string-replace-match (regexp string newtext
&optional literal global)
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))))
(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.
- (month (concat l l "+ *"))
+ ;; 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]")
(s " ")
(yyyy "[0-9][0-9][0-9][0-9]")
(mm "[ 0-1][0-9]")
- (dd "[ 0-3][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 "\\)"
- s "\\(" HH:MM "\\|" s yyyy "\\)"))
+ ;; weiand: changed: year potentially unaligned
+;;old s "\\(" HH:MM "\\|" s yyyy "\\|" yyyy s "\\)"))
+ s "\\(" HH:MM
+ "\\|" yyyy s s "?"
+ "\\|" s "?" yyyy
+ "\\)"))
(japanese (concat mm k s dd k s "\\(" s HH:MM "\\|" yyyy k "\\)")))
- ;; Require the previous column to end in a digit.
+ ;; 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
- (concat "[0-9]" s "\\(" western "\\|" japanese "\\)" s))
+ ;; 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.")
\f
;; Keeping Dired buffers in sync with the filesystem and with each other
-(defvar dired-buffers nil
- ;; 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 expanded directories and their associated dired buffers.")
-
(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)
\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)
;; 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")
+ (or (looking-at "^$\\|^. *$\\|^. total\\|^. wildcard\\|^. used")
(and (looking-at dired-subdir-regexp)
(save-excursion (not (dired-move-to-filename))))))
(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 ()
;; 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"
If there is already something hidden, make everything visible again.
Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
t)
+
+(autoload 'dired-show-file-type "dired-aux"
+ "Print the type of FILE, according to the `file' command.
+If FILE is a symbolic link and the optional argument DEREF-SYMLINKS is
+true then the type of the file linked to by FILE is printed instead."
+ t)
\f
(if (eq system-type 'vax-vms)
(load "dired-vms"))
HCoop / bpt / emacs.git / blobdiff