X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/004f9b3f1bf1fdf09c457cd30ea5e377d653a470..9efd720d16c6a8adba600cfb303b4bd75d7c6cdf:/lisp/dired.el diff --git a/lisp/dired.el b/lisp/dired.el index 0dc53bf32c..cec4ffa2f1 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -7,6 +7,7 @@ ;; Author: Sebastian Kremer ;; Maintainer: FSF ;; Keywords: files +;; Package: emacs ;; This file is part of GNU Emacs. @@ -25,8 +26,8 @@ ;;; Commentary: -;; This is a major mode for directory browsing and editing. It is -;; documented in the Emacs manual. +;; This is a major mode for directory browsing and editing. +;; It is documented in the Emacs manual. ;; Rewritten in 1990/1991 to add tree features, file marking and ;; sorting by Sebastian Kremer . @@ -61,32 +62,41 @@ some of the `ls' switches are not supported; see the doc string of :type 'string :group 'dired) -(defvar dired-subdir-switches nil +(defcustom dired-subdir-switches nil "If non-nil, switches passed to `ls' for inserting subdirectories. -If nil, `dired-listing-switches' is used.") - -; Don't use absolute file names as /bin should be in any PATH and people -; may prefer /usr/local/gnu/bin or whatever. However, chown is -; usually not in PATH. - -;;;###autoload -(defvar dired-chown-program - (purecopy - (if (memq system-type '(hpux usg-unix-v irix linux gnu/linux cygwin)) - "chown" - (if (file-exists-p "/usr/sbin/chown") - "/usr/sbin/chown" - "/etc/chown"))) - "Name of chown command (usually `chown' or `/etc/chown').") +If nil, `dired-listing-switches' is used." + :group 'dired + :type '(choice (const :tag "Use dired-listing-switches" nil) + (string :tag "Switches"))) + +(defcustom dired-chown-program + (purecopy (cond ((executable-find "chown") "chown") + ((file-executable-p "/usr/sbin/chown") "/usr/sbin/chown") + ((file-executable-p "/etc/chown") "/etc/chown") + (t "chown"))) + "Name of chown command (usually `chown')." + :group 'dired + :type 'file) -(defvar dired-use-ls-dired (not (not (string-match "gnu" system-configuration))) - "Non-nil means Dired should use `ls --dired'.") +(defcustom dired-use-ls-dired 'unspecified + "Non-nil means Dired should use \"ls --dired\". +The special value of `unspecified' means to check explicitly, and +save the result in this variable. This is performed the first +time `dired-insert-directory' is called." + :group 'dired + :type '(choice (const :tag "Check for --dired support" unspecified) + (const :tag "Do not use --dired" nil) + (other :tag "Use --dired" t))) -(defvar dired-chmod-program "chmod" - "Name of chmod command (usually `chmod').") +(defcustom dired-chmod-program "chmod" + "Name of chmod command (usually `chmod')." + :group 'dired + :type 'file) -(defvar dired-touch-program "touch" - "Name of touch command (usually `touch').") +(defcustom dired-touch-program "touch" + "Name of touch command (usually `touch')." + :group 'dired + :type 'file) (defcustom dired-ls-F-marks-symlinks nil "Informs Dired about how `ls -lF' marks symbolic links. @@ -104,7 +114,6 @@ always set this variable to t." :type 'boolean :group 'dired-mark) -;;;###autoload (defcustom dired-trivial-filenames (purecopy "^\\.\\.?$\\|^#") "Regexp of files to skip when finding first file of a directory. A value of nil means move to the subdir line. @@ -752,7 +761,6 @@ for a remote directory. This feature is used by Auto Revert Mode." buffer-read-only (dired-directory-changed-p dirname)))) -;;;###autoload (defcustom dired-auto-revert-buffer nil "Automatically revert dired buffer on revisiting. If t, revisiting an existing dired buffer automatically reverts it. @@ -1056,7 +1064,14 @@ 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 dired-use-ls-dired (file-remote-p dir)) + (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)) (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, @@ -1177,7 +1192,7 @@ Preserves old cursor, marks/flags, hidden-p." The positions have the form (BUFFER-POSITION WINDOW-POSITIONS). BUFFER-POSITION is the point position in the current dired buffer. -The buffer position have the form (BUFFER DIRED-FILENAME BUFFER-POINT). +It has the form (BUFFER DIRED-FILENAME BUFFER-POINT). WINDOW-POSITIONS are current positions in all windows displaying this dired buffer. The window positions have the form (WINDOW @@ -1380,10 +1395,8 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map ">" 'dired-next-dirline) (define-key map "^" 'dired-up-directory) (define-key map " " 'dired-next-line) - (define-key map "\C-n" 'dired-next-line) - (define-key map "\C-p" 'dired-previous-line) - (define-key map [down] 'dired-next-line) - (define-key map [up] 'dired-previous-line) + (define-key map [remap next-line] 'dired-next-line) + (define-key map [remap previous-line] 'dired-previous-line) ;; hiding (define-key map "$" 'dired-hide-subdir) (define-key map "\M-$" 'dired-hide-all) @@ -1393,7 +1406,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (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 [remap toggle-read-only] 'dired-toggle-read-only) (define-key map "?" 'dired-summary) (define-key map "\177" 'dired-unmark-backward) (define-key map [remap undo] 'dired-undo) @@ -1409,7 +1422,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (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-t\C-t" 'image-dired-dired-toggle-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) @@ -2012,6 +2025,14 @@ 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)) + (while (string-match "\\\\" file start) + (aset file (match-beginning 0) ?/) + (setq start (match-end 0)))))) + (setq file (read (concat "\"" file "\""))) ;; The above `read' will return a unibyte string if FILE ;; contains eight-bit-control/graphic characters. @@ -2139,7 +2160,7 @@ Return the position of the beginning of the filename, or nil if none found." ;; case-fold-search is nil now, so we can test for capital F: (setq used-F (string-match "F" dired-actual-switches) opoint (point) - eol (save-excursion (end-of-line) (point)) + eol (line-end-position) hidden (and selective-display (save-excursion (search-forward "\r" eol t)))) (if hidden @@ -2227,31 +2248,33 @@ You can then feed the file name(s) to other commands with \\[yank]." ;; Keeping Dired buffers in sync with the filesystem and with each other (defun dired-buffers-for-dir (dir &optional file) -;; Return a list of buffers that dired DIR (top level or in-situ subdir). +;; Return a list of buffers for DIR (top level or in-situ subdir). ;; If FILE is non-nil, include only those whose wildcard pattern (if any) ;; matches FILE. ;; The list is in reverse order of buffer creation, most recent last. ;; As a side effect, killed dired buffers for DIR are removed from ;; dired-buffers. (setq dir (file-name-as-directory dir)) - (let ((alist dired-buffers) result elt buf) - (while alist - (setq elt (car alist) - buf (cdr elt)) - (if (buffer-name buf) - (if (dired-in-this-tree dir (car elt)) - (with-current-buffer buf - (and (assoc dir dired-subdir-alist) - (or (null file) - (let ((wildcards - (file-name-nondirectory dired-directory))) - (or (= 0 (length wildcards)) - (string-match (dired-glob-regexp wildcards) - file)))) - (setq result (cons buf result))))) - ;; else buffer is killed - clean up: + (let (result buf) + (dolist (elt dired-buffers) + (setq buf (cdr elt)) + (cond + ((null (buffer-name buf)) + ;; Buffer is killed - clean up: (setq dired-buffers (delq elt dired-buffers))) - (setq alist (cdr alist))) + ((dired-in-this-tree dir (car elt)) + (with-current-buffer buf + (and (assoc dir dired-subdir-alist) + (or (null file) + (if (stringp dired-directory) + (let ((wildcards (file-name-nondirectory + dired-directory))) + (or (= 0 (length wildcards)) + (string-match (dired-glob-regexp wildcards) + file))) + (member (expand-file-name file dir) + (cdr dired-directory)))) + (setq result (cons buf result))))))) result)) (defun dired-glob-regexp (pattern) @@ -2579,7 +2602,7 @@ Anything else means ask for each directory." ;; Delete file, possibly delete a directory and all its files. ;; This function is usefull outside of dired. One could change it's name ;; to e.g. recursive-delete-file and put it somewhere else. -(defun dired-delete-file (file &optional recursive) "\ +(defun dired-delete-file (file &optional recursive trash) "\ Delete FILE or directory (possibly recursively if optional RECURSIVE is true.) RECURSIVE determines what to do with a non-empty directory. If RECURSIVE is: nil, do not delete. @@ -2590,15 +2613,19 @@ Anything else, ask for each sub-directory." ;; (and (file-directory-p fn) (not (file-symlink-p fn))) ;; but more efficient (if (not (eq t (car (file-attributes file)))) - (delete-file file) + (delete-file file trash) (if (and recursive (directory-files file t dired-re-no-dot) ; Not empty. (or (eq recursive 'always) - (yes-or-no-p (format "Recursive delete of %s? " + (yes-or-no-p (format "Recursively %s %s? " + (if (and trash + delete-by-moving-to-trash) + "trash" + "delete") (dired-make-relative file))))) (if (eq recursive 'top) (setq recursive 'always)) ; Don't ask again. (setq recursive nil)) - (delete-directory file recursive))) + (delete-directory file recursive trash))) (defun dired-do-flagged-delete (&optional nomessage) "In Dired, delete the files flagged for deletion. @@ -2616,7 +2643,7 @@ non-empty directories is allowed." ;; this can't move point since ARG is nil (dired-map-over-marks (cons (dired-get-filename) (point)) nil) - nil) + nil t) (or nomessage (message "(No deletions requested)"))))) @@ -2631,11 +2658,11 @@ non-empty directories is allowed." ;; this may move point if ARG is an integer (dired-map-over-marks (cons (dired-get-filename) (point)) arg) - arg)) + arg t)) (defvar dired-deletion-confirmer 'yes-or-no-p) ; or y-or-n-p? -(defun dired-internal-do-deletions (l arg) +(defun dired-internal-do-deletions (l arg &optional trash) ;; L is an alist of files to delete, with their buffer positions. ;; ARG is the prefix arg. ;; Filenames are absolute. @@ -2644,14 +2671,21 @@ non-empty directories is allowed." ;; lines still to be changed, so the (point) values in L stay valid. ;; Also, for subdirs in natural order, a subdir's files are deleted ;; before the subdir itself - the other way around would not work. - (let ((files (mapcar (function car) l)) - (count (length l)) - (succ 0)) + (let* ((files (mapcar (function car) l)) + (count (length l)) + (succ 0) + (trashing (and trash delete-by-moving-to-trash)) + (progress-reporter + (make-progress-reporter + (if trashing "Trashing..." "Deleting...") + succ count))) ;; canonicalize file list for pop up (setq files (nreverse (mapcar (function dired-make-relative) files))) (if (dired-mark-pop-up " *Deletions*" 'delete files dired-deletion-confirmer - (format "Delete %s " (dired-mark-prompt arg files))) + (format "%s %s " + (if trashing "Trash" "Delete") + (dired-mark-prompt arg files))) (save-excursion (let (failures);; files better be in reverse order for this loop! (while l @@ -2659,10 +2693,10 @@ non-empty directories is allowed." (let ((inhibit-read-only t)) (condition-case err (let ((fn (car (car l)))) - (dired-delete-file fn dired-recursive-deletes) + (dired-delete-file fn dired-recursive-deletes trash) ;; if we get here, removing worked (setq succ (1+ succ)) - (message "%s of %s deletions" succ count) + (progress-reporter-update progress-reporter succ) (dired-fun-in-all-buffers (file-name-directory fn) (file-name-nondirectory fn) (function dired-delete-entry) fn)) @@ -2671,7 +2705,7 @@ non-empty directories is allowed." (setq failures (cons (car (car l)) failures))))) (setq l (cdr l))) (if (not failures) - (message "%d deletion%s done" count (dired-plural-s count)) + (progress-reporter-done progress-reporter) (dired-log-summary (format "%d of %d deletion%s failed" (length failures) count @@ -2745,7 +2779,8 @@ name, or the marker and a count of marked files." ;; that's possible. (Bug#1806) (split-window-vertically)) ;; Otherwise, try to split WINDOW sensibly. - (split-window-sensibly window))))) + (split-window-sensibly window)))) + pop-up-frames) (pop-to-buffer (get-buffer-create buf))) ;; If dired-shrink-to-fit is t, make its window fit its contents. (when dired-shrink-to-fit @@ -2754,17 +2789,19 @@ name, or the marker and a count of marked files." (fit-window-to-buffer (get-buffer-window buf) nil 1))) (defcustom dired-no-confirm nil - "A list of symbols for commands Dired should not confirm. + "A list of symbols for commands Dired should not confirm, or t. Command symbols are `byte-compile', `chgrp', `chmod', `chown', `compress', `copy', `delete', `hardlink', `load', `move', `print', `shell', `symlink', -`touch' and `uncompress'." +`touch' and `uncompress'. +If t, confirmation is never needed." :group 'dired - :type '(set (const byte-compile) (const chgrp) - (const chmod) (const chown) (const compress) - (const copy) (const delete) (const hardlink) - (const load) (const move) (const print) - (const shell) (const symlink) (const touch) - (const uncompress))) + :type '(choice (const :tag "Confirmation never needed" t) + (set (const byte-compile) (const chgrp) + (const chmod) (const chown) (const compress) + (const copy) (const delete) (const hardlink) + (const load) (const move) (const print) + (const shell) (const symlink) (const touch) + (const uncompress)))) (defun dired-mark-pop-up (bufname op-symbol files function &rest args) "Return FUNCTION's result on ARGS after showing which files are marked. @@ -3235,12 +3272,16 @@ variable `dired-listing-switches'. To temporarily override the listing format, use `\\[universal-argument] \\[dired]'.") (defvar dired-sort-by-date-regexp - (concat "^-[^" dired-ls-sorting-switches - "]*t[^" dired-ls-sorting-switches "]*$") + (concat "\\(\\`\\| \\)-[^- ]*t" + ;; `dired-ls-sorting-switches' after -t overrides -t. + "[^ " dired-ls-sorting-switches "]*" + "\\(\\(\\`\\| +\\)\\(--[^ ]+\\|-[^- t" + dired-ls-sorting-switches "]+\\)\\)* *$") "Regexp recognized by Dired to set `by date' mode.") (defvar dired-sort-by-name-regexp - (concat "^-[^t" dired-ls-sorting-switches "]+$") + (concat "\\`\\(\\(\\`\\| +\\)\\(--[^ ]+\\|" + "-[^- t" dired-ls-sorting-switches "]+\\)\\)* *$") "Regexp recognized by Dired to set `by name' mode.") (defvar dired-sort-inhibit nil @@ -3266,8 +3307,8 @@ The idea is to set this buffer-locally in special dired buffers.") (force-mode-line-update))) (defun dired-sort-toggle-or-edit (&optional arg) - "Toggle between sort by date/name and refresh the dired buffer. -With a prefix argument you can edit the current listing switches instead." + "Toggle sorting by date, and refresh the Dired buffer. +With a prefix argument, edit the current listing switches instead." (interactive "P") (when dired-sort-inhibit (error "Cannot sort this dired buffer")) @@ -3278,24 +3319,24 @@ With a prefix argument you can edit the current listing switches instead." (defun dired-sort-toggle () ;; Toggle between sort by date/name. Reverts the buffer. - (setq dired-actual-switches - (let (case-fold-search) - (if (string-match " " dired-actual-switches) - ;; New toggle scheme: add/remove a trailing " -t" - (if (string-match " -t\\'" dired-actual-switches) - (substring dired-actual-switches 0 (match-beginning 0)) - (concat dired-actual-switches " -t")) - ;; old toggle scheme: look for some 't' switch and add/remove it - (concat - "-l" - (dired-replace-in-string (concat "[-lt" - dired-ls-sorting-switches "]") - "" - dired-actual-switches) - (if (string-match (concat "[t" dired-ls-sorting-switches "]") - dired-actual-switches) - "" - "t"))))) + (let ((sorting-by-date (string-match dired-sort-by-date-regexp + dired-actual-switches)) + ;; Regexp for finding (possibly embedded) -t switches. + (switch-regexp "\\(\\`\\| \\)-\\([a-su-zA-Z]*\\)\\(t\\)\\([^ ]*\\)") + case-fold-search) + ;; Remove the -t switch. + (while (string-match switch-regexp dired-actual-switches) + (if (and (equal (match-string 2 dired-actual-switches) "") + (equal (match-string 4 dired-actual-switches) "")) + ;; Remove a stand-alone -t switch. + (setq dired-actual-switches + (replace-match "" t t dired-actual-switches)) + ;; Remove a switch of the form -XtY for some X and Y. + (setq dired-actual-switches + (replace-match "" t t dired-actual-switches 3)))) + ;; Now, if we weren't sorting by date before, add the -t switch. + (unless sorting-by-date + (setq dired-actual-switches (concat dired-actual-switches " -t")))) (dired-sort-set-modeline) (revert-buffer)) @@ -3521,7 +3562,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" "07676ea25af17f5d50cc5db4f53bddc0") +;;;;;; dired-diff) "dired-aux" "dired-aux.el" "2e8658304f56098052e312d01c8763a2") ;;; Generated autoloads from dired-aux.el (autoload 'dired-diff "dired-aux" "\ @@ -3974,7 +4015,7 @@ 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" -;;;;;; "2f8d3d5a31b969b181e23c40d6bb16a0") +;;;;;; "27c312d6d5d40d8cb4ef8d62e30d5f4a") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\ @@ -3983,8 +4024,11 @@ If in a file, dired the current directory and move to file's line. If in Dired already, pop up a level and goto old directory's line. In case the proper dired file line cannot be found, refresh the dired buffer and try again. +When OTHER-WINDOW is non-nil, jump to dired buffer in other window. +Interactively with prefix argument, read FILE-NAME and +move to its line in dired. -\(fn &optional OTHER-WINDOW)" t nil) +\(fn &optional OTHER-WINDOW FILE-NAME)" t nil) (autoload 'dired-do-relsymlink "dired-x" "\ Relative symlink all marked (or next ARG) files into a directory. @@ -4009,5 +4053,4 @@ For absolute symlinks, use \\[dired-do-symlink]. (run-hooks 'dired-load-hook) ; for your customizations -;; arch-tag: e1af7a8f-691c-41a0-aac1-ddd4d3c87517 ;;; dired.el ends here