[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 1914d94 2/2: Change how Dired displays available space
|
From: |
Lars Ingebrigtsen |
|
Subject: |
master 1914d94 2/2: Change how Dired displays available space |
|
Date: |
Wed, 1 Dec 2021 17:27:26 -0500 (EST) |
branch: master
commit 1914d946d62de4ab7bab1434bcea09087d61bb5a
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Change how Dired displays available space
* doc/emacs/dired.texi (Misc Dired Features): Document it (bug#23812).
* lisp/dired.el (dired-free-space): New user option.
(dired-insert-directory): Use it from here.
(dired--insert-disk-space): New function that uses the user option.
* lisp/files.el (insert-directory): Don't transform "total" here.
* lisp/ls-lisp.el (ls-lisp--insert-directory): Or here. Instead
just leave the "total <num>" bit alone, and let Dired transform it.
* test/lisp/files-tests.el (files-tests): Move "available" tests
to dired-tests.
* test/lisp/dired-tests.el (data-dir): Moved here.
---
doc/emacs/dired.texi | 8 +++
etc/NEWS | 7 ++
lisp/dired.el | 51 ++++++++++++++-
lisp/files.el | 16 +----
lisp/ls-lisp.el | 13 +---
.../insert-directory/test_dir/bar | 0
.../insert-directory/test_dir/foo | 0
.../insert-directory/test_dir_other/bar | 0
.../insert-directory/test_dir_other/foo | 0
test/lisp/dired-tests.el | 74 ++++++++++++++++++++++
test/lisp/files-tests.el | 74 ----------------------
11 files changed, 140 insertions(+), 103 deletions(-)
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index 704850e..0edd8bc 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -1567,6 +1567,14 @@ rotation is lossless, and uses an external utility called
@node Misc Dired Features
@section Other Dired Features
+@vindex dired-free-space
+ By default, Dired will display the available space on the disk in
+the first line. This is the @code{first} value of the
+@code{dired-free-space} variable. If you set this to
+@code{separate} instead, Dired will display this on a separate line
+(including the space the files in the current directory takes). If
+you set this to @code{nil}, the free space isn't displayed at all.
+
@kindex + @r{(Dired)}
@findex dired-create-directory
The command @kbd{+} (@code{dired-create-directory}) reads a
diff --git a/etc/NEWS b/etc/NEWS
index 7a94052..f1f1512 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -589,6 +589,13 @@ updating the thumbnail file.
** Dired
+*** New user option 'dired-free-space'.
+Dired will now, by default, include the free space in the first line
+instead of having it on a separate line. To get the previous
+behaviour back, say:
+
+ (setq dired-free-space 'separate)
+
---
*** New user option 'dired-make-directory-clickable'.
If non-nil (which is the default), hitting 'RET' or 'mouse-1' on
diff --git a/lisp/dired.el b/lisp/dired.el
index 9280c08..c8add87 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -209,6 +209,17 @@ If a character, new links are unconditionally marked with
that character."
(character :tag "Mark"))
:group 'dired-mark)
+(defcustom dired-free-space 'first
+ "Whether to display 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 the free disk space on the first line."
+ :type '(choice (const :tag "On a separate line" separate)
+ (const :tag "On the first line" 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,
@@ -1614,15 +1625,51 @@ 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))
+ (when-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 " */")
+ (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))))))
+
(defun dired-insert-set-properties (beg end)
"Add various text properties to the lines in the region, from BEG to END."
(save-excursion
diff --git a/lisp/files.el b/lisp/files.el
index c96e79c..07279c4 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -7673,21 +7673,7 @@ normally equivalent short `-D' option is just passed on
to
(if val coding-no-eol coding))
(if val
(put-text-property pos (point)
- 'dired-filename t)))))))
-
- (if full-directory-p
- ;; Try to insert the amount of free space.
- (save-excursion
- (goto-char beg)
- ;; First find the line to put it on.
- (when (re-search-forward "^ *\\(total\\)" nil t)
- ;; Replace "total" with "total used in directory" to
- ;; avoid confusion.
- (replace-match "total used in directory" nil nil nil 1)
- (let ((available (get-free-disk-space file)))
- (when available
- (end-of-line)
- (insert " available " available))))))))))
+ 'dired-filename t)))))))))))
(defun insert-directory-adj-pos (pos error-lines)
"Convert `ls --dired' file name position value POS to a buffer position.
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index eea8089..25d1963 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -337,18 +337,7 @@ are also supported; unsupported long options are silently
ignored."
(ls-lisp-insert-directory
file switches (ls-lisp-time-index switches)
nil full-directory-p))
- (signal (car err) (cdr err)))))
- ;; Try to insert the amount of free space.
- (save-excursion
- (goto-char (point-min))
- ;; First find the line to put it on.
- (when (re-search-forward "^total" nil t)
- (let ((available (get-free-disk-space orig-file)))
- (when available
- ;; Replace "total" with "total used", to avoid confusion.
- (replace-match "total used in directory")
- (end-of-line)
- (insert " available " available)))))))))
+ (signal (car err) (cdr err)))))))))
(advice-add 'insert-directory :around #'ls-lisp--insert-directory)
(defun ls-lisp-insert-directory
diff --git a/test/lisp/files-resources/insert-directory/test_dir/bar
b/test/lisp/dired-resources/insert-directory/test_dir/bar
similarity index 100%
rename from test/lisp/files-resources/insert-directory/test_dir/bar
rename to test/lisp/dired-resources/insert-directory/test_dir/bar
diff --git a/test/lisp/files-resources/insert-directory/test_dir/foo
b/test/lisp/dired-resources/insert-directory/test_dir/foo
similarity index 100%
rename from test/lisp/files-resources/insert-directory/test_dir/foo
rename to test/lisp/dired-resources/insert-directory/test_dir/foo
diff --git a/test/lisp/files-resources/insert-directory/test_dir_other/bar
b/test/lisp/dired-resources/insert-directory/test_dir_other/bar
similarity index 100%
rename from test/lisp/files-resources/insert-directory/test_dir_other/bar
rename to test/lisp/dired-resources/insert-directory/test_dir_other/bar
diff --git a/test/lisp/files-resources/insert-directory/test_dir_other/foo
b/test/lisp/dired-resources/insert-directory/test_dir_other/foo
similarity index 100%
rename from test/lisp/files-resources/insert-directory/test_dir_other/foo
rename to test/lisp/dired-resources/insert-directory/test_dir_other/foo
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el
index ad1bca9..4379111 100644
--- a/test/lisp/dired-tests.el
+++ b/test/lisp/dired-tests.el
@@ -511,5 +511,79 @@
(when (file-directory-p testdir)
(delete-directory testdir t)))))
+;; `dired-insert-directory' output tests.
+(let* ((data-dir "insert-directory")
+ (test-dir (file-name-as-directory
+ (ert-resource-file
+ (concat data-dir "/test_dir"))))
+ (test-dir-other (file-name-as-directory
+ (ert-resource-file
+ (concat data-dir "/test_dir_other"))))
+ (test-files `(,test-dir "foo" "bar")) ;expected files to be found
+ ;; Free space test data for `insert-directory'.
+ ;; Meaning: (path free-space-bytes-to-stub expected-free-space-string)
+ (free-data `((,test-dir 10 "available 10 B")
+ (,test-dir-other 100 "available 100 B")
+ (:default 999 "available 999 B"))))
+
+ (defun files-tests--look-up-free-data (path)
+ "Look up free space test data, with a default for unspecified paths."
+ (let ((path (file-name-as-directory path)))
+ (cdr (or (assoc path free-data)
+ (assoc :default free-data)))))
+
+ (defun files-tests--make-file-system-info-stub (&optional static-path)
+ "Return a stub for `file-system-info' using dynamic or static test data.
+If that data should be static, pass STATIC-PATH to choose which
+path's data to use."
+ (lambda (path)
+ (let* ((path (cond (static-path)
+ ;; file-system-info knows how to handle ".", so we
+ ;; do the same thing
+ ((equal "." path) default-directory)
+ (path)))
+ (return-size
+ (car (files-tests--look-up-free-data path))))
+ (list return-size return-size return-size))))
+
+ (defun files-tests--insert-directory-output (dir &optional verbose)
+ "Run `insert-directory' and return its output."
+ (with-current-buffer-window "files-tests--insert-directory" nil nil
+ (let ((dired-free-space 'separate))
+ (dired-insert-directory dir "-l" nil nil t))
+ (buffer-substring-no-properties (point-min) (point-max))))
+
+ (ert-deftest files-tests-insert-directory-shows-files ()
+ "Verify `insert-directory' reports the files in the directory."
+ (let* ((test-dir (car test-files))
+ (files (cdr test-files))
+ (output (files-tests--insert-directory-output test-dir)))
+ (dolist (file files)
+ (should (string-match-p file output)))))
+
+ (defun files-tests--insert-directory-shows-given-free (dir &optional
+ info-func)
+ "Run `insert-directory' and verify it reports the correct available space.
+Stub `file-system-info' to ensure the available space is consistent,
+either with the given stub function or a default one using test data."
+ (cl-letf (((symbol-function 'file-system-info)
+ (or info-func
+ (files-tests--make-file-system-info-stub))))
+ (should (string-match-p (cadr
+ (files-tests--look-up-free-data dir))
+ (files-tests--insert-directory-output dir t)))))
+
+ (ert-deftest files-tests-insert-directory-shows-free ()
+ "Test that verbose `insert-directory' shows the correct available space."
+ (files-tests--insert-directory-shows-given-free
+ test-dir
+ (files-tests--make-file-system-info-stub test-dir)))
+
+ (ert-deftest files-tests-bug-50630 ()
+ "Verify verbose `insert-directory' shows free space of the target
directory.
+The current directory at call time should not affect the result (Bug#50630)."
+ (let ((default-directory test-dir-other))
+ (files-tests--insert-directory-shows-given-free test-dir))))
+
(provide 'dired-tests)
;;; dired-tests.el ends here
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index d3d58aa..4620488 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1822,79 +1822,5 @@ Prompt users for any modified buffer with
`buffer-offer-save' non-nil."
(should (equal (file-name-split "/foo/bar/") '("" "foo" "bar" "")))
(should (equal (file-name-split "foo/bar/") '("foo" "bar" ""))))
-;; `insert-directory' output tests.
-(let* ((data-dir "insert-directory")
- (test-dir (file-name-as-directory
- (ert-resource-file
- (concat data-dir "/test_dir"))))
- (test-dir-other (file-name-as-directory
- (ert-resource-file
- (concat data-dir "/test_dir_other"))))
- (test-files `(,test-dir "foo" "bar")) ;expected files to be found
- ;; Free space test data for `insert-directory'.
- ;; Meaning: (path free-space-bytes-to-stub expected-free-space-string)
- (free-data `((,test-dir 10 "available 10 B")
- (,test-dir-other 100 "available 100 B")
- (:default 999 "available 999 B"))))
-
-
- (defun files-tests--look-up-free-data (path)
- "Look up free space test data, with a default for unspecified paths."
- (let ((path (file-name-as-directory path)))
- (cdr (or (assoc path free-data)
- (assoc :default free-data)))))
-
- (defun files-tests--make-file-system-info-stub (&optional static-path)
- "Return a stub for `file-system-info' using dynamic or static test data.
-If that data should be static, pass STATIC-PATH to choose which
-path's data to use."
- (lambda (path)
- (let* ((path (cond (static-path)
- ;; file-system-info knows how to handle ".", so we
- ;; do the same thing
- ((equal "." path) default-directory)
- (path)))
- (return-size
- (car (files-tests--look-up-free-data path))))
- (list return-size return-size return-size))))
-
- (defun files-tests--insert-directory-output (dir &optional verbose)
- "Run `insert-directory' and return its output."
- (with-current-buffer-window "files-tests--insert-directory" nil nil
- (insert-directory dir "-l" nil t)
- (buffer-substring-no-properties (point-min) (point-max))))
-
- (ert-deftest files-tests-insert-directory-shows-files ()
- "Verify `insert-directory' reports the files in the directory."
- (let* ((test-dir (car test-files))
- (files (cdr test-files))
- (output (files-tests--insert-directory-output test-dir)))
- (dolist (file files)
- (should (string-match-p file output)))))
-
- (defun files-tests--insert-directory-shows-given-free (dir &optional
- info-func)
- "Run `insert-directory' and verify it reports the correct available space.
-Stub `file-system-info' to ensure the available space is consistent,
-either with the given stub function or a default one using test data."
- (cl-letf (((symbol-function 'file-system-info)
- (or info-func
- (files-tests--make-file-system-info-stub))))
- (should (string-match-p (cadr
- (files-tests--look-up-free-data dir))
- (files-tests--insert-directory-output dir t)))))
-
- (ert-deftest files-tests-insert-directory-shows-free ()
- "Test that verbose `insert-directory' shows the correct available space."
- (files-tests--insert-directory-shows-given-free
- test-dir
- (files-tests--make-file-system-info-stub test-dir)))
-
- (ert-deftest files-tests-bug-50630 ()
- "Verify verbose `insert-directory' shows free space of the target
directory.
-The current directory at call time should not affect the result (Bug#50630)."
- (let ((default-directory test-dir-other))
- (files-tests--insert-directory-shows-given-free test-dir))))
-
(provide 'files-tests)
;;; files-tests.el ends here