X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/02b5d79c8054be4206cbacf257172ff35dc7a1d9..ca2ebe63eba27e234394e9c5c20229dcdce87b33:/lisp/dired.el diff --git a/lisp/dired.el b/lisp/dired.el index 6bf16084c0..19d0b104ac 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1,6 +1,6 @@ ;;; dired.el --- directory-browsing commands -;; Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc. +;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 1997 Free Software Foundation, Inc. ;; Author: Sebastian Kremer ;; Maintainer: FSF @@ -18,8 +18,9 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. ;;; Commentary: @@ -34,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 @@ -47,19 +60,21 @@ may contain even `F', `b', `i' and `s'. See also the variable ;;;###autoload (defvar dired-chown-program - (if (memq system-type '(hpux dgux usg-unix-v irix linux)) - "chown" "/etc/chown") + (if (memq system-type '(hpux dgux usg-unix-v irix linux gnu/linux)) + "chown" + (if (file-exists-p "/usr/sbin/chown") + "/usr/sbin/chown" + "/etc/chown")) "Name of chown command (usually `chown' or `/etc/chown').") -(defvar dired-chmod-program - (if (eq system-type 'windows-nt) - "chmode" "chmod") - "Name of chmod command (usually `chmod' or `chmode').") +(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 `insert-directory-program' with `-lF' marks the symbolic link +Set this to t if `ls' (or whatever program is specified by +`insert-directory-program') with `-lF' marks the symbolic link itself with a trailing @ (usually the case under Ultrix). Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to @@ -68,63 +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.)") - -(defvar dired-font-lock-keywords - '(;; Put directory headers in italics. - ("^ \\(/.+\\)" 1 font-lock-type-face) - ;; Put symlinks in bold italics. - ("\\([^ ]+\\) -> [^ ]+$" . font-lock-function-name-face) - ;; Put marks in bold. - ("^[^ ]" . font-lock-reference-face) - ;; Put files that are subdirectories in bold. - ("^..d.* \\([^ ]+\\)$" 1 font-lock-keyword-face)) - "Additional expressions to highlight in Dired mode.") +\(This works on only some systems.)" + :type 'boolean + :group 'dired) ;;; Hook variables @@ -218,6 +244,48 @@ The match starts at the beginning of the line and ends after the end of the line (\\n or \\r). Subexpression 2 must end right before the \\n or \\r.") +(defvar dired-font-lock-keywords + (list + ;; + ;; Directory headers. + (list dired-subdir-regexp '(1 font-lock-type-face)) + ;; + ;; We make heavy use of MATCH-ANCHORED, since the regexps don't identify the + ;; file name itself. We search for Dired defined regexps, and then use the + ;; Dired defined function `dired-move-to-filename' before searching for the + ;; simple regexp ".+". It is that regexp which matches the file name. + ;; + ;; Dired marks. + (list dired-re-mark + '(0 font-lock-constant-face) + '(".+" (dired-move-to-filename) nil (0 font-lock-warning-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 + '(".+" (dired-move-to-filename) nil (0 font-lock-function-name-face))) + ;; + ;; Symbolic links. + (list dired-re-sym + '(".+" (dired-move-to-filename) nil (0 font-lock-keyword-face))) + ;; + ;; Files suffixed with `completion-ignored-extensions'. + '(eval . + (let ((extensions (mapcar 'regexp-quote completion-ignored-extensions))) + ;; It is quicker to first find just an extension, then go back to the + ;; start of that file name. So we do this complex MATCH-ANCHORED form. + (list (concat "\\(" (mapconcat 'identity extensions "\\|") "\\|#\\)$") + '(".+" (dired-move-to-filename) nil (0 font-lock-string-face)))))) + "Additional expressions to highlight in Dired mode.") ;;; Macros must be defined before they are used, for the byte compiler. @@ -378,14 +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 (file-directory-p dirname) - (setq dirname (file-name-as-directory dirname))) + (if find-file-visit-truename + (setq dirname (file-truename dirname))) + ;; If the argument was syntactically a directory name not a file name, + ;; or if it happens to name a file that is a directory, + ;; convert it syntactically to a directory name. + ;; The reason for checking initially-was-dirname + ;; and not just file-directory-p + ;; is that file-directory-p is slow over ftp. + (if (or initially-was-dirname (file-directory-p dirname)) + (setq dirname (file-name-as-directory dirname))) (if (consp dir-or-list) (setq dir-or-list (cons dirname (cdr dir-or-list))) (setq dir-or-list dirname)) @@ -434,17 +512,19 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." (and (= (car (nth 5 attributes)) (car modtime)) (= (nth 1 (nth 5 attributes)) (cdr modtime))))) nil - (message - (substitute-command-keys - "Directory has changed on disk; type \\[revert-buffer] to update Dired"))))) + (message "%s" + (substitute-command-keys + "Directory has changed on disk; type \\[revert-buffer] to update Dired"))))) ;; Else a new buffer (setq default-directory - (if (file-directory-p dirname) - dirname - (file-name-directory dirname))) + ;; 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)) @@ -517,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. ) @@ -564,9 +645,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. - (setenv "LC_ALL" "C") + ;; 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. @@ -733,11 +814,9 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." (define-key map [mouse-2] 'dired-mouse-find-file-other-window) ;; Commands to mark or flag certain categories of files (define-key map "#" 'dired-flag-auto-save-files) - (define-key map "*" 'dired-mark-executables) (define-key map "." 'dired-clean-directory) - (define-key map "/" 'dired-mark-directories) - (define-key map "@" 'dired-mark-symlinks) (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) @@ -775,14 +854,30 @@ 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) (define-key map "%H" 'dired-do-hardlink-regexp) (define-key map "%R" 'dired-do-rename-regexp) (define-key map "%S" 'dired-do-symlink-regexp) + ;; Commands for marking and unmarking. + (define-key map "*" nil) + (define-key map "**" 'dired-mark-executables) + (define-key map "*/" 'dired-mark-directories) + (define-key map "*@" 'dired-mark-symlinks) + (define-key map "*%" 'dired-mark-files-regexp) + (define-key map "*c" 'dired-change-marks) + (define-key map "*s" 'dired-mark-subdir-files) + (define-key map "*m" 'dired-mark) + (define-key map "*u" 'dired-unmark) + (define-key map "*?" 'dired-unmark-all-files) + (define-key map "*!" 'dired-unmark-all-marks) + (define-key map "*\177" 'dired-unmark-backward) + (define-key map "*\C-n" 'dired-next-marked-file) + (define-key map "*\C-p" 'dired-prev-marked-file) + (define-key map "*t" 'dired-do-toggle) ;; Lower keys for commands not operating on all the marked files - (define-key map "c" 'dired-change-marks) (define-key map "d" 'dired-flag-file-deletion) (define-key map "e" 'dired-find-file) (define-key map "f" 'dired-find-file) @@ -797,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) @@ -853,6 +949,12 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." (define-key map [menu-bar immediate] (cons "Immediate" (make-sparse-keymap "Immediate"))) + (define-key map [menu-bar immediate revert-buffer] + '("Update Buffer" . revert-buffer)) + + (define-key map [menu-bar immediate dashes] + '("--")) + (define-key map [menu-bar immediate backup-diff] '("Compare with Backup" . dired-backup-diff)) (define-key map [menu-bar immediate diff] @@ -887,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"))) @@ -898,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] @@ -907,6 +1011,8 @@ If DIRNAME is already in a dired buffer, that buffer is used without refresh." '("Mark Old Backups" . dired-clean-directory)) (define-key map [menu-bar mark executables] '("Mark Executables" . dired-mark-executables)) + (define-key map [menu-bar mark garbage-files] + '("Flag Garbage Files" . dired-flag-garbage-files)) (define-key map [menu-bar mark backup-files] '("Flag Backup Files" . dired-flag-backup-files)) (define-key map [menu-bar mark auto-save-files] @@ -917,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"))) @@ -1031,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) @@ -1049,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) @@ -1125,7 +1228,12 @@ Creates a buffer if necessary." (defun dired-find-file () "In dired, visit the file or directory named on this line." (interactive) - (find-file (file-name-sans-versions (dired-get-filename) t))) + (let ((file-name (file-name-sans-versions (dired-get-filename) t))) + (if (file-exists-p file-name) + (find-file file-name) + (if (file-symlink-p file-name) + (error "File is a symlink to a nonexistent target") + (error "File no longer exists; type `g' to update Dired buffer"))))) (defun dired-mouse-find-file-other-window (event) "In dired, visit the file or directory name you click on." @@ -1189,9 +1297,13 @@ Optional arg NO-ERROR-IF-NOT-FILEP means return nil if no filename on ;; some ls -b don't escape quotes, argh! ;; This is not needed for GNU ls, though. (or (dired-string-replace-match - "\\([^\\]\\)\"" file "\\1\\\\\"") + "\\([^\\]\\|\\`\\)\"" 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))))) @@ -1223,12 +1335,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 ~. @@ -1236,15 +1346,40 @@ 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.") + (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]\\([^ ]\\)" + "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." @@ -1279,8 +1414,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 @@ -1332,27 +1466,70 @@ Optional arg GLOBAL means to replace all matches." ;; 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. @@ -1751,12 +1928,10 @@ 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. @@ -1769,7 +1944,8 @@ if there are no flagged files." ;; 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 @@ -1925,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. @@ -1953,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 `^' @@ -2012,6 +2237,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." @@ -2057,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)) @@ -2186,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)) @@ -2308,13 +2548,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)