]> git.eshelyaron.com Git - emacs.git/commitdiff
Hide default-directory absolute file name in dired-hide-details-mode
authorÁlvaro Ramírez <me@xenodium.com>
Wed, 2 Oct 2024 10:36:57 +0000 (11:36 +0100)
committerEshel Yaron <me@eshelyaron.com>
Tue, 22 Oct 2024 18:55:36 +0000 (20:55 +0200)
* lisp/dired.el (dired-hide-details-hide-absolute-location):
New user option.
(dired-insert-directory, dired-build-subdir-alist): Use it to
hide absolute file name of the directory.
(dired-hide-details-mode): Update doc string.
* test/lisp/dired-tests.el
(dired-test-hide-absolute-location-enabled)
(dired-test-hide-absolute-location-disabled): New tests

* etc/NEWS: Announce the new feature.

Bug#72272

(cherry picked from commit 7cbca90569472af5643905fca5b7ab2dea67f876)

etc/NEWS
lisp/dired.el
test/lisp/dired-tests.el

index ece62d563afd118b54c7fa34cf5c1c58be4771c5..6724994475aca8b8a2b46a5ae428a35165516c33 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -448,6 +448,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
 
 +++
index 62e968c62c577756b4a5ce786100b35fc2d6a355..8db1c0b5b72c516c7203a1af42b2c132a8f40e50 100644 (file)
@@ -379,6 +379,12 @@ new Dired buffers."
   :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
@@ -1809,12 +1815,25 @@ see `dired-use-ls-dired' for more details.")
          (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.
@@ -3251,8 +3270,9 @@ unchanged."
 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"))
@@ -3276,6 +3296,11 @@ See options: `dired-hide-details-hide-symlink-targets' and
               '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)))
@@ -3680,7 +3705,18 @@ instead of `dired-actual-switches'."
                                (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 \.
index 3b1f80d3d3dbc7c1b345ab1b4af3646291d79405..5a9ba14b402945b88f6f7bc955bfd18522c7e93b 100644 (file)
       (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