X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/0609c9984c3f1c9791d1ae70d59258549d3c8509..1a0b9ae6bb90e81c4d511c10b512806b33112bd7:/lisp/dired.el diff --git a/lisp/dired.el b/lisp/dired.el index 528900aabd..546de206ae 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1,6 +1,6 @@ ;;; dired.el --- directory-browsing commands -;; Copyright (C) 1985, 86, 92, 93, 94, 95, 1996 Free Software Foundation, Inc. +;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 1997, 2000 Free Software Foundation, Inc. ;; Author: Sebastian Kremer ;; Maintainer: FSF @@ -35,12 +35,24 @@ ;;; 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 @@ -55,13 +67,11 @@ may contain even `F', `b', `i' and `s'. See also the variable "/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 @@ -73,52 +83,89 @@ nil (the default), if it gives `bar@ -> foo', set it to t. 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 @@ -185,8 +232,10 @@ directory name and the cdr is the actual files to list.") ;; "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) @@ -225,14 +274,18 @@ Subexpression 2 must end right before the \\n or \\r.") ;; ;; 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 @@ -281,66 +334,65 @@ Subexpression 2 must end right before the \\n or \\r.") (and (> count 0) count)))) (defmacro dired-map-over-marks (body arg &optional show-progress) -;; "Macro: Perform BODY with point somewhere on each marked line -;;and return a list of BODY's results. -;;If no marked file could be found, execute BODY on the current line. -;; If ARG is an integer, use the next ARG (or previous -ARG, if ARG<0) -;; files instead of the marked files. -;; In that case point is dragged along. This is so that commands on -;; the next ARG (instead of the marked) files can be chained easily. -;; If ARG is otherwise non-nil, use current file instead. -;;If optional third arg SHOW-PROGRESS evaluates to non-nil, -;; redisplay the dired buffer after each file is processed. -;;No guarantee is made about the position on the marked line. -;; BODY must ensure this itself if it depends on this. -;;Search starts at the beginning of the buffer, thus the car of the list -;; corresponds to the line nearest to the buffer's bottom. This -;; is also true for (positive and negative) integer values of ARG. -;;BODY should not be too long as it is expanded four times." -;; -;;Warning: BODY must not add new lines before point - this may cause an -;;endless loop. -;;This warning should not apply any longer, sk 2-Sep-1991 14:10. - (` (prog1 - (let (buffer-read-only case-fold-search found results) - (if (, arg) - (if (integerp (, arg)) - (progn;; no save-excursion, want to move point. - (dired-repeat-over-lines - (, arg) - (function (lambda () - (if (, show-progress) (sit-for 0)) - (setq results (cons (, body) results))))) - (if (< (, arg) 0) - (nreverse results) - results)) - ;; non-nil, non-integer ARG means use current file: - (list (, body))) - (let ((regexp (dired-marker-regexp)) next-position) - (save-excursion - (goto-char (point-min)) - ;; remember position of next marked file before BODY - ;; can insert lines before the just found file, - ;; confusing us by finding the same marked file again - ;; and again and... + "Eval BODY with point on each marked line. Return a list of BODY's results. +If no marked file could be found, execute BODY on the current line. + If ARG is an integer, use the next ARG (or previous -ARG, if ARG<0) + files instead of the marked files. + In that case point is dragged along. This is so that commands on + the next ARG (instead of the marked) files can be chained easily. + If ARG is otherwise non-nil, use current file instead. +If optional third arg SHOW-PROGRESS evaluates to non-nil, + redisplay the dired buffer after each file is processed. +No guarantee is made about the position on the marked line. + BODY must ensure this itself if it depends on this. +Search starts at the beginning of the buffer, thus the car of the list + corresponds to the line nearest to the buffer's bottom. This + is also true for (positive and negative) integer values of ARG. +BODY should not be too long as it is expanded four times." + ;; + ;;Warning: BODY must not add new lines before point - this may cause an + ;;endless loop. + ;;This warning should not apply any longer, sk 2-Sep-1991 14:10. + `(prog1 + (let (buffer-read-only case-fold-search found results) + (if ,arg + (if (integerp ,arg) + (progn ;; no save-excursion, want to move point. + (dired-repeat-over-lines + ,arg + (function (lambda () + (if ,show-progress (sit-for 0)) + (setq results (cons ,body results))))) + (if (< ,arg 0) + (nreverse results) + results)) + ;; non-nil, non-integer ARG means use current file: + (list ,body)) + (let ((regexp (dired-marker-regexp)) next-position) + (save-excursion + (goto-char (point-min)) + ;; remember position of next marked file before BODY + ;; can insert lines before the just found file, + ;; confusing us by finding the same marked file again + ;; and again and... + (setq next-position (and (re-search-forward regexp nil t) + (point-marker)) + found (not (null next-position))) + (while next-position + (goto-char next-position) + (if ,show-progress (sit-for 0)) + (setq results (cons ,body results)) + ;; move after last match + (goto-char next-position) + (forward-line 1) + (set-marker next-position nil) (setq next-position (and (re-search-forward regexp nil t) - (point-marker)) - found (not (null next-position))) - (while next-position - (goto-char next-position) - (if (, show-progress) (sit-for 0)) - (setq results (cons (, body) results)) - ;; move after last match - (goto-char next-position) - (forward-line 1) - (set-marker next-position nil) - (setq next-position (and (re-search-forward regexp nil t) - (point-marker))))) - (if found - results - (list (, body)))))) - ;; save-excursion loses, again - (dired-move-to-filename)))) + (point-marker))))) + (if found + results + (list ,body))))) + ;; save-excursion loses, again + (dired-move-to-filename))) (defun dired-get-marked-files (&optional localp arg) "Return the marked files' names as list of strings. @@ -410,16 +462,24 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." (or dir-or-list (setq dir-or-list default-directory)) ;; This loses the distinction between "/foo/*/" and "/foo/*" that ;; some shells make: - (let (dirname) + (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 (file-directory-p dirname) - (setq dirname (file-name-as-directory 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)) @@ -473,12 +533,14 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." "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))) + ;; 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)) + (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)) @@ -498,6 +560,12 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." (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. @@ -532,7 +600,8 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." ;; 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. - (let (dirname) + (let (dirname + (indent-tabs-mode nil)) (if (consp dir-or-list) (setq dirname (car dir-or-list)) (setq dirname dir-or-list)) @@ -551,7 +620,8 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." ;; 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. ) @@ -587,9 +657,10 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." ;; 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, @@ -598,17 +669,9 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." (let ((opoint (point)) (process-environment (copy-sequence process-environment)) end) - ;; This makes sure that month names come out in English - ;; so we can find the start of the file name. - ;; But if the user has customized the way of finding the file name, - ;; this is not necessary. - (if (and (equal dired-move-to-filename-regexp - dired-standard-move-to-filename-regexp) - ;; It also isn't necessary if we'd use the C locale anyway. - (not (equal (or (getenv "LC_ALL") (getenv "LC_TIME") - (getenv "LANGUAGE") (getenv "LANG") "C") - "C"))) - (setq process-environment (cons "LC_ALL=C" process-environment))) + ;; 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. @@ -617,7 +680,40 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." (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 ") + ;; Non-Posix systems don't always have dired-free-space-program, + ;; but might have an equivalent system call. + (if (fboundp 'file-system-info) + (let ((beg (point)) + (fsinfo (file-system-info dir-or-list))) + (if fsinfo + (insert + (format "%.0f" (/ (nth 2 fsinfo) 1024))) + ;; file-system-info failed; delete " free ". + (delete-region (- beg 7) beg))) + (let ((beg (point))) + (condition-case nil + (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))) + (error (delete-region (- beg 7) (point)))))))))) ;; Quote certain characters, unless ls quoted them for us. (if (not (string-match "b" dired-actual-switches)) (save-excursion @@ -639,11 +735,13 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." (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)) + (add-text-properties + (point) + (save-excursion + (dired-move-to-end-of-filename) + (point)) + '(mouse-face 'highlight + help-echo "mouse-2: visit this file in other window"))) (error nil)) (forward-line 1)))) @@ -777,6 +875,7 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." (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) @@ -788,7 +887,7 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." (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) @@ -814,6 +913,7 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." (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) @@ -831,14 +931,17 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." (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 "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) @@ -850,8 +953,9 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." (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) @@ -876,140 +980,214 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." ;; 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-files-no-query)) + '(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] + '(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] + '(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))) @@ -1090,7 +1268,8 @@ Keybindings: ;; case-fold-search nil buffer-read-only t selective-display t ; for subdirectory hiding - mode-line-buffer-identification '("Dired: %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) @@ -1108,11 +1287,6 @@ Keybindings: ;; 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) @@ -1187,7 +1361,15 @@ Creates a buffer if necessary." (let ((file-name (file-name-sans-versions (dired-get-filename) t))) (if (file-exists-p file-name) (find-file file-name) - (error "File no longer exists; type `g' to update Dired buffer")))) + (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-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." @@ -1229,11 +1411,12 @@ otherwise, display it in another buffer." "In dired, return name of file mentioned on this line. Value returned normally includes the directory name. Optional arg LOCALP with value `no-dir' means don't include directory - name in result. A value of t means construct name relative to + name in result. A value of `verbatim' means to return the name exactly as + it occurs in the buffer, and a value of t means construct name relative to `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)))) @@ -1254,9 +1437,21 @@ Optional arg NO-ERROR-IF-NOT-FILEP means return nil if no filename on "\\([^\\]\\|\\`\\)\"" file "\\1\\\\\"" nil t) file) "\""))))) - (if (eq localp 'no-dir) - file - (and file (concat (dired-current-directory localp) 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))) + (cond + ((eq localp 'verbatim) + file) + ((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) @@ -1265,12 +1460,12 @@ 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)) + (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)))) @@ -1285,12 +1480,10 @@ Optional arg GLOBAL means to replace all matches." ;; 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 ~. @@ -1298,19 +1491,60 @@ Optional arg GLOBAL means to replace all matches." (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)) ;;; Functions for finding the file name in a dired buffer line. (defvar dired-move-to-filename-regexp - "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+ [ 0-9][0-9][:0-9][0-9][ 0-9] " - "Regular expression to match a month abbreviation followed by a number.") - -(defconst dired-standard-move-to-filename-regexp - "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+ [ 0-9][0-9][:0-9][0-9][ 0-9] " - "Regular expression to match a month abbreviation followed by a number.") + (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]") + (seconds "[0-6][0-9]\\([.,][0-9]+\\)?") + (zone "[-+][0-2][0-9][0-5][0-9]") + (iso-mm-dd "[01][0-9]-[0-3][0-9]") + (iso-time (concat HH:MM "\\(:" seconds "\\( ?" zone "\\)?\\)?")) + (iso (concat "\\(\\(" yyyy "-\\)?" iso-mm-dd "[ T]" iso-time + "\\|" yyyy "-" iso-mm-dd " ?\\)")) + (western (concat "\\(" month s dd "\\|" dd s month "\\)" + ;; 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 "+" "\\(" 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 "[kMGTPEZY]?" below supports "ls -alh" output. + ;; 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][kMGTPEZY]?" + s "\\(" western "\\|" japanese "\\|" iso "\\)" 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]\\([^ ]\\)" + "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." @@ -1345,8 +1579,7 @@ Optional arg GLOBAL means to replace all matches." ;; "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 @@ -1392,33 +1625,70 @@ Optional arg GLOBAL means to replace all matches." ;; 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) +(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 buf) + (let ((alist dired-buffers) result elt buf pattern) (while alist (setq elt (car alist) buf (cdr elt)) (if (buffer-name buf) (if (dired-in-this-tree dir (car elt)) - (if (assoc dir (save-excursion - (set-buffer buf) - dired-subdir-alist)) - (setq result (cons buf result)))) + (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. @@ -1520,7 +1790,13 @@ Returns the new value of the alist." (save-excursion (let ((count 0) (buffer-read-only nil) - new-dir-name) + new-dir-name + (R-ftp-base-dir-regex + ;; Used to expand subdirectory names correctly in recursive + ;; ange-ftp listings. + (and (string-match "R" dired-actual-switches) + (string-match "\\`/.*:\\(/.*\\)" default-directory) + (concat "\\`" (match-string 1 default-directory))))) (goto-char (point-min)) (setq dired-subdir-alist nil) (while (and (re-search-forward dired-subdir-regexp nil t) @@ -1534,7 +1810,15 @@ Returns the new value of the alist." (save-excursion (goto-char (match-beginning 1)) (setq new-dir-name - (expand-file-name (buffer-substring (point) (match-end 1)))) + (buffer-substring-no-properties (point) (match-end 1)) + new-dir-name + (save-match-data + (if (and R-ftp-base-dir-regex + (not (string= new-dir-name default-directory)) + (string-match R-ftp-base-dir-regex new-dir-name)) + (concat default-directory + (substring new-dir-name (match-end 0))) + (expand-file-name new-dir-name)))) (delete-region (point) (match-end 1)) (insert new-dir-name)) (setq count (1+ count)) @@ -1664,6 +1948,50 @@ Optional argument means return a file name relative to `default-directory'." ;; 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 @@ -1719,12 +2047,7 @@ if there are no flagged files." (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) @@ -1817,32 +2140,31 @@ if there are no flagged files." ))) (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. - ;;Return FUNCTION's result on ARGS after popping up a window (in a buffer - ;;named BUFNAME, nil gives \" *Marked Files*\") showing the marked - ;;files. Uses function `dired-pop-to-buffer' to do that. - ;; FUNCTION should not manipulate files. - ;; It should only read input (an argument or confirmation). - ;;The window is not shown if there is just one file or - ;; OP-SYMBOL is a member of the list in `dired-no-confirm'. - ;;FILES is the list of marked files." + "Args BUFNAME OP-SYMBOL FILES FUNCTION &rest ARGS. +Return FUNCTION's result on ARGS after popping up a window (in a buffer +named BUFNAME, nil gives \" *Marked Files*\") showing the marked +files. Uses function `dired-pop-to-buffer' to do that. + FUNCTION should not manipulate files. + It should only read input (an argument or confirmation). +The window is not shown if there is just one file or + 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)) + (with-current-buffer (get-buffer-create bufname) (erase-buffer) (dired-format-columns-of-files files) - (remove-text-properties (point-min) (point-max) '(mouse-face))) + (remove-text-properties (point-min) (point-max) + '(mouse-face nil help-echo nil))) (save-window-excursion (dired-pop-to-buffer bufname) (apply function args)))) @@ -1904,7 +2226,7 @@ if there are no flagged 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") + (or (looking-at "^$\\|^. *$\\|^. total\\|^. wildcard\\|^. used\\|^. find") (and (looking-at dired-subdir-regexp) (save-excursion (not (dired-move-to-filename)))))) @@ -1991,6 +2313,29 @@ If on a subdir headerline, mark all its files except `.' and `..'." 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))))) ;;; Commands to mark or flag files based on their characteristics or names. @@ -2019,6 +2364,37 @@ object files--just `.o' will mark more than you might think." (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 `^' @@ -2078,6 +2454,15 @@ A prefix argument says to unflag those files instead." (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 () + "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) "Flag all backup files (names ending with `~') for deletion. With prefix argument, unflag these files." @@ -2123,7 +2508,7 @@ OLD and NEW are both characters used to mark files." (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)) @@ -2252,19 +2637,26 @@ With a prefix argument you can edit the current listing switches instead." ;; 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)) +;; Some user code loads dired especially for this. (defun dired-replace-in-string (regexp newtext string) ;; Replace REGEXP with NEWTEXT everywhere in STRING and return result. ;; NEWTEXT is taken literally---no \\DIGIT escapes will be recognized. @@ -2281,9 +2673,45 @@ With a prefix argument you can edit the current listing switches instead." ;; `dired-sort-by-date-regexp' or `dired-sort-by-name-regexp' set the ;; minor mode accordingly, others appear literally in the mode line. ;; With optional second arg NO-REVERT, don't refresh the listing afterwards. + (dired-sort-R-check switches) (setq dired-actual-switches switches) (if (eq major-mode 'dired-mode) (dired-sort-set-modeline)) (or no-revert (revert-buffer))) + +(make-variable-buffer-local + (defvar dired-subdir-alist-pre-R nil + "Value of `dired-subdir-alist' before -R switch added.")) + +(defun dired-sort-R-check (switches) + "Additional processing of -R in ls option string SWITCHES. +Saves `dired-subdir-alist' when R is set and restores saved value +minus any directories explicitly deleted when R is cleared. +To be called first in body of `dired-sort-other', etc." + (cond + ((and (string-match "R" switches) + (not (string-match "R" dired-actual-switches))) + ;; Adding -R to ls switches -- save `dired-subdir-alist': + (setq dired-subdir-alist-pre-R dired-subdir-alist)) + ((and (string-match "R" dired-actual-switches) + (not (string-match "R" switches))) + ;; Deleting -R from ls switches -- revert to pre-R subdirs + ;; that are still present: + (setq dired-subdir-alist + (if dired-subdir-alist-pre-R + (let (subdirs) + (while dired-subdir-alist-pre-R + (if (assoc (caar dired-subdir-alist-pre-R) + dired-subdir-alist) + ;; subdir still present... + (setq subdirs + (cons (car dired-subdir-alist-pre-R) + subdirs))) + (setq dired-subdir-alist-pre-R + (cdr dired-subdir-alist-pre-R))) + (reverse subdirs)) + ;; No pre-R subdir alist, so revert to main directory + ;; listing: + (list (car (reverse dired-subdir-alist)))))))) ;; To make this file smaller, the less common commands ;; go in a separate file. But autoload them here @@ -2291,7 +2719,8 @@ With a prefix argument you can edit the current listing switches instead." (autoload 'dired-diff "dired-aux" "Compare file at point with file FILE using `diff'. -FILE defaults to the file at the mark. +FILE defaults to the file at the mark. (That's the mark set by +\\[set-mark-command], not by Dired's \\[dired-mark] command.) The prompted-for file is the first file given to `diff'." t) @@ -2374,13 +2803,6 @@ If on a subdir line, redisplay that subdirectory. In that case, a prefix arg lets you edit the `ls' switches used for the new listing." 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) @@ -2426,17 +2848,17 @@ With a zero prefix arg, renaming by regexp affects the complete (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" @@ -2500,6 +2922,12 @@ Use \\[dired-hide-all] to (un)hide all directories." 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) (if (eq system-type 'vax-vms) (load "dired-vms"))