From 1914d946d62de4ab7bab1434bcea09087d61bb5a Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 1 Dec 2021 23:27:09 +0100 Subject: [PATCH] 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 " 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(-) rename test/lisp/{files-resources => dired-resources}/insert-directory/test_dir/bar (100%) rename test/lisp/{files-resources => dired-resources}/insert-directory/test_dir/foo (100%) rename test/lisp/{files-resources => dired-resources}/insert-directory/test_dir_other/bar (100%) rename test/lisp/{files-resources => dired-resources}/insert-directory/test_dir_other/foo (100%) diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 704850e584c..0edd8bc7da0 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 7a94052625b..f1f1512a672 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 9280c080a4c..c8add87a008 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 c96e79cc63d..07279c4c871 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 eea8089daa7..25d196392ab 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 ad1bca923d9..43791118f14 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 d3d58aad5f2..462048802f0 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 -- 2.39.2