X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/f67e15be8d94718b2e2ea7da68eb0b2dc94ce016..0b22a5e17ba44f559664af2d59c4828bfe56baaa:/lisp/dired.el diff --git a/lisp/dired.el b/lisp/dired.el index 51dc58167b..d53a6831b1 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -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 . ;;; 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." - `(let (buffer-read-only count) + `(let ((inhibit-read-only t) count) (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 - (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. @@ -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) - (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 @@ -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)) - (let (buffer-read-only + (let ((inhibit-read-only t) ;; 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) - (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. @@ -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 - 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))) @@ -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. - (let (buffer-read-only) + (let ((inhibit-read-only t)) (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) - (let (buffer-read-only) + (let ((inhibit-read-only t)) (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) - (buffer-read-only nil) + (inhibit-read-only t) (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 (buffer-read-only) + (let ((inhibit-read-only t)) (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) - (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)) @@ -2776,7 +2784,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 @@ -2801,7 +2809,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))))))) @@ -2836,7 +2844,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) @@ -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)) - (buffer-read-only)) + (inhibit-read-only 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) - 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, @@ -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") +;; 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.