*** empty log message ***

[bpt/emacs.git] / lisp / dired.el

diff --git a/lisp/dired.el b/lisp/dired.el
index 51dc581..d53a683 100644 (file)
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -9,10 +9,10 @@
 
 ;; This file is part of GNU Emacs.
 
 
 ;; 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
 ;; 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
 
 ;; 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
 ;; 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:
 
 
 ;;; Commentary:
 


@@ -466,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."
 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))
     (save-excursion
       (setq count 0)
       (if ,msg (message "Marking %ss..." ,msg))


@@ -512,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
   ;;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.
         (if ,arg
             (if (integerp ,arg)
                 (progn ;; no save-excursion, want to move point.


@@ -600,33 +598,41 @@ Don't use that together with FILTER."
     (if (next-read-file-uses-dialog-p)
         (read-directory-name (format "Dired %s(directory): " str)
                              nil default-directory nil)
     (if (next-read-file-uses-dialog-p)
         (read-directory-name (format "Dired %s(directory): " str)
                              nil default-directory nil)

-      (lexical-let ((default (and buffer-file-name
-                                  (abbreviate-file-name buffer-file-name)))
-                    (defdir default-directory))
-        (minibuffer-with-setup-hook
-            (lambda ()
-              (setq minibuffer-default default)
-              (setq minibuffer-completing-file-name t)
-              (setq default-directory defdir))
-          (substitute-in-file-name
-           (completing-read
-            (format "Dired %s(directory): " str)
-            ;; 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 'file-directory-p))
-                 (complete-with-action
-                  action 'read-file-name-internal str nil)))
-             'read-file-name-internal)
-            nil nil (abbreviate-file-name defdir) 'file-name-history))))))))
+      (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
 
 ;;;###autoload (define-key ctl-x-map "d" 'dired)
 ;;;###autoload


@@ -835,7 +841,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))
       (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)
            ;; Don't make undo entries for readin.
            (buffer-undo-list t))
        (widen)


@@ -1038,7 +1044,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)
     ;; 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.
          ;; 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.


@@ -1079,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
        (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)))
     (goto-char (point-min))
     (setq mark-alist;; only after dired-remember-hidden since this unhides:
          (dired-remember-marks (point-min) (point-max)))


@@ -1113,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.
 (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
        (subst-char-in-region beg end ?\r ?\n)))
   (let (fil chr alist)
     (save-excursion


@@ -1722,7 +1730,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)
 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.
     (undo))
   (dired-build-subdir-alist)
   (message "Change in dired buffer undone.


@@ -2275,7 +2283,7 @@ instead of `dired-actual-switches'."
   (dired-clear-alist)
   (save-excursion
     (let* ((count 0)
   (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
           (buffer-undo-list t)
           (switches (or switches dired-actual-switches))
           new-dir-name


@@ -2543,7 +2551,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 (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)
                (condition-case err
                    (let ((fn (car (car l))))
                      (dired-delete-file fn dired-recursive-deletes)


@@ -2585,7 +2593,7 @@ non-empty directories is allowed."
 (defun dired-delete-entry (file)
   (save-excursion
     (and (dired-goto-file file)
 (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))
           (delete-region (progn (beginning-of-line) (point))
                          (save-excursion (forward-line 1) (point))))))
   (dired-clean-up-after-deletion file))


@@ -2776,7 +2784,7 @@ just the current file."
               (following-char))))))
 
 (defun dired-mark-files-in-region (start end)
               (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
     (if (> start end)
        (error "start > end"))
     (goto-char start)                  ; assumed at beginning of line


@@ -2801,7 +2809,7 @@ this subdir."
   (interactive "P")
   (if (dired-get-subdir)
       (save-excursion (dired-mark-subdir-files))
   (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)))))))
       (dired-repeat-over-lines
        (prefix-numeric-value arg)
        (function (lambda () (delete-char 1) (insert dired-marker-char)))))))


@@ -2836,7 +2844,7 @@ As always, hidden subdirs are not affected."
   (interactive)
   (save-excursion
     (goto-char (point-min))
   (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)
       (while (not (eobp))
         (or (dired-between-files)
             (looking-at dired-re-dot)


@@ -3016,7 +3024,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))
   (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)
       (save-excursion
        (goto-char (point-min))
        (while (search-forward string nil t)


@@ -3041,7 +3049,7 @@ Type \\[help-command] at that time for help."
   (interactive "cRemove marks (RET means all): \nP")
   (save-excursion
     (let* ((count 0)
   (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,
           (string (format "\n%c" mark))
           (help-form "\
 Type SPC or `y' to unmark one file, DEL or `n' to skip to next,


@@ -3307,6 +3315,10 @@ Anything else means ask for each directory."
 (declare-function dired-relist-entry "dired-aux" (file))
 (declare-function make-symbolic-link "fileio.c")
 
 (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.
 (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.