Merge from emacs--devo--0
[bpt/emacs.git] / lisp / dired.el
index 7209248..1a90609 100644 (file)
@@ -1,7 +1,7 @@
 ;;; dired.el --- directory-browsing commands
 
 ;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1997, 2000,
-;;   2001, 2002, 2003, 2004, 2005, 2006 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
@@ -11,7 +11,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -56,7 +56,7 @@ may contain even `F', `b', `i' and `s'.  See also the variable
 `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)
 
@@ -791,6 +791,9 @@ wildcards, erases the buffer, and builds the subdir-alist anew
       (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))
@@ -1042,9 +1045,9 @@ Preserves old cursor, marks/flags, hidden-p."
     ;; 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
@@ -1212,9 +1215,9 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
     (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)
@@ -1244,22 +1247,24 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
     (define-key map "$" 'dired-hide-subdir)
     (define-key map "\M-$" 'dired-hide-all)
     ;; misc
+    (define-key map "\C-x\C-q" 'dired-toggle-read-only)
     (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 (tumme)
-    (define-key map "\C-td" 'tumme-display-thumbs)
-    (define-key map "\C-tt" 'tumme-tag-files)
-    (define-key map "\C-tr" 'tumme-tag-remove)
-    (define-key map "\C-tj" 'tumme-jump-thumbnail-buffer)
-    (define-key map "\C-ti" 'tumme-display-dired-image)
-    (define-key map "\C-tx" 'tumme-dired-display-external)
-    (define-key map "\C-ta" 'tumme-display-thumbs-append)
-    (define-key map "\C-t." 'tumme-display-thumb)
-    (define-key map "\C-tc" 'tumme-dired-comment-files)
-    (define-key map "\C-tf" 'tumme-mark-tagged-files)
-    (define-key map "\C-t\C-t" 'tumme-dired-insert-marked-thumbs)
+    ;; 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.
 
@@ -1305,6 +1310,18 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
     (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"))
@@ -1313,7 +1330,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
       '("--"))
 
     (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
@@ -1336,11 +1353,20 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
     (define-key map [menu-bar immediate create-directory]
       '(menu-item "Create Directory..." dired-create-directory))
     (define-key map [menu-bar immediate wdired-mode]
-      '(menu-item "Edit File Names" wdired-change-to-wdired-mode))
+      '(menu-item "Edit File Names" wdired-change-to-wdired-mode
+                 :filter (lambda (x) (if (eq major-mode 'dired-mode) x))))
 
     (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
@@ -1428,6 +1454,26 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
     (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"))
@@ -1611,6 +1657,16 @@ You can use it to recover marks, killed lines or subdirs."
   (message "Change in dired buffer undone.
 Actual changes in files cannot be undone by Emacs."))
 
+(defun dired-toggle-read-only ()
+  "Edit dired buffer with Wdired, or set it read-only.
+Call `wdired-change-to-wdired-mode' in dired buffers whose editing is
+supported by Wdired (the major mode of the dired buffer is `dired-mode').
+Otherwise, for buffers inheriting from dired-mode, call `toggle-read-only'."
+  (interactive)
+  (if (eq major-mode 'dired-mode)
+      (wdired-change-to-wdired-mode)
+    (toggle-read-only)))
+
 (defun dired-next-line (arg)
   "Move down lines then position at filename.
 Optional prefix ARG says how many lines to move; default is one line."
@@ -2160,40 +2216,40 @@ instead of `dired-actual-switches'."
                 (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.
@@ -2218,7 +2274,7 @@ instead of `dired-actual-switches'."
       (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
@@ -2315,9 +2371,9 @@ Optional argument means return a file name relative to `default-directory'."
 \f
 ;; Deleting files
 
-(defcustom dired-recursive-deletes nil ; Default only delete empty directories.
+(defcustom dired-recursive-deletes 'top
   "*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.
@@ -2363,7 +2419,9 @@ Anything else, ask for each sub-directory."
 (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))
@@ -2379,7 +2437,9 @@ if there are no flagged files."
          (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")
@@ -2999,6 +3059,10 @@ Thus, use \\[backward-page] to find the beginning of a group of errors."
               (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
@@ -3047,15 +3111,18 @@ The idea is to set this buffer-locally in special dired buffers.")
   ;; 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.
@@ -3111,7 +3178,7 @@ 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))
+  (dired-sort-set-modeline)
   (or no-revert (revert-buffer)))
 
 (defvar dired-subdir-alist-pre-R nil
@@ -3152,9 +3219,9 @@ To be called first in body of `dired-sort-other', etc."
 
 ;;;;  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."