* bitmaps/README:
[bpt/emacs.git] / lisp / dired.el
index 375894c..06a11a6 100644 (file)
@@ -9,10 +9,10 @@
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -20,9 +20,7 @@
 ;; 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, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -35,6 +33,8 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'cl))
+
 ;;; Customizable variables
 
 (defgroup dired nil
@@ -464,7 +464,7 @@ PREDICATE is evaluated on each line, with point at beginning of line.
 MSG is a noun phrase for the type of files being marked.
 It should end with a noun that can be pluralized by adding `s'.
 Return value is the number of files marked, or nil if none were marked."
-  `(let (buffer-read-only count)
+  `(let ((inhibit-read-only t) count)
     (save-excursion
       (setq count 0)
       (if ,msg (message "Marking %ss..." ,msg))
@@ -510,7 +510,7 @@ return (t FILENAME) instead of (FILENAME)."
   ;;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)
+       (let ((inhibit-read-only t) case-fold-search found results)
         (if ,arg
             (if (integerp ,arg)
                 (progn ;; no save-excursion, want to move point.
@@ -587,19 +587,52 @@ Don't use that together with FILTER."
 
 (defun dired-read-dir-and-switches (str)
   ;; For use in interactive.
-  (reverse (list
-           (if current-prefix-arg
-               (read-string "Dired listing switches: "
-                            dired-listing-switches))
-           ;; If a dialog is about to be used, call read-directory-name so
-           ;; the dialog code knows we want directories.  Some dialogs can
-           ;; only select directories or files when popped up, not both.
-           (let ((default (and buffer-file-name
-                               (abbreviate-file-name buffer-file-name))))
-             (minibuffer-with-setup-hook
-                 (lambda () (setq minibuffer-default default))
-               (read-directory-name (format "Dired %s(directory): " str)
-                                    nil default-directory nil))))))
+  (reverse
+   (list
+    (if current-prefix-arg
+        (read-string "Dired listing switches: "
+                     dired-listing-switches))
+    ;; If a dialog is about to be used, call read-directory-name so
+    ;; the dialog code knows we want directories.  Some dialogs can
+    ;; only select directories or files when popped up, not both.
+    (if (next-read-file-uses-dialog-p)
+        (read-directory-name (format "Dired %s(directory): " str)
+                             nil default-directory nil)
+      (let ((cie ()))
+        (dolist (ext completion-ignored-extensions)
+          (if (eq ?/ (aref ext (1- (length ext)))) (push ext cie)))
+        (setq cie (concat (regexp-opt cie "\\(?:") "\\'"))
+        (lexical-let* ((default (and buffer-file-name
+                                     (abbreviate-file-name buffer-file-name)))
+                       (cie cie)
+                       (completion-table
+                        ;; We need a mix of read-file-name and
+                        ;; read-directory-name so that completion to directories
+                        ;; is preferred, but if the user wants to enter a global
+                        ;; pattern, he can still use completion on filenames to
+                        ;; help him write the pattern.
+                        ;; Essentially, we want to use
+                        ;; (completion-table-with-predicate
+                        ;;  'read-file-name-internal 'file-directory-p nil)
+                        ;; but that doesn't work because read-file-name-internal
+                        ;; does not obey its `predicate' argument.
+                        (completion-table-in-turn
+                         (lambda (str pred action)
+                           (let ((read-file-name-predicate
+                                  (lambda (f)
+                                    (and (not (member f '("./" "../")))
+                                         ;; Hack! Faster than file-directory-p!
+                                         (eq (aref f (1- (length f))) ?/)
+                                         (not (string-match cie f))))))
+                             (complete-with-action
+                              action 'read-file-name-internal str nil)))
+                         'read-file-name-internal)))
+          (minibuffer-with-setup-hook
+              (lambda ()
+                (setq minibuffer-default default)
+                (setq minibuffer-completion-table completion-table))
+            (read-file-name (format "Dired %s(directory): " str)
+                            nil default-directory nil))))))))
 
 ;;;###autoload (define-key ctl-x-map "d" 'dired)
 ;;;###autoload
@@ -686,7 +719,6 @@ for a remote directory.  This feature is used by Auto Revert Mode."
         (file-readable-p dirname)
         (dired-directory-changed-p dirname))))
 
-;; Separate function from dired-noselect for the sake of dired-vms.el.
 (defun dired-internal-noselect (dir-or-list &optional switches mode)
   ;; If there is an existing dired buffer for DIRNAME, just leave
   ;; buffer as it is (don't even call dired-revert).
@@ -808,7 +840,7 @@ wildcards, erases the buffer, and builds the subdir-alist anew
       (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
+      (let ((inhibit-read-only t)
            ;; Don't make undo entries for readin.
            (buffer-undo-list t))
        (widen)
@@ -1011,7 +1043,9 @@ If HDR is non-nil, insert a header line with the directory name."
     ;; Insert text at the beginning to standardize things.
     (save-excursion
       (goto-char opoint)
-      (if (and (or hdr wildcard) (not (looking-at "^  /.*:$")))
+      (if (and (or hdr wildcard)
+               (not (and (looking-at "^  \\(.*\\):$")
+                         (file-name-absolute-p (match-string 1)))))
          ;; Note that dired-build-subdir-alist will replace the name
          ;; by its expansion, so it does not matter whether what we insert
          ;; here is fully expanded, but it should be absolute.
@@ -1033,6 +1067,7 @@ If HDR is non-nil, insert a header line with the directory name."
                 (dired-move-to-end-of-filename)
                 (point))
               '(mouse-face highlight
+                dired-filename t
                 help-echo "mouse-2: visit this file in other window")))
        (error nil))
       (forward-line 1))))
@@ -1052,7 +1087,7 @@ Preserves old cursor, marks/flags, hidden-p."
        (hidden-subdirs (dired-remember-hidden))
        (old-subdir-alist (cdr (reverse dired-subdir-alist))) ; except pwd
        (case-fold-search nil)          ; we check for upper case ls flags
-       buffer-read-only)
+       (inhibit-read-only t))
     (goto-char (point-min))
     (setq mark-alist;; only after dired-remember-hidden since this unhides:
          (dired-remember-marks (point-min) (point-max)))
@@ -1086,7 +1121,7 @@ Preserves old cursor, marks/flags, hidden-p."
 (defun dired-remember-marks (beg end)
   "Return alist of files and their marks, from BEG to END."
   (if selective-display                        ; must unhide to make this work.
-      (let (buffer-read-only)
+      (let ((inhibit-read-only t))
        (subst-char-in-region beg end ?\r ?\n)))
   (let (fil chr alist)
     (save-excursion
@@ -1159,7 +1194,6 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
     (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)
@@ -1178,6 +1212,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
     (define-key map "X" 'dired-do-shell-command)
     (define-key map "Z" 'dired-do-compress)
     (define-key map "!" 'dired-do-shell-command)
+    (define-key map "&" 'dired-do-async-shell-command)
     ;; Comparison commands
     (define-key map "=" 'dired-diff)
     (define-key map "\M-=" 'dired-backup-diff)
@@ -1205,6 +1240,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
     (define-key map "%H" 'dired-do-hardlink-regexp)
     (define-key map "%R" 'dired-do-rename-regexp)
     (define-key map "%S" 'dired-do-symlink-regexp)
+    (define-key map "%&" 'dired-flag-garbage-files)
     ;; Commands for marking and unmarking.
     (define-key map "*" nil)
     (define-key map "**" 'dired-mark-executables)
@@ -1260,6 +1296,11 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
     ;; hiding
     (define-key map "$" 'dired-hide-subdir)
     (define-key map "\M-$" 'dired-hide-all)
+    ;; isearch
+    (define-key map (kbd "M-s a C-s")   'dired-do-isearch)
+    (define-key map (kbd "M-s a M-C-s") 'dired-do-isearch-regexp)
+    (define-key map (kbd "M-s f C-s")   'dired-isearch-filenames)
+    (define-key map (kbd "M-s f M-C-s") 'dired-isearch-filenames-regexp)
     ;; misc
     (define-key map "\C-x\C-q" 'dired-toggle-read-only)
     (define-key map "?" 'dired-summary)
@@ -1279,6 +1320,11 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
     (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)
+    ;; encryption and decryption (epa-dired)
+    (define-key map ":d" 'epa-dired-do-decrypt)
+    (define-key map ":v" 'epa-dired-do-verify)
+    (define-key map ":s" 'epa-dired-do-sign)
+    (define-key map ":e" 'epa-dired-do-encrypt)
 
     ;; Make menu bar items.
 
@@ -1324,6 +1370,29 @@ 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 epa-dired-do-decrypt]
+      '(menu-item "Decrypt" epa-dired-do-decrypt
+                 :help "Decrypt file at cursor"))
+
+    (define-key map
+      [menu-bar immediate epa-dired-do-verify]
+      '(menu-item "Verify" epa-dired-do-verify
+                 :help "Verify digital signature of file at cursor"))
+
+    (define-key map
+      [menu-bar immediate epa-dired-do-sign]
+      '(menu-item "Sign" epa-dired-do-sign
+                 :help "Create digital signature of file at cursor"))
+
+    (define-key map
+      [menu-bar immediate epa-dired-do-encrypt]
+      '(menu-item "Encrypt" epa-dired-do-encrypt
+                 :help "Encrypt file at cursor"))
+
+    (define-key map [menu-bar immediate dashes-4]
+      '("--"))
+
     (define-key map
       [menu-bar immediate image-dired-dired-display-external]
       '(menu-item "Display Image Externally" image-dired-dired-display-external
@@ -1343,6 +1412,12 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
     (define-key map [menu-bar immediate dashes]
       '("--"))
 
+    (define-key map [menu-bar immediate isearch-filenames-regexp]
+      '(menu-item "Isearch Regexp in File Names..." dired-isearch-filenames-regexp
+                 :help "Incrementally search for regexp in file names only"))
+    (define-key map [menu-bar immediate isearch-filenames]
+      '(menu-item "Isearch in File Names..." dired-isearch-filenames
+                 :help "Incrementally search for string in file names only."))
     (define-key map [menu-bar immediate compare-directories]
       '(menu-item "Compare Directories..." dired-compare-directories
                  :help "Mark files with different attributes in two dired buffers"))
@@ -1365,9 +1440,12 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
       '(menu-item "Find This File" dired-find-file
                  :help "Edit file at cursor"))
     (define-key map [menu-bar immediate create-directory]
-      '(menu-item "Create Directory..." dired-create-directory))
+      '(menu-item "Create Directory..." dired-create-directory
+                 :help "Create a directory"))
     (define-key map [menu-bar immediate wdired-mode]
       '(menu-item "Edit File Names" wdired-change-to-wdired-mode
+                 :help "Put a dired buffer in a mode in which filenames are editable"
+                 :keys "C-x C-q"
                  :filter (lambda (x) (if (eq major-mode 'dired-mode) x))))
 
     (define-key map [menu-bar regexp]
@@ -1482,8 +1560,8 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
                   :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"))
+      '(menu-item "Display image thumbnails" image-dired-display-thumbs
+                  :help "Display image thumbnails for current or marked image files"))
 
     (define-key map [menu-bar operate dashes-3]
       '("--"))
@@ -1494,6 +1572,12 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
     (define-key map [menu-bar operate search]
       '(menu-item "Search Files..." dired-do-search
                  :help "Search marked files for regexp"))
+    (define-key map [menu-bar operate isearch-regexp]
+      '(menu-item "Isearch Regexp Files..." dired-do-isearch-regexp
+                 :help "Incrementally search marked files for regexp"))
+    (define-key map [menu-bar operate isearch]
+      '(menu-item "Isearch Files..." dired-do-isearch
+                 :help "Incrementally search marked files for string"))
     (define-key map [menu-bar operate chown]
       '(menu-item "Change Owner..." dired-do-chown
                  :visible (not (memq system-type '(ms-dos windows-nt)))
@@ -1648,6 +1732,7 @@ Keybindings:
   (when (featurep 'dnd)
     (set (make-local-variable 'dnd-protocol-alist)
         (append dired-dnd-protocol-alist dnd-protocol-alist)))
+  (add-hook 'isearch-mode-hook 'dired-isearch-filenames-setup nil t)
   (run-mode-hooks 'dired-mode-hook))
 \f
 ;; Idiosyncratic dired commands that don't deal with marks.
@@ -1665,7 +1750,7 @@ Keybindings:
 This doesn't recover lost files, it just undoes changes in the buffer itself.
 You can use it to recover marks, killed lines or subdirs."
   (interactive)
-  (let (buffer-read-only)
+  (let ((inhibit-read-only t))
     (undo))
   (dired-build-subdir-alist)
   (message "Change in dired buffer undone.
@@ -1901,8 +1986,7 @@ Optional arg GLOBAL means to replace all matches."
   ;;"Convert FILE (a file name relative to DIR) to an absolute file name."
   ;; We can't always use expand-file-name as this would get rid of `.'
   ;; or expand in / instead default-directory if DIR=="".
-  ;; This should be good enough for ange-ftp, but might easily be
-  ;; redefined (for VMS?).
+  ;; This should be good enough for ange-ftp.
   ;; It should be reasonably fast, though, as it is called in
   ;; dired-get-filename.
   (concat (or dir default-directory) file))
@@ -2218,7 +2302,7 @@ instead of `dired-actual-switches'."
   (dired-clear-alist)
   (save-excursion
     (let* ((count 0)
-          (buffer-read-only nil)
+          (inhibit-read-only t)
           (buffer-undo-list t)
           (switches (or switches dired-actual-switches))
           new-dir-name
@@ -2468,7 +2552,7 @@ non-empty directories is allowed."
 (defun dired-internal-do-deletions (l arg)
   ;; L is an alist of files to delete, with their buffer positions.
   ;; ARG is the prefix arg.
-  ;; Filenames are absolute (VMS needs this for logical search paths).
+  ;; Filenames are absolute.
   ;; (car L) *must* be the *last* (bottommost) file in the dired buffer.
   ;; That way as changes are made in the buffer they do not shift the
   ;; lines still to be changed, so the (point) values in L stay valid.
@@ -2486,7 +2570,7 @@ non-empty directories is allowed."
          (let (failures);; files better be in reverse order for this loop!
            (while l
              (goto-char (cdr (car l)))
-             (let (buffer-read-only)
+             (let ((inhibit-read-only t))
                (condition-case err
                    (let ((fn (car (car l))))
                      (dired-delete-file fn dired-recursive-deletes)
@@ -2528,7 +2612,7 @@ non-empty directories is allowed."
 (defun dired-delete-entry (file)
   (save-excursion
     (and (dired-goto-file file)
-        (let (buffer-read-only)
+        (let ((inhibit-read-only t))
           (delete-region (progn (beginning-of-line) (point))
                          (save-excursion (forward-line 1) (point))))))
   (dired-clean-up-after-deletion file))
@@ -2651,31 +2735,9 @@ just the current file."
       (apply function args))))
 
 (defun dired-format-columns-of-files (files)
-  ;; Files should be in forward order for this loop.
-  ;; i.e., (car files) = first file in buffer.
-  ;; Returns the number of lines used.
-  (let* ((maxlen (+ 2 (apply 'max (mapcar 'length files))))
-        (width (- (window-width (selected-window)) 2))
-        (columns (max 1 (/ width maxlen)))
-        (nfiles (length files))
-        (rows (+ (/ nfiles columns)
-                 (if (zerop (% nfiles columns)) 0 1)))
-        (i 0)
-        (j 0))
-    (setq files (nconc (copy-sequence files) ; fill up with empty fns
-                      (make-list (- (* columns rows) nfiles) "")))
-    (setcdr (nthcdr (1- (length files)) files) files) ; make circular
-    (while (< j rows)
-      (while (< i columns)
-       (indent-to (* i maxlen))
-       (insert (car files))
-       (setq files (nthcdr rows files)
-             i (1+ i)))
-      (insert "\n")
-      (setq i 0
-           j (1+ j)
-           files (cdr files)))
-    rows))
+  (let ((beg (point)))
+    (completion--insert-strings files)
+    (put-text-property beg (point) 'mouse-face nil)))
 \f
 ;; Commands to mark or flag file(s) at or near current line.
 
@@ -2741,7 +2803,7 @@ just the current file."
               (following-char))))))
 
 (defun dired-mark-files-in-region (start end)
-  (let (buffer-read-only)
+  (let ((inhibit-read-only t))
     (if (> start end)
        (error "start > end"))
     (goto-char start)                  ; assumed at beginning of line
@@ -2766,7 +2828,7 @@ this subdir."
   (interactive "P")
   (if (dired-get-subdir)
       (save-excursion (dired-mark-subdir-files))
-    (let (buffer-read-only)
+    (let ((inhibit-read-only t))
       (dired-repeat-over-lines
        (prefix-numeric-value arg)
        (function (lambda () (delete-char 1) (insert dired-marker-char)))))))
@@ -2801,7 +2863,7 @@ As always, hidden subdirs are not affected."
   (interactive)
   (save-excursion
     (goto-char (point-min))
-    (let (buffer-read-only)
+    (let ((inhibit-read-only t))
       (while (not (eobp))
         (or (dired-between-files)
             (looking-at dired-re-dot)
@@ -2981,7 +3043,7 @@ OLD and NEW are both characters used to mark files."
   (if (or (eq old ?\r) (eq new ?\r))
       (ding)
     (let ((string (format "\n%c" old))
-         (buffer-read-only))
+         (inhibit-read-only t))
       (save-excursion
        (goto-char (point-min))
        (while (search-forward string nil t)
@@ -3006,7 +3068,7 @@ Type \\[help-command] at that time for help."
   (interactive "cRemove marks (RET means all): \nP")
   (save-excursion
     (let* ((count 0)
-          buffer-read-only case-fold-search query
+          (inhibit-read-only t) case-fold-search query
           (string (format "\n%c" mark))
           (help-form "\
 Type SPC or `y' to unmark one file, DEL or `n' to skip to next,
@@ -3272,6 +3334,10 @@ Anything else means ask for each directory."
 (declare-function dired-relist-entry "dired-aux" (file))
 (declare-function make-symbolic-link "fileio.c")
 
+;; Only used when (featurep 'dnd).
+(declare-function dnd-get-local-file-name "dnd" (uri &optional must-exist))
+(declare-function dnd-get-local-file-uri "dnd" (uri))
+
 (defun dired-dnd-handle-local-file (uri action)
   "Copy, move or link a file to the dired directory.
 URI is the file to handle, ACTION is one of copy, move, link or ask.
@@ -3374,9 +3440,6 @@ Ask means pop up a menu for the user to select one of copy, move or link."
             '(dired-mode . dired-restore-desktop-buffer))
 
 \f
-(if (eq system-type 'vax-vms)
-    (load "dired-vms"))
-
 (provide 'dired)
 
 (run-hooks 'dired-load-hook)           ; for your customizations