diff options
Diffstat (limited to 'lisp/dired.el')
| -rw-r--r-- | lisp/dired.el | 414 |
1 files changed, 246 insertions, 168 deletions
diff --git a/lisp/dired.el b/lisp/dired.el index ede89189154..9813fca4359 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -35,6 +35,7 @@ ;;; Code: (eval-when-compile (require 'subr-x)) +(eval-when-compile (require 'cl-lib)) ;; When bootstrapping dired-loaddefs has not been generated. (require 'dired-loaddefs nil t) @@ -208,6 +209,18 @@ If a character, new links are unconditionally marked with that character." (character :tag "Mark")) :group 'dired-mark) +(defcustom dired-free-space 'first + "Whether and how to display the amount of free disk space in Dired buffers. +If nil, don't display. +If `separate', display on a separate line (along with used count). +If `first', display only the free disk space on the first line, +following the directory name." + :type '(choice (const :tag "On a separate line" separate) + (const :tag "On the first line, after directory name" first) + (const :tag "Don't display" nil)) + :version "29.1" + :group 'dired) + (defcustom dired-dwim-target nil "If non-nil, Dired tries to guess a default target directory. This means: if there is a Dired buffer displayed in some window, @@ -281,6 +294,11 @@ with the buffer narrowed to the listing." ;; Note this can't simply be run inside function `dired-ls' as the hook ;; functions probably depend on the dired-subdir-alist to be OK. +(defcustom dired-make-directory-clickable t + "When non-nil, make the directory at the start of the dired buffer clickable." + :version "29.1" + :type 'boolean) + (defcustom dired-initial-position-hook nil "This hook is used to position the point. It is run by the function `dired-initial-position'." @@ -339,11 +357,11 @@ When `file', the region marking is based on the file name. This means don't mark the file if the end of the region is before the file name displayed on the Dired line, so the file name is visually outside the region. This behavior is consistent with -marking files without the region using the key `m' that advances +marking files without the region using the key \\`m' that advances point to the next line after marking the file. Thus the number of keys used to mark files is the same as the number of keys -used to select the region, e.g. `M-2 m' marks 2 files, and -`C-SPC M-2 n m' marks 2 files, and `M-2 S-down m' marks 2 files. +used to select the region, for example \\`M-2 m' marks 2 files, and +\\`C-SPC M-2 n m' marks 2 files, and \\`M-2 S-<down> m' marks 2 files. When `line', the region marking is based on Dired lines, so include the file into marking if the end of the region @@ -1247,8 +1265,7 @@ The return value is the target column for the file names." ;; 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)))) + (buffers (nreverse (dired-buffers-for-dir dirname))) (cur-buf-matches (and (memq cur-buf buffers) ;; Wildcards must match, too: (equal dired-directory dirname)))) @@ -1326,6 +1343,8 @@ wildcards, erases the buffer, and builds the subdir-alist anew (set-visited-file-modtime (file-attribute-modification-time attributes)))) (set-buffer-modified-p nil) + (when dired-make-directory-clickable + (dired--make-directory-clickable)) ;; No need to narrow since the whole buffer contains just ;; dired-readin's output, nothing else. The hook can ;; successfully use dired functions (e.g. dired-get-filename) @@ -1606,15 +1625,55 @@ see `dired-use-ls-dired' for more details.") ;; by its expansion, so it does not matter whether what we insert ;; here is fully expanded, but it should be absolute. (insert " " (or (car-safe (insert-directory-wildcard-in-dir-p dir)) - (directory-file-name (file-name-directory dir))) ":\n") + (directory-file-name (file-name-directory dir))) + ":\n") (setq content-point (point))) (when wildcard ;; Insert "wildcard" line where "total" line would be for a full dir. (insert " wildcard " (or (cdr-safe (insert-directory-wildcard-in-dir-p dir)) (file-name-nondirectory dir)) - "\n"))) + "\n")) + (setq content-point (dired--insert-disk-space opoint dir))) (dired-insert-set-properties content-point (point))))) +(defun dired--insert-disk-space (beg file) + ;; Try to insert the amount of free space. + (save-excursion + (goto-char beg) + ;; First find the line to put it on. + (if (not (re-search-forward "^ *\\(total\\)" nil t)) + beg + (if (or (not dired-free-space) + (eq dired-free-space 'first)) + (delete-region (match-beginning 0) (line-beginning-position 2)) + ;; Replace "total" with "total used in directory" to + ;; avoid confusion. + (replace-match "total used in directory" nil nil nil 1)) + (if-let ((available (get-free-disk-space file))) + (cond + ((eq dired-free-space 'separate) + (end-of-line) + (insert " available " available) + (forward-line 1) + (point)) + ((eq dired-free-space 'first) + (goto-char beg) + (when (and (looking-at + (if (memq system-type '(windows-nt ms-dos)) + " *[A-Za-z]:/" + " */")) + (progn + (end-of-line) + (eq (char-after (1- (point))) ?:))) + (put-text-property (1- (point)) (point) + 'display + (concat ": (" available " available)"))) + (forward-line 1) + (point)) + (t + beg)) + beg)))) + (defun dired-insert-set-properties (beg end) "Add various text properties to the lines in the region, from BEG to END." (save-excursion @@ -1643,6 +1702,32 @@ see `dired-use-ls-dired' for more details.") 'invisible 'dired-hide-details-link)))) (forward-line 1)))) +(defun dired--make-directory-clickable () + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^ /" nil t 1) + (let ((bound (line-end-position)) + (segment-start (point)) + (inhibit-read-only t) + (dir "/")) + (while (search-forward "/" bound t 1) + (setq dir (concat dir (buffer-substring segment-start (point)))) + (add-text-properties + segment-start (1- (point)) + `( mouse-face highlight + help-echo "mouse-1: goto this directory" + keymap ,(let* ((current-dir dir) + (click (lambda () + (interactive) + (if (assoc current-dir dired-subdir-alist) + (dired-goto-subdir current-dir) + (dired current-dir))))) + (define-keymap + "<mouse-2>" click + "<follow-link>" 'mouse-face + "RET" click)))) + (setq segment-start (point))))))) + ;;; Reverting a dired buffer @@ -1835,160 +1920,152 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." ;;; Dired mode key bindings and menus -(defvar dired-mode-map +(defvar-keymap dired-mode-map + :doc "Local keymap for Dired mode buffers." + :full t + :parent special-mode-map ;; 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))) - (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 - (define-key map "#" 'dired-flag-auto-save-files) - (define-key map "." 'dired-clean-directory) - (define-key map "~" 'dired-flag-backup-files) - ;; Upper case keys (except !) for operating on the marked files - (define-key map "A" 'dired-do-find-regexp) - (define-key map "C" 'dired-do-copy) - (define-key map "B" 'dired-do-byte-compile) - (define-key map "D" 'dired-do-delete) - (define-key map "G" 'dired-do-chgrp) - (define-key map "H" 'dired-do-hardlink) - (define-key map "L" 'dired-do-load) - (define-key map "M" 'dired-do-chmod) - (define-key map "O" 'dired-do-chown) - (define-key map "P" 'dired-do-print) - (define-key map "Q" 'dired-do-find-regexp-and-replace) - (define-key map "R" 'dired-do-rename) - (define-key map "S" 'dired-do-symlink) - (define-key map "T" 'dired-do-touch) - (define-key map "X" 'dired-do-shell-command) - (define-key map "Z" 'dired-do-compress) - (define-key map "c" 'dired-do-compress-to) - (define-key map "!" 'dired-do-shell-command) - (define-key map "&" 'dired-do-async-shell-command) - ;; Comparison commands - (define-key map "=" 'dired-diff) - ;; Tree Dired commands - (define-key map "\M-\C-?" 'dired-unmark-all-files) - (define-key map "\M-\C-d" 'dired-tree-down) - (define-key map "\M-\C-u" 'dired-tree-up) - (define-key map "\M-\C-n" 'dired-next-subdir) - (define-key map "\M-\C-p" 'dired-prev-subdir) - ;; move to marked files - (define-key map "\M-{" 'dired-prev-marked-file) - (define-key map "\M-}" 'dired-next-marked-file) - ;; Make all regexp commands share a `%' prefix: - ;; We used to get to the submap via a symbol dired-regexp-prefix, - ;; but that seems to serve little purpose, and copy-keymap - ;; does a better job without it. - (define-key map "%" nil) - (define-key map "%u" 'dired-upcase) - (define-key map "%l" 'dired-downcase) - (define-key map "%d" 'dired-flag-files-regexp) - (define-key map "%g" 'dired-mark-files-containing-regexp) - (define-key map "%m" 'dired-mark-files-regexp) - (define-key map "%r" 'dired-do-rename-regexp) - (define-key map "%C" 'dired-do-copy-regexp) - (define-key map "%H" 'dired-do-hardlink-regexp) - (define-key map "%R" 'dired-do-rename-regexp) - (define-key map "%S" 'dired-do-symlink-regexp) - (define-key map "%&" 'dired-flag-garbage-files) - ;; Commands for marking and unmarking. - (define-key map "*" nil) - (define-key map "**" 'dired-mark-executables) - (define-key map "*/" 'dired-mark-directories) - (define-key map "*@" 'dired-mark-symlinks) - (define-key map "*%" 'dired-mark-files-regexp) - (define-key map "*N" 'dired-number-of-marked-files) - (define-key map "*c" 'dired-change-marks) - (define-key map "*s" 'dired-mark-subdir-files) - (define-key map "*m" 'dired-mark) - (define-key map "*u" 'dired-unmark) - (define-key map "*?" 'dired-unmark-all-files) - (define-key map "*!" 'dired-unmark-all-marks) - (define-key map "U" 'dired-unmark-all-marks) - (define-key map "*\177" 'dired-unmark-backward) - (define-key map "*\C-n" 'dired-next-marked-file) - (define-key map "*\C-p" 'dired-prev-marked-file) - (define-key map "*t" 'dired-toggle-marks) - ;; Lower keys for commands not operating on all the marked files - (define-key map "a" 'dired-find-alternate-file) - (define-key map "d" 'dired-flag-file-deletion) - (define-key map "e" 'dired-find-file) - (define-key map "f" 'dired-find-file) - (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 "i" 'dired-maybe-insert-subdir) - (define-key map "j" 'dired-goto-file) - (define-key map "k" 'dired-do-kill-lines) - (define-key map "l" 'dired-do-redisplay) - (define-key map "m" 'dired-mark) - (define-key map "n" 'dired-next-line) - (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 "s" 'dired-sort-toggle-or-edit) - (define-key map "t" 'dired-toggle-marks) - (define-key map "u" 'dired-unmark) - (define-key map "v" 'dired-view-file) - (define-key map "w" 'dired-copy-filename-as-kill) - (define-key map "W" 'browse-url-of-dired-file) - (define-key map "x" 'dired-do-flagged-delete) - (define-key map "y" 'dired-show-file-type) - (define-key map "+" 'dired-create-directory) - ;; moving - (define-key map "<" 'dired-prev-dirline) - (define-key map ">" 'dired-next-dirline) - (define-key map "^" 'dired-up-directory) - (define-key map " " 'dired-next-line) - (define-key map [?\S-\ ] '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) - (define-key map "(" 'dired-hide-details-mode) - ;; isearch - (define-key map (kbd "M-s a C-s") 'dired-do-isearch) - (define-key map (kbd "M-s a M-C-s") 'dired-do-isearch-regexp) - (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 [remap read-only-mode] 'dired-toggle-read-only) - ;; `toggle-read-only' is an obsolete alias for `read-only-mode' - (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) - (define-key map [remap advertised-undo] 'dired-undo) - (define-key map [remap vc-next-action] 'dired-vc-next-action) - ;; thumbnail manipulation (image-dired) - (define-key map "\C-td" 'image-dired-display-thumbs) - (define-key map "\C-tt" 'image-dired-tag-files) - (define-key map "\C-tr" 'image-dired-delete-tag) - (define-key map "\C-tj" 'image-dired-jump-thumbnail-buffer) - (define-key map "\C-ti" 'image-dired-dired-display-image) - (define-key map "\C-tx" 'image-dired-dired-display-external) - (define-key map "\C-ta" 'image-dired-display-thumbs-append) - (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-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) - (define-key map ":v" 'epa-dired-do-verify) - (define-key map ":s" 'epa-dired-do-sign) - (define-key map ":e" 'epa-dired-do-encrypt) - - ;; No need to do this, now that top-level items are fewer. - ;;;; - ;; Get rid of the Edit menu bar item to save space. - ;;(define-key map [menu-bar edit] 'undefined) - - map) - "Local keymap for Dired mode buffers.") + ;; "C-d" #'dired-flag-file-deletion + "<mouse-2>" #'dired-mouse-find-file-other-window + "<follow-link>" 'mouse-face + ;; Commands to mark or flag certain categories of files + "#" #'dired-flag-auto-save-files + "." #'dired-clean-directory + "~" #'dired-flag-backup-files + ;; Upper case keys (except !) for operating on the marked files + "A" #'dired-do-find-regexp + "C" #'dired-do-copy + "B" #'dired-do-byte-compile + "D" #'dired-do-delete + "G" #'dired-do-chgrp + "H" #'dired-do-hardlink + "L" #'dired-do-load + "M" #'dired-do-chmod + "O" #'dired-do-chown + "P" #'dired-do-print + "Q" #'dired-do-find-regexp-and-replace + "R" #'dired-do-rename + "S" #'dired-do-symlink + "T" #'dired-do-touch + "X" #'dired-do-shell-command + "Z" #'dired-do-compress + "c" #'dired-do-compress-to + "!" #'dired-do-shell-command + "&" #'dired-do-async-shell-command + ;; Comparison commands + "=" #'dired-diff + ;; Tree Dired commands + "M-DEL" #'dired-unmark-all-files + "C-M-d" #'dired-tree-down + "C-M-u" #'dired-tree-up + "C-M-n" #'dired-next-subdir + "C-M-p" #'dired-prev-subdir + ;; move to marked files + "M-{" #'dired-prev-marked-file + "M-}" #'dired-next-marked-file + ;; Make all regexp commands share a `%' prefix: + ;; We used to get to the submap via a symbol dired-regexp-prefix, + ;; but that seems to serve little purpose, and copy-keymap + ;; does a better job without it. + "% u" #'dired-upcase + "% l" #'dired-downcase + "% d" #'dired-flag-files-regexp + "% g" #'dired-mark-files-containing-regexp + "% m" #'dired-mark-files-regexp + "% r" #'dired-do-rename-regexp + "% C" #'dired-do-copy-regexp + "% H" #'dired-do-hardlink-regexp + "% R" #'dired-do-rename-regexp + "% S" #'dired-do-symlink-regexp + "% &" #'dired-flag-garbage-files + ;; Commands for marking and unmarking. + "* *" #'dired-mark-executables + "* /" #'dired-mark-directories + "* @" #'dired-mark-symlinks + "* %" #'dired-mark-files-regexp + "* N" #'dired-number-of-marked-files + "* c" #'dired-change-marks + "* s" #'dired-mark-subdir-files + "* m" #'dired-mark + "* u" #'dired-unmark + "* ?" #'dired-unmark-all-files + "* !" #'dired-unmark-all-marks + "U" #'dired-unmark-all-marks + "* DEL" #'dired-unmark-backward + "* C-n" #'dired-next-marked-file + "* C-p" #'dired-prev-marked-file + "* t" #'dired-toggle-marks + ;; Lower keys for commands not operating on all the marked files + "a" #'dired-find-alternate-file + "d" #'dired-flag-file-deletion + "e" #'dired-find-file + "f" #'dired-find-file + "C-m" #'dired-find-file + "g" #'revert-buffer + "i" #'dired-maybe-insert-subdir + "j" #'dired-goto-file + "k" #'dired-do-kill-lines + "l" #'dired-do-redisplay + "m" #'dired-mark + "n" #'dired-next-line + "o" #'dired-find-file-other-window + "C-o" #'dired-display-file + "p" #'dired-previous-line + "s" #'dired-sort-toggle-or-edit + "t" #'dired-toggle-marks + "u" #'dired-unmark + "v" #'dired-view-file + "w" #'dired-copy-filename-as-kill + "W" #'browse-url-of-dired-file + "x" #'dired-do-flagged-delete + "y" #'dired-show-file-type + "+" #'dired-create-directory + ;; moving + "<" #'dired-prev-dirline + ">" #'dired-next-dirline + "^" #'dired-up-directory + "SPC" #'dired-next-line + "S-SPC" #'dired-previous-line + "<remap> <next-line>" #'dired-next-line + "<remap> <previous-line>" #'dired-previous-line + ;; hiding + "$" #'dired-hide-subdir + "M-$" #'dired-hide-all + "(" #'dired-hide-details-mode + ;; isearch + "M-s a C-s" #'dired-do-isearch + "M-s a C-M-s" #'dired-do-isearch-regexp + "M-s f C-s" #'dired-isearch-filenames + "M-s f C-M-s" #'dired-isearch-filenames-regexp + ;; misc + "<remap> <read-only-mode>" #'dired-toggle-read-only + ;; `toggle-read-only' is an obsolete alias for `read-only-mode' + "<remap> <toggle-read-only>" #'dired-toggle-read-only + "?" #'dired-summary + "DEL" #'dired-unmark-backward + "<remap> <undo>" #'dired-undo + "<remap> <advertised-undo>" #'dired-undo + "<remap> <vc-next-action>" #'dired-vc-next-action + ;; thumbnail manipulation (image-dired) + "C-t d" #'image-dired-display-thumbs + "C-t t" #'image-dired-tag-files + "C-t r" #'image-dired-delete-tag + "C-t j" #'image-dired-jump-thumbnail-buffer + "C-t i" #'image-dired-dired-display-image + "C-t x" #'image-dired-dired-display-external + "C-t a" #'image-dired-display-thumbs-append + "C-t ." #'image-dired-display-thumb + "C-t c" #'image-dired-dired-comment-files + "C-t f" #'image-dired-mark-tagged-files + "C-t C-t" #'image-dired-dired-toggle-marked-thumbs + "C-t e" #'image-dired-dired-edit-comment-and-tags + ;; encryption and decryption (epa-dired) + ": d" #'epa-dired-do-decrypt + ": v" #'epa-dired-do-verify + ": s" #'epa-dired-do-sign + ": e" #'epa-dired-do-encrypt) + +(put 'dired-find-file :advertised-binding (kbd "RET")) (easy-menu-define dired-mode-subdir-menu dired-mode-map "Subdir menu for Dired mode." @@ -2415,7 +2492,9 @@ directory in another window." file-name (if (file-symlink-p file-name) (error "File is a symlink to a nonexistent target") - (error "File no longer exists; type `g' to update Dired buffer"))))) + (error (substitute-command-keys + (concat "File no longer exists; type \\<dired-mode-map>" + "\\[revert-buffer] to update Dired buffer"))))))) ;; Force C-m keybinding rather than `f' or `e' in the mode doc: (define-obsolete-function-alias 'dired-advertised-find-file @@ -2879,7 +2958,7 @@ directories below DIR. 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)) + (setq dir (file-name-as-directory (expand-file-name dir))) (let (result buf) (dolist (elt dired-buffers) (setq buf (cdr elt)) @@ -3430,7 +3509,7 @@ If the buffer has a wildcard pattern, check that it matches FILE. FILE may be nil, in which case ignore it. Return list of buffers where FUN succeeded (i.e., returned non-nil)." (let (success-list) - (dolist (buf (dired-buffers-for-dir (expand-file-name directory) file)) + (dolist (buf (dired-buffers-for-dir directory file)) (with-current-buffer buf (when (apply fun args) (push (buffer-name buf) success-list)))) @@ -3479,8 +3558,7 @@ confirmation. To disable the confirmation, see (file-name-nondirectory fn)))) (not dired-clean-confirm-killing-deleted-buffers)) (kill-buffer buf))) - (let ((buf-list (dired-buffers-for-dir (expand-file-name fn) - nil 'subdirs))) + (let ((buf-list (dired-buffers-for-dir fn nil 'subdirs))) (and buf-list (or (and dired-clean-confirm-killing-deleted-buffers (y-or-n-p @@ -4066,9 +4144,9 @@ Type \\[help-command] at that time for help." (inhibit-read-only t) case-fold-search dired-unmark-all-files-query (string (format "\n%c" mark)) - (help-form "\ -Type SPC or `y' to unmark one file, DEL or `n' to skip to next, -`!' to unmark all remaining files with no more questions.")) + (help-form (substitute-command-keys "\ +Type \\`SPC' or \\`y' to unmark one file, \\`DEL' or \\`n' to skip to next, +\\`!' to unmark all remaining files with no more questions."))) (goto-char (point-min)) (while (if (eq mark ?\r) (re-search-forward dired-re-mark nil t) |