X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/53ad04fc4628d0c75ff3054bd3b77c8689fca6d4..c80c6166fbc20ffde6a2b407507226cac37cd9c4:/lisp/dired.el diff --git a/lisp/dired.el b/lisp/dired.el index bb0cc22328..bd3fb531d7 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. @@ -72,7 +73,7 @@ If nil, `dired-listing-switches' is used.") ;;;###autoload (defvar dired-chown-program (purecopy - (if (memq system-type '(hpux usg-unix-v irix linux gnu/linux cygwin)) + (if (memq system-type '(hpux usg-unix-v irix gnu/linux cygwin)) "chown" (if (file-exists-p "/usr/sbin/chown") "/usr/sbin/chown" @@ -1380,10 +1381,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 +1392,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 +1408,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) @@ -2139,7 +2138,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 @@ -2581,7 +2580,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. @@ -2592,15 +2591,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. @@ -2618,7 +2621,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)"))))) @@ -2633,11 +2636,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. @@ -2646,14 +2649,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 @@ -2661,10 +2671,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)) @@ -2673,7 +2683,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 @@ -2756,17 +2766,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. @@ -3237,12 +3249,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 @@ -3268,8 +3284,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")) @@ -3280,24 +3296,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)) @@ -3523,7 +3539,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" "1628b7a7d379fb4da8ae4bf29faad4b5") ;;; Generated autoloads from dired-aux.el (autoload 'dired-diff "dired-aux" "\ @@ -3976,7 +3992,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" -;;;;;; "bb37ec379c0a523368794491b691fd8d") +;;;;;; "27c312d6d5d40d8cb4ef8d62e30d5f4a") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\ @@ -3985,8 +4001,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. @@ -4011,5 +4030,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