From 0ed4df0ae090a96bc40f19a15e4d62be58900d3b Mon Sep 17 00:00:00 2001 From: Álvaro Ramírez Date: Wed, 2 Oct 2024 11:36:57 +0100 Subject: [PATCH] Hide default-directory absolute location via dired-hide-details-mode --- etc/NEWS | 14 +++++++++++ lisp/dired.el | 54 +++++++++++++++++++++++++++++++++------- test/lisp/dired-tests.el | 46 ++++++++++++++++++++++++++++++++++ 3 files changed, 105 insertions(+), 9 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index daaae54d7d3..3ae46b45e7e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -490,6 +490,20 @@ fontifying them, which can be slow for remote directories. Setting 'dired-check-symlinks' to nil disables these checks. Defaults to t, can be set as a connection-local variable. +--- +*** New user option 'dired-hide-details-hide-absolute-location'. +When dired's 'dired-hide-details-mode' is enabled, also hide the +'default-directory' absolute location, typically displayed as the first +line in a dired buffer. + +With dired-hide-details-hide-absolute-location: + + project: (100 GiB available) + +Without dired-hide-details-hide-absolute-location: + + /absolute/path/to/my/important/project: (100 GiB available) + ** Grep +++ diff --git a/lisp/dired.el b/lisp/dired.el index 2bf5a221f4e..625de019d3b 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -387,6 +387,12 @@ dired-hide-details-hide-information-lines :version "24.4" :group 'dired) +(defcustom dired-hide-details-hide-absolute-location nil + "Non-nil means `dired-hide-details-mode' hides directory absolute location." + :type 'boolean + :version "31.1" + :group 'dired) + (defcustom dired-always-read-filesystem nil "Non-nil means revert buffers visiting files before searching them. By default, commands like `dired-mark-files-containing-regexp' will @@ -1816,12 +1822,25 @@ dired-insert-directory (when (and (or hdr wildcard) (not (and (looking-at "^ \\(.*\\):$") (file-name-absolute-p (match-string 1))))) - ;; Note that dired-build-subdir-alist will replace the name - ;; 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 dir-wildcard) - (directory-file-name (file-name-directory dir))) - ":\n") + (let* ((dir-indent " ") + (dir-name (or (car-safe dir-wildcard) + (directory-file-name + (file-name-directory dir)))) + (dir-name-point (+ (point) (length dir-indent))) + (hideable-location + (and dired-hide-details-hide-absolute-location + (not (string-empty-p (file-name-nondirectory + dir-name)))))) + ;; Inserted directory name must be absolute, but keep in + ;; mind it may be replaced in some instances like in + ;; `dired-build-subdir-alist'. + (insert dir-indent dir-name ":\n") + (when hideable-location + (put-text-property + dir-name-point + (+ dir-name-point + (length (file-name-directory dir-name))) + 'invisible 'dired-hide-details-absolute-location))) (setq content-point (point))) (when wildcard ;; Insert "wildcard" line where "total" line would be for a full dir. @@ -3257,8 +3276,9 @@ dired-hide-details-mode When this minor mode is enabled, details such as file ownership and permissions are hidden from view. -See options: `dired-hide-details-hide-symlink-targets' and -`dired-hide-details-hide-information-lines'." +See options: `dired-hide-details-hide-symlink-targets', +`dired-hide-details-hide-information-lines' and +`dired-hide-details-hide-absolute-location'." :group 'dired (unless (derived-mode-p '(dired-mode wdired-mode)) (error "Not a Dired buffer")) @@ -3282,6 +3302,11 @@ dired-hide-details-update-invisibility-spec 'add-to-invisibility-spec 'remove-from-invisibility-spec) 'dired-hide-details-information) + (funcall (if (and dired-hide-details-mode + dired-hide-details-hide-absolute-location) + #'add-to-invisibility-spec + #'remove-from-invisibility-spec) + 'dired-hide-details-absolute-location) (funcall (if (and dired-hide-details-mode dired-hide-details-hide-symlink-targets (not (derived-mode-p 'wdired-mode))) @@ -3688,7 +3713,18 @@ dired-build-subdir-alist (substring new-dir-name (match-end 0))) (expand-file-name new-dir-name)))) (delete-region (point) (match-end 1)) - (insert new-dir-name)) + (let ((new-dir-name-pos (point)) + (hideable-location + (and dired-hide-details-hide-absolute-location + (not (string-empty-p + (file-name-nondirectory new-dir-name)))))) + (insert new-dir-name) + (when hideable-location + (put-text-property + new-dir-name-pos + (+ new-dir-name-pos + (length (file-name-directory new-dir-name))) + 'invisible 'dired-hide-details-absolute-location)))) (setq count (1+ count)) ;; Undo any escaping of newlines and \ by dired-insert-directory. ;; Convert "n" preceded by odd number of \ to newline, and \\ to \. diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 3b1f80d3d3d..5a9ba14b402 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -524,6 +524,52 @@ dired-test-directory-files-and-attributes (when (file-directory-p testdir) (delete-directory testdir t))))) +(ert-deftest dired-test-hide-absolute-location-enabled () + "Test for https://debbugs.gnu.org/72272 ." + (let* ((dired-hide-details-hide-absolute-location t) + (dir-name (expand-file-name "lisp" source-directory)) + (buffer (prog1 (dired (list dir-name "dired.el" "play")) + (dired-insert-subdir (file-name-concat default-directory + "play"))))) + (unwind-protect + (progn + (goto-char (point-min)) + (re-search-forward dired-subdir-regexp) + (goto-char (match-beginning 1)) + (should (equal "lisp" (file-name-nondirectory + (directory-file-name (dired-get-subdir))))) + (should (equal 'dired-hide-details-absolute-location + (get-text-property (match-beginning 1) 'invisible))) + (re-search-forward dired-subdir-regexp) + (goto-char (match-beginning 1)) + (should (equal "play" (file-name-nondirectory + (directory-file-name (dired-get-subdir))))) + (should (equal 'dired-hide-details-absolute-location + (get-text-property (match-beginning 1) 'invisible)))) + (kill-buffer buffer)))) + +(ert-deftest dired-test-hide-absolute-location-disabled () + "Test for https://debbugs.gnu.org/72272 ." + (let* ((dired-hide-details-hide-absolute-location nil) + (dir-name (expand-file-name "lisp" source-directory)) + (buffer (prog1 (dired (list dir-name "dired.el" "play")) + (dired-insert-subdir (file-name-concat default-directory + "play"))))) + (unwind-protect + (progn + (goto-char (point-min)) + (re-search-forward dired-subdir-regexp) + (goto-char (match-beginning 1)) + (should (equal "lisp" (file-name-nondirectory + (directory-file-name (dired-get-subdir))))) + (should-not (get-text-property (match-beginning 1) 'invisible)) + (re-search-forward dired-subdir-regexp) + (goto-char (match-beginning 1)) + (should (equal "play" (file-name-nondirectory + (directory-file-name (dired-get-subdir))))) + (should-not (get-text-property (match-beginning 1) 'invisible))) + (kill-buffer buffer)))) + ;; `dired-insert-directory' output tests. (let* ((data-dir "insert-directory") (test-dir (file-name-as-directory -- 2.39.5 (Apple Git-154)