X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ef74616458b12a83fb05901344c469afecf1b1d0..ca2ebe63eba27e234394e9c5c20229dcdce87b33:/lisp/dired.el diff --git a/lisp/dired.el b/lisp/dired.el index 470a970dd2..19d0b104ac 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -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,74 @@ 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) ;;; Hook variables @@ -225,14 +257,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 @@ -410,16 +446,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 +517,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)) @@ -551,7 +597,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. ) @@ -807,6 +854,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) @@ -824,10 +872,11 @@ 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 "d" 'dired-flag-file-deletion) (define-key map "e" 'dired-find-file) @@ -843,8 +892,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) @@ -939,6 +989,8 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." '("Flag..." . dired-flag-files-regexp)) (define-key map [menu-bar regexp mark] '("Mark..." . dired-mark-files-regexp)) + (define-key map [menu-bar regexp mark] + '("Mark Containing..." . dired-mark-files-containing-regexp)) (define-key map [menu-bar mark] (cons "Mark" (make-sparse-keymap "Mark"))) @@ -950,7 +1002,7 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." (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] @@ -971,6 +1023,8 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." '("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"))) @@ -1085,7 +1139,7 @@ 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 '("%17b")) (set (make-local-variable 'revert-buffer-function) (function dired-revert)) (set (make-local-variable 'page-delimiter) @@ -1103,11 +1157,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) @@ -1176,13 +1225,15 @@ Creates a buffer if necessary." ;; 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." @@ -1249,6 +1300,10 @@ Optional arg NO-ERROR-IF-NOT-FILEP means return nil if no filename 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))))) @@ -1298,9 +1353,29 @@ DIR must be a directory name, not a file name." ;;; 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. + (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]") + (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 "\\|" yyyy s "\\)")) + (japanese (concat mm k s dd k s "\\(" s HH:MM "\\|" yyyy k "\\)"))) + ;; Require 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)) + "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]\\([^ ]\\)" @@ -2026,6 +2101,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. @@ -2054,6 +2152,32 @@ 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))) + (and fn (save-excursion + ;; For now we do it inside emacs + ;; Grep might be better if there are a lot of files + (message "Checking %s" fn) + (let* ((prebuf (get-file-buffer fn))) + (find-file fn) + (goto-char (point-min)) + (prog1 + (re-search-forward regexp nil t) + (if (not prebuf) (kill-buffer nil)))) + )))) + "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 `^' @@ -2114,12 +2238,12 @@ A prefix argument says to unflag those files instead." "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) @@ -2167,7 +2291,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)) @@ -2296,16 +2420,22 @@ 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))