;;; dired.el --- directory-browsing commands
;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1997, 2000,
-;; 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+;; 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
;; Maintainer: FSF
`dired-ls-F-marks-symlinks' concerning the `F' switch.
On systems such as MS-DOS and MS-Windows, which use `ls' emulation in Lisp,
some of the `ls' switches are not supported; see the doc string of
-`insert-directory' on `ls-lisp.el' for more details."
+`insert-directory' in `ls-lisp.el' for more details."
:type 'string
:group 'dired)
("^file:" . dired-dnd-handle-local-file))
"The functions to call when a drop in `dired-mode' is made.
See `dnd-protocol-alist' for more information. When nil, behave
-as in other buffers."
+as in other buffers. Changing this option is effective only for
+new dired buffers."
:type '(choice (repeat (cons (regexp) (function)))
(const :tag "Behave as in other buffers" nil))
:version "22.1"
This is an alist of the form (SUBDIR . SWITCHES).")
(make-variable-buffer-local 'dired-switches-alist)
+(defvaralias 'dired-move-to-filename-regexp
+ 'directory-listing-before-filename-regexp)
+
(defvar dired-subdir-regexp "^. \\([^\n\r]+\\)\\(:\\)[\n\r]"
"Regexp matching a maybe hidden subdirectory line in `ls -lR' output.
Subexpression 1 is the subdirectory proper, no trailing colon.
(run-hooks 'dired-before-readin-hook)
(if (consp buffer-undo-list)
(setq buffer-undo-list nil))
+ (make-local-variable 'file-name-coding-system)
+ (setq file-name-coding-system
+ (or coding-system-for-read file-name-coding-system))
(let (buffer-read-only
;; Don't make undo entries for readin.
(buffer-undo-list t))
;; line, the alignment if this line w.r.t the rest is messed up because
;; the fields of that one line will generally be smaller.
;;
- ;; To work around this problem, we here add spaces to try and re-align the
- ;; fields as needed. Since this is purely aesthetic, it is of utmost
- ;; importance that it doesn't mess up anything like
- ;; `dired-move-to-filename'. To this end, we limit ourselves to adding
- ;; spaces only, and to only add them at places where there was already at
- ;; least one space. This way, as long as `dired-move-to-filename-regexp'
- ;; always matches spaces with "*" or "+", we know we haven't made anything
- ;; worse. There is one spot where the exact number of spaces is
- ;; important, which is just before the actual filename, so we refrain from
- ;; adding spaces there (and within the filename as well, of course).
+ ;; To work around this problem, we here add spaces to try and
+ ;; re-align the fields as needed. Since this is purely aesthetic,
+ ;; it is of utmost importance that it doesn't mess up anything like
+ ;; `dired-move-to-filename'. To this end, we limit ourselves to
+ ;; adding spaces only, and to only add them at places where there
+ ;; was already at least one space. This way, as long as
+ ;; `directory-listing-before-filename-regexp' always matches spaces
+ ;; with "*" or "+", we know we haven't made anything worse. There
+ ;; is one spot where the exact number of spaces is important, which
+ ;; is just before the actual filename, so we refrain from adding
+ ;; spaces there (and within the filename as well, of course).
(save-excursion
(let (file file-col other other-col)
;; Check the there is indeed a file, and that there is anoter adjacent
(setq switches (concat "--dired " switches)))
;; 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.
+ ;; with the new value of `directory-listing-before-filename-regexp'.
(if file-list
(dolist (f file-list)
(let ((beg (point)))
;; treat top level dir extra (it may contain wildcards)
(dired-uncache
(if (consp dired-directory) (car dired-directory) dired-directory))
- (dired-readin)
+ ;; Run dired-after-readin-hook just once, below.
(let ((dired-after-readin-hook nil))
- ;; don't run that hook for each subdir...
+ (dired-readin)
(dired-insert-old-subdirs old-subdir-alist))
(dired-mark-remembered mark-alist) ; mark files that were marked
;; ... run the hook for the whole buffer, and only after markers
(define-key map "f" 'dired-find-file)
(define-key map "\C-m" 'dired-advertised-find-file)
(define-key map "g" 'revert-buffer)
- (define-key map "\M-g" 'dired-goto-file)
(define-key map "h" 'describe-mode)
(define-key map "i" 'dired-maybe-insert-subdir)
+ (define-key map "j" 'dired-goto-file)
(define-key map "k" 'dired-do-kill-lines)
(define-key map "l" 'dired-do-redisplay)
(define-key map "m" 'dired-mark)
(define-key map "$" 'dired-hide-subdir)
(define-key map "\M-$" 'dired-hide-all)
;; misc
+ (define-key map "\C-x\C-q" 'wdired-change-to-wdired-mode)
(define-key map "?" 'dired-summary)
(define-key map "\177" 'dired-unmark-backward)
(define-key map [remap undo] 'dired-undo)
(define-key map [remap advertised-undo] 'dired-undo)
+ ;; thumbnail manipulation (image-dired)
+ (define-key map "\C-td" 'image-dired-display-thumbs)
+ (define-key map "\C-tt" 'image-dired-tag-files)
+ (define-key map "\C-tr" 'image-dired-delete-tag)
+ (define-key map "\C-tj" 'image-dired-jump-thumbnail-buffer)
+ (define-key map "\C-ti" 'image-dired-dired-display-image)
+ (define-key map "\C-tx" 'image-dired-dired-display-external)
+ (define-key map "\C-ta" 'image-dired-display-thumbs-append)
+ (define-key map "\C-t." 'image-dired-display-thumb)
+ (define-key map "\C-tc" 'image-dired-dired-comment-files)
+ (define-key map "\C-tf" 'image-dired-mark-tagged-files)
+ (define-key map "\C-t\C-t" 'image-dired-dired-insert-marked-thumbs)
+ (define-key map "\C-te" 'image-dired-dired-edit-comment-and-tags)
;; Make menu bar items.
(define-key map [menu-bar immediate]
(cons "Immediate" (make-sparse-keymap "Immediate")))
+ (define-key map
+ [menu-bar immediate image-dired-dired-display-external]
+ '(menu-item "Display Image Externally" image-dired-dired-display-external
+ :help "Display image in external viewer"))
+ (define-key map
+ [menu-bar immediate image-dired-dired-display-image]
+ '(menu-item "Display Image" image-dired-dired-display-image
+ :help "Display sized image in a separate window"))
+
+ (define-key map [menu-bar immediate dashes-4]
+ '("--"))
+
(define-key map [menu-bar immediate revert-buffer]
'(menu-item "Refresh" revert-buffer
:help "Update contents of shown directories"))
'("--"))
(define-key map [menu-bar immediate compare-directories]
- '(menu-item "Compare directories..." dired-compare-directories
+ '(menu-item "Compare Directories..." dired-compare-directories
:help "Mark files with different attributes in two dired buffers"))
(define-key map [menu-bar immediate backup-diff]
'(menu-item "Compare with Backup" dired-backup-diff
(define-key map [menu-bar regexp]
(cons "Regexp" (make-sparse-keymap "Regexp")))
+ (define-key map
+ [menu-bar regexp image-dired-mark-tagged-files]
+ '(menu-item "Mark From Image Tag..." image-dired-mark-tagged-files
+ :help "Mark files whose image tags matches regexp"))
+
+ (define-key map [menu-bar regexp dashes-1]
+ '("--"))
+
(define-key map [menu-bar regexp downcase]
'(menu-item "Downcase" dired-downcase
;; When running on plain MS-DOS, there's only one
(define-key map [menu-bar operate]
(cons "Operate" (make-sparse-keymap "Operate")))
+ (define-key map
+ [menu-bar operate image-dired-delete-tag]
+ '(menu-item "Delete Image Tag..." image-dired-delete-tag
+ :help "Delete image tag from current or marked files"))
+ (define-key map
+ [menu-bar operate image-dired-tag-files]
+ '(menu-item "Add Image Tags..." image-dired-tag-files
+ :help "Add image tags to current or marked files"))
+ (define-key map
+ [menu-bar operate image-dired-dired-comment-files]
+ '(menu-item "Add Image Comment..." image-dired-dired-comment-files
+ :help "Add image comment to current or marked files"))
+ (define-key map
+ [menu-bar operate image-dired-display-thumbs]
+ '(menu-item "Display Image-Dired" image-dired-display-thumbs
+ :help "Display image-dired for current or marked image files"))
+
+ (define-key map [menu-bar operate dashes-3]
+ '("--"))
+
(define-key map [menu-bar operate query-replace]
'(menu-item "Query Replace in Files..." dired-do-query-replace-regexp
:help "Replace regexp in marked files"))
\f
;;; Functions for finding the file name in a dired buffer line.
-(defvar dired-move-to-filename-regexp
- (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
- (l-or-quote "\\([A-Za-z']\\|[^\0-\177]\\)")
- ;; In some locales, month abbreviations are as short as 2 letters,
- ;; and they can be followed by ".".
- ;; In Breton, a month name can include a quote character.
- (month (concat l-or-quote l-or-quote "+\\.?"))
- (s " ")
- (yyyy "[0-9][0-9][0-9][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 "\\)"
- s "+"
- "\\(" HH:MM "\\|" yyyy "\\)"))
- (western-comma (concat month s "+" dd "," s "+" yyyy))
- ;; Japanese MS-Windows ls-lisp has one-digit months, and
- ;; omits the Kanji characters after month and day-of-month.
- (mm "[ 0-1]?[0-9]")
- (japanese
- (concat mm l "?" s dd l "?" s "+"
- "\\(" HH:MM "\\|" yyyy l "?" "\\)")))
- ;; 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 "[BkKMGTPEZY]?" 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][BkKMGTPEZY]?" s
- "\\(" western "\\|" western-comma "\\|" 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'.")
(cond
((and change (< change eol))
(goto-char change))
- ((re-search-forward dired-move-to-filename-regexp eol t)
+ ((re-search-forward directory-listing-before-filename-regexp eol t)
(goto-char (match-end 0)))
((re-search-forward dired-permission-flags-regexp eol t)
;; Ha! There *is* a file. Our regexp-from-hell just failed to find it.
(if raise-error
- (error "Unrecognized line! Check dired-move-to-filename-regexp"))
+ (error "Unrecognized line! Check directory-listing-before-filename-regexp"))
(beginning-of-line)
nil)
(raise-error
(eq (preceding-char) ?@) ;; did ls really mark the link?
(forward-char -1))))
(goto-char eol) ;; else not a symbolic link
- ;; ls -lF marks dirs, sockets and executables with exactly one
- ;; trailing character. (Executable bits on symlinks ain't mean
+ ;; ls -lF marks dirs, sockets, fifos and executables with exactly
+ ;; one trailing character. (Executable bits on symlinks ain't mean
;; a thing, even to ls, but we know it's not a symlink.)
(and used-F
- (or (memq file-type '(?d ?s))
+ (or (memq file-type '(?d ?s ?p))
executable)
(forward-char -1))))
(or no-error
(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)
- ;; Avoid taking a file name ending in a colon
- ;; as a subdir name.
- (not (save-excursion
- (goto-char (match-beginning 0))
- (beginning-of-line)
- (forward-char 2)
- (save-match-data (looking-at dired-re-perms)))))
- (save-excursion
- (goto-char (match-beginning 1))
- (setq new-dir-name
- (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))
- (dired-alist-add-1 new-dir-name
- ;; Place a sub directory boundary between lines.
- (save-excursion
- (goto-char (match-beginning 0))
- (beginning-of-line)
- (point-marker))))
+ (while (re-search-forward dired-subdir-regexp nil t)
+ ;; Avoid taking a file name ending in a colon
+ ;; as a subdir name.
+ (unless (save-excursion
+ (goto-char (match-beginning 0))
+ (beginning-of-line)
+ (forward-char 2)
+ (save-match-data (looking-at dired-re-perms)))
+ (save-excursion
+ (goto-char (match-beginning 1))
+ (setq new-dir-name
+ (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))
+ (dired-alist-add-1 new-dir-name
+ ;; Place a sub directory boundary between lines.
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (beginning-of-line)
+ (point-marker)))))
(if (and (> count 1) (interactive-p))
- (message "Buffer includes %d directories" count))
- ;; We don't need to sort it because it is in buffer order per
- ;; constructionem. Return new alist:
- dired-subdir-alist)))
+ (message "Buffer includes %d directories" count)))
+ ;; We don't need to sort it because it is in buffer order per
+ ;; constructionem. Return new alist:
+ dired-subdir-alist))
(defun dired-alist-add-1 (dir new-marker)
;; Add new DIR at NEW-MARKER. Don't sort.
(forward-line 1))))
(defun dired-goto-file (file)
- "Go to file line of FILE in this dired buffer."
+ "Go to line describing file FILE in this dired buffer."
;; Return value of point on success, else nil.
;; FILE must be an absolute file name.
;; Loses if FILE contains control chars like "\007" for which ls
\f
;; Deleting files
-(defcustom dired-recursive-deletes nil ; Default only delete empty directories.
+(defcustom dired-recursive-deletes 'top ; Default only delete empty directories.
"*Decide whether recursive deletes are allowed.
-nil means no recursive deletes.
+A value of 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.
(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 "
+ (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).
(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
-if there are no flagged files."
+if there are no flagged files.
+`dired-recursive-deletes' controls whether
+deletion of non-empty directories is allowed."
(interactive)
(let* ((dired-marker-char dired-del-marker)
(regexp (dired-marker-regexp))
(message "(No deletions requested)")))))
(defun dired-do-delete (&optional arg)
- "Delete all marked (or next ARG) files."
+ "Delete all marked (or next ARG) files.
+`dired-recursive-deletes' controls whether
+deletion of non-empty directories is allowed."
;; This is more consistent with the file marking feature than
;; dired-do-flagged-delete.
(interactive "P")
(set-window-start w2 1)
)))
-(defvar dired-no-confirm nil
+(defcustom dired-no-confirm nil
"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',
-`touch' and `uncompress'.")
+`touch' and `uncompress'."
+ :group 'dired
+ :type '(set (const byte-compile) (const chgrp)
+ (const chmod) (const chown) (const compress)
+ (const copy) (const delete) (const hardlink)
+ (const load) (const move) (const print)
+ (const shell) (const symlink) (const touch)
+ (const uncompress)))
(defun dired-mark-pop-up (bufname op-symbol files function &rest args)
"Return FUNCTION's result on ARGS after showing which files are marked.
(insert "\f\n")))))))
(defun dired-log-summary (string failures)
+ "State a summary of a command's failures, in echo area and log buffer.
+STRING is an overall summary of the failures.
+FAILURES is a list of file names that we failed to operate on,
+or nil if file names are not applicable."
(if (= (length failures) 1)
(message "%s"
(with-current-buffer dired-log-buffer
;; Modeline display of "by name" or "by date" guarantees the user a
;; match with the corresponding regexps. Non-matching switches are
;; shown literally.
- (setq mode-name
- (let (case-fold-search)
- (cond ((string-match dired-sort-by-name-regexp dired-actual-switches)
- "Dired by name")
- ((string-match dired-sort-by-date-regexp dired-actual-switches)
- "Dired by date")
- (t
- (concat "Dired " dired-actual-switches)))))
- (force-mode-line-update))
+ (when (eq major-mode 'dired-mode)
+ (setq mode-name
+ (let (case-fold-search)
+ (cond ((string-match
+ dired-sort-by-name-regexp dired-actual-switches)
+ "Dired by name")
+ ((string-match
+ dired-sort-by-date-regexp dired-actual-switches)
+ "Dired by date")
+ (t
+ (concat "Dired " dired-actual-switches)))))
+ (force-mode-line-update)))
(defun dired-sort-toggle-or-edit (&optional arg)
"Toggle between sort by date/name and refresh the dired buffer.
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))
+ (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."))
+(defvar dired-subdir-alist-pre-R nil
+ "Value of `dired-subdir-alist' before -R switch added.")
+(make-variable-buffer-local 'dired-subdir-alist-pre-R)
(defun dired-sort-R-check (switches)
"Additional processing of -R in ls option string SWITCHES.
;;;; Drag and drop support
-(defcustom dired-recursive-copies nil
+(defcustom dired-recursive-copies 'top
"*Decide whether recursive copies are allowed.
-nil means no recursive copies.
+A value of nil means no recursive copies.
`always' means copy recursively without asking.
`top' means ask for each directory at top level.
Anything else means ask for each directory."
(when desktop-missing-file-warning (sit-for 1))
nil)))
-(eval-after-load 'desktop
- '(add-to-list 'desktop-buffer-mode-handlers
- '(dired-mode . dired-restore-desktop-buffer)))
+(add-to-list 'desktop-buffer-mode-handlers
+ '(dired-mode . dired-restore-desktop-buffer))
\f
(if (eq system-type 'vax-vms)