X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/aae4b48c36b85f4af4fceaeb9091cf567065649e..4cb3bfa09c6838a579fcf3dab9b7ea1135a2fb4b:/lisp/dired.el diff --git a/lisp/dired.el b/lisp/dired.el index cec4ffa2f1..43b2170d13 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1,7 +1,6 @@ -;;; dired.el --- directory-browsing commands +;;; dired.el --- directory-browsing commands -*- lexical-binding: t -*- -;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1997, 2000, -;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Copyright (C) 1985-1986, 1992-1997, 2000-2011 ;; Free Software Foundation, Inc. ;; Author: Sebastian Kremer @@ -250,9 +249,19 @@ Local to each dired buffer. May be a list, in which case the car is the directory name and the cdr is the list of files to mention. The directory name must be absolute, but need not be fully expanded.") +;; Beware of "-l;reboot" etc. See bug#3230. +(defun dired-safe-switches-p (switches) + "Return non-nil if string SWITCHES does not look risky for dired." + (or (not switches) + (and (stringp switches) + (< (length switches) 100) ; arbitrary + (string-match "\\` *-[- [:alnum:]]+\\'" switches)))) + (defvar dired-actual-switches nil "The value of `dired-listing-switches' used to make this buffer's text.") +(put 'dired-actual-switches 'safe-local-variable 'dired-safe-switches-p) + (defvar dired-re-inode-size "[0-9 \t]*" "Regexp for optional initial inode and file size as made by `ls -i -s'.") @@ -602,9 +611,12 @@ Don't use that together with FILTER." (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 a dialog is 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 no dialog is used, call `read-file-name' + ;; because the user may want completion of file names for + ;; use in a wildcard pattern. (if (next-read-file-uses-dialog-p) (read-directory-name (format "Dired %s(directory): " str) nil default-directory nil) @@ -848,28 +860,47 @@ periodically reverts at specified time intervals." ;; killed buffer, it is removed from this list. "Alist of expanded directories and their associated dired buffers.") +(defvar dired-find-subdir) + +;; FIXME add a doc-string, and document dired-x extensions. (defun dired-find-buffer-nocreate (dirname &optional mode) ;; This differs from dired-buffers-for-dir in that it does not consider ;; subdirs of default-directory and searches for the first match only. ;; Also, the major mode must be MODE. - (setq dirname (expand-file-name dirname)) - (let (found (blist dired-buffers)) ; was (buffer-list) - (or mode (setq mode 'dired-mode)) - (while blist - (if (null (buffer-name (cdr (car blist)))) - (setq blist (cdr blist)) - (with-current-buffer (cdr (car blist)) - (if (and (eq major-mode mode) - dired-directory ;; nil during find-alternate-file - (equal dirname - (expand-file-name - (if (consp dired-directory) - (car dired-directory) - dired-directory)))) - (setq found (cdr (car blist)) - blist nil) - (setq blist (cdr blist)))))) - found)) + (if (and (featurep 'dired-x) + dired-find-subdir + ;; Don't try to find a wildcard as a subdirectory. + (string-equal dirname (file-name-directory dirname))) + (let* ((cur-buf (current-buffer)) + (buffers (nreverse + (dired-buffers-for-dir (expand-file-name dirname)))) + (cur-buf-matches (and (memq cur-buf buffers) + ;; Wildcards must match, too: + (equal dired-directory dirname)))) + ;; We don't want to switch to the same buffer--- + (setq buffers (delq cur-buf buffers)) + (or (car (sort buffers #'dired-buffer-more-recently-used-p)) + ;; ---unless it's the only possibility: + (and cur-buf-matches cur-buf))) + ;; No dired-x, or dired-find-subdir nil. + (setq dirname (expand-file-name dirname)) + (let (found (blist dired-buffers)) ; was (buffer-list) + (or mode (setq mode 'dired-mode)) + (while blist + (if (null (buffer-name (cdr (car blist)))) + (setq blist (cdr blist)) + (with-current-buffer (cdr (car blist)) + (if (and (eq major-mode mode) + dired-directory ;; nil during find-alternate-file + (equal dirname + (expand-file-name + (if (consp dired-directory) + (car dired-directory) + dired-directory)))) + (setq found (cdr (car blist)) + blist nil) + (setq blist (cdr blist)))))) + found))) ;; Read in a new dired buffer @@ -1053,6 +1084,8 @@ BEG..END is the line where the file info is located." (set-marker file nil))))) +(defvar ls-lisp-use-insert-directory-program) + (defun dired-insert-directory (dir switches &optional file-list wildcard hdr) "Insert a directory listing of DIR, Dired style. Use SWITCHES to make the listings. @@ -1064,14 +1097,20 @@ If HDR is non-nil, insert a header line with the directory name." (let ((opoint (point)) (process-environment (copy-sequence process-environment)) end) - (if (or (if (eq dired-use-ls-dired 'unspecified) - ;; Check whether "ls --dired" gives exit code 0, and - ;; save the answer in `dired-use-ls-dired'. - (setq dired-use-ls-dired - (eq (call-process insert-directory-program nil nil nil "--dired") - 0)) - dired-use-ls-dired) - (file-remote-p dir)) + (if (and + ;; Don't try to invoke `ls' if we are on DOS/Windows where + ;; ls-lisp emulation is used, except if they want to use `ls' + ;; as indicated by `ls-lisp-use-insert-directory-program'. + (not (and (featurep 'ls-lisp) + (null ls-lisp-use-insert-directory-program))) + (or (if (eq dired-use-ls-dired 'unspecified) + ;; Check whether "ls --dired" gives exit code 0, and + ;; save the answer in `dired-use-ls-dired'. + (setq dired-use-ls-dired + (eq (call-process insert-directory-program nil nil nil "--dired") + 0)) + dired-use-ls-dired) + (file-remote-p dir))) (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, @@ -1142,11 +1181,14 @@ If HDR is non-nil, insert a header line with the directory name." ;; Reverting a dired buffer -(defun dired-revert (&optional arg noconfirm) +(defun dired-revert (&optional _arg _noconfirm) "Reread the dired buffer. Must also be called after `dired-actual-switches' have changed. Should not fail even on completely garbaged buffers. -Preserves old cursor, marks/flags, hidden-p." +Preserves old cursor, marks/flags, hidden-p. + +Dired sets `revert-buffer-function' to this function. The args +ARG and NOCONFIRM, passed from `revert-buffer', are ignored." (widen) ; just in case user narrowed (let ((modflag (buffer-modified-p)) (positions (dired-save-positions)) @@ -1292,7 +1334,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." ;; This looks ugly when substitute-command-keys uses C-d instead d: ;; (define-key dired-mode-map "\C-d" 'dired-flag-file-deletion) (let ((map (make-keymap))) - (suppress-keymap map) + (set-keymap-parent map special-mode-map) (define-key map [mouse-2] 'dired-mouse-find-file-other-window) (define-key map [follow-link] 'mouse-face) ;; Commands to mark or flag certain categories of files @@ -1371,7 +1413,6 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map "\C-m" 'dired-find-file) (put 'dired-find-file :advertised-binding "\C-m") (define-key map "g" 'revert-buffer) - (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) @@ -1381,7 +1422,6 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map "o" 'dired-find-file-other-window) (define-key map "\C-o" 'dired-display-file) (define-key map "p" 'dired-previous-line) - (define-key map "q" 'quit-window) (define-key map "s" 'dired-sort-toggle-or-edit) (define-key map "t" 'dired-toggle-marks) (define-key map "u" 'dired-unmark) @@ -1833,6 +1873,7 @@ Keybindings: (set (make-local-variable 'desktop-save-buffer) 'dired-desktop-buffer-misc-data) (setq dired-switches-alist nil) + (hack-dir-local-variables-non-file-buffer) ; before sorting (dired-sort-other dired-actual-switches t) (when (featurep 'dnd) (set (make-local-variable 'dnd-protocol-alist) @@ -2025,7 +2066,7 @@ Otherwise, an error occurs in these cases." ;; with quotation marks in their names. (while (string-match "\\(?:[^\\]\\|\\`\\)\\(\"\\)" file) (setq file (replace-match "\\\"" nil t file 1))) - + (when (eq system-type 'windows-nt) (save-match-data (let ((start 0)) @@ -2102,7 +2143,7 @@ Optional arg GLOBAL means to replace all matches." ;; dired-get-filename. (concat (or dir default-directory) file)) -(defun dired-make-relative (file &optional dir ignore) +(defun dired-make-relative (file &optional dir _ignore) "Convert FILE (an absolute file name) to a name relative to DIR. If this is impossible, return FILE unchanged. DIR must be a directory name, not a file name." @@ -2536,11 +2577,15 @@ instead of `dired-actual-switches'." ;; return value of point (i.e., FOUND): (goto-char found)))) +(defvar dired-find-subdir) + +;; FIXME document whatever dired-x is doing. (defun dired-initial-position (dirname) - ;; Where point should go in a new listing of DIRNAME. - ;; Point assumed at beginning of new subdir line. - ;; You may redefine this function as you wish, e.g. like in dired-x.el. + "Where point should go in a new listing of DIRNAME. +Point assumed at beginning of new subdir line." (end-of-line) + (and (featurep 'dired-x) dired-find-subdir + (dired-goto-subdir dirname)) (if dired-trivial-filenames (dired-goto-next-nontrivial-file))) ;; These are hooks which make tree dired work. @@ -2737,12 +2782,32 @@ non-empty directories is allowed." (save-excursion (forward-line 1) (point)))))) (dired-clean-up-after-deletion file)) -;; This is a separate function for the sake of dired-x.el. +(defvar dired-clean-up-buffers-too) + (defun dired-clean-up-after-deletion (fn) - ;; Clean up after a deleted file or directory FN. + "Clean up after a deleted file or directory FN. +Removes any expanded subdirectory of deleted directory. +If `dired-x' is loaded and `dired-clean-up-buffers-too' is non-nil, +also offers to kill buffers visiting deleted files and directories." (save-excursion (and (cdr dired-subdir-alist) (dired-goto-subdir fn) - (dired-kill-subdir)))) + (dired-kill-subdir))) + ;; Offer to kill buffer of deleted file FN. + (when (and (featurep 'dired-x) dired-clean-up-buffers-too) + (let ((buf (get-file-buffer fn))) + (and buf + (funcall #'y-or-n-p + (format "Kill buffer of %s, too? " + (file-name-nondirectory fn))) + (kill-buffer buf))) + (let ((buf-list (dired-buffers-for-dir (expand-file-name fn)))) + (and buf-list + (y-or-n-p (format "Kill dired buffer%s of %s, too? " + (dired-plural-s (length buf-list)) + (file-name-nondirectory fn))) + (dolist (buf buf-list) + (kill-buffer buf)))))) + ;; Confirmation @@ -3168,7 +3233,7 @@ Type \\[help-command] at that time for help." (interactive "cRemove marks (RET means all): \nP") (save-excursion (let* ((count 0) - (inhibit-read-only t) case-fold-search query + (inhibit-read-only t) case-fold-search (string (format "\n%c" mark)) (help-form "\ Type SPC or `y' to unmark one file, DEL or `n' to skip to next, @@ -3443,6 +3508,8 @@ Anything else means ask for each directory." (declare-function dnd-get-local-file-name "dnd" (uri &optional must-exist)) (declare-function dnd-get-local-file-uri "dnd" (uri)) +(defvar dired-overwrite-confirmed) ;Defined in dired-aux. + (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. @@ -3504,38 +3571,38 @@ Ask means pop up a menu for the user to select one of copy, move or link." (eval-when-compile (require 'desktop)) -(defun dired-desktop-buffer-misc-data (desktop-dirname) +(defun dired-desktop-buffer-misc-data (dirname) "Auxiliary information to be saved in desktop file." (cons ;; Value of `dired-directory'. (if (consp dired-directory) ;; Directory name followed by list of files. - (cons (desktop-file-name (car dired-directory) desktop-dirname) + (cons (desktop-file-name (car dired-directory) dirname) (cdr dired-directory)) ;; Directory name, optionally with shell wildcard. - (desktop-file-name dired-directory desktop-dirname)) + (desktop-file-name dired-directory dirname)) ;; Subdirectories in `dired-subdir-alist'. (cdr (nreverse (mapcar - (function (lambda (f) (desktop-file-name (car f) desktop-dirname))) + (function (lambda (f) (desktop-file-name (car f) dirname))) dired-subdir-alist))))) -(defun dired-restore-desktop-buffer (desktop-buffer-file-name - desktop-buffer-name - desktop-buffer-misc) +(defun dired-restore-desktop-buffer (_file-name + _buffer-name + misc-data) "Restore a dired buffer specified in a desktop file." - ;; First element of `desktop-buffer-misc' is the value of `dired-directory'. + ;; First element of `misc-data' is the value of `dired-directory'. ;; This value is a directory name, optionally with shell wildcard or ;; a directory name followed by list of files. - (let* ((dired-dir (car desktop-buffer-misc)) + (let* ((dired-dir (car misc-data)) (dir (if (consp dired-dir) (car dired-dir) dired-dir))) (if (file-directory-p (file-name-directory dir)) (progn (dired dired-dir) - ;; The following elements of `desktop-buffer-misc' are the keys + ;; The following elements of `misc-data' are the keys ;; from `dired-subdir-alist'. - (mapc 'dired-maybe-insert-subdir (cdr desktop-buffer-misc)) + (mapc 'dired-maybe-insert-subdir (cdr misc-data)) (current-buffer)) (message "Desktop: Directory %s no longer exists." dir) (when desktop-missing-file-warning (sit-for 1)) @@ -3562,7 +3629,7 @@ Ask means pop up a menu for the user to select one of copy, move or link." ;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command ;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown ;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff -;;;;;; dired-diff) "dired-aux" "dired-aux.el" "2e8658304f56098052e312d01c8763a2") +;;;;;; dired-diff) "dired-aux" "dired-aux.el" "7efcfe4f9e0913ae4a87be014010c27f") ;;; Generated autoloads from dired-aux.el (autoload 'dired-diff "dired-aux" "\ @@ -3699,7 +3766,7 @@ can be produced by `dired-get-marked-files', for example. \(fn COMMAND &optional ARG FILE-LIST)" t nil) (autoload 'dired-run-shell-command "dired-aux" "\ -Not documented + \(fn COMMAND)" nil nil) @@ -3718,17 +3785,23 @@ command with a prefix argument (the value does not matter). \(fn &optional ARG FMT)" t nil) (autoload 'dired-compress-file "dired-aux" "\ -Not documented + \(fn FILE)" nil nil) (autoload 'dired-query "dired-aux" "\ -Query user and return nil or t. -Store answer in symbol VAR (which must initially be bound to nil). -Format PROMPT with ARGS. -Binding variable `help-form' will help the user who types the help key. +Format PROMPT with ARGS, query user, and store the result in SYM. +The return value is either nil or t. + +The user may type y or SPC to accept once; n or DEL to skip once; +! to accept this and subsequent queries; or q or ESC to decline +this and subsequent queries. -\(fn QS-VAR QS-PROMPT &rest QS-ARGS)" nil nil) +If SYM is already bound to a non-nil value, this function may +return automatically without querying the user. If SYM is !, +return t; if SYM is q or ESC, return nil. + +\(fn SYM PROMPT &rest ARGS)" nil nil) (autoload 'dired-do-compress "dired-aux" "\ Compress or uncompress marked (or next ARG) files. @@ -3761,12 +3834,12 @@ See Info node `(emacs)Subdir switches' for more details. \(fn &optional ARG TEST-FOR-SUBDIR)" t nil) (autoload 'dired-add-file "dired-aux" "\ -Not documented + \(fn FILENAME &optional MARKER-CHAR)" nil nil) (autoload 'dired-remove-file "dired-aux" "\ -Not documented + \(fn FILE)" nil nil) @@ -3776,17 +3849,18 @@ Create or update the line for FILE in all Dired buffers it would belong in. \(fn FILE)" nil nil) (autoload 'dired-copy-file "dired-aux" "\ -Not documented + \(fn FROM TO OK-FLAG)" nil nil) (autoload 'dired-rename-file "dired-aux" "\ -Not documented + \(fn FILE NEWNAME OK-IF-ALREADY-EXISTS)" nil nil) (autoload 'dired-create-directory "dired-aux" "\ Create a directory called DIRECTORY. +If DIRECTORY already exists, signal an error. \(fn DIRECTORY)" t nil) @@ -4014,8 +4088,8 @@ true then the type of the file linked to by FILE is printed instead. ;;;*** -;;;### (autoloads (dired-do-relsymlink dired-jump) "dired-x" "dired-x.el" -;;;;;; "27c312d6d5d40d8cb4ef8d62e30d5f4a") +;;;### (autoloads (dired-do-relsymlink dired-jump-other-window dired-jump) +;;;;;; "dired-x" "dired-x.el" "cdeb2935dc1d33819b12981ba5272073") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\ @@ -4030,6 +4104,11 @@ move to its line in dired. \(fn &optional OTHER-WINDOW FILE-NAME)" t nil) +(autoload 'dired-jump-other-window "dired-x" "\ +Like \\[dired-jump] (`dired-jump') but in other window. + +\(fn &optional FILE-NAME)" t nil) + (autoload 'dired-do-relsymlink "dired-x" "\ Relative symlink all marked (or next ARG) files into a directory. Otherwise make a relative symbolic link to the current file.